# 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 ()
ocaml/idl/ocaml_backend/xmlrpcclient.ml | 28 +++++++++++++++++++---------
ocaml/idl/ocaml_backend/xmlrpcclient.mli | 6 ++++++
ocaml/xapi/xapi.ml | 8 +++++++-
3 files changed, 32 insertions(+), 10 deletions(-)
xen-api.hg.patch
Description: Text Data
_______________________________________________
xen-api mailing list
xen-api@xxxxxxxxxxxxxxxxxxx
http://lists.xensource.com/mailman/listinfo/xen-api
|