# HG changeset patch
# User David Scott <dave.scott@xxxxxxxxxxxxx>
# Date 1278583916 -3600
# Node ID e81508994446d06cd964e8f6bbadec1e78aed511
# Parent  a646309a4a055f7f3eadb6e0169c4d4c5cb08277
CA-40530: Unset the Task.stunnel_pid when the stunnel connections are closed. This prevents the killing of old pids in the event of (i) a task leak; and (ii) a host being declared offline.

Signed-off-by: David Scott <dave.scott@xxxxxxxxxxxxx>

diff -r a646309a4a05 -r e81508994446 ocaml/idl/ocaml_backend/xmlrpcclient.ml
--- a/ocaml/idl/ocaml_backend/xmlrpcclient.ml	Wed Apr 21 13:10:14 2010 +0100
+++ b/ocaml/idl/ocaml_backend/xmlrpcclient.ml	Thu Jul 08 11:11:56 2010 +0100
@@ -19,6 +19,7 @@
 open D
 
 let set_stunnelpid_callback : (string -> int -> unit) option ref = ref None
+let unset_stunnelpid_callback : (string -> int -> unit) option ref = ref None
 
 (* Headers for an HTTP CONNECT operation *)
 let connect_headers ?session_id ?task_id ?subtask_of host path = 
@@ -340,14 +341,23 @@
   let s = st_proc.Stunnel.fd in
   let s_pid = Stunnel.getpid st_proc.Stunnel.pid in
   info "stunnel pid: %d (cached = %b) connected to %s:%d" s_pid use_stunnel_cache host port;
-  begin
-    match task_id with
-        None -> debug "Did not write stunnel pid: no task passed to http_rpc fn"
-      | Some t ->
-          match !set_stunnelpid_callback with
-	      None -> warn "Did not write stunnel pid: no callback registered"
-	    | Some f -> f t s_pid
-  end;
+
+  (* Call the {,un}set_stunnelpid_callback hooks around the remote call *)
+  let with_recorded_stunnelpid task_opt s_pid f = 
+	begin
+	  match task_id, !set_stunnelpid_callback with
+	  | Some t, Some f -> f t s_pid
+	  | _, _ -> ()
+	end;
+	finally f
+		(fun () ->
+			 match task_id, !unset_stunnelpid_callback with
+			 | Some t, Some f -> f t s_pid
+			 | _, _ -> ()
+		) in
+
+  with_recorded_stunnelpid task_id s_pid
+	(fun () ->
   finally
     (fun () ->
       try
@@ -368,7 +378,7 @@
           Stunnel.disconnect st_proc
         end
     )
-      
+    )
 
 (** Take an optional content_length and task_id together with a socket
     and return the XMLRPC response as an XML document *)
diff -r a646309a4a05 -r e81508994446 ocaml/idl/ocaml_backend/xmlrpcclient.mli
--- a/ocaml/idl/ocaml_backend/xmlrpcclient.mli	Wed Apr 21 13:10:14 2010 +0100
+++ b/ocaml/idl/ocaml_backend/xmlrpcclient.mli	Thu Jul 08 11:11:56 2010 +0100
@@ -37,8 +37,14 @@
     the connection works fail. *)
 exception Stunnel_connection_failed
 
+(** When invoking an XMLRPC call over HTTPS via stunnel, this callback is called to allow
+	us to store the association between a task and an stunnel pid *)
 val set_stunnelpid_callback : (string -> int -> unit) option ref
 
+(** After invoking an XMLRPC call over HTTPS via stunnel, this callback is called to allow
+    us to forget the association between a task and an stunnel pid *)
+val unset_stunnelpid_callback : (string -> int -> unit) option ref
+
 val connect_headers : ?session_id:string -> ?task_id:string -> ?subtask_of:string -> string -> string -> string list
 val xmlrpc_headers : ?task_id:string -> ?subtask_of:string -> version:string -> string -> string -> int -> string list
 val http_rpc_fd : Unix.file_descr -> string list -> string -> int * string option
diff -r a646309a4a05 -r e81508994446 ocaml/xapi/xapi.ml
--- a/ocaml/xapi/xapi.ml	Wed Apr 21 13:10:14 2010 +0100
+++ b/ocaml/xapi/xapi.ml	Thu Jul 08 11:11:56 2010 +0100
@@ -204,9 +204,15 @@
       Db.Task.set_stunnelpid ~__context:Context.initial ~self:(Ref.of_string t) ~value:(Int64.of_int s_pid);
     with _ -> 
       debug "Did not write stunnel pid: no task record in db for this action"
-    in
+  in
+  let unset_stunnelpid t s_pid = 
+	try
+	  Db.Task.set_stunnelpid ~__context:Context.initial ~self:(Ref.of_string t) ~value:0L
+	with _ -> () in
+
     Helpers.rpc_fun := Some fake_rpc;
     Xmlrpcclient.set_stunnelpid_callback := Some set_stunnelpid;
+    Xmlrpcclient.unset_stunnelpid_callback := Some unset_stunnelpid;
     Pervasiveext.exnhook := Some (fun _ -> log_backtrace ());
     TaskHelper.init ()