Shells in OCaml
Handle argument expansion better
Still not happy with this implementation, but it is closer to the
specification in terms of field-splitting and handling of awkward
parameters like $@.
+691
-319
+1
dune-project
+1
dune-project
+1
merry.opam
+1
merry.opam
+19
-15
src/bin/main.ml
+19
-15
src/bin/main.ml
···
5
5
Merry.Interactive.Make (Merry_posix.State) (Merry_posix.Exec)
6
6
(Merry.History.Prefix_search)
7
7
8
-
let sh ~command ~dump ~file ~rest env =
8
+
let sh ~command_flag ~dump ~file ~rest env =
9
9
let executor = Merry_posix.Exec.{ mgr = env#process_mgr } in
10
-
let interactive = Option.is_none file && Option.is_none command in
10
+
let interactive = Option.is_none file && rest = [] in
11
11
let pos_zero = match file with Some f -> f | None -> "msh" in
12
12
Eio.Switch.run @@ fun async_switch ->
13
13
let signal_handler f = Eio_posix.run @@ fun _ -> f () in
···
17
17
~home:(Sys.getenv "HOME" ^ "/")
18
18
(Fpath.v (Merry.Eunix.cwd ())))
19
19
executor ~fs:env#fs ~stdin:env#stdin ~stdout:env#stdout ~async_switch
20
-
~argv:(Array.of_list (pos_zero :: rest))
20
+
~argv:(Array.of_list (pos_zero :: (try List.tl rest with _ -> [])))
21
21
~program:pos_zero ~signal_handler
22
22
in
23
-
match (file, command) with
24
-
| None, None -> I.run (Merry.Exit.zero ctx)
23
+
match (file, command_flag) with
24
+
| None, false -> I.run (Merry.Exit.zero ctx)
25
25
| _ ->
26
26
let ast =
27
-
match (file, command) with
28
-
| None, None -> assert false
29
-
| Some file, None -> Merry.Ast.of_file Eio.Path.(env#fs / file)
30
-
| _, Some c -> Merry.Ast.of_string c
27
+
match (file, command_flag, rest) with
28
+
| None, false, _ -> assert false
29
+
| Some file, false, _ -> Merry.Ast.of_file Eio.Path.(env#fs / file)
30
+
| _, true, c :: _ -> Merry.Ast.of_string c
31
+
| _, b, cs -> Fmt.failwith "Bad usage: %b %a" b Fmt.(list string) cs
31
32
in
32
33
if dump then Merry.Ast.Dump.pp Fmt.stdout ast
33
34
else
···
37
38
open Cmdliner
38
39
open Cmdliner.Term.Syntax
39
40
40
-
let command =
41
-
let doc = "command to run" in
42
-
Arg.(value & opt (some string) None & info [ "c"; "C" ] ~doc)
41
+
let command_flag =
42
+
let doc = "Run commands from the command-line" in
43
+
Arg.(value & flag & info [ "c" ] ~doc)
43
44
44
45
let file =
45
46
let doc = "The shell script to execute" in
···
52
53
in
53
54
Arg.(value & flag & info [ "d"; "D"; "dump" ] ~doc)
54
55
55
-
let rest = Arg.(value & pos_right 0 string [] & info [])
56
+
let rest = Arg.(value & pos_all string [] & info [])
56
57
57
58
let cmd env =
58
59
let doc = "Mere's shell." in
···
74
75
in
75
76
Cmd.make (Cmd.info "msh" ~version:"v0.0.1" ~doc ~man)
76
77
@@
77
-
let+ command = command and+ dump = dump and+ file = file and+ rest = rest in
78
-
sh ~command ~dump ~file ~rest env
78
+
let+ command_flag = command_flag
79
+
and+ dump = dump
80
+
and+ file = file
81
+
and+ rest = rest in
82
+
sh ~command_flag ~dump ~file ~rest env
79
83
80
84
let main () = Eio_posix.run @@ fun env -> Cmd.eval (cmd env)
81
85
+2
-3
src/lib/arith.ml
+2
-3
src/lib/arith.ml
···
27
27
let eval initial_state expr =
28
28
let lookup state s =
29
29
match S.lookup state ~param:s with
30
-
| Some [ Ast.WordLiteral n ] when Option.is_some (int_of_string_opt n) ->
31
-
int_of_string n
30
+
| Some n when Option.is_some (int_of_string_opt n) -> int_of_string n
32
31
| _ -> 0
33
32
in
34
33
let update state s i =
35
-
match S.update state ~param:s [ Ast.WordLiteral (string_of_int i) ] with
34
+
match S.update state ~param:s (string_of_int i) with
36
35
| Ok s -> s
37
36
| Error m -> failwith m
38
37
in
+51
-11
src/lib/ast.ml
+51
-11
src/lib/ast.ml
···
748
748
let fname = Eio.Path.native_exn path in
749
749
Eio.Path.load path |> of_string ~filename:fname
750
750
751
-
let rec word_component_to_string : word_component -> string = function
752
-
| WordName s -> s
753
-
| WordLiteral s -> s
754
-
| WordDoubleQuoted s -> word_components_to_string s
755
-
| WordSingleQuoted s -> word_components_to_string s
756
-
| WordGlobAll -> "*"
757
-
| WordGlobAny -> "?"
758
-
| WordEmpty -> ""
759
-
| WordAssignmentWord (Name p, v) -> p ^ "=" ^ word_components_to_string v
751
+
let rec word_component_to_string :
752
+
?field_splitting:bool -> word_component -> string list =
753
+
fun ?(field_splitting = true) -> function
754
+
| WordName s -> [ s ]
755
+
| WordLiteral s -> [ s ]
756
+
| WordDoubleQuoted s -> word_components_to_strings ~field_splitting:false s
757
+
| WordSingleQuoted s -> word_components_to_strings ~field_splitting:false s
758
+
| WordGlobAll -> [ "*" ]
759
+
| WordGlobAny -> [ "?" ]
760
+
| WordEmpty -> [ "" ]
761
+
| WordAssignmentWord (Name p, v) ->
762
+
p :: "=" :: word_components_to_strings ~field_splitting v
760
763
| WordSubshell _ ->
761
764
Fmt.failwith
762
765
"This is an error in Merry, subshells should already have been \
···
765
768
Fmt.failwith "Conversion of %a" Yojson.Safe.pp
766
769
(word_component_to_yojson v)
767
770
768
-
and word_components_to_string ws =
769
-
String.concat "" (List.map word_component_to_string ws)
771
+
and word_components_to_strings ?(field_splitting = true) ws =
772
+
if field_splitting then
773
+
List.concat_map (word_component_to_string ~field_splitting) ws
774
+
else
775
+
[
776
+
String.concat ""
777
+
(List.concat_map (word_component_to_string ~field_splitting) ws);
778
+
]
770
779
771
780
class check_ast =
772
781
object (_)
773
782
inherit [bool] Sast.fold
774
783
method int _ ctx = ctx
784
+
method bool _ ctx = ctx
775
785
method string _ ctx = ctx
776
786
method char _ ctx = ctx
777
787
method option f v ctx = Option.fold ~none:ctx ~some:(fun i -> f i ctx) v
···
822
832
end
823
833
in
824
834
o#word_cst ast false
835
+
836
+
module Fragment = struct
837
+
let make ?(splittable = false) ?(globbable = false) ?(join = `No) txt =
838
+
{ txt; splittable; join; globbable }
839
+
840
+
let empty = make ""
841
+
let to_string { txt; _ } = txt
842
+
let join ~sep f1 f2 = { f1 with txt = f1.txt ^ sep ^ f2.txt }
843
+
let join_list ~sep fs = List.fold_left (join ~sep) empty fs |> to_string
844
+
845
+
let pp_join ppf = function
846
+
| `No -> Fmt.pf ppf "no"
847
+
| `With_previous -> Fmt.pf ppf "with-previous"
848
+
| `With_next -> Fmt.pf ppf "with-next"
849
+
850
+
let pp ppf { txt; join; splittable; globbable } =
851
+
Fmt.pf ppf "{ txt = %s; join = %a; splittable = %b; globbable = %b }" txt
852
+
pp_join join splittable globbable
853
+
854
+
let handle_joins cst =
855
+
let rec loop = function
856
+
| [] -> []
857
+
| x :: { txt; join = `With_previous; _ } :: rest ->
858
+
loop ({ x with txt = x.txt ^ txt } :: rest)
859
+
| { txt; join = `With_next; _ } :: y :: rest ->
860
+
{ y with txt = txt ^ y.txt } :: loop rest
861
+
| x :: xs -> x :: loop xs
862
+
in
863
+
loop cst
864
+
end
+21
-2
src/lib/ast.mli
+21
-2
src/lib/ast.mli
···
19
19
20
20
(* class map : Ppxlib_traverse_builtins.map *)
21
21
22
-
val word_component_to_string : word_component -> string
23
-
val word_components_to_string : word_cst -> string
22
+
val word_component_to_string :
23
+
?field_splitting:bool -> word_component -> string list
24
+
25
+
val word_components_to_strings :
26
+
?field_splitting:bool -> word_cst -> string list
24
27
25
28
val has_async : complete_command -> bool
26
29
(** Checks, recursively, the command to see if there is any use of the async
···
28
31
29
32
val has_glob : word_cst -> bool
30
33
(** Checks whether or not any glob patterns exist in a given word_cst *)
34
+
35
+
module Fragment : sig
36
+
val make :
37
+
?splittable:bool ->
38
+
?globbable:bool ->
39
+
?join:[ `No | `With_next | `With_previous ] ->
40
+
string ->
41
+
fragment
42
+
43
+
val empty : fragment
44
+
val to_string : fragment -> string
45
+
val join : sep:string -> fragment -> fragment -> fragment
46
+
val join_list : sep:string -> fragment list -> string
47
+
val handle_joins : fragment list -> fragment list
48
+
val pp : fragment Fmt.t
49
+
end
31
50
32
51
module Dump : sig
33
52
val pp : t Fmt.t
+318
-264
src/lib/eval.ml
+318
-264
src/lib/eval.ml
···
39
39
rdrs : Types.redirect list;
40
40
signal_handler : signal_handler;
41
41
exit_handler : (unit -> unit) option;
42
+
in_double_quotes : bool;
42
43
}
43
44
44
45
let _stdin ctx = ctx.stdin
···
46
47
let make_ctx ?(interactive = false) ?(subshell = false) ?(local_state = [])
47
48
?(background_jobs = []) ?(last_background_process = "") ?(functions = [])
48
49
?(rdrs = []) ?exit_handler ?(options = Built_ins.Options.default)
49
-
?(hash = Hash.empty) ~fs ~stdin ~stdout ~async_switch ~program ~argv
50
-
~signal_handler state executor =
50
+
?(hash = Hash.empty) ?(in_double_quotes = false) ~fs ~stdin ~stdout
51
+
~async_switch ~program ~argv ~signal_handler state executor =
51
52
let signal_handler = { run = signal_handler; sigint_set = false } in
52
53
{
53
54
interactive;
···
69
70
rdrs;
70
71
signal_handler;
71
72
exit_handler;
73
+
in_double_quotes;
72
74
}
73
75
74
76
let state ctx = ctx.state
···
76
78
let fs ctx = ctx.fs
77
79
let clear_local_state ctx = { ctx with local_state = [] }
78
80
79
-
let rec tilde_expansion ctx = function
80
-
| [] -> []
81
-
| Ast.WordTildePrefix _ :: rest ->
82
-
Ast.WordName (S.expand ctx.state `Tilde) :: tilde_expansion ctx rest
83
-
| v :: rest -> v :: tilde_expansion ctx rest
81
+
let tilde_expansion ctx = function
82
+
| Ast.WordTildePrefix _ -> Ast.WordLiteral (S.expand ctx.state `Tilde)
83
+
| v -> v
84
+
85
+
let word_cst_to_string ?field_splitting v =
86
+
Ast.word_components_to_strings ?field_splitting v |> String.concat ""
84
87
85
-
let arithmetic_expansion ctx expr =
86
-
let rec fold (ctx, cst) = function
87
-
| [] -> (ctx, cst)
88
-
| Ast.WordArithmeticExpression word :: rest ->
89
-
let expr = Ast.word_components_to_string word in
90
-
let aexpr =
91
-
Arith_parser.main Arith_lexer.read (Lexing.from_string expr)
92
-
in
93
-
let state, i = A.eval ctx.state aexpr in
94
-
fold
95
-
({ ctx with state }, Ast.WordLiteral (string_of_int i) :: cst)
96
-
rest
97
-
| Ast.WordDoubleQuoted dq :: rest ->
98
-
let ctx, v = fold (ctx, []) dq in
99
-
fold (ctx, Ast.WordDoubleQuoted (List.rev v) :: cst) rest
100
-
| Ast.WordSingleQuoted dq :: rest ->
101
-
let ctx, v = fold (ctx, []) dq in
102
-
fold (ctx, Ast.WordSingleQuoted (List.rev v) :: cst) rest
103
-
| v :: rest -> fold (ctx, v :: cst) rest
104
-
in
105
-
let state, cst = fold (ctx, []) expr in
106
-
(state, List.rev cst)
88
+
let arithmetic_expansion ctx word =
89
+
let expr = word_cst_to_string word in
90
+
let aexpr = Arith_parser.main Arith_lexer.read (Lexing.from_string expr) in
91
+
let state, i = A.eval ctx.state aexpr in
92
+
({ ctx with state }, Ast.Fragment.make (string_of_int i))
107
93
108
94
let stdout_for_pipeline ~sw ctx = function
109
95
| [] -> (None, `Global ctx.stdout)
···
119
105
match op with
120
106
| Io_op_less ->
121
107
(* Simple redirection for input *)
122
-
let r =
123
-
Eio.Path.open_in ~sw (ctx.fs / Ast.word_components_to_string file)
124
-
in
108
+
let r = Eio.Path.open_in ~sw (ctx.fs / word_cst_to_string file) in
125
109
let fd = Eio_unix.Resource.fd_opt r |> Option.get in
126
110
[ Types.Redirect (n, fd, `Blocking) ]
127
111
| Io_op_lessand -> (
···
148
132
in
149
133
let w =
150
134
Eio.Path.open_out ~sw ~append ~create
151
-
(ctx.fs / Ast.word_components_to_string file)
135
+
(ctx.fs / word_cst_to_string file)
152
136
in
153
137
let fd = Eio_unix.Resource.fd_opt w |> Option.get in
154
138
[ Types.Redirect (n, fd, `Blocking) ]
···
171
155
(* Simple file creation *)
172
156
let w =
173
157
Eio.Path.open_out ~sw ~create:(`If_missing 0o644)
174
-
(ctx.fs / Ast.word_components_to_string file)
158
+
(ctx.fs / word_cst_to_string file)
175
159
in
176
160
let fd = Eio_unix.Resource.fd_opt w |> Option.get in
177
161
[
···
181
165
| Io_op_clobber ->
182
166
let w =
183
167
Eio.Path.open_out ~sw ~create:(`Or_truncate 0o644)
184
-
(ctx.fs / Ast.word_components_to_string file)
168
+
(ctx.fs / word_cst_to_string file)
185
169
in
186
170
let fd = Eio_unix.Resource.fd_opt w |> Option.get in
187
171
[ Types.Redirect (n, fd, `Blocking) ]
···
197
181
198
182
let cwd_of_ctx ctx = S.cwd ctx.state |> Fpath.to_string |> ( / ) ctx.fs
199
183
200
-
let needs_glob_expansion : Ast.word_component -> bool = function
201
-
| WordGlobAll | WordGlobAny -> true
202
-
| _ -> false
203
-
204
184
let resolve_program ?(update = true) ctx name =
205
185
let v =
206
186
if not (String.contains name '/') then begin
207
187
S.lookup ctx.state ~param:"PATH"
208
-
|> Option.map Ast.word_components_to_string
209
188
|> Option.value ~default:"/bin:/usr/bin"
210
189
|> String.split_on_char ':'
211
190
|> List.find_map (fun dir ->
···
224
203
225
204
let get_env ?(extra = []) ctx =
226
205
let extra =
227
-
extra
228
-
@ List.map (fun (k, v) -> (k, Ast.word_components_to_string v))
229
-
@@ S.exports ctx.state
206
+
extra @ List.map (fun (k, v) -> (k, v)) @@ S.exports ctx.state
230
207
in
231
208
let env = Eunix.env () in
232
209
List.fold_left (fun acc (k, _) -> List.remove_assoc k acc) env extra
···
241
218
242
219
let remove_quotes s =
243
220
let s_len = String.length s in
244
-
if s.[0] = '"' && s.[s_len - 1] = '"' then String.sub s 1 (s_len - 2) else s
221
+
let s = if s.[0] = '"' then String.sub s 1 (s_len - 1) else s in
222
+
let s_len = String.length s in
223
+
if s.[s_len - 1] = '"' then String.sub s 0 (s_len - 1) else s
245
224
246
225
let exit ctx code =
247
226
Option.iter (fun f -> f ()) ctx.exit_handler;
···
318
297
loop (Exit.value ctx) job stdout_of_previous
319
298
(Ast.SimpleCommand (Named (executable, suffix)) :: rest)
320
299
| Ast.SimpleCommand (Named (executable, suffix)) :: rest -> (
321
-
let ctx, executable = expand_cst ctx executable in
300
+
let ctx, executable = word_expansion ctx executable in
322
301
match ctx with
323
302
| Exit.Nonzero _ as ctx ->
324
303
let job = handle_job job (`Built_in (Exit.ignore ctx)) in
325
304
loop (Exit.value ctx) job stdout_of_previous rest
326
305
| Exit.Zero ctx -> (
327
-
let executable = handle_word_cst_subshell ctx executable in
328
306
let executable, extra_args =
329
307
(* This is a side-effect of the alias command with something like
330
308
alias ls="ls -la" *)
331
-
match executable with
332
-
| [ Ast.WordLiteral s ] as v -> (
333
-
match String.split_on_char ' ' (remove_quotes s) with
334
-
| exec :: args ->
335
-
( [ Ast.WordName exec ],
336
-
List.map
337
-
(fun w -> Ast.Suffix_word [ Ast.WordName w ])
338
-
args )
339
-
| _ -> (v, []))
340
-
| v -> (v, [])
309
+
match
310
+
Ast.Fragment.join_list ~sep:"" executable
311
+
|> String.split_on_char ' ' |> List.map Ast.Fragment.make
312
+
with
313
+
| [] -> ("", [])
314
+
| exec :: args ->
315
+
( remove_quotes exec.txt,
316
+
List.map
317
+
(fun v ->
318
+
Ast.Suffix_word
319
+
[ Ast.WordLiteral (remove_quotes v.Ast.txt) ])
320
+
args )
341
321
in
342
-
let executable = Ast.word_components_to_string executable in
343
322
let ctx, suffix =
344
323
match suffix with
345
324
| None -> (ctx, [])
···
351
330
let job = handle_job job (`Built_in (Exit.ignore ctx)) in
352
331
loop (Exit.value ctx) job stdout_of_previous rest
353
332
| Exit.Zero ctx -> (
354
-
let args_as_strings =
355
-
List.map Ast.word_components_to_string args
356
-
in
357
333
let some_read, some_write =
358
334
stdout_for_pipeline ~sw:pipeline_switch ctx rest
359
335
in
···
373
349
match handle_redirections ~sw:pipeline_switch ctx rdrs with
374
350
| Error ctx -> (ctx, handle_job job (`Rdr (Exit.nonzero () 1)))
375
351
| Ok rdrs -> (
376
-
match
377
-
Built_ins.of_args (executable :: args_as_strings)
378
-
with
352
+
match Built_ins.of_args (executable :: args) with
379
353
| Some (Error _) ->
380
354
(ctx, handle_job job (`Built_in (Exit.nonzero () 1)))
381
355
| (None | Some (Ok (Command _))) as v -> (
···
415
389
else
416
390
let ctx = { ctx with stdout = some_write } in
417
391
handle_function_application ctx
418
-
~name:executable
419
-
(ctx.program :: args_as_strings)
392
+
~name:executable (ctx.program :: args)
420
393
in
421
394
match func_app with
422
395
| Some ctx ->
···
474
447
Exit.zero ("echo", [ prog ])
475
448
else Exit.zero (x, xs))
476
449
end
477
-
else
478
-
Exit.zero (executable, args_as_strings)
450
+
else Exit.zero (executable, args)
479
451
in
480
452
match exec_and_args with
481
453
| Exit.Nonzero _ as v ->
···
503
475
~stdin:stdout
504
476
~stdout:some_write
505
477
~pgid:(job_pgid job)
506
-
executable args_as_strings
478
+
executable args
507
479
in
508
480
close_stdout ~is_global some_write;
509
481
loop ctx job some_read rest)))))
···
564
536
}
565
537
end
566
538
567
-
and parameter_expansion' ctx ast =
539
+
and parameter_expansion ctx ast : ctx Exit.t * Ast.fragment list list =
568
540
let get_prefix ~pattern ~kind param =
569
541
let _, prefix =
570
542
String.fold_left
···
596
568
in
597
569
prefix
598
570
in
599
-
let rec expand acc ctx = function
600
-
| [] -> (Exit.zero ctx, List.rev acc |> List.concat)
601
-
| Ast.WordVariable v :: rest -> (
571
+
let tl_or_empty v = try List.tl v with _ -> [] in
572
+
let expand ctx v : ctx Exit.t * Ast.fragment list list =
573
+
let module Fragment = struct
574
+
include Ast.Fragment
575
+
576
+
let make ?(join = if ctx.in_double_quotes then `With_previous else `No)
577
+
?globbable ?splittable v =
578
+
Ast.Fragment.make ~join ?splittable ?globbable v
579
+
end in
580
+
match v with
581
+
| Ast.WordVariable v -> (
602
582
match v with
603
583
| Ast.VariableAtom ("!", NoAttribute) ->
604
-
expand
605
-
([ Ast.WordName ctx.last_background_process ] :: acc)
606
-
ctx rest
584
+
(Exit.zero ctx, [ [ Fragment.make ctx.last_background_process ] ])
607
585
| Ast.VariableAtom ("-", NoAttribute) ->
608
586
let i = if ctx.interactive then "i" else "" in
609
-
expand
610
-
([ Ast.WordName (Built_ins.Options.to_letters ctx.options ^ i) ]
611
-
:: acc)
612
-
ctx rest
587
+
( Exit.zero ctx,
588
+
[
589
+
[
590
+
Fragment.make (Built_ins.Options.to_letters ctx.options ^ i);
591
+
];
592
+
] )
593
+
| Ast.VariableAtom ("@", NoAttribute) ->
594
+
let args = tl_or_empty @@ Array.to_list ctx.argv in
595
+
let args =
596
+
if not ctx.in_double_quotes then
597
+
List.map
598
+
(fun v -> [ Fragment.make ~join:`No ~splittable:true v ])
599
+
args
600
+
else
601
+
let l = List.length args in
602
+
List.mapi
603
+
(fun idx arg ->
604
+
if idx = 0 then [ Fragment.make ~join:`With_previous arg ]
605
+
else if idx = l - 1 then
606
+
[ Fragment.make ~join:`With_next arg ]
607
+
else [ Fragment.make ~join:`No arg ])
608
+
args
609
+
in
610
+
611
+
(Exit.zero ctx, args)
612
+
| Ast.VariableAtom ("#", NoAttribute) ->
613
+
( Exit.zero ctx,
614
+
[
615
+
[
616
+
Fragment.make
617
+
(string_of_int
618
+
(List.length @@ tl_or_empty (Array.to_list ctx.argv)));
619
+
];
620
+
] )
613
621
| Ast.VariableAtom (n, NoAttribute)
614
622
when Option.is_some (int_of_string_opt n) -> (
615
623
let n = int_of_string n in
616
624
match Array.get ctx.argv n with
617
-
| v -> expand ([ Ast.WordName v ] :: acc) ctx rest
625
+
| v -> (Exit.zero ctx, [ [ Fragment.make v ] ])
618
626
| exception Invalid_argument _ ->
619
-
expand ([ Ast.WordName "" ] :: acc) ctx rest)
627
+
(Exit.zero ctx, [ [ Fragment.make "" ] ]))
620
628
| Ast.VariableAtom (s, NoAttribute) -> (
621
629
match S.lookup ctx.state ~param:s with
622
630
| None ->
623
631
if ctx.options.no_unset then begin
624
632
( Exit.nonzero_msg ctx ~exit_code:1 "%s: unbound variable" s,
625
-
List.rev acc |> List.concat )
633
+
[ [ Fragment.make "" ] ] )
626
634
end
627
-
else expand ([ Ast.WordName "" ] :: acc) ctx rest
628
-
| Some cst -> expand (cst :: acc) ctx rest)
635
+
else (Exit.zero ctx, [ [ Fragment.make "" ] ])
636
+
| Some cst ->
637
+
( Exit.zero ctx,
638
+
[
639
+
[
640
+
Fragment.make ~splittable:(not ctx.in_double_quotes) cst;
641
+
];
642
+
] ))
629
643
| Ast.VariableAtom (s, ParameterLength) -> (
630
644
match S.lookup ctx.state ~param:s with
631
-
| None -> expand ([ Ast.WordLiteral "0" ] :: acc) ctx rest
645
+
| None -> (Exit.zero ctx, [ [ Fragment.make "0" ] ])
632
646
| Some cst ->
633
-
expand
634
-
([
635
-
Ast.WordLiteral
636
-
(string_of_int
637
-
(String.length (Ast.word_components_to_string cst)));
638
-
]
639
-
:: acc)
640
-
ctx rest)
647
+
( Exit.zero ctx,
648
+
[ [ Fragment.make (string_of_int (String.length cst)) ] ] ))
641
649
| Ast.VariableAtom (s, UseDefaultValues (_, cst)) -> (
642
650
match S.lookup ctx.state ~param:s with
643
-
| None -> expand (cst :: acc) ctx rest
644
-
| Some cst -> expand (cst :: acc) ctx rest)
651
+
| None ->
652
+
(Exit.zero ctx, [ [ Fragment.make (word_cst_to_string cst) ] ])
653
+
| Some cst -> (Exit.zero ctx, [ [ Fragment.make cst ] ]))
645
654
| Ast.VariableAtom
646
655
( s,
647
656
(( RemoveSmallestPrefixPattern cst
648
657
| RemoveLargestPrefixPattern cst ) as v) ) -> (
649
-
let ctx, spp = expand_cst ctx cst in
658
+
let ctx, spp = word_expansion ctx cst in
650
659
match ctx with
651
-
| Exit.Nonzero _ as ctx -> (ctx, List.rev acc |> List.concat)
660
+
| Exit.Nonzero _ as ctx -> (ctx, [ [ Fragment.make "" ] ])
652
661
| Exit.Zero ctx -> (
653
-
let pattern = Ast.word_components_to_string spp in
662
+
let pattern = Fragment.join_list ~sep:"" spp in
654
663
match S.lookup ctx.state ~param:s with
655
-
| None -> expand (cst :: acc) ctx rest
664
+
| None ->
665
+
( Exit.zero ctx,
666
+
[ [ Fragment.make (word_cst_to_string cst) ] ] )
656
667
| Some cst -> (
657
668
let kind =
658
669
match v with
···
660
671
| RemoveLargestPrefixPattern _ -> `Largest
661
672
| _ -> assert false
662
673
in
663
-
let param = Ast.word_components_to_string cst in
674
+
let param = cst in
664
675
let prefix = get_prefix ~pattern ~kind param in
665
676
match prefix with
666
-
| None -> expand ([ Ast.WordName param ] :: acc) ctx rest
677
+
| None -> (Exit.zero ctx, [ [ Fragment.make param ] ])
667
678
| Some s -> (
668
679
match String.cut_prefix ~prefix:s param with
669
-
| Some s ->
670
-
expand ([ Ast.WordName s ] :: acc) ctx rest
671
-
| None ->
672
-
expand ([ Ast.WordName param ] :: acc) ctx rest)))
673
-
)
680
+
| Some s -> (Exit.zero ctx, [ [ Fragment.make s ] ])
681
+
| None -> (Exit.zero ctx, [ [ Fragment.make param ] ])
682
+
))))
674
683
| Ast.VariableAtom
675
684
( s,
676
685
(( RemoveSmallestSuffixPattern cst
677
686
| RemoveLargestSuffixPattern cst ) as v) ) -> (
678
-
let ctx, spp = expand_cst ctx cst in
679
-
let pattern = Ast.word_components_to_string spp in
687
+
let ctx, spp = word_expansion ctx cst in
688
+
let pattern = Fragment.join_list ~sep:"" spp in
680
689
match ctx with
681
-
| Exit.Nonzero _ as ctx -> (ctx, List.rev acc |> List.concat)
690
+
| Exit.Nonzero _ as ctx -> (ctx, [ [ Fragment.empty ] ])
682
691
| Exit.Zero ctx -> (
683
692
match S.lookup ctx.state ~param:s with
684
-
| None -> expand (cst :: acc) ctx rest
693
+
| None ->
694
+
( Exit.zero ctx,
695
+
[ [ Fragment.make (word_cst_to_string cst) ] ] )
685
696
| Some cst -> (
686
697
let kind =
687
698
match v with
···
689
700
| RemoveLargestSuffixPattern _ -> `Largest
690
701
| _ -> assert false
691
702
in
692
-
let param = Ast.word_components_to_string cst in
703
+
let param = cst in
693
704
let suffix = get_suffix ~pattern ~kind param in
694
705
match suffix with
695
-
| None -> expand ([ Ast.WordName param ] :: acc) ctx rest
706
+
| None -> (Exit.zero ctx, [ [ Fragment.make param ] ])
696
707
| Some s -> (
697
708
match String.cut_suffix ~suffix:s param with
698
-
| Some s ->
699
-
expand ([ Ast.WordName s ] :: acc) ctx rest
700
-
| None ->
701
-
expand ([ Ast.WordName param ] :: acc) ctx rest)))
702
-
)
709
+
| Some s -> (Exit.zero ctx, [ [ Fragment.make s ] ])
710
+
| None -> (Exit.zero ctx, [ [ Fragment.make param ] ])
711
+
))))
703
712
| Ast.VariableAtom (s, UseAlternativeValue (_, alt)) -> (
704
713
match S.lookup ctx.state ~param:s with
705
-
| Some _ -> expand (alt :: acc) ctx rest
706
-
| None -> expand ([ Ast.WordEmpty ] :: acc) ctx rest)
714
+
| Some _ ->
715
+
(Exit.zero ctx, [ [ Fragment.make (word_cst_to_string alt) ] ])
716
+
| None -> (Exit.zero ctx, [ [ Fragment.empty ] ]))
707
717
| Ast.VariableAtom (s, AssignDefaultValues (_, value)) -> (
708
718
match S.lookup ctx.state ~param:s with
709
-
| Some cst -> expand (cst :: acc) ctx rest
719
+
| Some cst -> (Exit.zero ctx, [ [ Fragment.make cst ] ])
710
720
| None -> (
711
-
match S.update ctx.state ~param:s value with
721
+
match
722
+
S.update ctx.state ~param:s (word_cst_to_string value)
723
+
with
712
724
| Ok state ->
713
725
let new_ctx = { ctx with state } in
714
-
expand (value :: acc) new_ctx rest
726
+
( Exit.zero new_ctx,
727
+
[ [ Fragment.make (word_cst_to_string value) ] ] )
715
728
| Error m ->
716
729
( Exit.nonzero_msg ~exit_code:1 ctx "%s" m,
717
-
List.rev acc |> List.concat )))
730
+
[ [ Fragment.empty ] ] )))
718
731
| Ast.VariableAtom (_, IndicateErrorifNullorUnset (_, _)) ->
719
732
Fmt.failwith "TODO: Indicate Error")
720
-
| Ast.WordDoubleQuoted cst :: rest -> (
721
-
let new_ctx, cst_acc = expand [] ctx cst in
733
+
| Ast.WordDoubleQuoted cst -> (
734
+
let ctx = { ctx with in_double_quotes = true } in
735
+
let new_ctx, cst_acc = word_expansion ctx cst in
736
+
(* We now do any joining for $@... *)
737
+
let cst_acc = Fragment.handle_joins cst_acc in
738
+
let new_ctx =
739
+
Exit.map
740
+
~f:(fun ctx -> { ctx with in_double_quotes = false })
741
+
new_ctx
742
+
in
722
743
match new_ctx with
723
-
| Exit.Nonzero _ -> (new_ctx, cst_acc)
724
-
| Exit.Zero new_ctx ->
725
-
expand ([ Ast.WordDoubleQuoted cst_acc ] :: acc) new_ctx rest)
726
-
| Ast.WordSingleQuoted cst :: rest -> (
727
-
let new_ctx, cst_acc = expand [] ctx cst in
744
+
| Exit.Nonzero _ -> (new_ctx, [ cst_acc ])
745
+
| Exit.Zero new_ctx -> (Exit.zero new_ctx, [ cst_acc ]))
746
+
| Ast.WordSingleQuoted cst -> (
747
+
let ctx = { ctx with in_double_quotes = true } in
748
+
let new_ctx, cst_acc = word_expansion ctx cst in
749
+
let new_ctx =
750
+
Exit.map
751
+
~f:(fun ctx -> { ctx with in_double_quotes = false })
752
+
new_ctx
753
+
in
728
754
match new_ctx with
729
-
| Exit.Nonzero _ -> (new_ctx, cst_acc)
730
-
| Exit.Zero new_ctx ->
731
-
expand ([ Ast.WordSingleQuoted cst_acc ] :: acc) new_ctx rest)
732
-
| Ast.WordAssignmentWord (n, w) :: rest -> (
733
-
let new_ctx, cst_acc = expand [] ctx w in
755
+
| Exit.Nonzero _ -> (new_ctx, [ cst_acc ])
756
+
| Exit.Zero new_ctx -> (Exit.zero new_ctx, [ cst_acc ]))
757
+
| Ast.WordAssignmentWord (Name n, w) -> (
758
+
let new_ctx, cst_acc = word_expansion ctx w in
734
759
match new_ctx with
735
-
| Exit.Nonzero _ -> (new_ctx, cst_acc)
736
-
| Exit.Zero new_ctx ->
737
-
expand
738
-
([ Ast.WordAssignmentWord (n, cst_acc) ] :: acc)
739
-
new_ctx rest)
740
-
| v :: rest -> expand ([ v ] :: acc) ctx rest
760
+
| Exit.Nonzero _ -> (new_ctx, [ cst_acc ])
761
+
| Exit.Zero _ ->
762
+
( new_ctx,
763
+
[
764
+
[
765
+
Fragment.make
766
+
(n ^ "="
767
+
^ Fragment.join_list ~sep:"" (List.concat [ cst_acc ]));
768
+
];
769
+
] ))
770
+
| Ast.WordSubshell sub ->
771
+
(* Command substitution *)
772
+
let s = command_substitution ctx sub in
773
+
(Exit.zero ctx, [ [ Fragment.make s ] ])
774
+
| Ast.WordArithmeticExpression cst ->
775
+
arithmetic_expansion ctx cst |> fun (ctx, v) ->
776
+
(Exit.zero ctx, [ [ v ] ])
777
+
| Ast.WordName s -> (Exit.zero ctx, [ [ Fragment.make s ] ])
778
+
| Ast.WordLiteral s -> (Exit.zero ctx, [ [ Fragment.make s ] ])
779
+
| Ast.WordGlobAll ->
780
+
(Exit.zero ctx, [ [ Fragment.make ~globbable:true "*" ] ])
781
+
| Ast.WordGlobAny ->
782
+
(Exit.zero ctx, [ [ Fragment.make ~globbable:true "?" ] ])
783
+
| v ->
784
+
Fmt.failwith "TODO: expansion of %a" yojson_pp
785
+
(Ast.word_component_to_yojson v)
741
786
in
742
-
expand [] ctx ast
787
+
expand ctx ast
788
+
789
+
and field_splitting ctx = function
790
+
| [] -> []
791
+
| Ast.{ splittable = true; txt; _ } :: rest ->
792
+
(String.split_on_char ' ' txt |> List.map Ast.Fragment.make)
793
+
@ field_splitting ctx rest
794
+
| txt :: rest -> txt :: field_splitting ctx rest
743
795
744
-
and handle_export_or_readonly kind ctx (assignments : Ast.word_cst list) =
796
+
and word_expansion' ctx cst : ctx Exit.t * Ast.fragments list =
797
+
let cst = tilde_expansion ctx cst in
798
+
parameter_expansion ctx cst
799
+
800
+
and word_expansion ctx cst : ctx Exit.t * Ast.fragment list =
801
+
let rec aux ctx = function
802
+
| [] -> (ctx, []) (* one empty word *)
803
+
| c :: rest ->
804
+
let new_ctx, l = word_expansion' (Exit.value ctx) c in
805
+
let next_ctx, r = aux new_ctx rest in
806
+
let combined = l @ r in
807
+
(next_ctx, combined)
808
+
in
809
+
let ctx, cst = aux (Exit.zero ctx) cst in
810
+
match ctx with
811
+
| Exit.Nonzero _ -> (ctx, List.concat cst)
812
+
| Exit.Zero ctx ->
813
+
let fields = cst in
814
+
let fields = List.map (field_splitting ctx) fields in
815
+
let (ctx, cst) : ctx * Ast.fragments list =
816
+
begin
817
+
let glob = Ast.Fragment.join_list ~sep:"" (List.concat fields) in
818
+
let vs : Ast.fragments list =
819
+
let has_glob =
820
+
List.exists
821
+
(fun (f : Ast.fragment) -> f.globbable)
822
+
(List.concat fields)
823
+
in
824
+
let _new_ctx, s =
825
+
if (not ctx.options.no_path_expansion) && has_glob then
826
+
glob_expand ctx glob
827
+
else if ctx.options.no_path_expansion && has_glob then
828
+
(ctx, [ Ast.Fragment.make glob ])
829
+
else (ctx, List.concat fields)
830
+
in
831
+
[ s ]
832
+
in
833
+
(ctx, vs)
834
+
end
835
+
in
836
+
(Exit.zero ctx, List.concat cst)
837
+
838
+
and handle_export_or_readonly kind ctx (assignments : string list) =
745
839
let flags, assignments =
746
840
List.fold_left
747
-
(fun (fs, args) -> function
748
-
| [ Ast.WordName v ] | [ Ast.WordLiteral v ] -> (
749
-
match Astring.String.cut ~sep:"-" v with
750
-
| Some ("", f) -> (f :: fs, args)
751
-
| _ -> (fs, [ Ast.WordName v ] :: args))
752
-
| v -> (fs, v :: args))
841
+
(fun (fs, args) v ->
842
+
match Astring.String.cut ~sep:"-" v with
843
+
| Some ("", f) -> (f :: fs, args)
844
+
| _ -> (fs, v :: args))
753
845
([], []) assignments
754
846
in
755
847
let update =
···
757
849
| `Export -> update ~export:true ~readonly:false
758
850
| `Readonly -> update ~export:false ~readonly:true
759
851
in
760
-
let rec loop acc_ctx = function
761
-
| [] -> Exit.zero acc_ctx
762
-
| Ast.WordAssignmentWord (Name param, v) :: rest ->
763
-
update acc_ctx ~param v >>= fun new_ctx -> loop new_ctx rest
764
-
| Ast.WordName param :: rest -> (
852
+
let read_arg acc_ctx param =
853
+
(* TODO: quoting? *)
854
+
match Astring.String.cut ~sep:"=" param with
855
+
| Some (param, v) -> update acc_ctx ~param v
856
+
| None -> (
765
857
match S.lookup acc_ctx.state ~param with
766
-
| Some v ->
767
-
update acc_ctx ~param v >>= fun new_ctx -> loop new_ctx rest
768
-
| None -> loop acc_ctx rest)
769
-
| c :: _ ->
770
-
Exit.nonzero_msg acc_ctx "export weird arguments: %s\n"
771
-
(Ast.word_component_to_string c)
858
+
| Some v -> update acc_ctx ~param v
859
+
| None -> Exit.zero acc_ctx)
772
860
in
773
861
match flags with
774
862
| [] ->
775
863
List.fold_left
776
-
(fun ctx w -> match ctx with Exit.Zero ctx -> loop ctx w | _ -> ctx)
864
+
(fun ctx w ->
865
+
match ctx with Exit.Zero ctx -> read_arg ctx w | _ -> ctx)
777
866
(Exit.zero ctx) assignments
778
867
| fs ->
779
868
if List.mem "p" fs then begin
···
783
872
end;
784
873
Exit.zero ctx
785
874
786
-
and expand_cst (ctx : ctx) cst : ctx Exit.t * Ast.word_cst =
787
-
let cst = tilde_expansion ctx cst in
788
-
let ctx, cst = parameter_expansion' ctx cst in
789
-
match ctx with
790
-
| Exit.Nonzero _ as ctx -> (ctx, cst)
791
-
| Exit.Zero ctx ->
792
-
(* TODO: Propagate errors *)
793
-
let ctx, ast = arithmetic_expansion ctx cst in
794
-
(Exit.zero ctx, ast)
795
-
796
875
and expand_redirects ((ctx, acc) : ctx * Ast.cmd_suffix_item list)
797
876
(c : Ast.cmd_suffix_item list) =
798
877
match c with
799
878
| [] -> (ctx, List.rev acc)
800
879
| Ast.Suffix_redirect (IoRedirect_IoFile (num, (op, file))) :: rest -> (
801
-
let ctx, cst = expand_cst ctx file in
880
+
let ctx, cst = word_expansion ctx file in
802
881
match ctx with
803
-
| Exit.Nonzero _ -> assert false
882
+
| Exit.Nonzero _ -> Fmt.failwith "Redirect expansion"
804
883
| Exit.Zero ctx ->
805
-
let cst = handle_subshell ctx cst in
884
+
let cst =
885
+
List.map (fun Ast.{ txt; _ } -> Ast.WordLiteral txt) cst
886
+
in
806
887
let v = Ast.Suffix_redirect (IoRedirect_IoFile (num, (op, cst))) in
807
888
expand_redirects (ctx, v :: acc) rest)
808
889
| (Ast.Suffix_redirect _ as v) :: rest ->
···
857
938
match v with
858
939
| Ast.For_Name_DoGroup (_, (term, sep)) -> exec ctx (term, Some sep)
859
940
| Ast.For_Name_In_WordList_DoGroup (Name name, wdlist, (term, sep)) ->
860
-
let wdlist = Nlist.flatten @@ Nlist.map (word_glob_expand ctx) wdlist in
941
+
let wdlist = Nlist.map (word_expansion ctx) wdlist in
861
942
Nlist.fold_left
862
-
(fun _ word ->
863
-
update ctx ~param:name word >>= fun ctx -> exec ctx (term, Some sep))
943
+
(fun _ (_, words) ->
944
+
List.fold_left
945
+
(fun _ word ->
946
+
update ctx ~param:name word.Ast.txt >>= fun ctx ->
947
+
exec ctx (term, Some sep))
948
+
(Exit.zero ctx) words)
864
949
(Exit.zero ctx) wdlist
865
950
866
951
and handle_if_clause ctx = function
···
891
976
and handle_case_clause ctx = function
892
977
| Ast.Case _ -> Exit.zero ctx
893
978
| Cases (word, case_list) -> (
894
-
let ctx, word = expand_cst ctx word in
979
+
let ctx, word = word_expansion ctx word in
895
980
match ctx with
896
981
| Exit.Nonzero _ as ctx -> ctx
897
982
| Exit.Zero ctx -> (
898
-
let scrutinee = Ast.word_components_to_string word in
983
+
let scrutinee = Ast.Fragment.join_list ~sep:"" word in
899
984
let res =
900
985
Nlist.fold_left
901
986
(fun acc pat ->
···
908
993
(fun inner_acc pattern ->
909
994
match inner_acc with
910
995
| Some _ as v -> v
911
-
| None -> (
912
-
let ctx, pattern = expand_cst ctx pattern in
913
-
match ctx with
914
-
| Exit.Nonzero _ as ctx -> Some ctx
915
-
| Exit.Zero ctx ->
916
-
let pattern =
917
-
Ast.word_components_to_string pattern
918
-
in
919
-
if Glob.test ~pattern scrutinee then begin
920
-
match sub with
921
-
| Some sub ->
922
-
Some (exec_subshell ctx sub)
923
-
| None -> Some (Exit.zero ctx)
924
-
end
925
-
else inner_acc))
996
+
| None ->
997
+
let pattern = word_cst_to_string pattern in
998
+
if Glob.test ~pattern scrutinee then begin
999
+
match sub with
1000
+
| Some sub -> Some (exec_subshell ctx sub)
1001
+
| None -> Some (Exit.zero ctx)
1002
+
end
1003
+
else inner_acc)
926
1004
None p))
927
1005
None case_list
928
1006
in
···
971
1049
let ctx = { ctx with argv = Array.of_list argv } in
972
1050
Option.some @@ (handle_compound_command ctx commands >|= fun _ -> ctx)
973
1051
974
-
and needs_subshelling = function
975
-
| [] -> false
976
-
| Ast.WordSubshell _ :: _ -> true
977
-
| Ast.WordDoubleQuoted word :: rest ->
978
-
needs_subshelling word || needs_subshelling rest
979
-
| Ast.WordSingleQuoted word :: rest ->
980
-
needs_subshelling word || needs_subshelling rest
981
-
| _ -> false
982
-
983
-
and handle_subshell (ctx : ctx) wcs =
984
-
let exec_subshell ~sw ctx s =
1052
+
and command_substitution (ctx : ctx) (cc : Ast.complete_commands) =
1053
+
let exec_subshell ctx s =
985
1054
let buf = Buffer.create 16 in
986
1055
let stdout = Eio.Flow.buffer_sink buf in
987
-
let r, w = Eio_unix.pipe sw in
988
-
Eio.Fiber.fork ~sw (fun () -> Eio.Flow.copy r stdout);
989
-
let subshell_ctx = { ctx with stdout = w; subshell = true } in
990
-
let sub_ctx, _ = run (Exit.zero subshell_ctx) s in
991
-
Eio.Flow.close w;
1056
+
let sub_ctx =
1057
+
Eio.Switch.run @@ fun sw ->
1058
+
let r, w = Eio_unix.pipe sw in
1059
+
Eio.Fiber.fork ~sw (fun () -> Eio.Flow.copy r stdout);
1060
+
let subshell_ctx = { ctx with stdout = w; subshell = true } in
1061
+
let sub_ctx, _ = run (Exit.zero subshell_ctx) s in
1062
+
Eio.Flow.close w;
1063
+
sub_ctx
1064
+
in
992
1065
((sub_ctx >|= fun _ -> ctx), Buffer.contents buf)
993
1066
in
994
-
let rec run_subshells ~sw ran_subshell = function
995
-
| [] -> []
996
-
| Ast.WordSubshell s :: rest ->
997
-
let _ctx, std = exec_subshell ~sw ctx s in
998
-
ran_subshell := true;
999
-
Ast.WordName (String.trim std) :: run_subshells ~sw ran_subshell rest
1000
-
| Ast.WordDoubleQuoted word :: rest ->
1001
-
let subshell_q = ref false in
1002
-
let res = run_subshells ~sw subshell_q word in
1003
-
if !subshell_q then res @ run_subshells ~sw subshell_q rest
1004
-
else Ast.WordDoubleQuoted res :: run_subshells ~sw subshell_q rest
1005
-
| Ast.WordSingleQuoted word :: rest ->
1006
-
let subshell_q = ref false in
1007
-
let res = run_subshells ~sw subshell_q word in
1008
-
if !subshell_q then res @ run_subshells ~sw subshell_q rest
1009
-
else Ast.WordSingleQuoted res :: run_subshells ~sw subshell_q rest
1010
-
| v :: rest -> v :: run_subshells ~sw ran_subshell rest
1067
+
let run_subshells s =
1068
+
let _ctx, std = exec_subshell ctx s in
1069
+
String.trim std
1011
1070
in
1012
-
Eio.Switch.run @@ fun sw -> run_subshells ~sw (ref false) wcs
1013
-
1014
-
and handle_word_cst_subshell (ctx : ctx) wcs : Ast.word_cst =
1015
-
if needs_subshelling wcs then begin
1016
-
let wcs = handle_subshell ctx wcs in
1017
-
wcs
1018
-
end
1019
-
else wcs
1020
-
1021
-
and glob_expand ctx wc =
1022
-
let wc = handle_word_cst_subshell ctx wc in
1023
-
if Ast.has_glob wc && not ctx.options.no_path_expansion then
1024
-
Ast.word_components_to_string wc |> fun pattern ->
1025
-
Glob.glob_dir ~pattern (cwd_of_ctx ctx)
1026
-
|> List.map (fun w -> [ Ast.WordName w ])
1027
-
else [ wc ]
1071
+
run_subshells cc
1028
1072
1029
-
and word_glob_expand (ctx : ctx) wc : Ast.word_cst list =
1030
-
if List.exists needs_glob_expansion wc then glob_expand ctx wc
1031
-
else [ handle_word_cst_subshell ctx wc ]
1073
+
and glob_expand ctx pattern : ctx * Ast.fragment list =
1074
+
( ctx,
1075
+
match Glob.glob_dir ~pattern (cwd_of_ctx ctx) with
1076
+
| [] -> [ Ast.Fragment.make pattern ]
1077
+
| exception _ -> [ Ast.Fragment.make pattern ]
1078
+
| xs -> List.map Ast.Fragment.make xs )
1032
1079
1033
1080
and collect_assignments ?(update = true) ctx vs : ctx Exit.t =
1034
1081
List.fold_left
···
1039
1086
match prefix with
1040
1087
| Ast.Prefix_assignment (Name param, v) -> (
1041
1088
(* Expand the values *)
1042
-
let ctx, v = expand_cst ctx v in
1089
+
let ctx, v = word_expansion ctx v in
1043
1090
match ctx with
1044
1091
| Exit.Nonzero _ as ctx -> ctx
1045
1092
| Exit.Zero ctx -> (
1046
-
let v = handle_subshell ctx v in
1047
1093
let state =
1048
-
if update then S.update ctx.state ~param v
1094
+
if update then
1095
+
S.update ctx.state ~param
1096
+
(Ast.Fragment.join_list ~sep:"" v)
1049
1097
else Ok ctx.state
1050
1098
in
1051
1099
match state with
···
1056
1104
ctx with
1057
1105
state;
1058
1106
local_state =
1059
-
(param, Ast.word_components_to_string v)
1107
+
(param, Ast.Fragment.join_list ~sep:"" v)
1060
1108
:: ctx.local_state;
1061
1109
}))
1062
1110
| _ -> Exit.zero ctx))
1063
1111
(Exit.zero ctx) vs
1064
1112
1065
-
and args ctx swc : ctx Exit.t * Ast.word_cst list =
1066
-
List.fold_left
1067
-
(fun (ctx, acc) -> function
1068
-
| Ast.Suffix_redirect _ -> (ctx, acc)
1069
-
| Suffix_word wc -> (
1070
-
match ctx with
1071
-
| Exit.Nonzero _ as ctx -> (ctx, acc)
1072
-
| Exit.Zero ctx -> (
1073
-
let ctx, cst = expand_cst ctx wc in
1074
-
match ctx with
1075
-
| Exit.Nonzero _ as ctx -> (ctx, acc)
1076
-
| Exit.Zero c as ctx -> (ctx, acc @ word_glob_expand c cst))))
1077
-
(Exit.zero ctx, [])
1078
-
swc
1113
+
and args ctx swc : ctx Exit.t * string list =
1114
+
let ctx, fs =
1115
+
List.fold_left
1116
+
(fun (ctx, acc) -> function
1117
+
| Ast.Suffix_redirect _ -> (ctx, acc)
1118
+
| Suffix_word wc -> (
1119
+
match ctx with
1120
+
| Exit.Nonzero _ as ctx -> (ctx, acc)
1121
+
| Exit.Zero ctx -> (
1122
+
let ctx, cst = word_expansion ctx wc in
1123
+
let cst = Ast.Fragment.handle_joins cst in
1124
+
(* Fmt.pr "Expanding: %a\n%!" Fmt.(list Ast.Fragment.pp) cst; *)
1125
+
match ctx with
1126
+
| Exit.Nonzero _ as ctx -> (ctx, acc)
1127
+
| Exit.Zero _ as ctx -> (ctx, acc @ cst))))
1128
+
(Exit.zero ctx, [])
1129
+
swc
1130
+
in
1131
+
(* Fmt.pr "Arguments: %a\n%!" Fmt.(list Ast.Fragment.pp) fs; *)
1132
+
(ctx, List.map Ast.Fragment.to_string fs)
1079
1133
1080
1134
and handle_built_in ~rdrs ~(stdout : Eio_unix.sink_ty Eio.Flow.sink)
1081
1135
(ctx : ctx) v =
+6
src/lib/eval.mli
+6
src/lib/eval.mli
···
21
21
?exit_handler:(unit -> unit) ->
22
22
?options:Built_ins.Options.t ->
23
23
?hash:Hash.t ->
24
+
?in_double_quotes:bool ->
24
25
fs:Eio.Fs.dir_ty Eio.Path.t ->
25
26
stdin:Eio_unix.source_ty r ->
26
27
stdout:Eio_unix.sink_ty r ->
···
43
44
44
45
val run : ctx Exit.t -> Ast.t -> ctx Exit.t * Ast.t list
45
46
(** [run ctx ast] evaluates [ast] using the initial [ctx]. *)
47
+
48
+
(** {2 Private} *)
49
+
50
+
val word_expansion : ctx -> Ast.word_cst -> ctx Exit.t * Ast.fragment list
51
+
(* Mostly for testing purposes, this exposes the logic for expanding words. *)
46
52
end
+1
-2
src/lib/interactive.ml
+1
-2
src/lib/interactive.ml
···
94
94
in
95
95
let rec loop (ctx : Eval.ctx Exit.t) =
96
96
Option.iter (Fmt.epr "%s%!")
97
-
(S.lookup (Exit.value ctx |> Eval.state) ~param:"PS1"
98
-
|> Option.map Ast.word_components_to_string);
97
+
(S.lookup (Exit.value ctx |> Eval.state) ~param:"PS1");
99
98
let p = prompt ctx in
100
99
Fmt.pr "%s\r%!" p;
101
100
let hint command =
+6
-18
src/lib/posix/state.ml
+6
-18
src/lib/posix/state.ml
···
10
10
root : int;
11
11
outermost : bool;
12
12
home : string;
13
-
variables : (attributes * Merry.Ast.word_cst) Variables.t;
13
+
variables : (attributes * string) Variables.t;
14
14
}
15
15
16
16
let update ?(export = false) ?(readonly = false) t ~param v =
···
26
26
let env = Merry.Eunix.env () in
27
27
List.fold_left
28
28
(fun vars (param, v) ->
29
-
Variables.add param
30
-
({ default_attribute with export = true }, [ Merry.Ast.WordName v ])
31
-
vars)
29
+
Variables.add param ({ default_attribute with export = true }, v) vars)
32
30
Variables.empty env
33
31
34
32
let make ?(functions = []) ?(root = 0) ?(outermost = true) ?(home = "/root")
···
60
58
61
59
let pp_readonly fmt t =
62
60
let rs = readonly t in
63
-
let rs =
64
-
List.map
65
-
(fun (p, cst) ->
66
-
("readonly " ^ p, Merry.Ast.word_components_to_string cst))
67
-
rs
68
-
in
61
+
let rs = List.map (fun (p, cst) -> ("readonly " ^ p, cst)) rs in
69
62
Fmt.(list ~sep:(Fmt.any "\n") (pair ~sep:(Fmt.any "=") string (quote string)))
70
63
fmt rs
71
64
72
65
let pp_export fmt t =
73
66
let rs = exports t in
74
-
let rs =
75
-
List.map
76
-
(fun (p, cst) -> ("export " ^ p, Merry.Ast.word_components_to_string cst))
77
-
rs
78
-
in
67
+
let rs = List.map (fun (p, cst) -> ("export " ^ p, cst)) rs in
79
68
Fmt.(list ~sep:(Fmt.any "\n") (pair ~sep:(Fmt.any "=") string (quote string)))
80
69
fmt rs
81
70
82
71
let dump ppf s =
83
72
Fmt.pf ppf "Variables:[%a]"
84
-
Fmt.(list ~sep:Fmt.comma (pair string Yojson.Safe.pp))
85
-
(Variables.to_list s.variables
86
-
|> List.map (fun (s, (_, v)) -> (s, Merry.Ast.word_cst_to_yojson v)))
73
+
Fmt.(list ~sep:Fmt.comma (pair string string))
74
+
(Variables.to_list s.variables |> List.map (fun (s, (_, v)) -> (s, v)))
+11
src/lib/sast.ml
+11
src/lib/sast.ml
···
126
126
(* Empty CST. Useful to represent the absence of relevant CSTs. *)
127
127
| WordEmpty
128
128
129
+
and fragment = {
130
+
txt : string;
131
+
splittable : bool;
132
+
globbable : bool;
133
+
join : [ `No | `With_previous | `With_next ]; (* Used for "args: [$@]" *)
134
+
}
135
+
(** Post expansion representation of strings ready for possible field splitting
136
+
and globbing. *)
137
+
138
+
and fragments = fragment list
139
+
129
140
and bracket_expression =
130
141
| BracketExpression_LBRACKET_MatchingList_RBRACKET of matching_list
131
142
| BracketExpression_LBRACKET_NonMatchingList_RBRACKET of nonmatching_list
+4
-4
src/lib/types.ml
+4
-4
src/lib/types.ml
···
20
20
val expand : t -> [ `Tilde ] -> string
21
21
(** Expansions *)
22
22
23
-
val lookup : t -> param:string -> Ast.word_cst option
23
+
val lookup : t -> param:string -> string option
24
24
(** Parameter lookup. [None] means [unset]. *)
25
25
26
26
val update :
···
28
28
?readonly:bool ->
29
29
t ->
30
30
param:string ->
31
-
Ast.word_cst ->
31
+
string ->
32
32
(t, string) result
33
33
(** Update the state with a new parameter mapping and whether or not it should
34
34
exported to the environment (default false). *)
···
37
37
(** [remove ~param t] removes [param] from [t] if it exists. [bool] is [true]
38
38
if a removal took place. *)
39
39
40
-
val exports : t -> (string * Ast.word_cst) list
40
+
val exports : t -> (string * string) list
41
41
(** All of the variables that must be exported to the environment *)
42
42
43
-
val readonly : t -> (string * Ast.word_cst) list
43
+
val readonly : t -> (string * string) list
44
44
(** All of the variables that must be exported to the environment *)
45
45
46
46
val pp_readonly : t Fmt.t
+67
src/lib/util.ml
+67
src/lib/util.ml
···
1
+
(* Some random utils for debugging *)
2
+
open Eio.Std
3
+
4
+
let traced_sink tag
5
+
(Eio.Resource.T (t, handler) : Eio_unix.sink_ty Eio.Flow.sink) :
6
+
Eio_unix.sink_ty r =
7
+
let module Sink = (val Eio.Resource.get handler Eio.Flow.Pi.Sink) in
8
+
let close = Eio.Resource.get handler Eio.Resource.Close in
9
+
let buf = Cstruct.create 4096 in
10
+
let copy () ~src =
11
+
try
12
+
while true do
13
+
match Eio.Flow.single_read src buf with
14
+
| i ->
15
+
Eio.traceln ">>>>> %s Single read: %s" tag (Cstruct.to_string buf);
16
+
let bufs = [ Cstruct.sub buf 0 i ] in
17
+
Sink.copy ~src:(Eio.Flow.cstruct_source bufs) t
18
+
done
19
+
with End_of_file -> Eio.traceln ">>>>>> EOF"
20
+
in
21
+
let single_write () x =
22
+
Eio.traceln ">>>>> single write: %s" (Cstruct.concat x |> Cstruct.to_string);
23
+
Sink.single_write t x
24
+
in
25
+
let module T = struct
26
+
type t = unit
27
+
28
+
let single_write = single_write
29
+
let copy = copy
30
+
end in
31
+
let t =
32
+
Eio.Resource.handler
33
+
[
34
+
H (Eio.Flow.Pi.Sink, (module T));
35
+
H (Eio.Resource.Close, fun () -> close t);
36
+
]
37
+
in
38
+
Eio.Resource.T ((), t)
39
+
40
+
let traced_sink_flow tag
41
+
(Eio.Resource.T (t, handler) : Eio.Flow.sink_ty Eio.Flow.sink) :
42
+
Eio.Flow.sink_ty r =
43
+
let module Sink = (val Eio.Resource.get handler Eio.Flow.Pi.Sink) in
44
+
let buf = Cstruct.create 4096 in
45
+
let copy () ~src =
46
+
try
47
+
while true do
48
+
match Eio.Flow.single_read src buf with
49
+
| i ->
50
+
Eio.traceln ">>>>> %s Single read: %s" tag (Cstruct.to_string buf);
51
+
let bufs = [ Cstruct.sub buf 0 i ] in
52
+
Sink.copy ~src:(Eio.Flow.cstruct_source bufs) t
53
+
done
54
+
with End_of_file -> Eio.traceln ">>>>>> EOF"
55
+
in
56
+
let single_write () x =
57
+
Eio.traceln ">>>>> single write: %s" (Cstruct.concat x |> Cstruct.to_string);
58
+
Sink.single_write t x
59
+
in
60
+
let module T = struct
61
+
type t = unit
62
+
63
+
let single_write = single_write
64
+
let copy = copy
65
+
end in
66
+
let t = Eio.Resource.handler [ H (Eio.Flow.Pi.Sink, (module T)) ] in
67
+
Eio.Resource.T ((), t)
+1
src/lib/wordexp.ml
+1
src/lib/wordexp.ml
···
1
+
(* Word expansion. *)
+3
test/debootstrap/Dockerfile
+3
test/debootstrap/Dockerfile
+4
test/dune
+4
test/dune
test/fields.t
test/fields.t
This is a binary file and will not be displayed.
+31
test/ryan.t
+31
test/ryan.t
···
1
+
Test cases from the mind of Ryan Gibb; only those that were designed to torture
2
+
shell users and shell authors alike.
3
+
4
+
$ cat > test.sh << EOF
5
+
>
6
+
> for arg in \$@; do
7
+
> echo "No quote: \$arg"
8
+
> done
9
+
>
10
+
> for arg in "\$@"; do
11
+
> echo "In quotes quote: \$arg"
12
+
> done
13
+
> EOF
14
+
15
+
$ sh test.sh a b "c d"
16
+
No quote: a
17
+
No quote: b
18
+
No quote: c
19
+
No quote: d
20
+
In quotes quote: a
21
+
In quotes quote: b
22
+
In quotes quote: c d
23
+
$ msh test.sh a b "c d"
24
+
No quote: a
25
+
No quote: b
26
+
No quote: c
27
+
No quote: d
28
+
In quotes quote: a
29
+
In quotes quote: b
30
+
In quotes quote: c d
31
+
+20
test/simple.t
+20
test/simple.t
···
78
78
$ msh test.sh
79
79
/bin:/usr/bin
80
80
81
+
Some variable expansions:
82
+
83
+
$ cat > test.sh << EOF
84
+
> echo "Got \$# arguments: [\$@]"
85
+
> for arg in "\$@"; do
86
+
> echo "[\$arg]"
87
+
> done
88
+
> EOF
89
+
90
+
$ sh test.sh hello world "from the shell"
91
+
Got 3 arguments: [hello world from the shell]
92
+
[hello]
93
+
[world]
94
+
[from the shell]
95
+
$ msh test.sh hello world "from the shell"
96
+
Got 3 arguments: [hello world from the shell]
97
+
[hello]
98
+
[world]
99
+
[from the shell]
100
+
81
101
2. Pipelines with And|Or
82
102
83
103
2.1 Simple Or
+124
test/wordexp.ml
+124
test/wordexp.ml
···
1
+
(* Thorough testing of word expansion *)
2
+
open Merry
3
+
module C = Merry.Eval.Make (Merry_posix.State) (Merry_posix.Exec)
4
+
5
+
let expand ctx cst = C.word_expansion ctx cst |> snd
6
+
let fragment = Alcotest.of_pp Merry.Ast.Fragment.pp
7
+
let fragments = Alcotest.list fragment
8
+
let frags = List.map Ast.Fragment.make
9
+
10
+
let with_default_ctx ?(args = []) ?(params = []) env fn =
11
+
let executor = Merry_posix.Exec.{ mgr = env#process_mgr } in
12
+
let interactive = false in
13
+
let pos_zero = "msh" in
14
+
Eio.Switch.run @@ fun async_switch ->
15
+
let signal_handler f = Eio_posix.run @@ fun _ -> f () in
16
+
let state =
17
+
Merry_posix.State.make
18
+
~home:(Sys.getenv "HOME" ^ "/")
19
+
(Fpath.v (Merry.Eunix.cwd ()))
20
+
in
21
+
let state =
22
+
List.fold_left
23
+
(fun s (k, v) -> Merry_posix.State.update s ~param:k v |> Result.get_ok)
24
+
state params
25
+
in
26
+
let ctx =
27
+
C.make_ctx ~interactive state executor ~fs:env#fs ~stdin:env#stdin
28
+
~stdout:env#stdout ~async_switch ~argv:(Array.of_list args)
29
+
~program:pos_zero ~signal_handler
30
+
in
31
+
fn ctx
32
+
33
+
module W = struct
34
+
let name s = Ast.WordName s
35
+
let lit s = Ast.WordLiteral s
36
+
let dquote c = Ast.WordDoubleQuoted c
37
+
let glob_all = Ast.WordGlobAll
38
+
39
+
(* let squote c = Ast.WordSingleQuoted c *)
40
+
(* let arith a = Ast.WordArithmeticExpression a *)
41
+
let var v = Ast.WordVariable (Ast.VariableAtom (v, Ast.NoAttribute))
42
+
end
43
+
44
+
let test_no_expansions env () =
45
+
let args = [ "echo"; "hello" ] in
46
+
let cargs = W.[ name "echo"; lit "hello" ] in
47
+
with_default_ctx ~args env @@ fun ctx ->
48
+
let expected = frags args in
49
+
let actual = expand ctx cargs in
50
+
Alcotest.check fragments "same fragments" expected actual
51
+
52
+
let test_dquote env () =
53
+
let args = [ "echo"; "\"hello there\"" ] in
54
+
let cargs = W.[ name "echo"; dquote [ lit "hello there" ] ] in
55
+
with_default_ctx ~args env @@ fun ctx ->
56
+
let expected =
57
+
Ast.
58
+
[ Fragment.make "echo"; Fragment.make ~join:`With_previous "hello there" ]
59
+
in
60
+
let actual = expand ctx cargs in
61
+
Alcotest.check fragments "same fragments" expected actual
62
+
63
+
let test_dquote_expansion env () =
64
+
let args = [ "echo"; "\"hello $FOO...\"" ] in
65
+
let cargs =
66
+
W.[ name "echo"; dquote [ lit "hello "; var "FOO"; lit "..." ] ]
67
+
in
68
+
with_default_ctx ~args ~params:[ ("FOO", "there") ] env @@ fun ctx ->
69
+
let expected =
70
+
Ast.Fragment.[ make "echo"; make ~join:`With_previous "hello there..." ]
71
+
in
72
+
let actual = expand ctx cargs in
73
+
Alcotest.check fragments "same fragments" expected actual
74
+
75
+
let test_single_expansion env () =
76
+
let args = [ "echo"; "$FOO" ] in
77
+
let cargs = W.[ name "echo"; var "FOO" ] in
78
+
with_default_ctx ~args ~params:[ ("FOO", "bar") ] env @@ fun ctx ->
79
+
let expected = [ Ast.Fragment.make "echo"; Ast.Fragment.make "bar" ] in
80
+
let actual = expand ctx cargs in
81
+
Alcotest.check fragments "same fragments" expected actual
82
+
83
+
let test_argv_expansion env () =
84
+
let cargs = W.[ name "echo"; var "@" ] in
85
+
with_default_ctx ~args:[ "echo"; "a"; "b"; "c" ] env @@ fun ctx ->
86
+
let expected = frags [ "echo"; "a"; "b"; "c" ] in
87
+
let actual = expand ctx cargs in
88
+
Alcotest.check fragments "same fragments" expected actual
89
+
90
+
let test_argv_in_quotes_expansion env () =
91
+
let cargs = W.[ name "echo"; dquote [ lit "got ["; var "@"; lit "]" ] ] in
92
+
with_default_ctx ~args:[ "echo"; "a"; "b"; "c" ] env @@ fun ctx ->
93
+
let expected =
94
+
Ast.Fragment.
95
+
[
96
+
make "echo";
97
+
make ~join:`With_previous "got [a";
98
+
make "b";
99
+
make ~join:`With_next "c]";
100
+
]
101
+
in
102
+
let actual = expand ctx cargs in
103
+
Alcotest.check fragments "same fragments" expected actual
104
+
105
+
let test_glob env () =
106
+
let cargs = W.[ glob_all; lit ".ml" ] in
107
+
with_default_ctx ~args:[ "*.ml" ] env @@ fun ctx ->
108
+
let expected = Ast.Fragment.[ make "test_merry.ml"; make "wordexp.ml" ] in
109
+
let actual = expand ctx cargs in
110
+
Alcotest.check fragments "same fragments" expected actual
111
+
112
+
let simple env =
113
+
[
114
+
("no expansions", `Quick, test_no_expansions env);
115
+
("double quote", `Quick, test_dquote env);
116
+
("double quote expansion", `Quick, test_dquote_expansion env);
117
+
("single expansion", `Quick, test_single_expansion env);
118
+
("argv expansion", `Quick, test_argv_expansion env);
119
+
("argv expansion dquote", `Quick, test_argv_in_quotes_expansion env);
120
+
("glob all", `Quick, test_glob env);
121
+
]
122
+
123
+
let () =
124
+
Eio_posix.run @@ fun env -> Alcotest.run "wordexp" [ ("simple", simple env) ]