# HG changeset patch # User David Scott # 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 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;