Add some optional parameters to Stunnel.disconnect to cope with the stunnel zombie...

Signed-off-by: Zheng Li <dev@zheng.li>

diff --git a/stunnel/stunnel.ml b/stunnel/stunnel.ml
index 85c58a6ebec1d51ead7ce9fd9a9bfa78f5800469..86e48d441018dc76513593bf377f3ef7d857bda0 100644 (file)
--- a/stunnel/stunnel.ml
+++ b/stunnel/stunnel.ml
@@ -130,12 +130,29 @@ let config_file verify_cert extended_diagnosis host port =
 
 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 --git a/stunnel/stunnel.mli b/stunnel/stunnel.mli
index fa549193db16748c0d7867e38c3d5a2e713e2cc0..570fb6b6db419af8490fb1b78df6caba967f244a 100644 (file)
--- a/stunnel/stunnel.mli
+++ b/stunnel/stunnel.mli
@@ -53,7 +53,7 @@ val connect :
   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