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
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
|
open Eio.Std
let resolve_program name =
if Filename.is_implicit name then (
Sys.getenv_opt "PATH"
|> Option.value ~default:"/bin:/usr/bin"
|> String.split_on_char ':'
|> List.find_map (fun dir ->
let p = Filename.concat dir name in
if Sys.file_exists p then Some p else None
)
) else if Sys.file_exists name then (
Some name
) else None
let read_of_fd ~sw ~default ~to_close = function
| None -> default
| Some f ->
match Resource.fd_opt f with
| Some fd -> fd
| None ->
let r, w = Private.pipe sw in
Fiber.fork ~sw (fun () ->
Eio.Flow.copy f w;
Eio.Flow.close w
);
let r = Resource.fd r in
to_close := r :: !to_close;
r
let write_of_fd ~sw ~default ~to_close = function
| None -> default
| Some f ->
match Resource.fd_opt f with
| Some fd -> fd
| None ->
let r, w = Private.pipe sw in
Fiber.fork ~sw (fun () ->
Eio.Flow.copy r f;
Eio.Flow.close r
);
let w = Resource.fd w in
to_close := w :: !to_close;
w
let with_close_list fn =
let to_close = ref [] in
let close () =
List.iter Fd.close !to_close
in
match fn to_close with
| x -> close (); x
| exception ex ->
let bt = Printexc.get_raw_backtrace () in
close ();
Printexc.raise_with_backtrace ex bt
let get_executable ~args = function
| Some exe -> exe
| None ->
match args with
| [] -> invalid_arg "Arguments list is empty and no executable given!"
| (x :: _) ->
match resolve_program x with
| Some x -> x
| None -> raise (Eio.Process.err (Executable_not_found x))
let get_env = function
| Some e -> e
| None -> Unix.environment ()
type ty = [ `Generic | `Unix ] Eio.Process.ty
type 'a t = ([> ty] as 'a) r
type mgr_ty = [`Generic | `Unix] Eio.Process.mgr_ty
type 'a mgr = ([> mgr_ty] as 'a) r
module Pi = struct
module type MGR = sig
include Eio.Process.Pi.MGR
val spawn_unix :
t ->
sw:Switch.t ->
?cwd:Eio.Fs.dir_ty Eio.Path.t ->
env:string array ->
fds:(int * Fd.t * Fork_action.blocking) list ->
executable:string ->
string list ->
ty r
end
type (_, _, _) Eio.Resource.pi +=
| Mgr_unix : ('t, (module MGR with type t = 't), [> mgr_ty]) Eio.Resource.pi
let mgr_unix (type t tag) (module X : MGR with type t = t and type tag = tag) =
Eio.Resource.handler [
H (Eio.Process.Pi.Mgr, (module X));
H (Mgr_unix, (module X));
]
end
module Make_mgr (X : sig
type t
val spawn_unix :
t ->
sw:Switch.t ->
?cwd:Eio.Fs.dir_ty Eio.Path.t ->
env:string array ->
fds:(int * Fd.t * Fork_action.blocking) list ->
executable:string ->
string list ->
ty r
end) = struct
type t = X.t
type tag = [ `Generic | `Unix ]
let pipe _ ~sw =
(Private.pipe sw :> ([Eio.Resource.close_ty | Eio.Flow.source_ty] r *
[Eio.Resource.close_ty | Eio.Flow.sink_ty] r))
let spawn v ~sw ?cwd ?stdin ?stdout ?stderr ?env ?executable args =
let executable = get_executable executable ~args in
let env = get_env env in
with_close_list @@ fun to_close ->
let stdin_fd = read_of_fd ~sw stdin ~default:Fd.stdin ~to_close in
let stdout_fd = write_of_fd ~sw stdout ~default:Fd.stdout ~to_close in
let stderr_fd = write_of_fd ~sw stderr ~default:Fd.stderr ~to_close in
let fds = [
0, stdin_fd, `Blocking;
1, stdout_fd, `Blocking;
2, stderr_fd, `Blocking;
] in
X.spawn_unix v ~sw ?cwd ~env ~fds ~executable args
let spawn_unix = X.spawn_unix
end
let spawn_unix ~sw (Eio.Resource.T (v, ops)) ?cwd ~fds ?env ?executable args =
let module X = (val (Eio.Resource.get ops Pi.Mgr_unix)) in
let executable = get_executable executable ~args in
let env = get_env env in
X.spawn_unix v ~sw ?cwd ~fds ~env ~executable args
let sigchld = Eio.Condition.create ()
let install_sigchld_handler () =
Sys.(set_signal sigchld) (Signal_handle (fun (_:int) -> Eio.Condition.broadcast sigchld))
|
