1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
|
(***********************************************************************)
(* *)
(* JoCaml *)
(* *)
(* Luc Maranget, projet Moscova, INRIA Rocquencourt *)
(* *)
(* Copyright 2008 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the Q Public License version 1.0. *)
(* *)
(***********************************************************************)
(* $Id: joinProc.ml 11010 2011-04-13 09:30:59Z maranget $ *)
open Unix
let try_set_close_on_exec fd =
try set_close_on_exec fd; true with Invalid_argument _ -> false
let open_proc cmd args input output err toclose =
let cloexec = List.for_all try_set_close_on_exec toclose in
match fork () with
| 0 ->
(* Safer to use close on exec, (ocaml bug PR#2715) *)
if not cloexec then List.iter close toclose;
if input <> stdin then begin
dup2 input stdin; close input
end;
if output <> stdout then begin
dup2 output stdout; close output
end;
if err <> stderr then begin
dup2 err stderr; close err
end;
begin try Unix.execvp cmd args
with _ -> exit 127 end
| id -> id
let command cmd args =
open_proc cmd args stdin stdout stderr []
let open_in cmd args =
let in_read, in_write = pipe() in
let id = open_proc cmd args stdin in_write stderr [in_read] in
close in_write ;
let inchan = in_channel_of_descr in_read in
id, inchan
let open_out cmd args =
let out_read, out_write = pipe() in
let id = open_proc cmd args out_read stdout stderr [out_write] in
close out_read;
let outchan = out_channel_of_descr out_write in
id, outchan
let open_in_out cmd args =
let in_read, in_write = pipe() in
let out_read, out_write = pipe() in
let id =
open_proc cmd args out_read in_write stderr [in_read; out_write] in
close out_read;
close in_write;
let inchan = in_channel_of_descr in_read in
let outchan = out_channel_of_descr out_write in
id, (inchan, outchan)
let open_full cmd args =
let in_read, in_write = pipe() in
let out_read, out_write = pipe() in
let err_read, err_write = pipe() in
let id =
open_proc cmd args out_read in_write err_write
[in_read; out_write; err_read] in
(* Critical section in open_fork, from fork system call *)
close out_read;
close in_write;
close err_write;
(* End critical section *)
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
id, (inchan, outchan, errchan)
|
