diff options
| -rw-r--r-- | otherlibs/unix/unix.ml | 32 | ||||
| -rw-r--r-- | otherlibs/unix/unix.mli | 14 | ||||
| -rw-r--r-- | otherlibs/win32unix/unix.ml | 27 |
3 files changed, 65 insertions, 8 deletions
diff --git a/otherlibs/unix/unix.ml b/otherlibs/unix/unix.ml index 011ac5d3a..61a08de22 100644 --- a/otherlibs/unix/unix.ml +++ b/otherlibs/unix/unix.ml @@ -569,6 +569,7 @@ type popen_process = Process of in_channel * out_channel | Process_in of in_channel | Process_out of out_channel + | Process_full of in_channel * out_channel * in_channel let popen_processes = (Hashtbl.create 7 : (popen_process, int) Hashtbl.t) @@ -606,6 +607,30 @@ let open_process cmd = close in_write; (inchan, outchan) +let open_proc_full cmd env proc input output error toclose = + match fork() with + 0 -> dup2 input stdin; close input; + dup2 output stdout; close output; + dup2 error stderr; close error; + List.iter close toclose; + execve "/bin/sh" [| "/bin/sh"; "-c"; cmd |] env; + exit 127 + | id -> Hashtbl.add popen_processes proc id + +let open_process_full cmd env = + let (in_read, in_write) = pipe() in + let (out_read, out_write) = pipe() in + let (err_read, err_write) = pipe() in + let inchan = in_channel_of_descr in_read in + let outchan = out_channel_of_descr out_write in + let errchan = in_channel_of_descr err_read in + open_proc_full cmd env (Process_full(inchan, outchan, errchan)) + out_read in_write err_write [in_read; out_write; err_read]; + close out_read; + close in_write; + close err_write; + (inchan, outchan, errchan) + let find_proc_id fun_name proc = try let pid = Hashtbl.find popen_processes proc in @@ -629,6 +654,13 @@ let close_process (inchan, outchan) = close_in inchan; close_out outchan; snd(waitpid [] pid) +let close_process_full (inchan, outchan, errchan) = + let pid = + find_proc_id "close_process_full" + (Process_full(inchan, outchan, errchan)) in + close_in inchan; close_out outchan; close_in errchan; + snd(waitpid [] pid) + (* High-level network functions *) let open_connection sockaddr = diff --git a/otherlibs/unix/unix.mli b/otherlibs/unix/unix.mli index 5fac6cd99..8ede09552 100644 --- a/otherlibs/unix/unix.mli +++ b/otherlibs/unix/unix.mli @@ -439,12 +439,20 @@ val open_process: string -> in_channel * out_channel by the shell [/bin/sh] (cf. [system]). Warning: writes on channels are buffered, hence be careful to call [flush] at the right times to ensure correct synchronization. *) +val open_process_full: + string -> string array -> in_channel * out_channel * in_channel + (* Similar to [open_process], but the second argument specifies + the environment passed to the command. The result is a triple + of channels connected to the standard output, standard input, + and standard error of the command. *) val close_process_in: in_channel -> process_status val close_process_out: out_channel -> process_status val close_process: in_channel * out_channel -> process_status - (* Close channels opened by [open_process_in], [open_process_out] - and [open_process], respectively, wait for the associated - command to terminate, and return its termination status. *) +val close_process_full: in_channel * out_channel * in_channel -> process_status + (* Close channels opened by [open_process_in], [open_process_out], + [open_process] and [open_process_full], respectively, + wait for the associated command to terminate, + and return its termination status. *) (*** Symbolic links *) diff --git a/otherlibs/win32unix/unix.ml b/otherlibs/win32unix/unix.ml index c85fcafd2..2bec12571 100644 --- a/otherlibs/win32unix/unix.ml +++ b/otherlibs/win32unix/unix.ml @@ -573,22 +573,24 @@ type popen_process = Process of in_channel * out_channel | Process_in of in_channel | Process_out of out_channel + | Process_full of in_channel * out_channel * in_channel let popen_processes = (Hashtbl.create 7 : (popen_process, int) Hashtbl.t) -let open_proc cmd proc input output = +let open_proc cmd optenv proc input output error = let shell = try Sys.getenv "COMSPEC" with Not_found -> raise(Unix_error(ENOEXEC, "open_proc", cmd)) in let pid = - create_process shell [|shell; "/c"; cmd|] input output stderr in + win_create_process shell (shell ^ " /c " ^ cmd) optenv + input output error in Hashtbl.add popen_processes proc pid let open_process_in cmd = let (in_read, in_write) = pipe() in set_close_on_exec in_read; let inchan = in_channel_of_descr in_read in - open_proc cmd (Process_in inchan) stdin in_write; + open_proc cmd None (Process_in inchan) stdin in_write stderr; close in_write; inchan @@ -596,7 +598,7 @@ let open_process_out cmd = let (out_read, out_write) = pipe() in set_close_on_exec out_write; let outchan = out_channel_of_descr out_write in - open_proc cmd (Process_out outchan) out_read stdout; + open_proc cmd None (Process_out outchan) out_read stdout stderr; close out_read; outchan @@ -607,10 +609,25 @@ let open_process cmd = set_close_on_exec out_write; let inchan = in_channel_of_descr in_read in let outchan = out_channel_of_descr out_write in - open_proc cmd (Process(inchan, outchan)) out_read in_write; + open_proc cmd None (Process(inchan, outchan)) out_read in_write stderr; close out_read; close in_write; (inchan, outchan) +let open_process_full cmd env = + let (in_read, in_write) = pipe() in + let (out_read, out_write) = pipe() in + let (err_read, err_write) = pipe() in + set_close_on_exec in_read; + set_close_on_exec out_write; + set_close_on_exec err_read; + let inchan = in_channel_of_descr in_read in + let outchan = out_channel_of_descr out_write in + let errchan = in_channel_of_descr err_read in + open_proc cmd (Some env) (Process_full(inchan, outchan, errchan)) + out_read in_write err_write; + close out_read; close in_write; close err_write; + (inchan, outchan, errchan) + let find_proc_id fun_name proc = try let pid = Hashtbl.find popen_processes proc in |