WARNING - OLD ARCHIVES

This is an archived copy of the Xen.org mailing list, which we have preserved to ensure that existing links to archives are not broken. The live archive, which contains the latest emails, can be found at http://lists.xen.org/
   
 
 
Xen 
 
Home Products Support Community News
 
   
 

xen-api

[Xen-API] [PATCH 2 of 6] CA-33440: Move the unsafe direct fork_and_exec

To: xen-api@xxxxxxxxxxxxxxxxxxx
Subject: [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
From: David Scott <dave.scott@xxxxxxxxxxxxx>
Date: Mon, 21 Dec 2009 17:58:00 +0000
Delivery-date: Mon, 21 Dec 2009 09:55:14 -0800
Envelope-to: www-data@xxxxxxxxxxxxxxxxxxx
In-reply-to: <patchbomb.1261418278@xxxxxxxxxxxxxxxxxxxx>
List-help: <mailto:xen-api-request@lists.xensource.com?subject=help>
List-id: Discussion of API issues surrounding Xen <xen-api.lists.xensource.com>
List-post: <mailto:xen-api@lists.xensource.com>
List-subscribe: <http://lists.xensource.com/mailman/listinfo/xen-api>, <mailto:xen-api-request@lists.xensource.com?subject=subscribe>
List-unsubscribe: <http://lists.xensource.com/mailman/listinfo/xen-api>, <mailto:xen-api-request@lists.xensource.com?subject=unsubscribe>
Sender: xen-api-bounces@xxxxxxxxxxxxxxxxxxx
# 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