Signed-off-by: Zheng Li <[email protected]>

 stunnel/stunnel.ml  |  27 ++++++++++++++++++++++-----
 stunnel/stunnel.mli |   2 +-
 2 files changed, 23 insertions(+), 6 deletions(-)


diff -r 06f4d30cef5f -r 662381e03d34 stunnel/stunnel.ml
--- a/stunnel/stunnel.ml        Mon Apr 12 17:54:42 2010 +0100
+++ b/stunnel/stunnel.ml        Tue Apr 20 19:05:48 2010 +0100
@@ -130,12 +130,29 @@
 
 let ignore_exn f x = try f x with _ -> ()
 
-let disconnect x = 
+let rec disconnect ?(wait = true) ?(force = false) x = 
   List.iter (ignore_exn Unix.close) [ x.fd ];
-  match x.pid with
-  | FEFork pid -> ignore(Forkhelpers.waitpid pid)
-  | StdFork pid -> ignore(Unix.waitpid [] pid)
-  | Nopid -> ()
+  let waiter, pid = match x.pid with
+    | FEFork pid ->
+        (fun () -> 
+           (if wait then Forkhelpers.waitpid 
+            else Forkhelpers.waitpid_nohang) pid),
+        Forkhelpers.getpid pid
+    | StdFork pid -> 
+        (fun () -> 
+           (if wait then Unix.waitpid [] 
+            else Unix.waitpid [Unix.WNOHANG]) pid),
+        pid in
+  let res = 
+    try waiter ()
+    with Unix.Unix_error (Unix.ECHILD, _, _) -> pid, Unix.WEXITED 0 in
+  match res with
+  | 0, _ when force ->
+      (try Unix.kill pid Sys.sigkill 
+       with Unix.Unix_error (Unix.ESRCH, _, _) ->());
+      disconnect ~wait:wait ~force:force x
+  | _ -> ()
+
 
 (* With some probability, stunnel fails during its startup code before it reads
    the config data from us. Therefore we get a SIGPIPE writing the config data.
diff -r 06f4d30cef5f -r 662381e03d34 stunnel/stunnel.mli
--- a/stunnel/stunnel.mli       Mon Apr 12 17:54:42 2010 +0100
+++ b/stunnel/stunnel.mli       Tue Apr 20 19:05:48 2010 +0100
@@ -53,7 +53,7 @@
   string -> int -> t
 
 (** Disconnects from stunnel and cleans up *)
-val disconnect : t -> unit
+val disconnect : ?wait:bool -> ?force:bool -> t -> unit
 
 val diagnose_failure : t -> unit
 
# HG changeset patch
# User Zheng Li <[email protected]>
# Date 1271786748 -3600
# Node ID 662381e03d3485d3d600efcfffa95982acc52bf1
# Parent  06f4d30cef5f458c7b2cf8b47427424c9948db4f
Add some optional parameters to Stunnel.disconnect to cope with the stunnel zombie process issue and for future benefits.

Signed-off-by: Zheng Li <[email protected]>

diff -r 06f4d30cef5f -r 662381e03d34 stunnel/stunnel.ml
--- a/stunnel/stunnel.ml	Mon Apr 12 17:54:42 2010 +0100
+++ b/stunnel/stunnel.ml	Tue Apr 20 19:05:48 2010 +0100
@@ -130,12 +130,29 @@
 
 let ignore_exn f x = try f x with _ -> ()
 
-let disconnect x = 
+let rec disconnect ?(wait = true) ?(force = false) x = 
   List.iter (ignore_exn Unix.close) [ x.fd ];
-  match x.pid with
-  | FEFork pid -> ignore(Forkhelpers.waitpid pid)
-  | StdFork pid -> ignore(Unix.waitpid [] pid)
-  | Nopid -> ()
+  let waiter, pid = match x.pid with
+    | FEFork pid ->
+        (fun () -> 
+           (if wait then Forkhelpers.waitpid 
+            else Forkhelpers.waitpid_nohang) pid),
+        Forkhelpers.getpid pid
+    | StdFork pid -> 
+        (fun () -> 
+           (if wait then Unix.waitpid [] 
+            else Unix.waitpid [Unix.WNOHANG]) pid),
+        pid in
+  let res = 
+    try waiter ()
+    with Unix.Unix_error (Unix.ECHILD, _, _) -> pid, Unix.WEXITED 0 in
+  match res with
+  | 0, _ when force ->
+      (try Unix.kill pid Sys.sigkill 
+       with Unix.Unix_error (Unix.ESRCH, _, _) ->());
+      disconnect ~wait:wait ~force:force x
+  | _ -> ()
+
 
 (* With some probability, stunnel fails during its startup code before it reads
    the config data from us. Therefore we get a SIGPIPE writing the config data.
diff -r 06f4d30cef5f -r 662381e03d34 stunnel/stunnel.mli
--- a/stunnel/stunnel.mli	Mon Apr 12 17:54:42 2010 +0100
+++ b/stunnel/stunnel.mli	Tue Apr 20 19:05:48 2010 +0100
@@ -53,7 +53,7 @@
   string -> int -> t
 
 (** Disconnects from stunnel and cleans up *)
-val disconnect : t -> unit
+val disconnect : ?wait:bool -> ?force:bool -> t -> unit
 
 val diagnose_failure : t -> unit
 
_______________________________________________
xen-api mailing list
[email protected]
http://lists.xensource.com/mailman/listinfo/xen-api

Reply via email to