# HG changeset patch # User David Scott # Date 1261169770 0 # Node ID d0c22775c225d814fff66afbaf075ac52603e39a # Parent 5d6a3e43431f73d0af2bf28082960499819cd9b8 CA-33440: Slight modification to the fork/exec API to support fork/exec via an external daemon. We modify at least: * likewise/AD * database/stunnel handling * database redo log * gpg * xmlrpc client * pygrub * PV coredump handling * bugtool * blob handling * interface-reconfigure * patching * SM stuff * template scripts * udhcpd * vncsnapshots * qemu, vncterm, xenguest Signed-off-by: Jon Ludlam Acked-by: David Scott diff -r 5d6a3e43431f -r d0c22775c225 ocaml/auth/extauth_plugin_ADlikewise.ml --- a/ocaml/auth/extauth_plugin_ADlikewise.ml Thu Dec 17 14:08:46 2009 +0000 +++ b/ocaml/auth/extauth_plugin_ADlikewise.ml Fri Dec 18 20:56:10 2009 +0000 @@ -90,34 +90,11 @@ let err_writeme = Unix.openfile err_tmpfile [ Unix.O_WRONLY] 0o0 in fds_to_close := err_writeme :: !fds_to_close; - (*enforces that likewise cmd only inherits the fds explicitly cited below*) - let args = Forkhelpers.close_and_exec_cmdline - (* we use stdin,stdout and stderr instead of in_readme,out_writeme,err_writeme because *) - (* this function maps them internally: in_readme->unix.stdin, out_writeme->unix.stdout, err_writeme->unix.stderr *) - [Unix.stdin;Unix.stdout;Unix.stderr] - likewise_cmd - params_list - in - (* we bypass the shell here, calling create_process that forks and calls unix.execvp directly, *) - (* in order to avoid potential cmd injections that use shell vulnerabilities\escape sequences *) - let pid = - (try - Unix.create_process - (List.hd args) (*this is the likewise_cmd*) - (Array.append [|(List.hd args)|] (Array.of_list (List.tl args))) (* these are the parameters *) - in_readme (* pass along to likewise_cmd the read-only end point of our new stdin pipe *) - out_writeme (* pass along to likewise_cmd the write-only end point of our new stdout file *) - err_writeme (* pass along to likewise_cmd the write-only end point of our new stderr file *) - with - | e-> begin - let msg = (Printf.sprintf "Error creating process for cmd %s: %s" debug_cmd (ExnHelper.string_of_exn e)) in - debug "%s" msg; - raise (Auth_signature.Auth_service_error msg) (* general error *) - end) - in + let pid = Forkhelpers.safe_close_and_exec (Some in_readme) (Some out_writeme) (Some err_writeme) [] likewise_cmd params_list in + finally (fun () -> - debug "Created process pid %i for cmd %s" pid debug_cmd; + debug "Created process pid %s for cmd %s" (Forkhelpers.string_of_pidty pid) debug_cmd; (* Insert this delay to reproduce the cannot write to stdin bug: Thread.delay 5.; *) (* WARNING: we don't close the in_readme because otherwise in the case where the likewise @@ -143,7 +120,8 @@ end end; ) - (fun () -> Unix.waitpid [] pid); + (fun () -> Forkhelpers.waitpid pid); + (* <-- at this point the process has quit and left us its output in temporary files *) (* we parse the likewise cmd's STDOUT *) diff -r 5d6a3e43431f -r d0c22775c225 ocaml/database/master_connection.ml --- a/ocaml/database/master_connection.ml Thu Dec 17 14:08:46 2009 +0000 +++ b/ocaml/database/master_connection.ml Fri Dec 18 20:56:10 2009 +0000 @@ -38,7 +38,7 @@ match !my_connection with None -> () | Some st_proc -> - Unix.kill st_proc.Stunnel.pid Sys.sigterm + Unix.kill (Forkhelpers.getpid st_proc.Stunnel.pid) Sys.sigterm (* whenever a call is made that involves read/write to the master connection, a timestamp is written into this global: *) diff -r 5d6a3e43431f -r d0c22775c225 ocaml/database/redo_log.ml --- a/ocaml/database/redo_log.ml Thu Dec 17 14:08:46 2009 +0000 +++ b/ocaml/database/redo_log.ml Fri Dec 18 20:56:10 2009 +0000 @@ -187,7 +187,7 @@ (* Execute the process *) let args = ["-device"; block_dev; "-ctrlsock"; ctrlsockpath; "-datasock"; datasockpath] in let fds_needed = [ Unix.stdin; Unix.stdout; Unix.stderr ] in - Forkhelpers.fork_and_exec ~pre_exec:(fun _ -> Unixext.close_all_fds_except fds_needed) (prog::args) + Forkhelpers.safe_close_and_exec None None None [] prog args let connect sockpath latest_response_time = let s = Unix.socket Unix.PF_UNIX Unix.SOCK_STREAM 0 in @@ -426,7 +426,7 @@ let marker = Uuid.to_string (Uuid.make_uuid ()) let sock = ref None -let pid : (int * string * string) option ref = ref None (* pid, filename of control socket, filename of data socket *) +let pid : (Forkhelpers.pidty * string * string) option ref = ref None (* pid, filename of control socket, filename of data socket *) let dying_processes_mutex = Mutex.create () let num_dying_processes = ref 0 @@ -451,14 +451,15 @@ end; (* Terminate the child process *) - R.debug "Killing I/O process with pid %d" p; - Unix.kill p Sys.sigkill; + let ipid = Forkhelpers.getpid p in + R.debug "Killing I/O process with pid %d" ipid; + Unix.kill ipid Sys.sigkill; (* Wait for the process to die. This is done in a separate thread in case it does not respond to the signal immediately. *) ignore (Thread.create (fun () -> - R.debug "Waiting for I/O process with pid %d to die..." p; + R.debug "Waiting for I/O process with pid %d to die..." ipid; Mutex.execute dying_processes_mutex (fun () -> num_dying_processes := !num_dying_processes + 1); - ignore (Unix.waitpid [] p); - R.debug "Finished waiting for process %d" p; + ignore(Forkhelpers.waitpid p); + R.debug "Finished waiting for process %d" ipid; Mutex.execute dying_processes_mutex (fun () -> num_dying_processes := !num_dying_processes - 1) ) ()); (* Forget about that process *) @@ -515,7 +516,7 @@ let p = start_io_process block_dev ctrlsockpath datasockpath in pid := Some (p, ctrlsockpath, datasockpath); - R.debug "Block device I/O process has PID [%d]" p + R.debug "Block device I/O process has PID [%d]" (Forkhelpers.getpid p) end end end; diff -r 5d6a3e43431f -r d0c22775c225 ocaml/gpg/gpg.ml --- a/ocaml/gpg/gpg.ml Thu Dec 17 14:08:46 2009 +0000 +++ b/ocaml/gpg/gpg.ml Fri Dec 18 20:56:10 2009 +0000 @@ -58,6 +58,7 @@ Unix.unlink tmp_file; (* no need to close the 'tmp_oc' -> closing the fd is enough *) let status_out, status_in = Unix.pipe() in + let status_in_uuid = Uuid.to_string (Uuid.make_uuid ()) in (* from the parent's PoV *) let fds_to_close = ref [ result_out; result_in; status_out; status_in ] in let close' fd = @@ -70,7 +71,7 @@ "--homedir"; gpg_homedir; "--no-default-keyring"; "--keyring"; gpg_pub_keyring; - "--status-fd"; string_of_int (Unixext.int_of_file_descr status_in); + "--status-fd"; status_in_uuid; "--decrypt"; filename ] | `detached_signature -> @@ -79,7 +80,7 @@ "--homedir"; gpg_homedir; "--no-default-keyring"; "--keyring"; gpg_pub_keyring; - "--status-fd"; string_of_int (Unixext.int_of_file_descr status_in); + "--status-fd"; status_in_uuid; "--verify"; signature ] in @@ -97,12 +98,7 @@ (* Capture stderr output for logging *) match Forkhelpers.with_logfile_fd "gpg" (fun log_fd -> - let pid = Forkhelpers.safe_close_and_exec - [ Forkhelpers.Dup2(result_in, Unix.stdout); - Forkhelpers.Dup2(log_fd, Unix.stderr); - Forkhelpers.Close(result_out); - Forkhelpers.Close(status_out) ] - [ Unix.stdout; Unix.stderr; status_in ] (* close all but these *) + let pid = Forkhelpers.safe_close_and_exec None (Some result_in) (Some log_fd) [(status_in_uuid,status_in)] gpg_path gpg_args in (* parent *) List.iter close' [ result_in; status_in ]; @@ -111,7 +107,7 @@ let gpg_status = Unixext.read_whole_file 500 500 status_out in let fingerprint = parse_gpg_status gpg_status in f fingerprint result_out) - (fun () -> Forkhelpers.waitpid pid)) with + (fun () -> Forkhelpers.waitpid_fail_if_bad_exit pid)) with | Forkhelpers.Success(_, x) -> debug "gpg subprocess succeeded"; x | Forkhelpers.Failure(log, Forkhelpers.Subprocess_failed 2) -> (* Happens when gpg cannot find a readable signature *) diff -r 5d6a3e43431f -r d0c22775c225 ocaml/idl/ocaml_backend/xmlrpcclient.ml --- a/ocaml/idl/ocaml_backend/xmlrpcclient.ml Thu Dec 17 14:08:46 2009 +0000 +++ b/ocaml/idl/ocaml_backend/xmlrpcclient.ml Fri Dec 18 20:56:10 2009 +0000 @@ -331,34 +331,34 @@ let unique_id = get_new_stunnel_id () in Stunnel.connect ~use_external_fd_wrapper ~write_to_log ~unique_id ~verify_cert ~extended_diagnosis:true host port in let s = st_proc.Stunnel.fd in - let s_pid = st_proc.Stunnel.pid in - begin - match task_id with - None -> debug "Did not write stunnel pid: no task passed to http_rpc fn" - | Some t -> - match !set_stunnelpid_callback with - None -> warn "Did not write stunnel pid: no callback registered" - | Some f -> f t s_pid - end; - finally + let s_pid = Forkhelpers.getpid st_proc.Stunnel.pid in + begin + match task_id with + None -> debug "Did not write stunnel pid: no task passed to http_rpc fn" + | Some t -> + match !set_stunnelpid_callback with + None -> warn "Did not write stunnel pid: no callback registered" + | Some f -> f t s_pid + end; + finally (fun () -> - try - let content_length, task_id = http_rpc_fd s headers body in - f content_length task_id s - with - | Connection_reset -> - if not use_stunnel_cache then - Stunnel.diagnose_failure st_proc; - raise Connection_reset) + try + let content_length, task_id = http_rpc_fd s headers body in + f content_length task_id s + with + | Connection_reset -> + if not use_stunnel_cache then + Stunnel.diagnose_failure st_proc; + raise Connection_reset) (fun () -> - if use_stunnel_cache - then - Stunnel_cache.add st_proc - else - begin - Unix.unlink st_proc.Stunnel.logfile; - Stunnel.disconnect st_proc - end + if use_stunnel_cache + then + Stunnel_cache.add st_proc + else + begin + Unix.unlink st_proc.Stunnel.logfile; + Stunnel.disconnect st_proc + end ) diff -r 5d6a3e43431f -r d0c22775c225 ocaml/perftest/instrumented_xmlrpcclient.ml --- a/ocaml/perftest/instrumented_xmlrpcclient.ml Thu Dec 17 14:08:46 2009 +0000 +++ b/ocaml/perftest/instrumented_xmlrpcclient.ml Fri Dec 18 20:56:10 2009 +0000 @@ -327,7 +327,7 @@ let unique_id = get_new_stunnel_id () in Stunnel.connect ~use_external_fd_wrapper ~write_to_log ~unique_id host port in let s = st_proc.Stunnel.fd in - let s_pid = st_proc.Stunnel.pid in + let s_pid = Forkhelpers.getpid st_proc.Stunnel.pid in begin match task_id with None -> debug "Did not write stunnel pid: no task passed to http_rpc fn" diff -r 5d6a3e43431f -r d0c22775c225 ocaml/xapi/bootloader.ml --- a/ocaml/xapi/bootloader.ml Thu Dec 17 14:08:46 2009 +0000 +++ b/ocaml/xapi/bootloader.ml Fri Dec 18 20:56:10 2009 +0000 @@ -89,11 +89,7 @@ (* Capture stderr output for logging *) match with_logfile_fd "bootloader" (fun log_fd -> - let pid = safe_close_and_exec - [ Dup2(result_in, Unix.stdout); - Dup2(log_fd, Unix.stderr) ] - [ Unix.stdout; Unix.stderr ] (* close all but these *) - bootloader_path cmdline in + let pid = safe_close_and_exec None (Some result_in) (Some log_fd) [] bootloader_path cmdline in (* parent *) List.iter close' [ result_in ]; finally (* always waitpid eventually *) diff -r 5d6a3e43431f -r d0c22775c225 ocaml/xapi/events.ml --- a/ocaml/xapi/events.ml Thu Dec 17 14:08:46 2009 +0000 +++ b/ocaml/xapi/events.ml Fri Dec 18 20:56:10 2009 +0000 @@ -49,8 +49,8 @@ let path = "/opt/xensource/libexec/dumpcore" in let args = [ "-domid"; string_of_int domid; "-file"; filename ] in - let pid = Forkhelpers.safe_close_and_exec [] [] path args in - match snd (Unix.waitpid [] pid) with + let pid = Forkhelpers.safe_close_and_exec None None None [] path args in + match snd (Forkhelpers.waitpid pid) with | Unix.WEXITED 0 -> () | Unix.WEXITED n -> raise (Failed (sprintf "exit code %d" n)); | Unix.WSIGNALED i -> raise (Failed (sprintf "signal %d" i)); diff -r 5d6a3e43431f -r d0c22775c225 ocaml/xapi/helper_process.ml --- a/ocaml/xapi/helper_process.ml Thu Dec 17 14:08:46 2009 +0000 +++ b/ocaml/xapi/helper_process.ml Fri Dec 18 20:56:10 2009 +0000 @@ -15,5 +15,15 @@ (* a reasonable error. For now, just return the error code! *) let generic_handler cmd n = raise (Api_errors.Server_error (Api_errors.internal_error, [string_of_int n])) - -let get_process_output ?(handler=generic_handler) cmd = Unixext.get_process_output ~handler cmd + +exception Process_output_error of string +let get_process_output ?(handler=generic_handler) cmd = + let args = Stringext.String.split ' ' cmd in + try + fst (Forkhelpers.execute_command_get_output (List.hd args) (List.tl args)) + with + | Forkhelpers.Spawn_internal_error(err,out,Unix.WEXITED n) -> + handler cmd n + | _ -> + raise (Process_output_error cmd) + diff -r 5d6a3e43431f -r d0c22775c225 ocaml/xapi/system_status.ml --- a/ocaml/xapi/system_status.ml Thu Dec 17 14:08:46 2009 +0000 +++ b/ocaml/xapi/system_status.ml Fri Dec 18 20:56:10 2009 +0000 @@ -32,56 +32,47 @@ (* This fn outputs xen-bugtool straight to the socket, only for tar output. It should work on embedded edition *) let send_via_fd __context s entries output = - (* Make a copy of the socket fd as it closes when we exec *) - let cp_of_s = Unix.dup s in - finally - (fun () -> - let output_fd = Unixext.int_of_file_descr cp_of_s in - let params = - [sprintf "--entries=%s" entries; - "--silent"; - "--yestoall"; - sprintf "--output=%s" output; - sprintf "--outfd=%i" output_fd] - in - let cmd = - sprintf "%s %s" xen_bugtool (String.concat " " params) - in - debug "running %s" cmd; - try - let headers = - Http.http_200_ok ~keep_alive:false ~version:"1.0" () @ - [ "Server: "^Xapi_globs.xapi_user_agent; - "Content-Type: " ^ content_type; - "Content-Disposition: attachment; filename=\"system_status.tgz\""] - in - Http_svr.headers s headers; - - let result = with_logfile_fd "get-system-status" - (fun log_fd -> - let pid = - safe_close_and_exec - [ Close(Unix.stdin); - Dup2(log_fd, Unix.stdout); - Dup2(log_fd, Unix.stderr); ] - [ Unix.stdout; Unix.stderr; cp_of_s ] - xen_bugtool params - in - waitpid pid - ) - in - match result with - | Success _ -> debug "xen-bugtool exited successfully" - - | Failure (log, exn) -> - debug "xen-bugtool failed with output: %s" log; - raise exn - with e -> - let msg = "xen-bugtool failed: " ^ (Printexc.to_string e) in - error "%s" msg; - raise (Api_errors.Server_error (Api_errors.system_status_retrieval_failed, [msg])) + let s_uuid = Uuid.to_string (Uuid.make_uuid ()) in + + let params = + [sprintf "--entries=%s" entries; + "--silent"; + "--yestoall"; + sprintf "--output=%s" output; + "--outfd="^s_uuid] + in + let cmd = + sprintf "%s %s" xen_bugtool (String.concat " " params) + in + debug "running %s" cmd; + try + let headers = + Http.http_200_ok ~keep_alive:false ~version:"1.0" () @ + [ "Server: "^Xapi_globs.xapi_user_agent; + "Content-Type: " ^ content_type; + "Content-Disposition: attachment; filename=\"system_status.tgz\""] + in + Http_svr.headers s headers; + + let result = with_logfile_fd "get-system-status" + (fun log_fd -> + let pid = + safe_close_and_exec None (Some log_fd) (Some log_fd) [(s_uuid,s)] xen_bugtool params + in + waitpid_fail_if_bad_exit pid ) - (fun () -> Unix.close cp_of_s) + in + match result with + | Success _ -> debug "xen-bugtool exited successfully" + + | Failure (log, exn) -> + debug "xen-bugtool failed with output: %s" log; + raise exn + with e -> + let msg = "xen-bugtool failed: " ^ (Printexc.to_string e) in + error "%s" msg; + raise (Api_errors.Server_error (Api_errors.system_status_retrieval_failed, [msg])) + (* This fn outputs xen-bugtool into a file and then write the file out to the socket, to deal with zipped bugtool outputs diff -r 5d6a3e43431f -r d0c22775c225 ocaml/xapi/xapi_host.ml --- a/ocaml/xapi/xapi_host.ml Thu Dec 17 14:08:46 2009 +0000 +++ b/ocaml/xapi/xapi_host.ml Fri Dec 18 20:56:10 2009 +0000 @@ -924,7 +924,7 @@ Db.Host.remove_from_other_config ~__context ~self:host ~key:Xapi_globs.host_no_local_storage let disable_binary_storage ~__context ~host = - ignore(Unixext.get_process_output (Printf.sprintf "/bin/rm -rf %s" Xapi_globs.xapi_blob_location)); + ignore(Helpers.get_process_output (Printf.sprintf "/bin/rm -rf %s" Xapi_globs.xapi_blob_location)); Db.Host.remove_from_other_config ~__context ~self:host ~key:Xapi_globs.host_no_local_storage; Db.Host.add_to_other_config ~__context ~self:host ~key:Xapi_globs.host_no_local_storage ~value:"true" diff -r 5d6a3e43431f -r d0c22775c225 ocaml/xapi/xapi_host_backup.ml --- a/ocaml/xapi/xapi_host_backup.ml Thu Dec 17 14:08:46 2009 +0000 +++ b/ocaml/xapi/xapi_host_backup.ml Fri Dec 18 20:56:10 2009 +0000 @@ -30,13 +30,10 @@ match (with_logfile_fd "host-backup" (fun log_fd -> - let pid = safe_close_and_exec - [ Dup2(s, Unix.stdout); - Dup2(log_fd, Unix.stderr) ] - [ Unix.stdout; Unix.stderr ] host_backup [] in - - let waitpid () = - match Unix.waitpid [Unix.WNOHANG] pid with + let pid = safe_close_and_exec None (Some s) (Some log_fd) [] host_backup [] in + + let waitpid () = + match Forkhelpers.waitpid_nohang pid with | 0, _ -> false | _, Unix.WEXITED 0 -> true | _, Unix.WEXITED n -> raise (Subprocess_failed n) @@ -108,12 +105,7 @@ (* XXX: ideally need to log this stuff *) let result = with_logfile_fd "host-restore-log" (fun log_fd -> - let pid = safe_close_and_exec - [ Dup2(out_pipe, Unix.stdin); - Dup2(log_fd, Unix.stdout); - Dup2(log_fd, Unix.stderr) ] - [ Unix.stdin; Unix.stdout; Unix.stderr ] - host_restore [] in + let pid = safe_close_and_exec (Some out_pipe) (Some log_fd) (Some log_fd) [] host_restore [] in close out_pipe; diff -r 5d6a3e43431f -r d0c22775c225 ocaml/xapi/xapi_logs_download.ml --- a/ocaml/xapi/xapi_logs_download.ml Thu Dec 17 14:08:46 2009 +0000 +++ b/ocaml/xapi/xapi_logs_download.ml Fri Dec 18 20:56:10 2009 +0000 @@ -28,6 +28,5 @@ debug "send the http headers"; let fd = string_of_int (Unixext.int_of_file_descr Unix.stdout) in - let pid = safe_close_and_exec [ Dup2(s, Unix.stdout) ] - [ Unix.stdout ] logs_download [] in - waitpid pid) + let pid = safe_close_and_exec None (Some s) None [] logs_download [] in + waitpid_fail_if_bad_exit pid) diff -r 5d6a3e43431f -r d0c22775c225 ocaml/xapi/xapi_network_real.ml --- a/ocaml/xapi/xapi_network_real.ml Thu Dec 17 14:08:46 2009 +0000 +++ b/ocaml/xapi/xapi_network_real.ml Fri Dec 18 20:56:10 2009 +0000 @@ -59,12 +59,8 @@ begin match with_logfile_fd "ifconfig" (fun out -> - let pid = safe_close_and_exec - [ Dup2(out, Unix.stdout); - Dup2(out, Unix.stderr)] - [ Unix.stdout; Unix.stderr ] (* close all but these *) - "/sbin/ifconfig" [bridge;ip;"up"] in - Unix.waitpid [] pid) + let pid = safe_close_and_exec None (Some out) (Some out) [] "/sbin/ifconfig" [bridge;ip;"up"] in + waitpid pid) with | Success(log,_) -> () | Failure(log,_) -> error "ifconfig failure: %s" log @@ -72,12 +68,8 @@ begin match with_logfile_fd "fix_firewall" (fun out -> - let pid = safe_close_and_exec - [ Dup2(out, Unix.stdout); - Dup2(out, Unix.stderr)] - [ Unix.stdout; Unix.stderr ] (* close all but these *) - "/bin/bash" [Constants.fix_firewall_script;bridge;"start"] in - Unix.waitpid [] pid) + let pid = safe_close_and_exec None (Some out) (Some out) [] "/bin/bash" [Constants.fix_firewall_script;bridge;"start"] in + waitpid pid) with | Success(log,_) -> () | Failure(log,_) -> error "ifconfig failure: %s" log @@ -98,12 +90,8 @@ begin match with_logfile_fd "fix_firewall" (fun out -> - let pid = safe_close_and_exec - [ Dup2(out, Unix.stdout); - Dup2(out, Unix.stderr)] - [ Unix.stdout; Unix.stderr ] (* close all but these *) - "/bin/bash " [Constants.fix_firewall_script;bridge] in - Unix.waitpid [] pid) + let pid = safe_close_and_exec None (Some out) (Some out) [] "/bin/bash " [Constants.fix_firewall_script;bridge] in + waitpid pid) with | Success(log,_) -> () | Failure(log,_) -> error "ifconfig failure: %s" log diff -r 5d6a3e43431f -r d0c22775c225 ocaml/xapi/xapi_pool_patch.ml --- a/ocaml/xapi/xapi_pool_patch.ml Thu Dec 17 14:08:46 2009 +0000 +++ b/ocaml/xapi/xapi_pool_patch.ml Fri Dec 18 20:56:10 2009 +0000 @@ -98,11 +98,8 @@ (fun () -> with_logfile_fd "patch" (fun log_fd -> - let pid = safe_close_and_exec [ Dup2(log_fd, Unix.stdout); - Dup2(log_fd, Unix.stderr); - Close(Unix.stdin) ] - [ Unix.stdout; Unix.stderr ] run_path args in - waitpid pid) + let pid = safe_close_and_exec None (Some log_fd) (Some log_fd) [] run_path args in + waitpid_fail_if_bad_exit pid) ) (fun () -> Unixext.unlink_safe run_path) @@ -265,11 +262,8 @@ let output = with_logfile_fd "sync" (fun log_fd -> - let pid = safe_close_and_exec [ Dup2(log_fd, Unix.stdout); - Dup2(log_fd, Unix.stderr); - Close(Unix.stdin) ] - [ Unix.stdout; Unix.stderr ] bin_sync [] in - waitpid pid) + let pid = safe_close_and_exec None (Some log_fd) (Some log_fd) [] bin_sync [] in + waitpid_fail_if_bad_exit pid) in match output with | Failure(log, exn) -> diff -r 5d6a3e43431f -r d0c22775c225 ocaml/xapi/xapi_remotecmd.ml --- a/ocaml/xapi/xapi_remotecmd.ml Thu Dec 17 14:08:46 2009 +0000 +++ b/ocaml/xapi/xapi_remotecmd.ml Fri Dec 18 20:56:10 2009 +0000 @@ -24,17 +24,12 @@ let do_cmd s cmd args = let cmdline = String.concat " " (cmd :: args) in - let pid = ref 0 in + let pid = ref Forkhelpers.nopid in match with_logfile_fd "execute_command_get_output" (fun log_fd -> (* Capture stderr output for logging *) - pid := safe_close_and_exec - [ Dup2(s, Unix.stdout); - Dup2(s, Unix.stdin); - Dup2(log_fd, Unix.stderr);] - [ Unix.stdout; Unix.stdin; Unix.stderr ] (* close all but these *) - cmd args; - snd(Unix.waitpid [] !pid)) with + pid := safe_close_and_exec (Some s) (Some s) (Some log_fd) [] cmd args; + snd(waitpid !pid)) with | Success(log, status) -> debug "log: %s" log; begin match status with diff -r 5d6a3e43431f -r d0c22775c225 ocaml/xapi/xapi_sr.ml --- a/ocaml/xapi/xapi_sr.ml Thu Dec 17 14:08:46 2009 +0000 +++ b/ocaml/xapi/xapi_sr.ml Fri Dec 18 20:56:10 2009 +0000 @@ -254,6 +254,15 @@ Client.PBD.destroy ~rpc ~session_id ~self:pbd) pbds) +let probe ~__context ~host ~device_config ~_type ~sm_config = + debug "SR.probe sm_config=[ %s ]" (String.concat "; " (List.map (fun (k, v) -> k ^ " = " ^ v) sm_config)); + + let _type = String.lowercase _type in + if not(List.mem _type (Sm.supported_drivers ())) + then raise (Api_errors.Server_error(Api_errors.sr_unknown_driver, [ _type ])); + let subtask_of = Some (Context.get_task_id __context) in + Sm.sr_probe (subtask_of, Sm.sm_master true :: device_config) _type sm_config + (* Create actually makes the SR on disk, and introduces it into db, and creates PDB record for current host *) let create ~__context ~host ~device_config ~(physical_size:int64) ~name_label ~name_description ~_type ~content_type ~shared ~sm_config = @@ -261,6 +270,21 @@ let _type = String.lowercase _type in if not(List.mem _type (Sm.supported_drivers ())) then raise (Api_errors.Server_error(Api_errors.sr_unknown_driver, [ _type ])); + + let probe_result = probe ~__context ~host ~device_config ~_type ~sm_config in + begin + match Xml.parse_string probe_result with + | Xml.Element("SRlist", _, children) -> () + | _ -> + (* Figure out what was missing, then throw the appropriate error *) + match String.lowercase _type with + | "lvmoiscsi" -> + if not (List.exists (fun (s,_) -> "targetiqn" = String.lowercase s) device_config) + then raise (Api_errors.Server_error ("SR_BACKEND_FAILURE_96",["";"";probe_result])) + else if not (List.exists (fun (s,_) -> "scsiid" = String.lowercase s) device_config) + then raise (Api_errors.Server_error ("SR_BACKEND_FAILURE_107",["";"";probe_result])) + | _ -> () + end; let sr_uuid = Uuid.make_uuid() in let sr_uuid_str = Uuid.to_string sr_uuid in @@ -392,15 +416,6 @@ Db.SR.set_shared ~__context ~self:sr ~value end -let probe ~__context ~host ~device_config ~_type ~sm_config = - debug "SR.probe sm_config=[ %s ]" (String.concat "; " (List.map (fun (k, v) -> k ^ " = " ^ v) sm_config)); - - let _type = String.lowercase _type in - if not(List.mem _type (Sm.supported_drivers ())) - then raise (Api_errors.Server_error(Api_errors.sr_unknown_driver, [ _type ])); - let subtask_of = Some (Context.get_task_id __context) in - Sm.sr_probe (subtask_of, Sm.sm_master true :: device_config) _type sm_config - let set_virtual_allocation ~__context ~self ~value = Db.SR.set_virtual_allocation ~__context ~self ~value diff -r 5d6a3e43431f -r d0c22775c225 ocaml/xapi/xapi_support.ml --- a/ocaml/xapi/xapi_support.ml Thu Dec 17 14:08:46 2009 +0000 +++ b/ocaml/xapi/xapi_support.ml Fri Dec 18 20:56:10 2009 +0000 @@ -33,11 +33,7 @@ match with_logfile_fd label (fun log_fd -> - let pid = safe_close_and_exec - [ Close(Unix.stdin); - Dup2(log_fd, Unix.stdout); - Dup2(log_fd,Unix.stderr) ] - [ Unix.stdin; Unix.stdout; Unix.stderr ] upload_wrapper [file; url; proxy] in + let pid = safe_close_and_exec None (Some log_fd) (Some log_fd) [] upload_wrapper [file; url; proxy] in waitpid pid) with | Success _ -> debug "Upload succeeded" | Failure (log, exn) -> diff -r 5d6a3e43431f -r d0c22775c225 ocaml/xapi/xapi_templates_install.ml --- a/ocaml/xapi/xapi_templates_install.ml Thu Dec 17 14:08:46 2009 +0000 +++ b/ocaml/xapi/xapi_templates_install.ml Fri Dec 18 20:56:10 2009 +0000 @@ -66,24 +66,20 @@ match with_logfile_fd "install-log" (fun log -> - let pid = safe_close_and_exec ~env:(Array.of_list env) - [ Dup2(log, Unix.stdout); - Dup2(log, Unix.stderr) ] - [ Unix.stdout; Unix.stderr ] - script [] in + let pid = safe_close_and_exec ~env:(Array.of_list env) None (Some log) (Some log) [] script [] in let starttime = Unix.time () in let rec update_progress () = (* Check for cancelling *) if TaskHelper.is_cancelling ~__context then begin - Unix.kill pid Sys.sigterm; - let _ = Unix.waitpid [] pid in + Unix.kill (Forkhelpers.getpid pid) Sys.sigterm; + let _ = Forkhelpers.waitpid pid in raise (Api_errors.Server_error (Api_errors.task_cancelled, [])) end; - let (newpid,status) = Unix.waitpid [Unix.WNOHANG] pid in - if newpid = pid + let (newpid,status) = Forkhelpers.waitpid_nohang pid in + if newpid <> 0 then (match status with | Unix.WEXITED 0 -> (newpid,status) diff -r 5d6a3e43431f -r d0c22775c225 ocaml/xapi/xapi_udhcpd.ml --- a/ocaml/xapi/xapi_udhcpd.ml Thu Dec 17 14:08:46 2009 +0000 +++ b/ocaml/xapi/xapi_udhcpd.ml Fri Dec 18 20:56:10 2009 +0000 @@ -75,12 +75,8 @@ kill_if_running (); match with_logfile_fd "udhcpd" (fun out -> - let pid = safe_close_and_exec - [ Dup2(out, Unix.stdout); - Dup2(out, Unix.stderr)] - [ Unix.stdout; Unix.stderr ] (* close all but these *) - command ["/var/xapi/udhcpd.conf"] in - ignore(Unix.waitpid [] pid)) + let pid = safe_close_and_exec None (Some out) (Some out) [] command ["/var/xapi/udhcpd.conf"] in + ignore(waitpid pid)) with | Success(log,_) -> debug "success! %s" log | Failure(log,_) -> debug "failure! %s" log diff -r 5d6a3e43431f -r d0c22775c225 ocaml/xapi/xapi_vbd_helpers.ml --- a/ocaml/xapi/xapi_vbd_helpers.ml Thu Dec 17 14:08:46 2009 +0000 +++ b/ocaml/xapi/xapi_vbd_helpers.ml Fri Dec 18 20:56:10 2009 +0000 @@ -136,8 +136,8 @@ if not vdi_record.Db_actions.vDI_managed then set_errors Api_errors.vdi_not_managed [ _ref ] all_ops; - let operations_not_allowed_when_vdi_is_busy = - List.exists (fun x -> List.mem x current_ops) [ `attach; `plug; `insert ] in + let operations_not_allowed_when_vdi_is_busy = + List.exists (fun x -> List.mem x current_ops) [ `attach; `plug; `insert ] in if operations_not_allowed_when_vdi_is_busy && vdi_record.Db_actions.vDI_current_operations <> [] then begin debug "VBD operation %s not allowed because VDI.current-operations = [ %s ]" diff -r 5d6a3e43431f -r d0c22775c225 ocaml/xapi/xapi_vncsnapshot.ml --- a/ocaml/xapi/xapi_vncsnapshot.ml Thu Dec 17 14:08:46 2009 +0000 +++ b/ocaml/xapi/xapi_vncsnapshot.ml Fri Dec 18 20:56:10 2009 +0000 @@ -34,10 +34,10 @@ (fun () -> let vnc_port = Int64.to_int (Db.Console.get_port ~__context ~self:console) in - let pid = safe_close_and_exec [ ] [ ] - vncsnapshot [ "-quiet"; "-encodings"; "\"raw\""; - Printf.sprintf "%s:%d" "127.0.0.1" (vnc_port-5900); tmp ] in - waitpid pid; + let pid = safe_close_and_exec None None None [] vncsnapshot + [ "-quiet"; "-encodings"; "\"raw\""; + Printf.sprintf "%s:%d" "127.0.0.1" (vnc_port-5900); tmp ] in + waitpid_fail_if_bad_exit pid; Http_svr.response_file ~mime_content_type:None s tmp ) (fun () -> try Unix.unlink tmp with _ -> ()) diff -r 5d6a3e43431f -r d0c22775c225 ocaml/xenops/device.ml --- a/ocaml/xenops/device.ml Thu Dec 17 14:08:46 2009 +0000 +++ b/ocaml/xenops/device.ml Fri Dec 18 20:56:10 2009 +0000 @@ -903,15 +903,9 @@ "-x"; sprintf "/local/domain/%d/serial/0" domid; ] @ load_args statefile in (* Now add the close fds wrapper *) - let cmdline = Forkhelpers.close_and_exec_cmdline [] vncterm_wrapper l in - debug "Executing [ %s ]" (String.concat " " cmdline); - - let argv_0 = List.hd cmdline and argv = Array.of_list cmdline in - Unixext.double_fork (fun () -> - Sys.set_signal Sys.sigint Sys.Signal_ignore; - - Unix.execvp argv_0 argv - ); + let pid = Forkhelpers.safe_close_and_exec None None None [] vncterm_wrapper l in + Forkhelpers.dontwaitpid pid; + (* Block waiting for it to write the VNC port into the store *) try let port = Watch.wait_for ~xs (Watch.value_to_appear (path domid)) in @@ -1489,15 +1483,9 @@ @ (List.fold_left (fun l (k, v) -> ("-" ^ k) :: (match v with None -> l | Some v -> v :: l)) [] info.extras) in (* Now add the close fds wrapper *) - let cmdline = Forkhelpers.close_and_exec_cmdline [] dmpath l in - debug "qemu-dm: executing commandline: %s" (String.concat " " cmdline); + let pid = Forkhelpers.safe_close_and_exec None None None [] dmpath l in + Forkhelpers.dontwaitpid pid; - let argv_0 = List.hd cmdline and argv = Array.of_list cmdline in - Unixext.double_fork (fun () -> - Sys.set_signal Sys.sigint Sys.Signal_ignore; - - Unix.execvp argv_0 argv - ); debug "qemu-dm: should be running in the background (stdout and stderr redirected to %s)" log; (* We know qemu is ready (and the domain may be unpaused) when diff -r 5d6a3e43431f -r d0c22775c225 ocaml/xenops/domain.ml --- a/ocaml/xenops/domain.ml Thu Dec 17 14:08:46 2009 +0000 +++ b/ocaml/xenops/domain.ml Fri Dec 18 20:56:10 2009 +0000 @@ -581,15 +581,17 @@ raise Restore_signature_mismatch; Unix.clear_close_on_exec fd; + let fd_uuid = Uuid.to_string (Uuid.make_uuid ()) in + let cnx = XenguestHelper.connect ([ "-mode"; if hvm then "hvm_restore" else "restore"; "-domid"; string_of_int domid; - "-fd"; string_of_int (Obj.magic fd); + "-fd"; fd_uuid; "-store_port"; string_of_int store_port; "-console_port"; string_of_int console_port; "-fork"; "true"; - ] @ extras) [ fd ] in + ] @ extras) [ fd_uuid, fd ] in let line = finally (fun () -> XenguestHelper.receive_success cnx) @@ -703,6 +705,7 @@ let suspend ~xc ~xs ~hvm domid fd flags ?(progress_callback = fun _ -> ()) do_suspend_callback = debug "Domain.suspend domid=%d" domid; Io.write fd save_signature; + let fd_uuid = Uuid.to_string (Uuid.make_uuid ()) in let cmdline_to_flag flag = match flag with @@ -712,13 +715,13 @@ let flags' = List.map cmdline_to_flag flags in let xenguestargs = [ - "-fd"; string_of_int (Obj.magic fd); + "-fd"; fd_uuid; "-mode"; if hvm then "hvm_save" else "save"; "-domid"; string_of_int domid; "-fork"; "true"; ] @ (List.concat flags') in - let cnx = XenguestHelper.connect xenguestargs [ fd ] in + let cnx = XenguestHelper.connect xenguestargs [ fd_uuid, fd ] in finally (fun () -> debug "Blocking for suspend notification from xenguest"; diff -r 5d6a3e43431f -r d0c22775c225 ocaml/xenops/xenguestHelper.ml --- a/ocaml/xenops/xenguestHelper.ml Thu Dec 17 14:08:46 2009 +0000 +++ b/ocaml/xenops/xenguestHelper.ml Fri Dec 18 20:56:10 2009 +0000 @@ -32,11 +32,11 @@ (** We do all our IO through the buffered channels but pass the underlying fds as integers to the forked helper on the commandline. *) -type t = in_channel * out_channel * Unix.file_descr * Unix.file_descr * int +type t = in_channel * out_channel * Unix.file_descr * Unix.file_descr * Forkhelpers.pidty (** Fork and run a xenguest helper with particular args, leaving 'fds' open (in addition to internal control I/O fds) *) -let connect (args: string list) (fds: Unix.file_descr list) : t = +let connect (args: string list) (fds: (string * Unix.file_descr) list) : t = debug "connect: args = [ %s ]" (String.concat " " args); (* Need to send commands and receive responses from the slave process *) @@ -46,19 +46,22 @@ let last_log_file = "/tmp/xenguest.log" in (try Unix.unlink last_log_file with _ -> ()); + let slave_to_server_w_uuid = Uuid.to_string (Uuid.make_uuid ()) in + let server_to_slave_r_uuid = Uuid.to_string (Uuid.make_uuid ()) in + let slave_to_server_r, slave_to_server_w = Unix.pipe () in let server_to_slave_r, server_to_slave_w = Unix.pipe () in - let args = [ "-controloutfd"; - string_of_int (Obj.magic slave_to_server_w); - "-controlinfd"; - string_of_int (Obj.magic server_to_slave_r); + + let args = [ "-controloutfd"; slave_to_server_w_uuid; + "-controlinfd"; server_to_slave_r_uuid; "-debuglog"; last_log_file - ] @ (if using_xiu then [ "-fake" ] else []) @ args in - let pid = Forkhelpers.safe_close_and_exec [] - (fds @ [ Unix.stdout; Unix.stderr; slave_to_server_w; server_to_slave_r ]) (* close all but these *) - path args in - + ] @ (if using_xiu then [ "-fake" ] else []) @ args in + let pid = Forkhelpers.safe_close_and_exec None None None + ([ slave_to_server_w_uuid, slave_to_server_w; + server_to_slave_r_uuid, server_to_slave_r ] @ fds) + path args in + Unix.close slave_to_server_w; Unix.close server_to_slave_r; @@ -73,8 +76,8 @@ Unix.close r; Unix.close w; (* just in case *) - Unix.kill pid Sys.sigterm; - ignore(Unix.waitpid [] pid) + (try Unix.kill (Forkhelpers.getpid pid) Sys.sigterm with _ -> ()); + ignore(Forkhelpers.waitpid pid) (** immediately write a command to the control channel *) let send (_, out, _, _, _) txt = output_string out txt; flush out