[Xen-API] [PATCH 2 of 6] CA-33440: Move the unsafe direct fork_and_exec code from forkhelpers into stunnel, since it's only stunnel (called from the CLI) which actually needs it

[David Scott <dave.scott@xxxxxxxxxxxxx>]

# HG changeset patch
# User David Scott <dave.scott@xxxxxxxxxxxxx>
# Date 1261409809 0
# Node ID 6d735f8541855ebf3ab2b438e5c569d362e9d2de
# Parent  2729bb9dfe53eaa563c243d907593b9e8503114b
CA-33440: Move the unsafe direct fork_and_exec code from forkhelpers into 
stunnel, since it's only stunnel (called from the CLI) which actually needs it.

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

diff -r 2729bb9dfe53 -r 6d735f854185 stdext/forkhelpers.ml
--- a/stdext/forkhelpers.ml     Mon Dec 21 15:36:48 2009 +0000
+++ b/stdext/forkhelpers.ml     Mon Dec 21 15:36:49 2009 +0000
@@ -37,36 +37,6 @@
     | Nopid -> "Nopid"
 
 let nopid = Nopid
-
-(* Low-level (unsafe) function which forks, runs a 'pre_exec' function and
-   then executes some other binary. It makes sure to catch any exception 
thrown by
-   exec* so that we don't end up with two ocaml processes. *)
-let fork_and_exec ?(pre_exec=fun () -> ()) ?env (cmdline: string list) = 
-  let args = Array.of_list cmdline in
-  let argv0 = List.hd cmdline in
-  let pid = Unix.fork () in
-  if pid = 0 then begin
-      try
-       pre_exec ();
-       (* CA-18955: xapi now runs with priority -3. We then set his sons 
priority to 0. *) 
-       ignore_int (Unix.nice (-(Unix.nice 0)));
-       ignore_int (Unix.setsid ());
-       match env with
-       | None -> Unix.execv argv0 args
-       | Some env -> Unix.execve argv0 args env
-      with _ -> exit 1
-  end else Stdfork pid
-
-(** File descriptor operations to be performed after a fork.
-    These are all safe in the presence of threads *)
-type fd_operation = 
-    | Dup2 of Unix.file_descr * Unix.file_descr
-    | Close of Unix.file_descr
-
-let do_fd_operation = function
-  | Dup2(a, b) -> Unix.dup2 a b
-  | Close a -> Unix.close a
-
 
 exception Subprocess_failed of int
 exception Subprocess_killed of int
diff -r 2729bb9dfe53 -r 6d735f854185 stdext/forkhelpers.mli
--- a/stdext/forkhelpers.mli    Mon Dec 21 15:36:48 2009 +0000
+++ b/stdext/forkhelpers.mli    Mon Dec 21 15:36:49 2009 +0000
@@ -32,19 +32,6 @@
 
 val nopid : pidty
 
-(** File descriptor operations to be performed after a fork.
-    These are all safe in the presence of threads *)
-type fd_operation =
-    Dup2 of Unix.file_descr * Unix.file_descr
-  | Close of Unix.file_descr
-
-val do_fd_operation : fd_operation -> unit
-
-(** Low-level (unsafe) function which forks, runs a 'pre_exec' function and
-   then executes some other binary. It makes sure to catch any exception 
thrown by
-   exec* so that we don't end up with two ocaml processes. *)
-val fork_and_exec : ?pre_exec:(unit -> unit) -> ?env:string array -> string 
list -> pidty
-
 (** Safe function which forks a command, closing all fds except a whitelist and
     having performed some fd operations in the child *)
 val safe_close_and_exec : ?env:string array -> Unix.file_descr option -> 
Unix.file_descr option -> Unix.file_descr option -> (string * Unix.file_descr) 
list -> string -> string list -> pidty
diff -r 2729bb9dfe53 -r 6d735f854185 stunnel/stunnel.ml
--- a/stunnel/stunnel.ml        Mon Dec 21 15:36:48 2009 +0000
+++ b/stunnel/stunnel.ml        Mon Dec 21 15:36:49 2009 +0000
@@ -56,8 +56,56 @@
     | Some p -> p 
     | None -> raise Stunnel_binary_missing
 
+module Unsafe = struct
+  (** These functions are not safe in a multithreaded program *)
 
-type t = { mutable pid: Forkhelpers.pidty; fd: Unix.file_descr; host: string; 
port: int; 
+  (* Low-level (unsafe) function which forks, runs a 'pre_exec' function and
+        then executes some other binary. It makes sure to catch any exception 
thrown by
+        exec* so that we don't end up with two ocaml processes. *)
+  let fork_and_exec ?(pre_exec=fun () -> ()) ?env (cmdline: string list) = 
+       let args = Array.of_list cmdline in
+       let argv0 = List.hd cmdline in
+       let pid = Unix.fork () in
+       if pid = 0 then begin
+      try
+               pre_exec ();
+                 (* CA-18955: xapi now runs with priority -3. We then set his 
sons priority to 0. *) 
+                 ignore_int (Unix.nice (-(Unix.nice 0)));
+                 ignore_int (Unix.setsid ());
+                 match env with
+                 | None -> Unix.execv argv0 args
+                 | Some env -> Unix.execve argv0 args env
+      with _ -> exit 1
+       end else pid
+         
+  (** File descriptor operations to be performed after a fork.
+      These are all safe in the presence of threads *)
+  type fd_operation = 
+    | Dup2 of Unix.file_descr * Unix.file_descr
+    | Close of Unix.file_descr
+                 
+  let do_fd_operation = function
+       | Dup2(a, b) -> Unix.dup2 a b
+       | Close a -> Unix.close a
+end
+
+type pid = 
+  | StdFork of int (** we forked and exec'ed. This is the pid *)
+  | FEFork of Forkhelpers.pidty (** the forkhelpers module did it for us. *)
+  | Nopid
+
+let string_of_pid = function
+  | StdFork x -> Printf.sprintf "(StdFork %d)" x
+  | FEFork x -> Forkhelpers.string_of_pidty x
+  | Nopid -> "None"
+
+let getpid ty =
+  match ty with
+    | StdFork pid -> pid
+    | FEFork pid -> Forkhelpers.getpid pid
+    | Nopid -> failwith "No pid!"
+
+type t = { mutable pid: pid; fd: Unix.file_descr; host: string; port: int; 
           connected_time: float;
           unique_id: int option;
           mutable logfile: string;
@@ -82,7 +130,10 @@
 
 let disconnect x = 
   List.iter (ignore_exn Unix.close) [ x.fd ];
-  ignore_exn Forkhelpers.waitpid_fail_if_bad_exit x.pid
+  match x.pid with
+  | FEFork pid -> ignore(Forkhelpers.waitpid pid)
+  | StdFork pid -> ignore(Unix.waitpid [] pid)
+  | Nopid -> ()
 
 (* 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.
@@ -95,25 +146,26 @@
   assert (not extended_diagnosis); (* !!! Unimplemented *)
   let data_out,data_in = Unix.socketpair Unix.PF_UNIX Unix.SOCK_STREAM 0 in
   let args = [ "-m"; "client"; "-s"; "-"; "-d"; Printf.sprintf "%s:%d" host 
port ] in
-  let t = { pid = Forkhelpers.nopid; fd = data_out; host = host; port = port; 
+  let t = { pid = Nopid; fd = data_out; host = host; port = port; 
            connected_time = Unix.gettimeofday (); unique_id = unique_id;
            logfile = "" } in
   let to_close = ref [ data_in ] in
   let result = Forkhelpers.with_logfile_fd "stunnel" (fun logfd ->
     let fdops = [
-      Forkhelpers.Dup2(data_in, Unix.stdin);
-      Forkhelpers.Dup2(data_in, Unix.stdout);
-      Forkhelpers.Dup2(logfd, Unix.stderr)
+      Unsafe.Dup2(data_in, Unix.stdin);
+      Unsafe.Dup2(data_in, Unix.stdout);
+      Unsafe.Dup2(logfd, Unix.stderr)
     ] in
     let fds_needed = [ Unix.stdin; Unix.stdout; Unix.stderr ] in
     t.pid <- (
       if use_external_fd_wrapper then
-        Forkhelpers.safe_close_and_exec (Some data_in) (Some data_in) (Some 
logfd) [] (stunnel_path ()) args
+        FEFork (Forkhelpers.safe_close_and_exec (Some data_in) (Some data_in) 
(Some logfd) [] (stunnel_path ()) args)
       else
-       Forkhelpers.fork_and_exec ~pre_exec:(fun _ -> 
-          List.iter Forkhelpers.do_fd_operation fdops;
+               StdFork(Unsafe.fork_and_exec ~pre_exec:(fun _ -> 
+          List.iter Unsafe.do_fd_operation fdops;
           Unixext.close_all_fds_except fds_needed
-       ) ((stunnel_path ()) :: args)
+               
+               ) ((stunnel_path ()) :: args))
     );
     List.iter Unix.close [ data_in ];
   ) in
@@ -138,7 +190,7 @@
   let close fd = 
     if List.mem fd !to_close 
     then (Unix.close fd; to_close := List.filter (fun x -> x <> fd) !to_close) 
in
-  let t = { pid = Forkhelpers.nopid; fd = data_out; host = host; port = port; 
+  let t = { pid = Nopid; fd = data_out; host = host; port = port; 
            connected_time = Unix.gettimeofday (); unique_id = unique_id;
            logfile = "" } in
   let result = Forkhelpers.with_logfile_fd "stunnel"
@@ -146,9 +198,9 @@
     (fun logfd ->
        let path = stunnel_path() in
        let fdops = 
-        [ Forkhelpers.Dup2(data_in, Unix.stdin);
-          Forkhelpers.Dup2(data_in, Unix.stdout);
-          Forkhelpers.Dup2(logfd, Unix.stderr) ] in
+        [ Unsafe.Dup2(data_in, Unix.stdin);
+          Unsafe.Dup2(data_in, Unix.stdout);
+          Unsafe.Dup2(logfd, Unix.stderr) ] in
        let fds_needed = [ Unix.stdin; Unix.stdout; Unix.stderr; config_out ] in
        let args_external = [ "-fd"; config_out_uuid ] in
           let args_internal = [ "-fd"; string_of_int 
(Unixext.int_of_file_descr config_out) ] in
@@ -158,18 +210,18 @@
        end;
        t.pid <-
         if use_external_fd_wrapper
-        then Forkhelpers.safe_close_and_exec (Some data_in) (Some data_in) 
(Some logfd) [(config_out_uuid, config_out)] path args_external
-        else Forkhelpers.fork_and_exec ~pre_exec:
+        then FEFork(Forkhelpers.safe_close_and_exec (Some data_in) (Some 
data_in) (Some logfd) [(config_out_uuid, config_out)] path args_external)
+        else StdFork(Unsafe.fork_and_exec ~pre_exec:
                          (fun _ -> 
-                           List.iter Forkhelpers.do_fd_operation fdops;
+                           List.iter Unsafe.do_fd_operation fdops;
                            Unixext.close_all_fds_except fds_needed) 
-                         (path::args_internal);
+                         (path::args_internal));
        List.iter close [ data_in; config_out; ]; 
        (* Make sure we close config_in eventually *)
        finally
         (fun () ->
 
-           let pidmsg = Printf.sprintf "stunnel has pidty: %s\n" 
(Forkhelpers.string_of_pidty t.pid) in
+           let pidmsg = Printf.sprintf "stunnel has pidty: %s\n" 
(string_of_pid t.pid) in
            write_to_log pidmsg;
 
            let config = config_file verify_cert extended_diagnosis host port in
diff -r 2729bb9dfe53 -r 6d735f854185 stunnel/stunnel.mli
--- a/stunnel/stunnel.mli       Mon Dec 21 15:36:48 2009 +0000
+++ b/stunnel/stunnel.mli       Mon Dec 21 15:36:49 2009 +0000
@@ -22,8 +22,15 @@
 val use_new_stunnel : bool ref
 val init_stunnel_path : unit -> unit
 
+type pid = 
+  | StdFork of int (** we forked and exec'ed. This is the pid *)
+  | FEFork of Forkhelpers.pidty (** the forkhelpers module did it for us. *)
+  | Nopid
+
+val getpid: pid -> int
+
 (** Represents an active stunnel connection *)
-type t = { mutable pid: Forkhelpers.pidty; 
+type t = { mutable pid: pid; 
           fd: Unix.file_descr; 
           host: string; 
           port: int;
4 files changed, 79 insertions(+), 63 deletions(-)
stdext/forkhelpers.ml  |   30 ----------------
stdext/forkhelpers.mli |   13 ------
stunnel/stunnel.ml     |   90 +++++++++++++++++++++++++++++++++++++-----------
stunnel/stunnel.mli    |    9 ++++

Attachment: xen-api-libs.hg-6.patch
Description: Text Data

_______________________________________________
xen-api mailing list
xen-api@xxxxxxxxxxxxxxxxxxx
http://lists.xensource.com/mailman/listinfo/xen-api