From 6932d23152b932190b38c434d63b374f432488cc Mon Sep 17 00:00:00 2001
From: Xavier Leroy <xavier.leroy@inria.fr>
Date: Mon, 18 Oct 1999 09:43:24 +0000
Subject: Ajout de open_process_full
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@2441 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
---
otherlibs/unix/unix.ml | 32 ++++++++++++++++++++++++++++++++
otherlibs/unix/unix.mli | 14 +++++++++++---
2 files changed, 43 insertions(+), 3 deletions(-)
(limited to 'otherlibs/unix')
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 *)
--
cgit v1.2.3-70-g09d2