Shells in OCaml
More async support
Allow process to be made without a switch.
+184
-34
+1
src/bin/main.ml
+1
src/bin/main.ml
+26
-16
src/lib/eval.ml
+26
-16
src/lib/eval.ml
···
37
37
options : Built_ins.Options.t;
38
38
stdout : Eio_unix.sink_ty Eio.Flow.sink option;
39
39
background_jobs : J.t list;
40
+
last_background_process : string;
40
41
async_switch : Eio.Switch.t;
41
42
}
42
43
···
89
90
| [] -> []
90
91
| Ast.WordVariable v :: rest -> (
91
92
match v with
93
+
| Ast.VariableAtom ("!", NoAttribute) ->
94
+
Ast.WordName ctx.last_background_process :: expand rest
92
95
| Ast.VariableAtom (s, NoAttribute) -> (
93
96
match S.lookup ctx.state ~param:s with
94
97
| None -> Ast.WordName "" :: expand rest
···
206
209
|> List.append extra
207
210
208
211
let rec handle_pipeline ~async initial_ctx pipeline_switch p : ctx Exit.t =
209
-
let pipeline_switch =
210
-
if async then initial_ctx.async_switch else pipeline_switch
212
+
let mode = if async then Types.Async else Types.Switched pipeline_switch in
213
+
let set_last_background ~async process ctx =
214
+
if async then
215
+
{ ctx with last_background_process = string_of_int (E.pid process) }
216
+
else ctx
217
+
in
218
+
let on_process ~async process ctx =
219
+
clear_local_state ctx |> set_last_background ~async process
211
220
in
212
221
let handle_job ~pgid j p =
213
222
match (j, p) with
···
254
263
in
255
264
let ctx, job =
256
265
let process =
257
-
E.exec ctx.executor ?stdout:some_write ~pgid
258
-
~sw:pipeline_switch ~cwd:(cwd_of_ctx ctx)
266
+
E.exec ctx.executor ?stdout:some_write ~pgid ~mode
267
+
~cwd:(cwd_of_ctx ctx)
259
268
~env:(get_env ~extra:ctx.local_state ())
260
269
[ executable ]
261
270
in
262
271
let job = handle_job ~pgid job (`Process process) in
263
-
(clear_local_state ctx, job)
272
+
(on_process ~async process ctx, job)
264
273
in
265
274
Option.iter Eio.Flow.close some_write;
266
275
loop ctx job (pgid, some_read) rest
···
270
279
in
271
280
let ctx, job =
272
281
let process =
273
-
E.exec ctx.executor ~stdin:stdout ~pgid
274
-
~sw:pipeline_switch ?stdout:some_write
282
+
E.exec ctx.executor ~stdin:stdout ~pgid ~mode
283
+
?stdout:some_write
275
284
~env:(get_env ~extra:ctx.local_state ())
276
285
~cwd:(cwd_of_ctx ctx) [ executable ]
277
286
in
278
287
let job = handle_job ~pgid job (`Process process) in
279
-
(clear_local_state ctx, job)
288
+
(on_process ~async process ctx, job)
280
289
in
281
290
Option.iter Eio.Flow.close some_write;
282
291
loop ctx job (pgid, some_read) rest))
···
316
325
in
317
326
let ctx, job =
318
327
let process =
319
-
E.exec ctx.executor ?stdout:some_write ~pgid
320
-
~sw:pipeline_switch ~fds:redirect ~cwd:(cwd_of_ctx ctx)
328
+
E.exec ctx.executor ?stdout:some_write ~pgid ~mode
329
+
~fds:redirect ~cwd:(cwd_of_ctx ctx)
321
330
~env:(get_env ~extra:ctx.local_state ())
322
331
(executable :: args)
323
332
in
324
333
let job = handle_job ~pgid job (`Process process) in
325
-
(clear_local_state ctx, job)
334
+
(on_process ~async process ctx, job)
326
335
in
327
336
Option.iter Eio.Flow.close some_write;
328
337
loop ctx job (pgid, some_read) rest
···
332
341
in
333
342
let ctx, job =
334
343
let process =
335
-
E.exec ctx.executor ~stdin:stdout ~pgid
336
-
~sw:pipeline_switch ?stdout:some_write ~fds:redirect
344
+
E.exec ctx.executor ~stdin:stdout ~pgid ~mode
345
+
?stdout:some_write ~fds:redirect
337
346
~env:(get_env ~extra:ctx.local_state ())
338
347
~cwd:(cwd_of_ctx ctx) (executable :: args)
339
348
in
340
349
let job = handle_job ~pgid job (`Process process) in
341
-
(clear_local_state ctx, job)
350
+
(on_process ~async process ctx, job)
342
351
in
343
352
Option.iter Eio.Flow.close some_write;
344
353
loop ctx job (pgid, some_read) rest))
···
360
369
let ctx, job =
361
370
Eio.Switch.run @@ fun ghost_switch ->
362
371
let ghost_process =
363
-
E.exec ~sw:ghost_switch ~pgid:0 ~cwd:(cwd_of_ctx initial_ctx)
364
-
initial_ctx.executor [ "sleep"; "99999999" ]
372
+
E.exec ~mode:(Types.Switched ghost_switch) ~pgid:0
373
+
~cwd:(cwd_of_ctx initial_ctx) initial_ctx.executor
374
+
[ "sleep"; "99999999" ]
365
375
in
366
376
loop initial_ctx None (E.pid ghost_process, None) p
367
377
in
+144
-15
src/lib/posix/exec.ml
+144
-15
src/lib/posix/exec.ml
···
1
+
(* Much of this code is from Eio_posix.
2
+
3
+
Copyright (C) 2021 Anil Madhavapeddy Copyright (C) 2022 Thomas Leonard
4
+
5
+
Permission to use, copy, modify, and distribute this software for any purpose
6
+
with or without fee is hereby granted, provided that the above copyright notice
7
+
and this permission notice appear in all copies.
8
+
9
+
THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH
10
+
REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
11
+
FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT,
12
+
INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM
13
+
LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
14
+
OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
15
+
PERFORMANCE OF THIS SOFTWARE. *)
16
+
1
17
open Eio.Std
2
18
19
+
module Process = struct
20
+
type t = {
21
+
pid : int;
22
+
exit_status : Unix.process_status Promise.t;
23
+
lock : Mutex.t;
24
+
}
25
+
(* When [lock] is unlocked, [exit_status] is resolved iff the process has been reaped. *)
26
+
27
+
let exit_status t = t.exit_status
28
+
let pid t = t.pid
29
+
30
+
module Fork_action = Eio_unix.Private.Fork_action
31
+
32
+
(* Read a (typically short) error message from a child process. *)
33
+
let rec read_response fd =
34
+
let buf = Bytes.create 256 in
35
+
match Eio_posix.Low_level.read fd buf 0 (Bytes.length buf) with
36
+
| 0 -> ""
37
+
| n -> Bytes.sub_string buf 0 n ^ read_response fd
38
+
39
+
let with_pipe fn =
40
+
Switch.run @@ fun sw ->
41
+
let r, w = Eio_posix.Low_level.pipe ~sw in
42
+
fn r w
43
+
44
+
let signal t signal =
45
+
(* We need the lock here so that one domain can't signal the process exactly as another is reaping it. *)
46
+
Mutex.lock t.lock;
47
+
Fun.protect ~finally:(fun () -> Mutex.unlock t.lock) @@ fun () ->
48
+
if not (Promise.is_resolved t.exit_status) then Unix.kill t.pid signal
49
+
(* else process has been reaped and t.pid is invalid *)
50
+
51
+
external eio_spawn :
52
+
Unix.file_descr -> Eio_unix.Private.Fork_action.c_action list -> int
53
+
= "caml_eio_posix_spawn"
54
+
55
+
(* Wait for [pid] to exit and then resolve [exit_status] to its status. *)
56
+
let reap t exit_status =
57
+
Eio.Condition.loop_no_mutex Eio_unix.Process.sigchld (fun () ->
58
+
Mutex.lock t.lock;
59
+
match Unix.waitpid [ WNOHANG ] t.pid with
60
+
| 0, _ ->
61
+
Mutex.unlock t.lock;
62
+
None (* Not ready; wait for next SIGCHLD *)
63
+
| p, status ->
64
+
assert (p = t.pid);
65
+
Promise.resolve exit_status status;
66
+
Mutex.unlock t.lock;
67
+
Some ())
68
+
69
+
let iter_switch ~f = function
70
+
| Merry.Types.Async -> ()
71
+
| Merry.Types.Switched sw -> f sw
72
+
73
+
let spawn ~mode actions =
74
+
with_pipe @@ fun errors_r errors_w ->
75
+
Eio_unix.Private.Fork_action.with_actions actions @@ fun c_actions ->
76
+
iter_switch ~f:Switch.check mode;
77
+
let exit_status, set_exit_status = Promise.create () in
78
+
let t =
79
+
let pid =
80
+
Eio_unix.Fd.use_exn "errors-w" errors_w @@ fun errors_w ->
81
+
Eio.Private.Trace.with_span "spawn" @@ fun () ->
82
+
eio_spawn errors_w c_actions
83
+
in
84
+
Eio_unix.Fd.close errors_w;
85
+
{ pid; exit_status; lock = Mutex.create () }
86
+
in
87
+
let () =
88
+
iter_switch
89
+
~f:(fun sw ->
90
+
let hook =
91
+
Switch.on_release_cancellable sw (fun () ->
92
+
(* Kill process (if still running) *)
93
+
signal t Sys.sigkill;
94
+
(* The switch is being released, so either the daemon fiber got
95
+
cancelled or it hasn't started yet (and never will start). *)
96
+
if not (Promise.is_resolved t.exit_status) then
97
+
(* Do a (non-cancellable) waitpid here to reap the child. *)
98
+
reap t set_exit_status)
99
+
in
100
+
Fiber.fork_daemon ~sw (fun () ->
101
+
reap t set_exit_status;
102
+
Switch.remove_hook hook;
103
+
`Stop_daemon))
104
+
mode
105
+
in
106
+
(* Check for errors starting the process. *)
107
+
match read_response errors_r with
108
+
| "" -> t (* Success! Execing the child closed [errors_w] and we got EOF. *)
109
+
| err -> failwith err
110
+
end
111
+
112
+
module Process_impl = struct
113
+
type t = Process.t
114
+
type tag = [ `Generic | `Unix ]
115
+
116
+
let pid = Process.pid
117
+
118
+
let await t =
119
+
match Eio.Promise.await @@ Process.exit_status t with
120
+
| Unix.WEXITED i -> `Exited i
121
+
| Unix.WSIGNALED i -> `Signaled i
122
+
| Unix.WSTOPPED _ -> assert false
123
+
124
+
let signal = Process.signal
125
+
end
126
+
127
+
let process =
128
+
let handler = Eio.Process.Pi.process (module Process_impl) in
129
+
fun proc -> Eio.Resource.T (proc, handler)
130
+
3
131
let resolve_program name =
4
132
if not (String.contains name '/') then
5
133
Sys.getenv_opt "PATH"
···
11
139
else if Sys.file_exists name then Some name
12
140
else None
13
141
14
-
let read_of_fd ~sw ~default ~to_close = function
15
-
| None -> default
16
-
| Some f -> (
142
+
let read_of_fd ~mode ~default ~to_close v =
143
+
match (mode, v) with
144
+
| Merry.Types.Async, _ | _, None -> default
145
+
| Merry.Types.Switched sw, Some f -> (
17
146
match Eio_unix.Resource.fd_opt f with
18
147
| Some fd -> fd
19
148
| None ->
···
25
154
to_close := r :: !to_close;
26
155
r)
27
156
28
-
let write_of_fd ~sw ~default ~to_close = function
29
-
| None -> default
30
-
| Some f -> (
157
+
let write_of_fd ~mode ~default ~to_close v =
158
+
match (mode, v) with
159
+
| Merry.Types.Async, _ | _, None -> default
160
+
| Merry.Types.Switched sw, Some f -> (
31
161
match Eio_unix.Resource.fd_opt f with
32
162
| Some fd -> fd
33
163
| None ->
···
91
221
Eio_unix.Private.Fork_action.
92
222
{ run = (fun k -> k (Obj.repr (action_dups, plan, blocking))) }
93
223
94
-
let spawn_unix () ~sw ~fork_actions ?pgid ?uid ?gid ~env ~fds ~executable ~cwd
224
+
let spawn_unix () ~mode ~fork_actions ?pgid ?uid ?gid ~env ~fds ~executable ~cwd
95
225
args =
96
226
let open Eio_posix in
97
227
let actions =
···
132
262
in
133
263
fn (Low_level.Process.Fork_action.fchdir cwd :: actions)
134
264
in
135
-
with_actions cwd @@ fun actions ->
136
-
Eio_posix__.Process.process (Low_level.Process.spawn ~sw actions)
265
+
with_actions cwd @@ fun actions -> process (Process.spawn ~mode actions)
137
266
138
267
let fd_equal_int fd i =
139
268
Eio_unix.Fd.use_exn "fd_equal_int" fd @@ fun ufd ->
···
142
271
143
272
let pp_redirections ppf (i, fd, _) = Fmt.pf ppf "(%i,%a)" i Eio_unix.Fd.pp fd
144
273
145
-
let run ~sw _ ?stdin ?stdout ?stderr ?(fds = []) ?(fork_actions = []) ~pgid ~cwd
146
-
?env ?executable args =
274
+
let run ~mode _ ?stdin ?stdout ?stderr ?(fds = []) ?(fork_actions = []) ~pgid
275
+
~cwd ?env ?executable args =
147
276
with_close_list @@ fun to_close ->
148
277
let check_fd n = function
149
278
| Merry.Types.Redirect (m, _, _) -> Int.equal n m
···
155
284
else
156
285
[
157
286
( 0,
158
-
read_of_fd ~sw stdin ~default:Eio_unix.Fd.stdin ~to_close,
287
+
read_of_fd ~mode stdin ~default:Eio_unix.Fd.stdin ~to_close,
159
288
`Blocking );
160
289
])
161
290
@ (if fd_exists 1 then []
162
291
else
163
292
[
164
293
( 1,
165
-
write_of_fd ~sw stdout ~default:Eio_unix.Fd.stdout ~to_close,
294
+
write_of_fd ~mode stdout ~default:Eio_unix.Fd.stdout ~to_close,
166
295
`Blocking );
167
296
])
168
297
@
···
170
299
else
171
300
[
172
301
( 2,
173
-
write_of_fd ~sw stderr ~default:Eio_unix.Fd.stderr ~to_close,
302
+
write_of_fd ~mode stderr ~default:Eio_unix.Fd.stderr ~to_close,
174
303
`Blocking );
175
304
]
176
305
in
···
186
315
let fds = std_fds @ fds in
187
316
let executable = get_executable executable ~args in
188
317
let env = get_env env in
189
-
spawn_unix ~sw ~fork_actions ~cwd ~pgid ~fds ~env ~executable () args
318
+
spawn_unix ~mode ~fork_actions ~cwd ~pgid ~fds ~env ~executable () args
+2
-2
src/lib/posix/merry_posix.ml
+2
-2
src/lib/posix/merry_posix.ml
···
15
15
| `Exited n -> Merry.Exit.nonzero () n
16
16
| `Signaled n -> Merry.Exit.nonzero () n
17
17
18
-
let exec ?(fork_actions = []) ?(fds = []) ?stdin ?stdout ?stderr ?env ~sw
18
+
let exec ?(fork_actions = []) ?(fds = []) ?stdin ?stdout ?stderr ?env ~mode
19
19
~pgid ~cwd t args : process =
20
20
let env =
21
21
Option.map
22
22
(fun lst -> List.map (fun (a, b) -> a ^ "=" ^ b) lst |> Array.of_list)
23
23
env
24
24
in
25
-
Exec.run ~fork_actions ~sw ~fds ~pgid ~cwd ?stdin ?stdout ?stderr ?env t
25
+
Exec.run ~fork_actions ~mode ~fds ~pgid ~cwd ?stdin ?stdout ?stderr ?env t
26
26
args
27
27
end
+11
-1
src/lib/types.ml
+11
-1
src/lib/types.ml
···
33
33
| Redirect of int * Eio_unix.Fd.t * Eio_unix.Private.Fork_action.blocking
34
34
| Close of Eio_unix.Fd.t
35
35
36
+
type exec_mode =
37
+
| Switched of Eio.Switch.t
38
+
| Async
39
+
(** How to execute a process. This mainly controls what happens at the end
40
+
of the running a script or some commands. When a process is
41
+
"switched", we use the same semantics as Eio, we sigkill the process
42
+
and cleanup. If the process is complete Async then we do not wait.
43
+
This allows us to exit before some of our child processes, which is a
44
+
requirement for implementing the semantics of a shell! *)
45
+
36
46
module type Exec = sig
37
47
type t
38
48
(** An executor for commands *)
···
49
59
?stdout:_ Eio.Flow.sink ->
50
60
?stderr:_ Eio.Flow.sink ->
51
61
?env:(string * string) list ->
52
-
sw:Eio.Switch.t ->
62
+
mode:exec_mode ->
53
63
pgid:int ->
54
64
cwd:Eio.Fs.dir_ty Eio.Path.t ->
55
65
t ->