Shells in OCaml
Many fixes with redirections
+322
-183
+9
-3
src/bin/main.ml
+9
-3
src/bin/main.ml
···
4
4
Merry.Interactive.Make (Merry_posix.State) (Merry_posix.Exec)
5
5
(Merry.History.Prefix_search)
6
6
7
-
let sh ~command_flag ~dump ~file ~rest env =
7
+
let sh ~command_flag ~dump ~file ~rest ~options env =
8
8
let executor = Merry_posix.Exec.{ mgr = env#process_mgr } in
9
9
let interactive = Option.is_none file && rest = [] in
10
10
let pos_zero = match file with Some f -> f | None -> "msh" in
···
16
16
~home:(Sys.getenv "HOME" ^ "/")
17
17
(Fpath.v (Merry.Eunix.cwd ())))
18
18
executor ~fs:env#fs ~stdin:env#stdin ~stdout:env#stdout ~async_switch
19
+
~options
19
20
~argv:(Array.of_list (pos_zero :: (try List.tl rest with _ -> [])))
20
21
~program:pos_zero ~signal_handler
21
22
in
···
54
55
in
55
56
Arg.(value & flag & info [ "d"; "D"; "dump" ] ~doc)
56
57
58
+
let errexit = Merry.Built_ins.Set.errexit
59
+
57
60
let setup_log style_renderer level =
58
61
Fmt_tty.setup_std_outputs ?style_renderer ();
59
62
Logs.set_level level;
···
93
96
let+ command_flag = command_flag
94
97
and+ () = setup_log
95
98
and+ dump = dump
99
+
and+ errexit = errexit
96
100
and+ file = file
97
101
(* We keep this just to consume them on the command line *)
98
102
and+ _rest = rest in
···
102
106
let args =
103
107
remove_flag ~condition:command_flag [ "-c" ] args
104
108
|> remove_flag ~condition:dump [ "-d"; "--dump" ]
109
+
|> remove_flag ~condition:true [ "-e" ]
105
110
|> remove_flag ~condition:true [ "--" ]
106
111
|> remove_flag ~condition:true [ "-v" ]
107
112
in
···
110
115
|> List.sort (fun (i, _) (j, _) -> Int.compare i j)
111
116
|> List.map snd
112
117
in
113
-
sh ~command_flag ~dump ~file ~rest env
118
+
let options = Merry.Built_ins.Options.(with_options ~errexit default) in
119
+
sh ~command_flag ~dump ~file ~rest ~options env
114
120
115
121
let main () =
116
122
Eio_posix.run @@ fun env ->
117
-
let allowed_args = [ "-c"; "-d"; "--dump"; "--"; "-v" ] in
123
+
let allowed_args = [ "-c"; "-d"; "--dump"; "--"; "-v"; "-e" ] in
118
124
let is_allowed v =
119
125
List.mem v allowed_args || not (String.starts_with ~prefix:"-" v)
120
126
in
+6
-4
src/lib/ast.ml
+6
-4
src/lib/ast.ml
···
877
877
| `No -> Fmt.pf ppf "no"
878
878
| `With_previous -> Fmt.pf ppf "with-previous"
879
879
| `With_next -> Fmt.pf ppf "with-next"
880
+
| `Yes -> Fmt.pf ppf "yes"
880
881
881
882
let pp ppf { txt; join; splittable; globbable; tilde_expansion } =
882
883
Fmt.pf ppf
···
888
889
let rec loop = function
889
890
| [] -> []
890
891
| [ x ] -> [ { x with join = `No } ]
891
-
| x :: { txt; join = `With_previous; globbable; _ } :: rest ->
892
+
| x :: { txt; join = `With_previous | `Yes; globbable; _ } :: rest ->
892
893
loop
893
894
({
894
895
x with
···
897
898
globbable = x.globbable || globbable;
898
899
}
899
900
:: rest)
900
-
| { txt; join = `With_next; globbable; _ } :: y :: rest ->
901
-
{ y with txt = txt ^ y.txt; globbable = globbable || y.globbable }
902
-
:: loop rest
901
+
| { txt; join = `With_next | `Yes; globbable; _ } :: y :: rest ->
902
+
loop
903
+
({ y with txt = txt ^ y.txt; globbable = globbable || y.globbable }
904
+
:: rest)
903
905
| x :: xs -> x :: loop xs
904
906
in
905
907
let v = loop cst in
+1
-1
src/lib/ast.mli
+1
-1
src/lib/ast.mli
+2
-15
src/lib/built_ins.ml
+2
-15
src/lib/built_ins.ml
···
379
379
end
380
380
381
381
module Eval = struct
382
-
open Cmdliner
383
-
384
-
let args =
385
-
let doc = "Arguments to concatenate, parse and execute." in
386
-
Arg.(value & pos_all string [] & info [] ~docv:"ARGS" ~doc)
387
-
388
-
let t =
389
-
let make_eval args = Eval args in
390
-
let term = Term.(const make_eval $ args) in
391
-
let info =
392
-
let doc = "Construct a command by concatenating arguments together." in
393
-
Cmd.info "eval" ~doc
394
-
in
395
-
Cmd.v info term
382
+
let of_args w = Some (Ok (Eval w))
396
383
end
397
384
398
385
module Echo = struct
···
600
587
| "command" :: cmd -> Command.of_strings cmd
601
588
| "alias" :: _ -> Some (Ok Alias)
602
589
| "unalias" :: _ -> Some (Ok Unalias)
603
-
| "eval" :: _ as cmd -> exec_cmd cmd Eval.t
590
+
| "eval" :: cmd -> Eval.of_args cmd
604
591
| "echo" :: cmd -> Echo.of_args cmd
605
592
| "trap" :: _ as cmd -> exec_cmd cmd Trap.t
606
593
| "return" :: _ as cmd -> exec_cmd cmd Return.t
+5
src/lib/built_ins.mli
+5
src/lib/built_ins.mli
+4
-4
src/lib/eunix.ml
+4
-4
src/lib/eunix.ml
···
63
63
let fd_of_int (fd : int) : Unix.file_descr = Obj.magic fd
64
64
65
65
let with_redirections ?(restore = false) (rdrs : Types.redirect list) fn =
66
-
let saved_stdin = Unix.dup Unix.stdin in
67
-
let saved_stdout = Unix.dup Unix.stdout in
68
-
let saved_stderr = Unix.dup Unix.stderr in
66
+
let saved_stdin = Safe_fd.dup Unix.stdin in
67
+
let saved_stdout = Safe_fd.dup Unix.stdout in
68
+
let saved_stderr = Safe_fd.dup Unix.stderr in
69
69
let restore_fds =
70
70
List.filter_map
71
71
(function
···
74
74
let new_fd = fd_of_int i in
75
75
if (Obj.magic fd : int) <> i then begin
76
76
let saved_fd =
77
-
try Some (Unix.dup new_fd)
77
+
try Some (Safe_fd.dup new_fd)
78
78
with Unix.Unix_error (Unix.EBADF, _, _) -> None
79
79
in
80
80
Unix.dup2 ~cloexec:false fd new_fd;
+144
-64
src/lib/eval.ml
+144
-64
src/lib/eval.ml
···
6
6
open Import
7
7
open Exit.Syntax
8
8
9
+
let mk_new_id =
10
+
let i = ref 0 in
11
+
fun () ->
12
+
incr i;
13
+
"id" ^ string_of_int @@ !i
14
+
15
+
let mk_pipeline_scope () = "pipeline-" ^ mk_new_id ()
9
16
let pp_args = Fmt.(list ~sep:(Fmt.any " ") string)
10
17
11
18
let pp_fs_create ppf (v : Eio.Fs.create) =
···
56
63
exit_handler : (unit -> unit) option;
57
64
in_double_quotes : bool;
58
65
umask : int;
59
-
fd_pool : Fd_pool.t;
66
+
current_pipeline : string option;
60
67
}
61
68
62
69
exception Continue of int * ctx
···
69
76
(* Used for the [return] non-POSIX keyword *)
70
77
71
78
let make_ctx ?(interactive = false) ?(subshell = false) ?(local_state = [])
72
-
?(background_jobs = []) ?(last_background_process = "")
79
+
?(background_jobs = []) ?(last_background_process = "") ?current_pipeline
73
80
?last_pipeline_status ?(functions = []) ?(rdrs = []) ?exit_handler
74
81
?(options = Built_ins.Options.default) ?(hash = Hash.empty)
75
82
?(in_double_quotes = false) ?(umask = 0o22) ~fs ~stdin ~stdout
76
83
~async_switch ~program ~argv ~signal_handler state executor =
77
84
let signal_handler = { run = signal_handler; sigint_set = false } in
85
+
let state = S.update state ~param:"IFS" " \t\n" |> Result.get_ok in
78
86
{
79
87
interactive;
80
88
subshell;
···
98
106
exit_handler;
99
107
in_double_quotes;
100
108
umask;
101
-
fd_pool = Fd_pool.make 256;
109
+
current_pipeline;
102
110
}
103
111
104
112
let state ctx = ctx.state
···
106
114
let fs ctx = ctx.fs
107
115
let clear_local_state ctx = { ctx with local_state = [] }
108
116
117
+
let with_pipeline_scope ?(force = false) ?(remove_vars = true) ctx fn =
118
+
let saved_pipeline = ctx.current_pipeline in
119
+
let current_pipeline =
120
+
if force then mk_pipeline_scope ()
121
+
else Option.value ~default:(mk_pipeline_scope ()) ctx.current_pipeline
122
+
in
123
+
let changed = force || Option.is_none ctx.current_pipeline in
124
+
let v = fn { ctx with current_pipeline = Some current_pipeline } in
125
+
Exit.map
126
+
~f:(fun c ->
127
+
{
128
+
c with
129
+
current_pipeline = saved_pipeline;
130
+
state =
131
+
(if changed && remove_vars then
132
+
S.remove_group ~id:current_pipeline c.state
133
+
else c.state);
134
+
})
135
+
v
136
+
109
137
let tilde_expansion ctx = function
110
138
| Ast.WordTildePrefix _ -> Ast.WordTildePrefix (S.expand ctx.state `Tilde)
111
139
| v -> v
···
122
150
let stdout_for_pipeline ~sw ctx = function
123
151
| [] -> (None, `Global ctx.stdout)
124
152
| _ ->
125
-
let r, w = Fd_pool.pipe ctx.fd_pool sw in
153
+
let r, w = Safe_fd.pipe sw in
126
154
(Some r, `Local (w :> Eio_unix.sink_ty Eio.Flow.sink))
127
155
128
156
let fd_of_int ?(close_unix = true) ~sw (n : int) =
···
199
227
if not is_global then begin
200
228
Eio.Flow.close some_write
201
229
end
230
+
in
231
+
let update_stdin ~stdin ctx =
232
+
{ ctx with stdin = Option.value ~default:ctx.stdin stdin }
202
233
in
203
234
let exec_process ~sw ctx job ?fds ?stdin ~stdout ?pgid executable args =
204
235
let pgid = match pgid with None -> 0 | Some p -> p in
···
221
252
fds);
222
253
( ctx,
223
254
E.exec ctx.executor ~delay_reap:(fst reap) ~fds ?stdin ~stdout
224
-
~pgid ~mode ~cwd:(cwd_of_ctx ctx)
255
+
~pgid ~mode ~cwd:(cwd_of_ctx ctx) ~pipe:Safe_fd.pipe
225
256
~env:(get_env ~extra:ctx.local_state ctx)
226
257
~executable:full_path (executable :: args) )
227
258
in
···
235
266
(on_process ~async ~process ctx, job)
236
267
in
237
268
let job_pgid (t : J.t) = J.get_id t in
238
-
let rec loop pipeline_switch (ctx : ctx) (job : J.t)
239
-
(stdout_of_previous : Eio_unix.source_ty Eio_unix.source option) :
269
+
let rec loop pipeline_switch (ctx : ctx) (job : J.t) :
240
270
Ast.command list -> ctx * J.t =
241
271
fun c ->
242
272
let loop = loop pipeline_switch in
···
247
277
(Ast.cmd_prefix_to_yojson prefix));
248
278
let ctx = collect_assignments ctx prefix in
249
279
let job = handle_job job (`Built_in (Exit.ignore ctx)) in
250
-
loop (Exit.value ctx) job stdout_of_previous rest
280
+
loop (Exit.value ctx) job rest
251
281
| Ast.SimpleCommand (Prefixed (prefix, Some executable, suffix)) :: rest
252
282
->
253
283
let ctx = collect_assignments ~update:false ctx prefix in
254
284
let job = handle_job job (`Built_in (Exit.ignore ctx)) in
255
-
loop (Exit.value ctx) job stdout_of_previous
285
+
loop (Exit.value ctx) job
256
286
(Ast.SimpleCommand (Named (executable, suffix)) :: rest)
257
287
| Ast.SimpleCommand (Named (executable, suffix)) :: rest -> (
258
288
let ctx, executable = word_expansion ctx executable in
259
289
match ctx with
260
290
| Exit.Nonzero _ as ctx ->
261
291
let job = handle_job job (`Built_in (Exit.ignore ctx)) in
262
-
loop (Exit.value ctx) job stdout_of_previous rest
292
+
loop (Exit.value ctx) job rest
263
293
| Exit.Zero ctx -> (
264
294
let executable, extra_args =
265
295
(* This is a side-effect of the alias command with something like
···
286
316
match ctx with
287
317
| Exit.Nonzero _ as ctx ->
288
318
let job = handle_job job (`Built_in (Exit.ignore ctx)) in
289
-
loop (Exit.value ctx) job stdout_of_previous rest
319
+
loop (Exit.value ctx) job rest
290
320
| Exit.Zero ctx -> (
291
321
let some_read, some_write =
292
322
stdout_for_pipeline ~sw:pipeline_switch ctx rest
···
336
366
in
337
367
Debug.Log.debug (fun f ->
338
368
f "export %a" pp_args args);
339
-
loop (Exit.value updated) job stdout_of_previous
340
-
rest
369
+
loop (Exit.value updated) job rest
341
370
| "readonly" ->
342
371
let updated =
343
372
handle_assignments `Readonly ctx args
···
348
377
in
349
378
Debug.Log.debug (fun f ->
350
379
f "readonly %a" pp_args args);
351
-
loop (Exit.value updated) job stdout_of_previous
352
-
rest
380
+
loop (Exit.value updated) job rest
353
381
| "local" ->
354
382
let updated =
355
383
handle_assignments `Local ctx args
···
358
386
handle_job job
359
387
(`Built_in (updated >|= fun _ -> ()))
360
388
in
361
-
loop (Exit.value updated) job stdout_of_previous
362
-
rest
389
+
loop (Exit.value updated) job rest
363
390
| "exec" ->
364
-
(* let _ = Sys.command "ls -la /proc/self/fd" in *)
365
391
Debug.Log.debug (fun f ->
366
392
f "exec [%a] [%a]" pp_args args
367
393
Fmt.(list Types.pp_redirect)
···
370
396
Eunix.with_redirections ~restore:false rdrs
371
397
@@ fun () ->
372
398
if args <> [] then
373
-
Fmt.invalid_arg
374
-
"Exec with args not yet supported...";
375
-
(ctx, job)
399
+
let name = List.hd args in
400
+
let prog =
401
+
match
402
+
resolve_program ~update:false ctx name
403
+
with
404
+
| _, None -> Fmt.failwith "%s not found" name
405
+
| _, Some p -> p
406
+
in
407
+
Unix.execve prog (Array.of_list args)
408
+
(Array.of_list
409
+
@@ List.map (fun (k, v) -> k ^ "=" ^ v)
410
+
@@ get_env ~extra:ctx.local_state ctx)
411
+
else (ctx, job)
376
412
| ":" -> (ctx, job)
377
413
| _ -> (
378
414
let saved_ctx = ctx in
···
393
429
loop
394
430
{
395
431
saved_ctx with
432
+
stdin =
433
+
Option.value ~default:saved_ctx.stdin
434
+
some_read;
396
435
state = (Exit.value ctx).state;
397
436
}
398
-
job some_read rest
437
+
job rest
399
438
| None -> (
400
439
match Built_ins.of_args command_args with
401
440
| Some (Error _) ->
···
427
466
handle_job job
428
467
(`Built_in (Exit.ignore ctx))
429
468
in
430
-
loop (Exit.value ctx) job some_read rest
469
+
let ctx =
470
+
Exit.map
471
+
~f:(update_stdin ~stdin:some_read)
472
+
ctx
473
+
in
474
+
loop (Exit.value ctx) job rest
431
475
| _ -> (
432
476
let exec_and_args =
433
477
if is_command then begin
···
453
497
handle_job job
454
498
(`Built_in (Exit.ignore v))
455
499
in
456
-
loop ctx job some_read rest
457
-
| Exit.Zero (executable, args) -> (
458
-
match stdout_of_previous with
459
-
| None ->
460
-
let ctx, job =
461
-
exec_process ~sw:pipeline_switch
462
-
ctx job ~fds:rdrs
463
-
~stdout:some_write
464
-
~pgid:(job_pgid job)
465
-
executable args
466
-
in
467
-
close_stdout ~is_global some_write;
468
-
loop ctx job some_read rest
469
-
| Some stdout ->
470
-
let ctx, job =
471
-
exec_process ~sw:pipeline_switch
472
-
ctx job ~fds:rdrs
473
-
~stdin:stdout
474
-
~stdout:some_write
475
-
~pgid:(job_pgid job)
476
-
executable args
477
-
in
478
-
close_stdout ~is_global some_write;
479
-
loop ctx job some_read rest)))))
500
+
let ctx =
501
+
update_stdin ~stdin:some_read ctx
502
+
in
503
+
loop ctx job rest
504
+
| Exit.Zero (executable, args) ->
505
+
let ctx, job =
506
+
exec_process ~sw:pipeline_switch ctx
507
+
job ~fds:rdrs ~stdin:ctx.stdin
508
+
~stdout:some_write
509
+
~pgid:(job_pgid job) executable
510
+
args
511
+
in
512
+
close_stdout ~is_global some_write;
513
+
let ctx =
514
+
update_stdin ~stdin:some_read ctx
515
+
in
516
+
loop ctx job rest))))
480
517
| Some (Ok bi) ->
481
518
let rdrs = make_child_rdrs_for_parent rdrs in
482
519
let ctx =
···
496
533
else handle_job job (`Exit (Exit.ignore ctx))
497
534
| _ -> handle_job job (`Built_in (Exit.ignore ctx))
498
535
in
499
-
loop (Exit.value ctx) job some_read rest))))
536
+
let ctx =
537
+
Exit.map ~f:(update_stdin ~stdin:some_read) ctx
538
+
in
539
+
loop (Exit.value ctx) job rest))))
500
540
| CompoundCommand (c, rdrs) :: rest -> (
541
+
let some_read, some_write =
542
+
stdout_for_pipeline ~sw:pipeline_switch ctx rest
543
+
in
544
+
let is_global, some_write =
545
+
match some_write with
546
+
| `Global p -> (true, p)
547
+
| `Local p -> (false, p)
548
+
in
501
549
match handle_redirections ~sw:pipeline_switch ctx rdrs with
502
550
| Error ctx -> (ctx, handle_job job (`Rdr (Exit.nonzero () 1)))
503
551
| Ok rdrs ->
504
552
let saved_rdrs = ctx.rdrs in
553
+
let saved_stdout = ctx.stdout in
505
554
let rdrs = make_child_rdrs_for_parent rdrs in
506
555
(* TODO: No way this is right *)
507
-
let ctx = { ctx with rdrs = rdrs @ saved_rdrs } in
508
-
let ctx = handle_compound_command ctx c in
556
+
let ctx =
557
+
{ ctx with rdrs = rdrs @ saved_rdrs; stdout = some_write }
558
+
in
559
+
let ctx =
560
+
with_pipeline_scope ctx @@ fun ctx ->
561
+
handle_compound_command ctx c
562
+
in
563
+
close_stdout ~is_global some_write;
509
564
let job = handle_job job (`Built_in (ctx >|= fun _ -> ())) in
510
565
let actual_ctx = Exit.value ctx in
511
-
loop { actual_ctx with rdrs = saved_rdrs } job None rest)
566
+
loop
567
+
{
568
+
actual_ctx with
569
+
rdrs = saved_rdrs;
570
+
stdin = Option.value ~default:actual_ctx.stdin some_read;
571
+
stdout = saved_stdout;
572
+
}
573
+
job rest)
512
574
| FunctionDefinition (name, (body, _rdrs)) :: rest ->
513
575
let ctx = { ctx with functions = (name, body) :: ctx.functions } in
514
-
loop ctx job None rest
576
+
loop ctx job rest
515
577
| [] -> (clear_local_state ctx, job)
516
578
in
517
579
Eio.Switch.run @@ fun sw ->
···
519
581
let saved_ctx = initial_ctx in
520
582
let subshell = saved_ctx.subshell || List.length p > 1 in
521
583
let ctx = { initial_ctx with subshell } in
522
-
let ctx, job = loop sw ctx initial_job None p in
584
+
with_pipeline_scope ctx @@ fun ctx ->
585
+
let ctx, job = loop sw ctx initial_job p in
586
+
let ctx = { ctx with stdin = saved_ctx.stdin; state = ctx.state } in
523
587
match J.size job with
524
588
| 0 -> Exit.zero ctx
525
589
| _ ->
···
614
678
| Ast.IoRedirect_IoHere (i, Ast.IoHere (_, v)) ->
615
679
let _ctx, cst = word_expansion ctx v in
616
680
let s = List.concat cst |> Ast.Fragment.join_list ~sep:"" in
617
-
let r, w = Fd_pool.pipe ctx.fd_pool sw in
681
+
let r, w = Safe_fd.pipe sw in
618
682
Eio.Flow.copy_string s w;
619
683
Eio.Flow.close w;
620
684
let fd = Eio_unix.Resource.fd_opt r |> Option.get in
···
632
696
List.concat cst |> List.map strip_tab
633
697
|> Ast.Fragment.join_list ~sep:""
634
698
in
635
-
let r, w = Fd_pool.pipe ctx.fd_pool sw in
699
+
let r, w = Safe_fd.pipe sw in
636
700
Eio.Flow.copy_string s w;
637
701
Eio.Flow.close w;
638
702
let fd = Eio_unix.Resource.fd_opt r |> Option.get in
···
681
745
match int_of_string_opt param with
682
746
| Some n -> (
683
747
match Array.get ctx.argv n with
684
-
| v -> Some v
748
+
| v ->
749
+
Debug.Log.debug (fun f ->
750
+
f "lookup %s => %a" param Fmt.(quote string) v);
751
+
Some v
685
752
| exception Invalid_argument _ -> None)
686
-
| None -> S.lookup ctx.state ~param
753
+
| None ->
754
+
let v = S.lookup ctx.state ~param in
755
+
Debug.Log.debug (fun f ->
756
+
f "lookup %s => %a" param Fmt.(quote (option string)) v);
757
+
v
687
758
in
688
759
let expand ctx v : ctx Exit.t * Ast.fragment list list =
689
760
let module Fragment = struct
···
914
985
| Ast.WordSubshell sub ->
915
986
(* Command substitution *)
916
987
let s = command_substitution ctx sub in
917
-
(Exit.zero ctx, [ [ Fragment.make s ] ])
988
+
(Exit.zero ctx, [ [ Fragment.make ~join:`Yes s ] ])
918
989
| Ast.WordArithmeticExpression cst ->
919
990
arithmetic_expansion ctx cst |> fun (ctx, v) ->
920
991
(Exit.zero ctx, [ [ v ] ])
···
1196
1267
1197
1268
and exec_subshell ctx (term, sep) =
1198
1269
let saved_ctx = ctx in
1270
+
Debug.Log.debug (fun f -> f "enter subshell");
1199
1271
let e = exec ctx (term, Some sep) in
1272
+
Debug.Log.debug (fun f -> f "leave subshell");
1200
1273
let v = e >|= fun _ -> saved_ctx in
1201
1274
v
1202
1275
···
1248
1321
| Some commands ->
1249
1322
Debug.Log.debug (fun f ->
1250
1323
f "function enter: %s [%a]" name
1251
-
Fmt.(list ~sep:Fmt.(any " ") string)
1324
+
Fmt.(list ~sep:Fmt.(any " ") (quote string))
1252
1325
argv);
1253
1326
let ctx = { ctx with argv = Array.of_list argv } in
1254
1327
let v =
···
1264
1337
let stdout = Eio.Flow.buffer_sink buf in
1265
1338
let sub_ctx =
1266
1339
Eio.Switch.run @@ fun sw ->
1267
-
let r, w = Fd_pool.pipe ctx.fd_pool sw in
1340
+
let r, w = Safe_fd.pipe sw in
1268
1341
Eio.Fiber.fork ~sw (fun () -> Eio.Flow.copy r stdout);
1269
1342
let subshell_ctx = { ctx with stdout = w; subshell = true } in
1270
1343
let sub_ctx, _ = run (Exit.zero subshell_ctx) s in
···
1307
1380
match ctx with
1308
1381
| Exit.Nonzero _ as ctx -> ctx
1309
1382
| Exit.Zero ctx -> (
1383
+
let s = Ast.Fragment.join_list ~sep:"" @@ List.concat v in
1384
+
Debug.Log.debug (fun f ->
1385
+
f "collect assignment: %s is %a : %i chars" param
1386
+
Fmt.(quote string)
1387
+
s (String.length s));
1310
1388
let state =
1311
1389
(* TODO: Overhaul... need to collect assignments after word expansion...*)
1312
1390
if update || String.equal "IFS" param then
···
1439
1517
| _ -> assert false)
1440
1518
| Alias | Unalias -> Exit.zero ctx (* Morbig handles this for us *)
1441
1519
| Eval args ->
1442
-
let script = String.concat "" args in
1520
+
let script = String.concat " " args in
1443
1521
let ast = Ast.of_string script in
1444
1522
let ctx, _ = run (Exit.zero ctx) ast in
1445
1523
ctx
1446
1524
| Echo args ->
1447
-
let str = String.concat " " (List.map String.trim args) ^ "\n" in
1525
+
let str = String.concat " " args ^ "\n" in
1448
1526
Eio.Flow.copy_string str stdout;
1449
1527
Exit.zero ctx
1450
1528
| Trap (action, signals) ->
···
1529
1607
| [], lines ->
1530
1608
let last_var, last_line = List.hd acc in
1531
1609
List.rev
1532
-
((last_var, last_line ^ Ast.Fragment.join_list ~sep:"" lines)
1610
+
((last_var, last_line ^ Ast.Fragment.join_list ~sep:" " lines)
1533
1611
:: acc)
1534
1612
in
1535
1613
let fields =
···
1544
1622
let vars = loop [] (vars, fs) in
1545
1623
let state =
1546
1624
List.fold_left
1547
-
(fun st (k, v) -> S.update st ~param:k v |> Result.get_ok)
1625
+
(fun st (k, v) ->
1626
+
S.update ?id:ctx.current_pipeline st ~param:k v
1627
+
|> Result.get_ok)
1548
1628
ctx.state vars
1549
1629
in
1550
1630
Exit.zero { ctx with state })
+1
src/lib/eval.mli
+1
src/lib/eval.mli
-43
src/lib/fd_pool.ml
-43
src/lib/fd_pool.ml
···
1
-
type t = { pool : (Unix.file_descr * bool) array }
2
-
3
-
external is_actually_free : Unix.file_descr -> bool = "caml_merry_is_fd_free"
4
-
5
-
let make ?(min = 200) size =
6
-
let pool =
7
-
Array.init size (fun i -> ((Obj.magic (i + min) : Unix.file_descr), true))
8
-
in
9
-
{ pool }
10
-
11
-
let next_free t = Array.find_index (fun (_, free) -> free) t.pool
12
-
13
-
let get_fd ~sw t =
14
-
match next_free t with
15
-
| None -> Fmt.failwith "No free FDs"
16
-
| Some idx ->
17
-
let fd, _ = Array.get t.pool idx in
18
-
Eio.Switch.on_release sw (fun () -> Array.set t.pool idx (fd, true));
19
-
Array.set t.pool idx (fd, false);
20
-
fd
21
-
22
-
let with_fd t fn =
23
-
Eio.Switch.run @@ fun sw ->
24
-
let fd = get_fd ~sw t in
25
-
assert (is_actually_free fd);
26
-
fn fd
27
-
28
-
let pipe t sw =
29
-
let r, w = Eio_unix.pipe sw in
30
-
let r_fd, w_fd = (Eio_unix.Resource.fd r, Eio_unix.Resource.fd w) in
31
-
let new_r_fd, new_w_fd =
32
-
Eio_unix.Fd.use_exn "pipe" r_fd @@ fun r_fd ->
33
-
Eio_unix.Fd.use_exn "pipe" w_fd @@ fun w_fd ->
34
-
let new_r_fd = get_fd ~sw t in
35
-
let new_w_fd = get_fd ~sw t in
36
-
Unix.dup2 ~cloexec:true r_fd new_r_fd;
37
-
Unix.dup2 ~cloexec:true w_fd new_w_fd;
38
-
(new_r_fd, new_w_fd)
39
-
in
40
-
Eio_unix.Fd.close r_fd;
41
-
Eio_unix.Fd.close w_fd;
42
-
( Eio_posix.Flow.of_fd (Eio_unix.Fd.of_unix ~close_unix:true ~sw new_r_fd),
43
-
Eio_posix.Flow.of_fd (Eio_unix.Fd.of_unix ~close_unix:true ~sw new_w_fd) )
-17
src/lib/fd_pool.mli
-17
src/lib/fd_pool.mli
···
1
-
(* A simple file descriptor pool to deal with overwriting low
2
-
file descriptor by mistake that might be our own pipe's and
3
-
stuff! *)
4
-
5
-
type t
6
-
(** A file descriptor pool *)
7
-
8
-
val make : ?min:int -> int -> t
9
-
(** [make ?min size] creates a new pool of [size] where the lowest FD is [min].
10
-
*)
11
-
12
-
val with_fd : t -> (Unix.file_descr -> 'a) -> 'a
13
-
(** [with_fd pool fn] runs [fn] with the next available file descriptor, when
14
-
the function returns the [fd] is returned to the pool to be reused. *)
15
-
16
-
val pipe :
17
-
t -> Eio.Switch.t -> Eio_unix.source_ty Eio.Std.r * Eio_unix.sink_ty Eio.Std.r
+12
-5
src/lib/merry_stubs.c
+12
-5
src/lib/merry_stubs.c
···
7
7
#include <unistd.h>
8
8
#include <fcntl.h>
9
9
#include <signal.h>
10
+
#include <errno.h>
10
11
11
12
12
13
value caml_merry_tcsetpgrp(value v_fd, value v_pid_t) {
···
48
49
}
49
50
50
51
value
51
-
caml_merry_is_fd_free(value v_fd) {
52
-
if (! fcntl(Int_val(v_fd), F_GETFD)) {
53
-
return Val_true;
54
-
} else {
55
-
return Val_false;
52
+
caml_merry_safefd(value v_fd) {
53
+
int newfd;
54
+
int err;
55
+
56
+
newfd = fcntl(Int_val(v_fd), F_DUPFD, 10);
57
+
err = newfd < 0 ? errno : 0;
58
+
59
+
if (err) {
60
+
caml_uerror("fcntl-safefd", Nothing);
56
61
}
62
+
63
+
return Val_int(newfd);
57
64
}
+9
-8
src/lib/posix/exec.ml
+9
-8
src/lib/posix/exec.ml
···
129
129
let handler = Eio.Process.Pi.process (module Process_impl) in
130
130
fun proc -> Eio.Resource.T (proc, handler)
131
131
132
-
let read_of_fd ~mode ~default ~to_close v =
132
+
let read_of_fd ~mode ~default ~to_close ~pipe v =
133
133
match (mode, v) with
134
134
| Merry.Types.Async, _ | _, None -> default
135
135
| Merry.Types.Switched sw, Some f -> (
136
136
match Eio_unix.Resource.fd_opt f with
137
137
| Some fd -> fd
138
138
| None ->
139
-
let r, w = Eio_unix.pipe sw in
139
+
let r, w = pipe sw in
140
140
Fiber.fork ~sw (fun () ->
141
141
Eio.Flow.copy f w;
142
142
Eio.Flow.close w);
···
144
144
to_close := r :: !to_close;
145
145
r)
146
146
147
-
let write_of_fd ~mode ~default ~to_close v =
147
+
let write_of_fd ~mode ~default ~to_close ~pipe v =
148
148
match (mode, v) with
149
149
| Merry.Types.Async, _ | _, None -> default
150
150
| Merry.Types.Switched sw, Some f -> (
151
151
match Eio_unix.Resource.fd_opt f with
152
152
| Some fd -> fd
153
153
| None ->
154
-
let r, w = Eio_unix.pipe sw in
154
+
let r, w = pipe sw in
155
155
Fiber.fork ~sw (fun () ->
156
156
Eio.Flow.copy r f;
157
157
Eio.Flow.close r);
···
260
260
let pp_redirections ppf (i, fd, _) = Fmt.pf ppf "(%i,%a)" i Eio_unix.Fd.pp fd
261
261
262
262
let run ~mode ?delay_reap _ ?stdin ?stdout ?stderr ?(fds = [])
263
-
?(fork_actions = []) ~pgid ~cwd ?env ?executable args =
263
+
?(fork_actions = []) ~pgid ~cwd ~pipe ?env ?executable args =
264
264
with_close_list @@ fun to_close ->
265
265
let check_fd n = function
266
266
| Merry.Types.Parent_redirect (m, _, _) -> Int.equal n m
···
273
273
else
274
274
[
275
275
( 0,
276
-
read_of_fd ~mode stdin ~default:Eio_unix.Fd.stdin ~to_close,
276
+
read_of_fd ~mode ~pipe stdin ~default:Eio_unix.Fd.stdin ~to_close,
277
277
`Blocking );
278
278
])
279
279
@ (if fd_exists 1 then []
280
280
else begin
281
281
[
282
282
( 1,
283
-
write_of_fd ~mode stdout ~default:Eio_unix.Fd.stdout ~to_close,
283
+
write_of_fd ~mode ~pipe stdout ~default:Eio_unix.Fd.stdout
284
+
~to_close,
284
285
`Blocking );
285
286
]
286
287
end)
···
289
290
else
290
291
[
291
292
( 2,
292
-
write_of_fd ~mode stderr ~default:Eio_unix.Fd.stderr ~to_close,
293
+
write_of_fd ~mode stderr ~pipe ~default:Eio_unix.Fd.stderr ~to_close,
293
294
`Blocking );
294
295
]
295
296
in
+3
-3
src/lib/posix/merry_posix.ml
+3
-3
src/lib/posix/merry_posix.ml
···
16
16
| `Signaled n -> Merry.Exit.nonzero () n
17
17
18
18
let exec ?delay_reap ?(fork_actions = []) ?(fds = []) ?stdin ?stdout ?stderr
19
-
?env ~mode ~pgid ~cwd ~executable t args =
19
+
?env ~mode ~pgid ~cwd ~pipe ~executable t args =
20
20
let env =
21
21
Option.map
22
22
(fun lst -> List.map (fun (a, b) -> a ^ "=" ^ b) lst |> Array.of_list)
···
24
24
in
25
25
try
26
26
Ok
27
-
(Exec.run ?delay_reap ~fork_actions ~mode ~fds ~pgid ~cwd ?stdin ?stdout
28
-
?stderr ?env t ~executable args)
27
+
(Exec.run ?delay_reap ~pipe ~fork_actions ~mode ~fds ~pgid ~cwd ?stdin
28
+
?stdout ?stderr ?env t ~executable args)
29
29
with Eio.Io (Eio.Process.E (Eio.Process.Executable_not_found m), _ctx) ->
30
30
Fmt.epr "msh: command not found: %s\n%!" m;
31
31
Error (127, `Not_found)
+26
-6
src/lib/posix/state.ml
+26
-6
src/lib/posix/state.ml
···
1
1
module Variables = Map.Make (String)
2
2
3
-
type attributes = { export : bool; readonly : bool }
3
+
type attributes = { export : bool; readonly : bool; id : string }
4
4
5
-
let default_attribute = { export = false; readonly = false }
5
+
let default_attribute = { export = false; readonly = false; id = "id" }
6
6
7
7
type t = {
8
8
cwd : Fpath.t;
···
13
13
variables : (attributes * string) Variables.t;
14
14
}
15
15
16
-
let update ?(export = false) ?(readonly = false) t ~param v =
16
+
let update ?(id = "") ?(export = false) ?(readonly = false) t ~param v =
17
17
match Variables.find_opt param t.variables with
18
18
| Some ({ readonly = true; _ }, _) ->
19
19
Error (Fmt.str "%s: readonly variable" param)
20
20
| _ ->
21
-
let attr = { export; readonly } in
21
+
let attr = { export; readonly; id } in
22
22
let variables' = Variables.add param (attr, v) t.variables in
23
23
Ok { t with variables = variables' }
24
24
···
44
44
| None -> (false, t)
45
45
| Some _ -> (true, { t with variables = Variables.remove param t.variables })
46
46
47
+
let remove_group ~id t =
48
+
let variables =
49
+
Variables.fold
50
+
(fun param (({ id = id'; _ }, _) as v) vs ->
51
+
if String.equal id id' then vs
52
+
else begin
53
+
Variables.add param v vs
54
+
end)
55
+
t.variables Variables.empty
56
+
in
57
+
{ t with variables }
58
+
47
59
let exports t =
48
60
Variables.to_list t.variables
49
61
|> List.filter_map (function
···
68
80
Fmt.(list ~sep:(Fmt.any "\n") (pair ~sep:(Fmt.any "=") string (quote string)))
69
81
fmt rs
70
82
83
+
let pp_attr ppf attr =
84
+
Fmt.pf ppf "{ export = %b; readonly = %b; id = %a }" attr.export attr.readonly
85
+
Fmt.(quote string)
86
+
attr.id
87
+
88
+
let pp_variable ppf (k, (attr, v)) =
89
+
Fmt.pf ppf "%s={ value = %s; attr = %a }" k v pp_attr attr
90
+
71
91
let dump ppf s =
72
92
Fmt.pf ppf "Variables:[%a]"
73
-
Fmt.(list ~sep:Fmt.comma (pair string string))
74
-
(Variables.to_list s.variables |> List.map (fun (s, (_, v)) -> (s, v)))
93
+
Fmt.(list ~sep:Fmt.comma pp_variable)
94
+
(Variables.to_list s.variables)
+13
src/lib/safe_fd.ml
+13
src/lib/safe_fd.ml
···
1
+
external safefd : Unix.file_descr -> Unix.file_descr = "caml_merry_safefd"
2
+
3
+
let dup fd = safefd fd
4
+
5
+
let pipe sw =
6
+
let r, w = Unix.pipe () in
7
+
let new_r, new_w = (safefd r, safefd w) in
8
+
Unix.close r;
9
+
Unix.close w;
10
+
Unix.set_close_on_exec new_r;
11
+
Unix.set_close_on_exec new_w;
12
+
( Eio_unix.Net.import_socket_stream ~sw ~close_unix:true new_r,
13
+
Eio_unix.Net.import_socket_stream ~sw ~close_unix:true new_w )
+11
src/lib/safe_fd.mli
+11
src/lib/safe_fd.mli
···
1
+
(** This module "safely" provides file descriptors for the shell. In general,
2
+
these need to be opened above 10 to avoid accidentally clashing with
3
+
frequent shellisms like [exec 4>&1]. *)
4
+
5
+
val dup : Unix.file_descr -> Unix.file_descr
6
+
(** Like {! Unix.dup} but guarantees the file descriptor is opened above [10].
7
+
*)
8
+
9
+
val pipe :
10
+
Eio.Switch.t -> Eio_unix.source_ty Eio.Std.r * Eio_unix.sink_ty Eio.Std.r
11
+
(** Like {! Eio_unix.pipe} except it guarantees that the FD is above [10]. *)
+2
-1
src/lib/sast.ml
+2
-1
src/lib/sast.ml
···
127
127
splittable : bool;
128
128
globbable : bool;
129
129
tilde_expansion : bool;
130
-
join : [ `No | `With_previous | `With_next ]; (* Used for "args: [$@]" *)
130
+
join : [ `No | `With_previous | `With_next | `Yes ];
131
+
(* Used for "args: [$@]" *)
131
132
}
132
133
(** Post expansion representation of strings ready for possible field splitting
133
134
and globbing. *)
+11
-1
src/lib/types.ml
+11
-1
src/lib/types.ml
···
24
24
(** Parameter lookup. [None] means [unset]. *)
25
25
26
26
val update :
27
+
?id:string ->
27
28
?export:bool ->
28
29
?readonly:bool ->
29
30
t ->
···
32
33
(t, string) result
33
34
(** Update the state with a new parameter mapping and whether or not it should
34
35
exported to the environment (default false), if it is readonly (default
35
-
false). *)
36
+
false).
37
+
38
+
[id] can be used to group variables together (for example, all of the
39
+
variable that belong to a particular function call or pipeline). *)
36
40
37
41
val remove : param:string -> t -> bool * t
38
42
(** [remove ~param t] removes [param] from [t] if it exists. [bool] is [true]
39
43
if a removal took place. *)
44
+
45
+
val remove_group : id:string -> t -> t
46
+
(** [remove_group ~id t] removes all variables with the [id] group. *)
40
47
41
48
val exports : t -> (string * string) list
42
49
(** All of the variables that must be exported to the environment *)
···
91
98
mode:exec_mode ->
92
99
pgid:int ->
93
100
cwd:Eio.Fs.dir_ty Eio.Path.t ->
101
+
pipe:
102
+
(Eio.Switch.t ->
103
+
Eio_unix.source_ty Eio.Std.r * Eio_unix.sink_ty Eio.Std.r) ->
94
104
executable:string ->
95
105
t ->
96
106
string list ->
+1
test.md
+1
test.md
···
1
+
just one line with some spaces
+10
-3
test/built_ins.t
+10
-3
test/built_ins.t
···
326
326
world
327
327
err woops
328
328
329
+
Simply replacing the process entirely.
330
+
331
+
$ sh -c "exec uname"
332
+
Linux
333
+
$ msh -c "exec uname"
334
+
Linux
335
+
329
336
13. Umask
330
337
331
338
$ msh -c "umask; umask 045; umask"
···
364
371
FOO is
365
372
BAR is
366
373
$ msh test.sh
367
-
FOO is
368
-
BAR is
374
+
FOO is
375
+
BAR is
369
376
370
377
$ cat > test.sh << EOF
371
378
> echo hello > hello.txt
···
415
422
$ msh test.sh --help
416
423
arg --help
417
424
help
418
-
arg
425
+
arg
419
426
no more args
420
427
done
421
428
+1
-1
test/docker/Dockerfile.debootstrap
+1
-1
test/docker/Dockerfile.debootstrap
+2
-2
test/forloops.t
+2
-2
test/forloops.t
+33
test/ifs.t
+33
test/ifs.t
···
1
+
Field separation tests.
2
+
3
+
$ cat > test.sh << EOF
4
+
> count_args () {
5
+
> echo "Got \$# args"
6
+
> }
7
+
> echo "IFS \$IFS"
8
+
> VAR_TO_SPLIT="This is a var to split hahaha"
9
+
> count_args \$VAR_TO_SPLIT
10
+
> OLD_IFS="\$IFS"
11
+
> IFS=" "
12
+
> count_args \$VAR_TO_SPLIT
13
+
> IFS=" "
14
+
> count_args \$VAR_TO_SPLIT
15
+
> IFS="\$OLD_IFS"
16
+
> count_args \$VAR_TO_SPLIT
17
+
> EOF
18
+
19
+
$ sh test.sh
20
+
IFS
21
+
22
+
Got 7 args
23
+
Got 6 args
24
+
Got 2 args
25
+
Got 7 args
26
+
$ msh test.sh
27
+
IFS
28
+
29
+
Got 7 args
30
+
Got 6 args
31
+
Got 2 args
32
+
Got 7 args
33
+
+1
-1
test/non-posix.t
+1
-1
test/non-posix.t
+1
-1
test/options.t
+1
-1
test/options.t
+14
test/random.t
+14
test/random.t
···
22
22
0
23
23
--perl-regexp
24
24
25
+
Another example from the Debian world, this time when installing the
26
+
CA-certificates, the main idea is testing that piping works whenever their are
27
+
compound commands thrown into the mixed.
28
+
29
+
$ cat > test.sh << EOF
30
+
> VAR="world,there,hello"
31
+
> vars=\$( (echo "\$VAR" | tr ',' ' ') | rev)
32
+
> echo "Vars are \$vars"
33
+
> EOF
34
+
35
+
$ sh test.sh
36
+
Vars are olleh ereht dlrow
37
+
$ msh test.sh
38
+
Vars are olleh ereht dlrow