From b7edc9bf96e73c31a1dee620667a0ac2db22ceb6 Mon Sep 17 00:00:00 2001 From: Patrick Ferris Date: Tue, 16 Jun 2026 12:48:06 +0100 Subject: [PATCH] Refactoring redirections and word expansion It is not worth explaining in detail all of these changes, but mostly these are fixes to redirections and to word expansions (including storing variables as their expanded form). --- src/bin/main.ml | 2 + src/lib/arith.ml | 51 +- src/lib/arith_lexer.mll | 3 + src/lib/ast.ml | 52 +- src/lib/ast.mli | 4 + src/lib/eunix.ml | 123 ++-- src/lib/eval.ml | 948 +++++++++++++++++++---------- src/lib/eval.mli | 10 +- src/lib/import.ml | 40 +- src/lib/interactive.ml | 7 +- src/lib/merry.ml | 1 + src/lib/merry.mli | 1 + src/lib/posix/exec.ml | 12 +- src/lib/posix/state.ml | 117 +++- src/lib/sast.ml | 1 + src/lib/stack.ml | 11 + src/lib/stack.mli | 18 + src/lib/types.ml | 37 +- test/all.sh | 5 + test/arith.t | 13 + test/built_ins.t | 15 + test/docker/Dockerfile.debootstrap | 3 +- test/docker/fakechroot.sh | 12 + test/dune | 7 +- test/escaping.t | 16 + test/exitting.t | 28 + test/forloops.t | 15 + test/functions.t | 62 ++ test/nofork.t | 9 +- test/redirections.t | 55 ++ test/regressions.t | 55 ++ test/scripts/README.md | 1 + test/scripts/checksum.expected | 5 + test/scripts/checksum.sh | 24 + test/scripts/debfor_pkgs.expected | 9 + test/scripts/debfor_pkgs.sh | 31 + test/scripts/dune | 16 + test/scripts/dune.inc | 64 ++ test/scripts/funcdefs.expected | 5 + test/scripts/funcdefs.sh | 17 + test/scripts/gen_rules.sh | 29 + test/scripts/subshell.expected | 3 + test/scripts/subshell.sh | 16 + test/simple.t | 25 + test/subshell.t | 41 ++ test/test_merry.ml | 0 test/wordexp.ml | 44 +- 47 files changed, 1632 insertions(+), 431 deletions(-) create mode 100644 src/lib/stack.ml create mode 100644 src/lib/stack.mli create mode 100755 test/all.sh create mode 100644 test/arith.t create mode 100755 test/docker/fakechroot.sh create mode 100644 test/escaping.t create mode 100644 test/exitting.t create mode 100644 test/redirections.t create mode 100644 test/regressions.t create mode 100644 test/scripts/README.md create mode 100644 test/scripts/checksum.expected create mode 100644 test/scripts/checksum.sh create mode 100644 test/scripts/debfor_pkgs.expected create mode 100644 test/scripts/debfor_pkgs.sh create mode 100644 test/scripts/dune create mode 100644 test/scripts/dune.inc create mode 100644 test/scripts/funcdefs.expected create mode 100644 test/scripts/funcdefs.sh create mode 100755 test/scripts/gen_rules.sh create mode 100644 test/scripts/subshell.expected create mode 100644 test/scripts/subshell.sh delete mode 100644 test/test_merry.ml diff --git a/src/bin/main.ml b/src/bin/main.ml index da39333..efe9c35 100644 --- a/src/bin/main.ml +++ b/src/bin/main.ml @@ -89,6 +89,8 @@ let cmd ~args ~other_flags env = syntax."; `S Manpage.s_bugs; `P "Report bugs at https://tangled.org/patrick.sirref.org/merry/issues."; + `S Manpage.s_authors; + `P "Patrick Ferris "; ] in Cmd.make (Cmd.info "msh" ~version:"v0.0.1" ~doc ~man) diff --git a/src/lib/arith.ml b/src/lib/arith.ml index 7942f14..44ca181 100644 --- a/src/lib/arith.ml +++ b/src/lib/arith.ml @@ -1,3 +1,5 @@ +open Import + (* We handle _very_ simple arithmetic expressions. Really nothing crazy yet, hopefully enough to handle most [while x < 10 do x = x + 1 done] loops! *) @@ -23,27 +25,60 @@ type expr = | Ternary of (expr * expr * expr) [@@deriving to_yojson] +(* Faster way: extract the logic from morbig directly for parsing variables. *) +let collect_variables v = + let o = + object + inherit [Sast.variable list] Ast.fold + method int _ ctx = ctx + method bool _ ctx = ctx + method string _ ctx = ctx + method char _ ctx = ctx + method option f v ctx = Option.fold ~none:ctx ~some:(fun i -> f i ctx) v + method nlist__t f v ctx = Nlist.fold_left (fun acc i -> f i acc) ctx v + + method nslist__t f g v ctx = + Nslist.fold_left (fun acc a b -> f a acc |> g b) ctx v + + method list f v ctx = List.fold_left (fun acc i -> f i acc) ctx v + method! variable v ctx = v :: ctx + end + in + o#complete_commands v [] + +let parse_variable s = + let cst = Morbig.parse_string "arith" s in + let vars = Ast.of_program cst |> collect_variables in + let v = + match vars with + | [ v ] -> v + | vs -> Fmt.failwith "Unexpected number of variables: %i" (List.length vs) + in + v + module Make (S : Types.State) = struct - let eval initial_state expr = + let eval ~expand initial_state expr = let exception Abort of int in let lookup state s = - let s = - match String.get s 0 with - | '$' -> String.sub s 1 (String.length s - 1) - | (exception _) | _ -> s + let v = + match String.get ~label:"arith-eval" s 0 with + | '$' -> parse_variable s + | (exception _) | _ -> Sast.VariableAtom (s, Sast.NoAttribute) in - match S.lookup state ~param:s with + match expand state ~param:v with | Some n when Option.is_some (int_of_string_opt n) -> int_of_string n | _ -> raise (Abort 0) in let update state s i = - match S.update state ~param:s (string_of_int i) with + match S.update state ~param:s [ Ast.Fragment.make (string_of_int i) ] with | Ok s -> s | Error m -> failwith m in let rec calc state = function | Int i -> (state, i) - | Var v -> (state, lookup state v) + | Var v -> + Debug.Log.info (fun f -> f "V is %s" v); + (state, lookup state v) | Binop (op, e1, e2) -> let state, v1 = calc state e1 in let state, v2 = calc state e2 in diff --git a/src/lib/arith_lexer.mll b/src/lib/arith_lexer.mll index ac23d8d..2a5b3a9 100644 --- a/src/lib/arith_lexer.mll +++ b/src/lib/arith_lexer.mll @@ -7,9 +7,12 @@ let oct_digit = ['0'-'7'] let hex_digit = ['0'-'9' 'a'-'f' 'A'-'F'] let alpha = ['a'-'z' 'A'-'Z' '_'] let ident = alpha (alpha | digit)* +let enclosed = '{' (alpha | digit | '#' | '*' | '%' | ' ' | '-')* '}' + let var = ident | '$' ident +| '$' enclosed rule read = parse | [' ' '\t' '\n'] { read lexbuf } diff --git a/src/lib/ast.ml b/src/lib/ast.ml index dc8cb40..d20546a 100644 --- a/src/lib/ast.ml +++ b/src/lib/ast.ml @@ -816,6 +816,28 @@ class check_ast = method list f v ctx = List.fold_left (fun acc i -> f i acc) ctx v end +class map_ast = + object (_) + inherit Sast.map + method int i = i + method bool b = b + method string s = s + method char c = c + method option f o = Option.map f o + method nlist__t = Nlist.map + method nslist__t = Nslist.map + method list = List.map + end + +let map_strings f = + let o = + object + inherit map_ast + method! string s = f s + end + in + o#complete_commands + let has_async ast = let o = object @@ -857,12 +879,23 @@ let has_glob ast = o#word_cst ast false module Fragment = struct - let make ?(splittable = false) ?(globbable = false) ?(tilde_expansion = false) - ?(join = `No) txt = - { txt; splittable; join; globbable; tilde_expansion } + let make ?(escaping = false) ?(splittable = false) ?(globbable = false) + ?(tilde_expansion = false) ?(join = `No) txt = + { txt; escaping; splittable; join; globbable; tilde_expansion } let empty = make "" - let to_string { txt; _ } = txt + + let to_string { txt; escaping; _ } = + if not escaping then txt + else + let s_len = String.length txt in + let buf = Buffer.create s_len in + for i = 0 to s_len - 1 do + match String.get ~label:"frag-to-string" txt i with + | '\\' -> () + | c -> Buffer.add_char buf c + done; + Buffer.contents buf let join ~sep f1 f2 = { @@ -872,6 +905,7 @@ module Fragment = struct } let join_list ~sep fs = List.fold_left (join ~sep) empty fs |> to_string + let length v = join_list ~sep:"" v |> String.length let pp_join ppf = function | `No -> Fmt.pf ppf "no" @@ -879,11 +913,11 @@ module Fragment = struct | `With_next -> Fmt.pf ppf "with-next" | `Yes -> Fmt.pf ppf "yes" - let pp ppf { txt; join; splittable; globbable; tilde_expansion } = + let pp ppf { txt; join; escaping; splittable; globbable; tilde_expansion } = Fmt.pf ppf - "{ txt = %s; join = %a; splittable = %b; globbable = %b; tilde_expansion \ - = %b }" - txt pp_join join splittable globbable tilde_expansion + "{ txt = %S; join = %a; splittable = %b; globbable = %b; tilde_expansion \ + = %b; escaping = %b }" + txt pp_join join splittable globbable tilde_expansion escaping let handle_joins cst = let rec loop = function @@ -916,7 +950,7 @@ module Fragment = struct | [ x ] -> [ x ] | ({ txt; _ } as x) :: y :: rest -> ( let s = String.length txt in - match String.get txt (s - 1) with + match String.get ~label:"recombine" txt (s - 1) with | '=' -> { y with txt = txt ^ y.txt } :: recombine_equals rest | (exception Invalid_argument _) | _ -> x :: recombine_equals (y :: rest)) diff --git a/src/lib/ast.mli b/src/lib/ast.mli index 53a0d6f..d9b4cb4 100644 --- a/src/lib/ast.mli +++ b/src/lib/ast.mli @@ -32,8 +32,11 @@ val has_async : complete_command -> bool val has_glob : word_cst -> bool (** Checks whether or not any glob patterns exist in a given word_cst *) +val map_strings : (string -> string) -> complete_commands -> complete_commands + module Fragment : sig val make : + ?escaping:bool -> ?splittable:bool -> ?globbable:bool -> ?tilde_expansion:bool -> @@ -45,6 +48,7 @@ module Fragment : sig val to_string : fragment -> string val join : sep:string -> fragment -> fragment -> fragment val join_list : sep:string -> fragment list -> string + val length : fragment list -> int val handle_joins : fragment list -> fragment list val pp : fragment Fmt.t end diff --git a/src/lib/eunix.ml b/src/lib/eunix.ml index 1aa63e0..48a9bbe 100644 --- a/src/lib/eunix.ml +++ b/src/lib/eunix.ml @@ -1,3 +1,5 @@ +open Import + let cwd () = Eio_unix.run_in_systhread ~label:"cwd" @@ fun () -> Unix.getcwd () let env () = @@ -60,50 +62,85 @@ let background () = let fd_of_int (fd : int) : Unix.file_descr = Obj.magic fd -let with_redirections ?(restore = false) (rdrs : Types.redirect list) fn = - let saved_stdin = Safe_fd.dup Unix.stdin in - let saved_stdout = Safe_fd.dup Unix.stdout in - let saved_stderr = Safe_fd.dup Unix.stderr in - let restore_fds = - List.filter_map - (function - | Types.Parent_redirect (i, fd, _) -> - Eio_unix.Fd.use_exn "with_redirections" fd @@ fun fd -> - let new_fd = fd_of_int i in - if (Obj.magic fd : int) <> i then begin - let saved_fd = - try Some (Safe_fd.dup new_fd) - with Unix.Unix_error (Unix.EBADF, _, _) -> None - in - Unix.dup2 ~cloexec:false fd new_fd; - Some (saved_fd, new_fd) - end - else None - | Types.Close fd -> - Eio_unix.Fd.close fd; - None - | Types.Child_redirect _ -> None) - rdrs +let dup2 ?cloexec src dst = + try Unix.dup2 ?cloexec src dst + with Unix.Unix_error (Unix.EBADF, _, _) as e -> + Debug.Log.warn (fun f -> + f "EBADF dup2: %i %i" (Obj.magic src) (Obj.magic dst)); + raise e + +let dup fd = + try Unix.dup fd + with Unix.Unix_error (Unix.EBADF, _, _) as e -> + Debug.Log.warn (fun f -> f "EBADF dup: %a" Fmt.fd fd); + raise e + +let eio_dup2 ~sw ~src ~dst = + Eio_unix.Fd.use_exn "dup2" src @@ fun src_fd -> + let () = dup2 ~cloexec:true src_fd (Obj.magic (dst : int)) in + Eio_unix.Fd.of_unix ~sw ~close_unix:true (Obj.magic (dst : int)) + +let keep_first rdrs = + let is_equal v1 v2 = + match (v1, v2) with + | Types.Redirect (_, i, _, _), Types.Redirect (_, j, _, _) -> Int.equal i j + | _ -> false in - Fun.protect - ~finally:(fun () -> - if not restore then () - else begin - Unix.dup2 saved_stdin (fd_of_int 0); - Unix.dup2 saved_stdout (fd_of_int 1); - Unix.dup2 saved_stderr (fd_of_int 2); - Unix.close saved_stdin; - Unix.close saved_stdout; - Unix.close saved_stderr; - List.iter - (function - | Some saved_fd, old_fd -> - Unix.dup2 saved_fd old_fd; - Unix.close saved_fd - | _ -> ()) - restore_fds - end) - fn + List.fold_left + (fun acc rdr -> if List.exists (is_equal rdr) acc then acc else rdr :: acc) + [] rdrs + |> List.rev + +let redirect ~sw ~src ~dst = + let saved_fd = + try Some (dup src) with Unix.Unix_error (Unix.EBADF, _, _) -> None + in + dup2 ~cloexec:false src dst; + Eio.Switch.on_release sw (fun () -> + match saved_fd with + | None -> () + | Some saved_fd -> + dup2 saved_fd dst; + Unix.close saved_fd) + +let with_redirections ?(restore = false) (rdrs : Types.redirect list) fn = + if rdrs = [] then fn () + else + let rdrs = keep_first rdrs in + let restore_fds = + List.filter_map + (function + | Types.Redirect (true, i, fd, _) -> + Eio_unix.Fd.use ~if_closed:(fun () -> None) fd @@ fun fd -> + let new_fd = fd_of_int i in + if (Obj.magic fd : int) <> i then begin + let saved_fd = + try Some (Safe_fd.dup new_fd) + with Unix.Unix_error (Unix.EBADF, _, _) -> None + in + dup2 ~cloexec:false fd new_fd; + Some (saved_fd, new_fd) + end + else None + | Types.Close fd -> + Eio_unix.Fd.close fd; + None + | _ -> None) + rdrs + in + Fun.protect + ~finally:(fun () -> + if not restore then () + else begin + List.iter + (function + | Some saved_fd, old_fd -> + dup2 saved_fd old_fd; + Unix.close saved_fd + | _ -> ()) + restore_fds + end) + fn let with_stdin_in_raw_mode fn = let saved_tio = Unix.tcgetattr Unix.stdin in diff --git a/src/lib/eval.ml b/src/lib/eval.ml index 7c4df59..9ca69c6 100644 --- a/src/lib/eval.ml +++ b/src/lib/eval.ml @@ -1,4 +1,4 @@ -(*----------------------------------------------------------------- +(*-----------------------------------------------------------------eval Copyright (c) 2025 The merry programmers. All rights reserved. SPDX-License-Identifier: ISC -----------------------------------------------------------------*) @@ -15,6 +15,48 @@ let mk_new_id = let mk_pipeline_scope () = "pipeline-" ^ mk_new_id () let pp_args = Fmt.(list ~sep:(Fmt.any " ") string) +let has_ws txt = + String.contains txt ' ' || String.contains txt '\t' + || String.contains txt '\n' + +(* Merges two redirect lists, taking the firstmost redirect if there + are duplicates. *) +let _join_rdrs r1 r2 = + let is_equal v1 v2 = + match (v1, v2) with + | Types.Redirect (b1, i, _, _), Types.Redirect (b2, j, _, _) -> + Int.equal i j && b1 = b2 + | _ -> false + in + List.fold_left + (fun acc rdr -> if List.exists (is_equal rdr) acc then acc else rdr :: acc) + [] (r1 @ r2) + |> List.rev + +let unescape_eval txt = + let s_len = String.length txt in + let buf = Buffer.create s_len in + let i = ref 0 in + let is_backslash s i = + match String.get ~label:"backslash" s i with + | '\\' -> true + | (exception _) | _ -> false + in + while !i < s_len do + if is_backslash txt !i && is_backslash txt (!i + 1) then begin + incr i; + incr i + end + else if is_backslash txt !i then begin + incr i + end + else begin + Buffer.add_char buf (String.get ~label:"unescape_eval" txt !i); + incr i + end + done; + Buffer.contents buf + let pp_fs_create ppf (v : Eio.Fs.create) = match v with | `If_missing o -> Fmt.pf ppf "if-missing %o" o @@ -24,7 +66,7 @@ let pp_fs_create ppf (v : Eio.Fs.create) = let make_child_rdrs_for_parent = List.map (function - | Types.Child_redirect (a, b, c) -> Types.Parent_redirect (a, b, c) + | Types.Redirect (false, a, b, c) -> Types.Redirect (true, a, b, c) | v -> v) (** An evaluator over the AST *) @@ -44,7 +86,7 @@ module Make (S : Types.State) (E : Types.Exec) = struct interactive : bool; subshell : bool; state : S.t; - local_state : (string * string) list; + local_state : (string * Ast.fragments) list Stack.t; executor : E.t; fs : Eio.Fs.dir_ty Eio.Path.t; options : Built_ins.Options.t; @@ -61,12 +103,56 @@ module Make (S : Types.State) (E : Types.Exec) = struct rdrs : Types.redirect list; signal_handler : signal_handler; exit_handler : (unit -> unit) option; - in_double_quotes : bool; + quotes : [ `None | `Single | `Double ]; umask : int; current_pipeline : string option; current_context : [ `Toplevel | `Function | `CompoundCommand ]; } + let should_exit ctx v = + match v with + | Exit.Zero _ -> false + | Exit.Nonzero { should_exit = { interactive; non_interactive }; _ } -> + (ctx.interactive && interactive = `Yes) + || (not ctx.interactive) && non_interactive = `Yes + && ctx.options.errexit + + let dump_ctx ppf = + let pp_quotes ppf = function + | `None -> Fmt.string ppf "none" + | `Double -> Fmt.string ppf "double" + | `Single -> Fmt.string ppf "single" + in + (Fmt.braces + @@ Fmt.record + [ + Fmt.field "quotes" (fun t -> t.quotes) pp_quotes; + Fmt.field "rdrs" (fun t -> t.rdrs) Fmt.(lst Types.pp_redirect); + ]) + ppf + + let lookup_and_join ?(sep = "") state ~param = + match S.lookup state ~param with + | None -> None + | Some lst -> Some (Ast.Fragment.join_list ~sep lst) + + let update_variable ~splittable ~join v = + List.map (fun f -> Ast.{ f with splittable; join }) v + + let local_state_as_env ctx = Stack.to_list ctx.local_state |> List.concat + + (* One day, the logic needs to be here... *) + let await_job_ready j = ignore j + (* J.get_reaper j |> fst |> Eio.Promise.await *) + + let lookup ~param ctx = + match List.assoc_opt param (local_state_as_env ctx) with + | Some _ as v -> v + | None -> S.lookup ctx.state ~param + + let in_double_quotes ctx = ctx.quotes = `Double + let in_quotes ctx = ctx.quotes = `Single || ctx.quotes = `Double + exception Continue of int * ctx (* Used for the [continue] non-POSIX keyword *) @@ -76,19 +162,21 @@ module Make (S : Types.State) (E : Types.Exec) = struct exception Return of ctx Exit.t (* Used for the [return] non-POSIX keyword *) - let make_ctx ?(interactive = false) ?(subshell = false) ?(local_state = []) + let make_ctx ?(interactive = false) ?(subshell = false) ?(background_jobs = []) ?(last_background_process = "") ?current_pipeline - ?last_pipeline_status ?(functions = []) ?(rdrs = []) ?exit_handler + ?last_pipeline_status ?(functions = []) ?exit_handler ?(options = Built_ins.Options.default) ?(hash = Hash.empty) - ?(in_double_quotes = false) ?(umask = 0o22) ~fs ~stdin ~stdout - ~async_switch ~program ~argv ~signal_handler state executor = + ?(umask = 0o22) ~fs ~stdin ~stdout ~async_switch ~program ~argv + ~signal_handler state executor = let signal_handler = { run = signal_handler; sigint_set = false } in - let state = S.update state ~param:"IFS" " \t\n" |> Result.get_ok in + let state = + S.update state ~param:"IFS" [ Ast.Fragment.make " \t\n" ] |> Result.get_ok + in { interactive; subshell; state; - local_state; + local_state = Stack.empty; executor; fs; options; @@ -102,10 +190,14 @@ module Make (S : Types.State) (E : Types.Exec) = struct argv; functions; hash; - rdrs; + rdrs = + [ + Types.Redirect (false, 0, Eio_unix.Fd.stdin, `Blocking); + Types.Redirect (false, 1, Eio_unix.Fd.stdout, `Blocking); + ]; signal_handler; exit_handler; - in_double_quotes; + quotes = `None; umask; current_pipeline; current_context = `Toplevel; @@ -114,7 +206,11 @@ module Make (S : Types.State) (E : Types.Exec) = struct let state ctx = ctx.state let sigint_set ctx = ctx.signal_handler.sigint_set let fs ctx = ctx.fs - let clear_local_state ctx = { ctx with local_state = [] } + + let pop_local_state ctx = + match Stack.pop ctx.local_state with + | None -> ctx + | Some (_, local_state) -> { ctx with local_state } let with_pipeline_scope ?(force = false) ?(remove_vars = true) ctx fn = let saved_pipeline = ctx.current_pipeline in @@ -143,25 +239,77 @@ module Make (S : Types.State) (E : Types.Exec) = struct let word_cst_to_string ?field_splitting v = Ast.word_components_to_strings ?field_splitting v |> String.concat "" - let arithmetic_expansion ctx word = + let arithmetic_expansion ~expand ctx word = let expr = word_cst_to_string word in let aexpr = Arith_parser.main Arith_lexer.read (Lexing.from_string expr) in - let state, i = A.eval ctx.state aexpr in + let state, i = A.eval ~expand ctx.state aexpr in ({ ctx with state }, i) (* The minimal amount of context needed between pipeline stages. *) type pipeline_ctx = { - stdout : Eio_unix.sink_ty Eio.Flow.sink; - stdin : Eio_unix.source_ty Eio.Flow.source; + stdout : int * Eio_unix.Fd.t * Eio_unix.Private.Fork_action.blocking; + stdin : int * Eio_unix.Fd.t * Eio_unix.Private.Fork_action.blocking; } - let std_for_pipeline ?(first = false) ~sw (ctx : pipeline_ctx) rest = + let find_first_rdr kind rdrs = + match + List.find_map + (function + | Types.Redirect (_, j, fd, b) when Int.equal j 0 && kind = `Stdin -> + Some (j, fd, b) + | Types.Redirect (_, j, fd, b) when Int.equal j 1 && kind = `Stdout -> + Some (j, fd, b) + | _ -> None) + rdrs + with + | Some p -> p + | None -> ( + match kind with + | `Stdin -> (0, Eio_unix.Fd.stdin, `Blocking) + | `Stdout -> (1, Eio_unix.Fd.stdout, `Blocking)) + + let get_std_with_locality = function + | `Local p -> (p, false) + | `Global p -> (p, true) + + (* [std_for_pipeline] returns three things: + 1. The stdin for the current command of the pipeline. + 2. The stdout for the current command of the pipeline. + 3. The stdin for the next part of the pipeline. *) + let std_for_pipeline ?(first = false) ~sw rdrs (pctx : pipeline_ctx) rest = match (first, rest) with - | true, [] -> (`Global ctx.stdin, `Global ctx.stdout) - | false, [] -> (`Local ctx.stdin, `Global ctx.stdout) - | _ -> + | true, [] -> + let stdin_for_current_command = `Global (find_first_rdr `Stdin rdrs) in + let stdout_for_current_command = + `Global (find_first_rdr `Stdout rdrs) + in + (* There is no next command, so we can return whatever we like here. *) + let stdin_for_next_command = stdin_for_current_command in + ( stdin_for_current_command, + stdout_for_current_command, + stdin_for_next_command ) + | false, [] -> + let stdin_for_current_command = `Local pctx.stdin in + let stdout_for_current_command = + `Global (find_first_rdr `Stdout rdrs) + in + (* There is no next command, so we can return whatever we like here. *) + let stdin_for_next_command = stdin_for_current_command in + ( stdin_for_current_command, + stdout_for_current_command, + stdin_for_next_command ) + | _, _ :: _ -> let r, w = Safe_fd.pipe sw in - (`Global r, `Local (w :> Eio_unix.sink_ty Eio.Flow.sink)) + let stdin_for_current_command = `Local pctx.stdin in + let stdout_for_current_command = + `Local (1, Eio_unix.Resource.fd w, `Blocking) + in + let stdin_for_next_command = + `Global (0, Eio_unix.Resource.fd r, `Blocking) + in + ( stdin_for_current_command, + stdout_for_current_command, + stdin_for_next_command ) let fd_of_int ?(close_unix = true) ~sw (n : int) = Eio_unix.Fd.of_unix ~close_unix ~sw (Obj.magic n : Unix.file_descr) @@ -170,19 +318,22 @@ module Make (S : Types.State) (E : Types.Exec) = struct let cwd_of_ctx ctx = S.cwd ctx.state |> Fpath.to_string |> ( / ) ctx.fs let immediate_built_in v = `Built_in (Promise.create_resolved @@ Ok v) - let get_env ?(extra = []) ctx = + let get_env ?(extra = Stack.empty) ctx = + let extra = Stack.to_list extra |> List.concat in let extra = extra @ List.map (fun (k, v) -> (k, v)) @@ S.exports ctx.state in - let env = Eunix.env () in + let env = + Eunix.env () |> List.map (fun (k, v) -> (k, Ast.Fragment.[ make v ])) + in let env = List.fold_left (fun acc (k, _) -> List.remove_assoc k acc) env extra |> List.append extra in - env + List.map (fun (k, v) -> (k, Ast.Fragment.join_list ~sep:"" v)) env - let update ?export ?readonly ctx ~param v = - match S.update ?export ?readonly ctx.state ~param v with + let update ?export ?readonly ?local ctx ~param v = + match S.update ?export ?readonly ?local ctx.state ~param v with | Ok state -> Exit.zero { ctx with state } | Error msg -> Fmt.epr "%s\n%!" msg; @@ -190,9 +341,17 @@ module Make (S : Types.State) (E : Types.Exec) = struct let remove_quotes s = let s_len = String.length s in - let s = if s.[0] = '"' then String.sub s 1 (s_len - 1) else s in - let s_len = String.length s in - if s.[s_len - 1] = '"' then String.sub s 0 (s_len - 1) else s + if s_len < 2 then s + else + let s = + if String.get ~label:"remove-quotes" s 0 = '"' then + String.sub s 1 (s_len - 1) + else s + in + let s_len = String.length s in + if String.get ~label:"remove-quotes" s (s_len - 1) = '"' then + String.sub s 0 (s_len - 1) + else s let exit ctx code = Option.iter (fun f -> f ()) ctx.exit_handler; @@ -211,6 +370,11 @@ module Make (S : Types.State) (E : Types.Exec) = struct Exit.nonzero ~message:(Fmt.str "%a" Eio.Exn.pp_err err) ctx 2 let rec handle_pipeline ~async initial_ctx p : ctx Exit.t = + (* Push a new local state frame. *) + let initial_ctx = + { initial_ctx with local_state = Stack.push [] initial_ctx.local_state } + in + with_pipeline_scope initial_ctx @@ fun initial_ctx -> let set_last_background ~async process ctx = if async then begin { ctx with last_background_process = string_of_int (E.pid process) } @@ -219,7 +383,7 @@ module Make (S : Types.State) (E : Types.Exec) = struct in let should_exit ctx = (not ctx.subshell) && List.length p = 1 in let on_process ?process ~async ctx = - let ctx = clear_local_state ctx in + let ctx = pop_local_state ctx in match process with | None -> ctx | Some process -> set_last_background ~async process ctx @@ -232,43 +396,47 @@ module Make (S : Types.State) (E : Types.Exec) = struct | `Error p -> J.add_error p j | `Exit p -> J.add_exit p j in - let close_flow ~is_global flow = + let close_flow ~is_global (_, fd, _) = if not is_global then begin - Eio.Flow.close flow + Eio_unix.Fd.close fd end in let update_stdin ~stdin ctx = { ctx with stdin } in - let exec_process ~sw ctx job ?fds ?stdin ~stdout ?pgid executable args = + let exec_process ~sw ctx job ?(fds = []) ?pgid executable args = + let fds = Eunix.keep_first fds in let pgid = match pgid with None -> 0 | Some p -> p in let reap = J.get_reaper job in let mode = if async then Types.Switched ctx.async_switch else Types.Switched sw in - let fds = ctx.rdrs @ Option.value ~default:[] fds in let ctx, process = let hash, prog = Eunix.resolve_program - ?path:(S.lookup ctx.state ~param:"PATH") + ?path:(lookup_and_join ctx.state ~param:"PATH") ctx.hash executable in let ctx = { ctx with hash } in match (executable, prog) with | _, None | "", _ -> + Eunix.with_redirections + (make_child_rdrs_for_parent fds) + ~restore:true + @@ fun () -> Eio.Flow.copy_string (Fmt.str "msh: command not found: %s\n" executable) - stdout; + ctx.stdout; (ctx, Error 127) | _, Some full_path -> Debug.Log.debug (fun f -> f "executing %a (rdr: %a)" Fmt.(list ~sep:(Fmt.any " ") (quote string)) (full_path :: args) - Fmt.(list Types.pp_redirect) + Fmt.(lst Types.pp_redirect) fds); ( ctx, catch_execs_with_error @@ fun () -> - E.exec ctx.executor ~delay_reap:(fst reap) ~fds ?stdin ~stdout - ~pgid ~mode ~cwd:(cwd_of_ctx ctx) ~pipe:Safe_fd.pipe + E.exec ctx.executor ~delay_reap:(fst reap) ~fds ~pgid ~mode + ~cwd:(cwd_of_ctx ctx) ~pipe:Safe_fd.pipe ~env:(get_env ~extra:ctx.local_state ctx) ~executable:full_path (executable :: args) ) in @@ -280,12 +448,13 @@ module Make (S : Types.State) (E : Types.Exec) = struct let pgid = if Int.equal pgid 0 then E.pid process else pgid in let ctx = on_process ~async ~process ctx in let job = handle_job job (`Process (ctx, process)) |> J.set_id pgid in - (on_process ~async ~process ctx, job) + (ctx, job) in let job_pgid (t : _ J.t) = J.get_id t in let rec loop pipeline_switch (pctx : pipeline_ctx) (job : _ J.t) : Ast.command list -> _ J.t = fun c -> + ignore pctx.stdout; let loop = loop pipeline_switch in match c with | Ast.SimpleCommand (Prefixed (prefix, None, _suffix)) :: rest -> @@ -295,18 +464,16 @@ module Make (S : Types.State) (E : Types.Exec) = struct let job = handle_job job (`Noop ctx) in loop pctx job rest | Ast.SimpleCommand v :: rest as pipeline -> ( - let ctx, executable, suffix = + let executable, suffix = match v with - | Prefixed (prefix, Some exec, suffix) -> - let ctx = - collect_assignments ~update:false initial_ctx prefix - in + | Prefixed (_, Some exec, suffix) -> (* TODO: Exit.value *) - (Exit.value ctx, exec, suffix) - | Named (exec, suffix) -> (initial_ctx, exec, suffix) + (exec, suffix) + | Named (exec, suffix) -> (exec, suffix) | _ -> assert false in - let ctx, executable = word_expansion ctx executable in + (* Expand without the local state *) + let ctx, executable = word_expansion initial_ctx executable in match ctx with | Exit.Nonzero _ as ctx -> let job = handle_job job (`Noop ctx) in @@ -334,26 +501,22 @@ module Make (S : Types.State) (E : Types.Exec) = struct | Some suffix -> expand_redirects (ctx, []) suffix in let ctx, args = args ctx (extra_args @ suffix) in + (* Update the local state -- this is sensitive to all of the current pipeline's + word expansions that need to take place. *) + let ctx = + match v with + | Prefixed (prefix, _, _) -> ( + match ctx with + | Exit.Zero ctx -> + collect_assignments ~update:false ctx prefix + | _ -> ctx) + | _ -> ctx + in match ctx with | Exit.Nonzero _ as ctx -> let job = handle_job job (`Noop ctx) in loop pctx job rest | Exit.Zero ctx -> ( - let first = List.length p = List.length pipeline in - let std = - std_for_pipeline ~first ~sw:pipeline_switch pctx rest - in - let is_stdin_global, is_stdout_global, some_read, some_write = - match std with - | `Local stdin, `Local stdout -> - (false, false, stdin, stdout) - | `Local stdin, `Global stdout -> - (false, true, stdin, stdout) - | `Global stdin, `Local stdout -> - (true, false, stdin, stdout) - | `Global stdin, `Global stdout -> - (true, true, stdin, stdout) - in let rdrs = List.fold_left (fun acc -> function @@ -371,6 +534,20 @@ module Make (S : Types.State) (E : Types.Exec) = struct with | Error ctx -> handle_job job (`Rdr (Exit.nonzero ctx 1)) | Ok rdrs -> ( + let first = List.length p = List.length pipeline in + let std = + std_for_pipeline ~first ~sw:pipeline_switch + (rdrs @ ctx.rdrs) pctx rest + in + let ( (some_read, _is_stdin_global), + (some_write, is_stdout_global), + (next_read, _) ) = + match std with + | current_stdin, current_stdout, next_stdin -> + ( get_std_with_locality current_stdin, + get_std_with_locality current_stdout, + get_std_with_locality next_stdin ) + in match Built_ins.of_args (executable :: args) with | Some (Error _) -> handle_job job @@ -414,19 +591,19 @@ module Make (S : Types.State) (E : Types.Exec) = struct in loop pctx job rest | "exec" -> + let rdrs = make_child_rdrs_for_parent rdrs in Debug.Log.debug (fun f -> f "exec [%a] [%a]" pp_args args Fmt.(list Types.pp_redirect) rdrs); - let rdrs = make_child_rdrs_for_parent rdrs in - Eunix.with_redirections ~restore:false rdrs - @@ fun () -> + Eunix.with_redirections ~restore:false rdrs Fun.id; if args <> [] then let name = List.hd args in let ctx, prog = let hash, prog = Eunix.resolve_program ~update:false - ?path:(S.lookup ctx.state ~param:"PATH") + ?path: + (lookup_and_join ctx.state ~param:"PATH") ctx.hash name in let ctx = { ctx with hash } in @@ -441,30 +618,51 @@ module Make (S : Types.State) (E : Types.Exec) = struct else job | ":" -> job | _ -> ( - (* TODO: Make concurrent *) let saved_ctx = ctx in let func_app = if is_command then None else - let ctx = { ctx with stdout = some_write } in + let rdrs = + Types.redirect some_write :: rdrs + in + let rdrs = Types.redirect some_read :: rdrs in + let ctx = + { + ctx with + rdrs; + subshell = List.length p > 1; + } + in handle_function_application ctx ~name:executable (ctx.program :: args) in match func_app with - | Some ctx -> + | Some ctx_fn -> let ctx = - Exit.map - ~f:(fun ctx -> - { saved_ctx with state = ctx.state }) - ctx + Eio.Fiber.fork_promise ~sw:pipeline_switch + (fun () -> + Debug.Log.debug (fun f -> + f "With rdrs: %a" + Fmt.(lst Types.pp_redirect) + rdrs); + let ctx = ctx_fn () in + Exit.map + ~f:(fun ctx -> + { + saved_ctx with + state = ctx.state; + functions = ctx.functions; + }) + ctx) in - close_flow ~is_global:is_stdout_global - some_write; - (* TODO: Proper job stuff and redirects etc. *) - let job = - handle_job job (immediate_built_in ctx) + Eio.Fiber.fork ~sw:pipeline_switch (fun () -> + let _ = Eio.Promise.await_exn ctx in + close_flow ~is_global:is_stdout_global + some_write); + let job = handle_job job (`Built_in ctx) in + let pctx = + update_stdin ~stdin:next_read pctx in - let pctx = { pctx with stdin = some_read } in loop pctx job rest | None -> ( match Built_ins.of_args command_args with @@ -473,7 +671,11 @@ module Make (S : Types.State) (E : Types.Exec) = struct (immediate_built_in (Exit.nonzero ctx 1)) | Some (Ok bi) -> let rdrs = - make_child_rdrs_for_parent rdrs + rdrs + @ [ + Types.redirect some_write; + Types.redirect some_read; + ] in let ctx = Fiber.fork_promise ~sw:pipeline_switch @@ -482,20 +684,15 @@ module Make (S : Types.State) (E : Types.Exec) = struct let bi = catch_execs_with_exit ctx @@ fun () -> let blt = - handle_built_in ~rdrs - ~stdout:some_write ctx bi + handle_built_in ~rdrs ctx bi in + await_job_ready job; close_flow ~is_global:is_stdout_global some_write; blt in bi in - let ctx = - Promise.map ~sw:pipeline_switch - (Exit.map ~f:clear_local_state) - ctx - in let job = match bi with | Built_ins.Exit _ -> @@ -507,7 +704,7 @@ module Make (S : Types.State) (E : Types.Exec) = struct | _ -> handle_job job (`Built_in ctx) in let pctx = - update_stdin ~stdin:some_read pctx + update_stdin ~stdin:next_read pctx in loop pctx job rest | _ -> ( @@ -520,7 +717,7 @@ module Make (S : Types.State) (E : Types.Exec) = struct Eunix.resolve_program ~update:false ?path: - (S.lookup ctx.state + (lookup_and_join ctx.state ~param:"PATH") ctx.hash x in @@ -540,7 +737,7 @@ module Make (S : Types.State) (E : Types.Exec) = struct match exec_and_args with | Exit.Nonzero _ as v -> let pctx = - update_stdin ~stdin:some_read pctx + update_stdin ~stdin:next_read pctx in let job = handle_job job @@ -551,12 +748,19 @@ module Make (S : Types.State) (E : Types.Exec) = struct in loop pctx job rest | Exit.Zero (executable, args) -> + (* Redirect stdin and stdout *) + let rdrs = + rdrs + @ [ + Types.redirect some_write; + Types.redirect some_read; + ] + in + let fds = rdrs @ ctx.rdrs in let _ctx, job = exec_process ~sw:pipeline_switch ctx - job ~fds:rdrs ~stdin:pctx.stdin - ~stdout:some_write - ~pgid:(job_pgid job) executable - args + job ~fds ~pgid:(job_pgid job) + executable args in Eio.Fiber.fork ~sw: @@ -568,37 +772,37 @@ module Make (S : Types.State) (E : Types.Exec) = struct (J.last_process job) with | Some _ -> + (* TODO: Wrong! For failing processes? *) close_flow ~is_global:is_stdout_global - some_write; - close_flow - ~is_global:is_stdin_global - some_read - | None -> ()); + some_write + | None -> + Debug.Log.info (fun f -> + f "No process")); let pctx = - update_stdin ~stdin:some_read pctx + update_stdin ~stdin:next_read pctx in loop pctx job rest)))) | Some (Ok bi) -> - let rdrs = make_child_rdrs_for_parent rdrs in + let rdrs = + rdrs + @ [ + Types.redirect some_write; + Types.redirect some_read; + ] + in let ctx = Fiber.fork_promise ~sw:pipeline_switch @@ fun () -> Trace.name "built-in"; let bi = catch_execs_with_exit ctx @@ fun () -> - let blt = - handle_built_in ~rdrs ~stdout:some_write ctx bi - in + let blt = handle_built_in ~rdrs ctx bi in + await_job_ready job; close_flow ~is_global:is_stdout_global some_write; blt in bi in - let ctx = - Promise.map ~sw:pipeline_switch - (Exit.map ~f:clear_local_state) - ctx - in let job = match bi with | Built_ins.Exit _ -> @@ -612,45 +816,47 @@ module Make (S : Types.State) (E : Types.Exec) = struct else handle_job job (`Exit ctx) | _ -> handle_job job (`Built_in ctx) in - let pctx = update_stdin ~stdin:some_read pctx in + let pctx = update_stdin ~stdin:next_read pctx in loop pctx job rest)))) | CompoundCommand (c, rdrs) :: rest as v -> ( let first = List.length p = List.length v in - let std = std_for_pipeline ~first ~sw:pipeline_switch pctx rest in - let is_stdin_global, is_stdout_global, some_read, some_write = - match std with - | `Local stdin, `Local stdout -> (false, false, stdin, stdout) - | `Local stdin, `Global stdout -> (false, true, stdin, stdout) - | `Global stdin, `Local stdout -> (true, false, stdin, stdout) - | `Global stdin, `Global stdout -> (true, true, stdin, stdout) - in - match handle_redirections ~sw:pipeline_switch initial_ctx rdrs with + match + handle_redirections ~for_parent:true ~sw:pipeline_switch initial_ctx + rdrs + with | Error ctx -> handle_job job (`Rdr (Exit.nonzero ctx 1)) | Ok rdrs -> - let saved_rdrs = initial_ctx.rdrs in - let rdrs = make_child_rdrs_for_parent rdrs in + let std = + std_for_pipeline ~first ~sw:pipeline_switch + (rdrs @ initial_ctx.rdrs) pctx rest + in + let ( (some_read, _is_stdin_global), + (some_write, is_stdout_global), + (next_read, _) ) = + match std with + | current_stdin, current_stdout, next_stdin -> + ( get_std_with_locality current_stdin, + get_std_with_locality current_stdout, + get_std_with_locality next_stdin ) + in + let rdrs = + rdrs @ [ Types.redirect some_write; Types.redirect some_read ] + in let ctx = - { - initial_ctx with - rdrs = rdrs @ saved_rdrs; - stdout = some_write; - stdin = pctx.stdin; - (* subshell = true; *) - current_context = `CompoundCommand; - } + { initial_ctx with current_context = `CompoundCommand; rdrs } in let ctx = Fiber.fork_promise ~sw:pipeline_switch @@ fun () -> Trace.name "compound-command"; with_pipeline_scope ctx @@ fun ctx -> + (* Eunix.with_redirections ~restore:true rdrs @@ fun () -> *) let ctx = handle_compound_command ctx c in + await_job_ready job; Exit.map ~f:(fun c -> { c with - rdrs = saved_rdrs; - stdout = initial_ctx.stdout; - stdin = initial_ctx.stdin; + (* rdrs = saved_rdrs; *) current_context = initial_ctx.current_context; subshell = initial_ctx.subshell; }) @@ -663,10 +869,8 @@ module Make (S : Types.State) (E : Types.Exec) = struct (if async then initial_ctx.async_switch else pipeline_switch) (fun () -> match Promise.await ctx with - | _ -> - close_flow ~is_global:is_stdin_global some_read; - close_flow ~is_global:is_stdout_global some_write); - let pctx = { pctx with stdin = some_read } in + | _ -> close_flow ~is_global:is_stdout_global some_write); + let pctx = update_stdin ~stdin:next_read pctx in loop pctx job rest) | FunctionDefinition (name, (body, _rdrs)) :: rest -> let ctx = @@ -683,11 +887,12 @@ module Make (S : Types.State) (E : Types.Exec) = struct let saved_ctx = initial_ctx in let subshell = saved_ctx.subshell || List.length p > 1 in let ctx = { initial_ctx with subshell } in - with_pipeline_scope ctx @@ fun ctx -> let name = Option.value ~default:"pipeline" ctx.current_pipeline in Eio.Switch.run ~name @@ fun sw -> let job = - loop sw { stdout = ctx.stdout; stdin = ctx.stdin } initial_job p + let stdout = find_first_rdr `Stdout ctx.rdrs in + let stdin = find_first_rdr `Stdin ctx.rdrs in + loop sw { stdout; stdin } initial_job p in let ctx = { ctx with stdin = saved_ctx.stdin; state = ctx.state } in match J.size job with @@ -700,9 +905,9 @@ module Make (S : Types.State) (E : Types.Exec) = struct in exit_ctx >|= fun ctx -> { - ctx with + (pop_local_state ctx) with + rdrs = initial_ctx.rdrs; subshell = saved_ctx.subshell; - local_state = []; last_pipeline_status = Some (Exit.code exit_ctx); } end @@ -714,20 +919,16 @@ module Make (S : Types.State) (E : Types.Exec) = struct in Exit.zero { - ctx with + (pop_local_state ctx) with background_jobs = job :: ctx.background_jobs; + rdrs = initial_ctx.rdrs; last_background_process = Option.value ~default:ctx.last_background_process last_process; - local_state = []; subshell = saved_ctx.subshell; } end and handle_one_redirection ?(for_parent = false) ~sw ctx v = - let redirect (s, d, b) = - if for_parent then Types.Parent_redirect (s, d, b) - else Types.Child_redirect (s, d, b) - in match v with | Ast.IoRedirect_IoFile (n, (op, file)) -> ( let _ctx, file = word_expansion ctx file in @@ -737,7 +938,7 @@ module Make (S : Types.State) (E : Types.Exec) = struct (* Simple redirection for input *) let r = Eio.Path.open_in ~sw (ctx.fs / file) in let fd = Eio_unix.Resource.fd_opt r |> Option.get in - [ redirect (n, fd, `Blocking) ] + [ Types.redirect (n, fd, `Blocking) ] | Io_op_lessand -> ( match file with | "-" -> @@ -747,7 +948,10 @@ module Make (S : Types.State) (E : Types.Exec) = struct [ Types.Close fd ] | m when Option.is_some (int_of_string_opt m) -> let m = int_of_string m in - [ redirect (n, fd_of_int ~close_unix:false ~sw m, `Blocking) ] + [ + Types.redirect + (n, fd_of_int ~close_unix:false ~sw m, `Blocking); + ] | _ -> []) | (Io_op_great | Io_op_dgreat) as v -> (* Simple file creation *) @@ -758,12 +962,18 @@ module Make (S : Types.State) (E : Types.Exec) = struct `Exclusive (file_creation_mode ctx) else `Or_truncate (file_creation_mode ctx) in - Debug.Log.debug (fun f -> - f "Creating file (append:%b, %a): %s" append pp_fs_create create - file); let w = Eio.Path.open_out ~sw ~append ~create (ctx.fs / file) in let fd = Eio_unix.Resource.fd_opt w |> Option.get in - [ redirect (n, fd, `Blocking) ] + Debug.Log.debug (fun f -> + f "Creating file (append:%b, %a): %s:%a" append pp_fs_create + create file Eio_unix.Fd.pp fd); + if n > 2 then begin + Eio_unix.Fd.use_exn "handle-one-redirect" fd @@ fun src -> + Eunix.redirect ~sw ~src + ~dst:(Obj.magic (n : int) : Unix.file_descr); + [] + end + else [ Types.redirect (n, fd, `Blocking) ] | Io_op_greatand -> ( match file with | "-" -> @@ -773,7 +983,15 @@ module Make (S : Types.State) (E : Types.Exec) = struct [ Types.Close fd ] | m when Option.is_some (int_of_string_opt m) -> let m = int_of_string m in - [ redirect (n, fd_of_int ~close_unix:false ~sw m, `Blocking) ] + if for_parent then begin + Eunix.redirect ~sw ~src:(Obj.magic m) ~dst:(Obj.magic n); + [] + end + else + [ + Types.redirect + (n, fd_of_int ~close_unix:false ~sw m, `Blocking); + ] | _ -> []) | Io_op_andgreat -> (* Yesh, not very POSIX *) @@ -784,7 +1002,10 @@ module Make (S : Types.State) (E : Types.Exec) = struct (ctx.fs / file) in let fd = Eio_unix.Resource.fd_opt w |> Option.get in - [ redirect (1, fd, `Blocking); redirect (2, fd, `Blocking) ] + [ + Types.redirect (1, fd, `Blocking); + Types.redirect (2, fd, `Blocking); + ] | Io_op_clobber -> let w = Eio.Path.open_out ~sw @@ -792,7 +1013,7 @@ module Make (S : Types.State) (E : Types.Exec) = struct (ctx.fs / file) in let fd = Eio_unix.Resource.fd_opt w |> Option.get in - [ redirect (n, fd, `Blocking) ] + [ Types.redirect (n, fd, `Blocking) ] | Io_op_lessgreat -> Fmt.failwith "<> not support yet.") | Ast.IoRedirect_IoHere (i, Ast.IoHere (_, v)) -> let _ctx, cst = word_expansion ctx v in @@ -801,7 +1022,7 @@ module Make (S : Types.State) (E : Types.Exec) = struct Eio.Flow.copy_string s w; Eio.Flow.close w; let fd = Eio_unix.Resource.fd_opt r |> Option.get in - [ redirect (i, fd, `Blocking) ] + [ Types.redirect (i, fd, `Blocking) ] | Ast.IoRedirect_IoHere (i, Ast.IoHere_Dash (_, v)) -> let _ctx, cst = word_expansion ctx v in let strip_tab (Ast.{ txt; _ } as v) = @@ -819,10 +1040,10 @@ module Make (S : Types.State) (E : Types.Exec) = struct Eio.Flow.copy_string s w; Eio.Flow.close w; let fd = Eio_unix.Resource.fd_opt r |> Option.get in - [ redirect (i, fd, `Blocking) ] + [ Types.redirect (i, fd, `Blocking) ] - and handle_redirections ?(for_parent = false) ~sw ctx rdrs = - try Ok (List.concat_map (handle_one_redirection ~for_parent ~sw ctx) rdrs) + and handle_redirections ?for_parent ~sw ctx rdrs = + try Ok (List.concat_map (handle_one_redirection ?for_parent ~sw ctx) rdrs) with Eio.Io (Eio.Fs.E (Already_exists _), _) -> Fmt.epr "msh: cannot overwrite existing file\n%!"; Error ctx @@ -863,25 +1084,36 @@ module Make (S : Types.State) (E : Types.Exec) = struct let lookup_variable ctx ~param = match int_of_string_opt param with | Some n -> ( - match Array.get ctx.argv n with + match + Array.get + ~label:(Fmt.str "parameter-expansion-argv(%i)" n) + ctx.argv n + with | v -> Debug.Log.debug (fun f -> - f "lookup %s => %a" param Fmt.(quote string) v); - Some v + f "lookup argv %s => %a %i chars" param + Fmt.(quote string) + v (String.length v)); + Some Ast.Fragment.[ make v ] | exception Invalid_argument _ -> None) | None -> - let v = S.lookup ctx.state ~param in + let v = lookup ctx ~param in Debug.Log.debug (fun f -> - f "lookup %s => %a" param Fmt.(quote (option string)) v); + f "lookup %s => %a" param + Fmt.(quote (option (lst Ast.Fragment.pp))) + v); v in - let expand ctx v : ctx Exit.t * Ast.fragment list = + let maybe_join ctx = if in_quotes ctx then `Yes else `With_previous in + let rec expand ctx v : ctx Exit.t * Ast.fragment list = let module Fragment = struct include Ast.Fragment - let make ?(join = if ctx.in_double_quotes then `With_previous else `Yes) - ?globbable ?splittable ?tilde_expansion v = - Ast.Fragment.make ~join ?splittable ?tilde_expansion ?globbable v + let make ?(join = if in_double_quotes ctx then `With_previous else `Yes) + ?globbable ?splittable ?tilde_expansion + ?(escaping = if in_quotes ctx then false else true) v = + Ast.Fragment.make ~join ?splittable ?tilde_expansion ?globbable + ~escaping v end in match v with | Ast.WordVariable v -> ( @@ -905,7 +1137,7 @@ module Make (S : Types.State) (E : Types.Exec) = struct Debug.Log.debug (fun f -> f "expanding %@: %a\n%!" Fmt.(list string) args); let args = - if not ctx.in_double_quotes then + if not (in_double_quotes ctx) then List.map (fun v -> Fragment.make ~join:`No ~splittable:true v) args @@ -925,13 +1157,14 @@ module Make (S : Types.State) (E : Types.Exec) = struct Debug.Log.debug (fun f -> f "expanding *: %a\n%!" Fmt.(list string) args); let args = - if not ctx.in_double_quotes then List.map Ast.Fragment.make args + if not (in_double_quotes ctx) then + List.map Ast.Fragment.make args else [ Ast.Fragment.make ~join:`With_previous (String.concat (Option.value ~default:" " - (S.lookup ctx.state ~param:"IFS")) + (lookup_and_join ctx.state ~param:"IFS")) args); ] in @@ -946,33 +1179,57 @@ module Make (S : Types.State) (E : Types.Exec) = struct | Ast.VariableAtom (n, NoAttribute) when Option.is_some (int_of_string_opt n) -> ( let n = int_of_string n in - match Array.get ctx.argv n with - | v -> (Exit.zero ctx, [ Fragment.make v ]) + match Array.get ~label:(Fmt.str "argv(%i)" n) ctx.argv n with + | v -> + ( Exit.zero ctx, + [ Fragment.make ~splittable:(not (in_double_quotes ctx)) v ] + ) | exception Invalid_argument _ -> - (Exit.zero ctx, [ Fragment.make "" ])) + if in_double_quotes ctx then + (Exit.zero ctx, [ Ast.Fragment.make "" ]) + else (Exit.zero ctx, [])) | Ast.VariableAtom (s, NoAttribute) -> ( match lookup_variable ctx ~param:s with - | None -> + | None when not (in_quotes ctx) -> if ctx.options.no_unset then begin ( Exit.nonzero_msg ctx ~exit_code:1 "%s: unbound variable" s, - [ Fragment.make "" ] ) + [] ) end - else (Exit.zero ctx, [ Fragment.make "" ]) + else (Exit.zero ctx, []) + | Some [ Ast.{ txt = ""; _ } ] when not (in_quotes ctx) -> + (Exit.zero ctx, []) + | None | Some [ Ast.{ txt = ""; _ } ] -> + (Exit.zero ctx, [ Fragment.make "" ]) | Some cst -> ( Exit.zero ctx, - [ Fragment.make ~splittable:(not ctx.in_double_quotes) cst ] - )) + update_variable + ~splittable:(not (in_double_quotes ctx)) + ~join:(maybe_join ctx) cst )) | Ast.VariableAtom (s, ParameterLength) -> ( match lookup_variable ctx ~param:s with | None -> (Exit.zero ctx, [ Fragment.make "0" ]) | Some cst -> ( Exit.zero ctx, - [ Fragment.make (string_of_int (String.length cst)) ] )) + [ Fragment.make (string_of_int (Ast.Fragment.length cst)) ] + )) | Ast.VariableAtom (s, UseDefaultValues (_, cst)) -> ( match lookup_variable ctx ~param:s with - | None -> - (Exit.zero ctx, [ Fragment.make (word_cst_to_string cst) ]) - | Some cst -> (Exit.zero ctx, [ Fragment.make cst ])) + | None | Some [ Ast.{ txt = ""; _ } ] -> + let nctx, w = + let nctx, w = word_expansion ctx cst in + let v = + List.map (fun (f : Ast.fragment) -> + { f with splittable = not (in_quotes ctx) }) + @@ List.concat w + in + (nctx, v) + in + (nctx, w) + | Some cst -> + ( Exit.zero ctx, + update_variable + ~splittable:(not (in_quotes ctx)) + ~join:(maybe_join ctx) cst )) | Ast.VariableAtom ( s, (( RemoveSmallestPrefixPattern cst @@ -984,7 +1241,10 @@ module Make (S : Types.State) (E : Types.Exec) = struct let pattern = Fragment.join_list ~sep:"" (List.concat spp) in match lookup_variable ctx ~param:s with | None -> - (Exit.zero ctx, [ Fragment.make (word_cst_to_string cst) ]) + let fs = + if in_quotes ctx then [ Ast.Fragment.make "" ] else [] + in + (Exit.zero ctx, fs) | Some cst -> ( let kind = match v with @@ -992,14 +1252,19 @@ module Make (S : Types.State) (E : Types.Exec) = struct | RemoveLargestPrefixPattern _ -> `Largest | _ -> assert false in - let param = cst in + let param = Ast.Fragment.join_list ~sep:"" cst in let prefix = get_prefix ~pattern ~kind param in + let splittable = not (in_quotes ctx) in match prefix with - | None -> (Exit.zero ctx, [ Fragment.make param ]) + | None | Some "" -> + (Exit.zero ctx, [ Fragment.make ~splittable param ]) | Some s -> ( match String.cut_prefix ~prefix:s param with - | Some s -> (Exit.zero ctx, [ Fragment.make s ]) - | None -> (Exit.zero ctx, [ Fragment.make param ]))))) + | Some s -> + (Exit.zero ctx, [ Fragment.make ~splittable s ]) + | None -> + ( Exit.zero ctx, + [ Fragment.make ~splittable param ] ))))) | Ast.VariableAtom ( s, (( RemoveSmallestSuffixPattern cst @@ -1010,8 +1275,11 @@ module Make (S : Types.State) (E : Types.Exec) = struct | Exit.Nonzero _ as ctx -> (ctx, [ Fragment.empty ]) | Exit.Zero ctx -> ( match lookup_variable ctx ~param:s with - | None -> - (Exit.zero ctx, [ Fragment.make (word_cst_to_string cst) ]) + | Some [ { txt = ""; _ } ] | None -> + let fs = + if in_quotes ctx then [ Ast.Fragment.make "" ] else [] + in + (Exit.zero ctx, fs) | Some cst -> ( let kind = match v with @@ -1019,55 +1287,64 @@ module Make (S : Types.State) (E : Types.Exec) = struct | RemoveLargestSuffixPattern _ -> `Largest | _ -> assert false in - let param = cst in + let param = Ast.Fragment.join_list ~sep:"" cst in let suffix = get_suffix ~pattern ~kind param in + let splittable = not (in_quotes ctx) in match suffix with - | None -> (Exit.zero ctx, [ Fragment.make param ]) + | None -> + (Exit.zero ctx, [ Fragment.make ~splittable param ]) | Some s -> ( match String.cut_suffix ~suffix:s param with - | Some s -> (Exit.zero ctx, [ Fragment.make s ]) - | None -> (Exit.zero ctx, [ Fragment.make param ]))))) + | Some s -> + (Exit.zero ctx, [ Fragment.make ~splittable s ]) + | None -> + ( Exit.zero ctx, + [ Fragment.make ~splittable param ] ))))) | Ast.VariableAtom (s, UseAlternativeValue (_, alt)) -> ( - let ctx, alt = word_expansion ctx alt in - match lookup_variable (Exit.value ctx) ~param:s with - | Some "" | None -> (ctx, []) - | Some _ -> (ctx, List.concat alt)) + let nctx, alt = word_expansion ctx alt in + match lookup_variable (Exit.value nctx) ~param:s with + | Some [ { txt = ""; _ } ] | None -> + let fs = + if in_quotes ctx then [ Ast.Fragment.make "" ] else [] + in + (nctx, fs) + | Some _ -> + let alt = + List.map (fun (f : Ast.fragment) -> + { f with splittable = not (in_quotes ctx) }) + @@ List.concat alt + in + (nctx, alt)) | Ast.VariableAtom (s, AssignDefaultValues (_, value)) -> ( let new_ctx, value = word_expansion ctx value in match lookup_variable (Exit.value new_ctx) ~param:s with - | Some "" | None -> ( - match - S.update ctx.state ~param:s - (List.concat value |> Ast.Fragment.join_list ~sep:"") - with + | Some [ { txt = ""; _ } ] | None -> ( + match S.update ctx.state ~param:s (List.concat value) with | Ok state -> let new_ctx = { (Exit.value new_ctx) with state } in (Exit.zero new_ctx, List.concat value) | Error m -> (Exit.nonzero_msg ~exit_code:1 ctx "%s" m, [])) - | Some cst -> (new_ctx, [ Fragment.make cst ])) + | Some cst -> (new_ctx, cst)) | Ast.VariableAtom (_, IndicateErrorifNullorUnset (_, _)) -> Fmt.failwith "TODO: Indicate Error") | Ast.WordDoubleQuoted [] -> (Exit.zero ctx, [ Ast.Fragment.empty ]) | Ast.WordDoubleQuoted cst -> ( - let saved_dqoute = ctx.in_double_quotes in - let ctx = { ctx with in_double_quotes = true } in + let saved_dqoute = ctx.quotes in + let ctx = { ctx with quotes = `Double } in let new_ctx, cst_acc = word_expansion ctx cst in let new_ctx = - Exit.map - ~f:(fun ctx -> { ctx with in_double_quotes = saved_dqoute }) - new_ctx + Exit.map ~f:(fun ctx -> { ctx with quotes = saved_dqoute }) new_ctx in match new_ctx with | Exit.Nonzero _ -> (new_ctx, List.concat cst_acc) | Exit.Zero new_ctx -> (Exit.zero new_ctx, List.concat cst_acc)) | Ast.WordSingleQuoted [] -> (Exit.zero ctx, [ Ast.Fragment.empty ]) | Ast.WordSingleQuoted cst -> ( - let saved_dqoute = ctx.in_double_quotes in + let saved_dqoute = ctx.quotes in + let ctx = { ctx with quotes = `Single } in let new_ctx, cst_acc = word_expansion ctx cst in let new_ctx = - Exit.map - ~f:(fun ctx -> { ctx with in_double_quotes = saved_dqoute }) - new_ctx + Exit.map ~f:(fun ctx -> { ctx with quotes = saved_dqoute }) new_ctx in match new_ctx with | Exit.Nonzero _ -> (new_ctx, List.concat cst_acc) @@ -1084,10 +1361,20 @@ module Make (S : Types.State) (E : Types.Exec) = struct ] )) | Ast.WordSubshell sub -> (* Command substitution *) + let saved_ctx = ctx in + let ctx = { ctx with quotes = `None } in let s = command_substitution ctx sub in - (Exit.zero ctx, [ Fragment.make ~join:`Yes s ]) + ( Exit.zero saved_ctx, + [ + Fragment.make ~splittable:(not (in_quotes saved_ctx)) ~join:`Yes s; + ] ) | Ast.WordArithmeticExpression cst -> - arithmetic_expansion ctx cst |> fun (ctx, v) -> + let aexpand state ~param = + match expand { ctx with state } (Sast.WordVariable param) with + | _, [] -> None + | _, frags -> Some (Ast.Fragment.join_list ~sep:"" frags) + in + arithmetic_expansion ~expand:aexpand ctx cst |> fun (ctx, v) -> (Exit.zero ctx, [ Fragment.make @@ string_of_int v ]) | Ast.WordName s -> (Exit.zero ctx, [ Fragment.make s ]) | Ast.WordLiteral s -> @@ -1097,6 +1384,9 @@ module Make (S : Types.State) (E : Types.Exec) = struct | Ast.WordGlobAny -> (Exit.zero ctx, [ Fragment.make ~globbable:true "?" ]) | Ast.WordTildePrefix s -> (Exit.zero ctx, [ Fragment.make ~tilde_expansion:true s ]) + | Ast.WordEmpty -> + let fs = if in_quotes ctx then [ Ast.Fragment.make "" ] else [] in + (Exit.zero ctx, fs) | v -> Fmt.failwith "TODO: expansion of %a" yojson_pp (Ast.word_component_to_yojson v) @@ -1107,28 +1397,51 @@ module Make (S : Types.State) (E : Types.Exec) = struct let v, ls = String.fold_left (fun (so_far, ls) c -> - if String.contains ifs c then ("", so_far :: ls) + if String.contains ifs c then begin + if has_ws ifs && String.(equal so_far empty) then ("", ls) + else ("", so_far :: ls) + end else (so_far ^ String.make 1 c, ls)) ("", []) s in List.rev (v :: ls) - and field_splitting ctx = function - | [] -> [] - | Ast.{ splittable = true; txt; globbable; _ } :: rest -> ( - match S.lookup ctx.state ~param:"IFS" with - | Some "" -> [ Ast.Fragment.make ~join:`No ~globbable txt ] - | (None | Some _) as ifs -> - let ifs = Option.value ~default:" \t\n" ifs in - (split_fields ifs txt |> List.map (Ast.Fragment.make ~globbable)) - @ field_splitting ctx rest) - | txt :: rest -> txt :: field_splitting ctx rest + and field_splitting ctx v = + let ifs = lookup ctx ~param:"IFS" in + let rec loop = function + | [] -> [] + | Ast.{ splittable = true; txt; globbable; _ } :: rest -> ( + let ifs = Option.map (Ast.Fragment.join_list ~sep:"") ifs in + match ifs with + | Some "" -> [ Ast.Fragment.make ~join:`No ~globbable txt ] + | (None | Some _) as ifs -> + let ifs = Option.value ~default:" \t\n" ifs in + let txt = if has_ws ifs then String.trim txt else txt in + (split_fields ifs txt |> List.map (Ast.Fragment.make ~globbable)) + @ loop rest) + | txt :: rest -> txt :: loop rest + in + let fields = loop v in + match fields with + | [] | [ _ ] -> fields + | _ -> ( + (* Remove empty final field if any *) + let fields = + match List.rev fields with + | { Sast.txt = ""; _ } :: rest -> List.rev rest + | _ -> fields + in + match (Option.map (Ast.Fragment.join_list ~sep:"") ifs, fields) with + | Some w, { Sast.txt = ""; _ } :: rest when String.contains w ' ' -> + rest + | _ -> fields) and word_expansion' ctx cst : ctx Exit.t * Ast.fragments = let cst = tilde_expansion ctx cst in parameter_expansion ctx cst - and word_expansion ctx cst : ctx Exit.t * Ast.fragments list = + and word_expansion ?collect ?(update = false) ctx cst : + ctx Exit.t * Ast.fragments list = let rec aux ctx = function | [] -> (ctx, []) (* one empty word *) | c :: rest -> @@ -1138,6 +1451,31 @@ module Make (S : Types.State) (E : Types.Exec) = struct (next_ctx, combined) in let ctx, cst = aux (Exit.zero ctx) cst in + let ctx = + match (ctx, collect) with + | _, None -> ctx + | Exit.Nonzero _, Some _ -> ctx + | Exit.Zero ctx, Some param -> ( + Debug.Log.debug (fun f -> + f "collect assignment: %s is %a" param + Fmt.(lst @@ Ast.Fragment.pp) + cst); + let state = + if update then S.update ctx.state ~param cst else Ok ctx.state + in + match state with + | Error message -> Exit.nonzero ~message ctx 1 + | Ok state -> + let v = (param, cst) in + let local_state = + match Stack.pop ctx.local_state with + | Some (h, rest) -> + let h = v :: h in + Stack.push h rest + | None -> Stack.push [ v ] Stack.empty + in + Exit.Zero { ctx with state; local_state }) + in let cst = Ast.Fragment.handle_joins cst in match ctx with | Exit.Nonzero _ -> (ctx, [ cst ]) @@ -1176,26 +1514,26 @@ module Make (S : Types.State) (E : Types.Exec) = struct in let update = match kind with - | `Export -> update ~export:true ~readonly:false - | `Readonly -> update ~export:false ~readonly:true - | `Local -> update ~export:false ~readonly:false + | `Export -> update ~export:true ~readonly:false ~local:false + | `Readonly -> update ~export:false ~readonly:true ~local:false + | `Local -> update ~export:false ~readonly:false ~local:true in let read_arg acc_ctx param = (* TODO: quoting? *) match Astring.String.cut ~sep:"=" param with - | Some (param, v) -> update acc_ctx ~param v + | Some (param, v) -> update acc_ctx ~param [ Ast.Fragment.make v ] | None -> ( match S.lookup acc_ctx.state ~param with | Some v -> update acc_ctx ~param v - | None -> Exit.zero acc_ctx) + | None -> update acc_ctx ~param [ (* TODO: Empty string? *) ]) in - match flags with - | [] -> + match (flags, assignments) with + | [], assignments -> List.fold_left (fun ctx w -> match ctx with Exit.Zero ctx -> read_arg ctx w | _ -> ctx) (Exit.zero ctx) assignments - | fs -> + | fs, _assignments -> if List.mem "p" fs then begin match kind with | `Readonly -> S.pp_readonly Fmt.stdout ctx.state @@ -1285,9 +1623,13 @@ module Make (S : Types.State) (E : Types.Exec) = struct (* TODO: fold ctx with exit value... *) let ctx, wdlist = Nlist.fold_left - (fun (ctx, acc) w -> - let ctx, w = word_expansion (Exit.value ctx) w in - (ctx, acc @ [ w ])) + (fun (ctx, acc) wd -> + Debug.Log.debug (fun f -> + f "FOR: Local state: %a" dump_ctx (Exit.value ctx)); + let ctx, w = word_expansion (Exit.value ctx) wd in + Debug.Log.debug (fun f -> + f "FOR: %a" Fmt.(lst @@ lst Ast.Fragment.pp) w); + if w = [ [] ] then (ctx, acc) else (ctx, acc @ [ w ])) (Exit.zero ctx, []) wdlist in @@ -1299,10 +1641,7 @@ module Make (S : Types.State) (E : Types.Exec) = struct let ctx = Exit.value ctx in List.fold_left (fun ctx word -> - Debug.Log.debug (fun f -> - f "for-loop: %s=%s" name word.Ast.txt); - update (Exit.value ctx) ~param:name word.Ast.txt - >>= fun ctx -> + update (Exit.value ctx) ~param:name [ word ] >>= fun ctx -> try exec ctx (term, Some sep) with | Continue (1, ctx) -> Exit.zero ctx | Continue (n, ctx) -> raise (Continue (n - 1, ctx))) @@ -1404,7 +1743,7 @@ module Make (S : Types.State) (E : Types.Exec) = struct | Exit.Nonzero _ -> exit_so_far (* TODO: Context? *) | Exit.Zero ctx -> (* Before we loop, we yield to other pipeline tasks. *) - (* Fiber.yield (); *) + Fiber.yield (); loop (try exec ctx (term', Some sep') with | Continue (1, ctx) -> Exit.zero ctx @@ -1440,7 +1779,8 @@ module Make (S : Types.State) (E : Types.Exec) = struct | Ast.WhileClause while_ -> handle_while_clause ctx while_ | Ast.UntilClause until -> handle_until_clause ctx until - and handle_function_application (ctx : ctx) ~name argv : ctx Exit.t option = + and handle_function_application (ctx : ctx) ~name argv : + (unit -> ctx Exit.t) option = match List.assoc_opt name ctx.functions with | None -> None | Some commands -> @@ -1448,15 +1788,28 @@ module Make (S : Types.State) (E : Types.Exec) = struct f "function enter: %s [%a]" name Fmt.(list ~sep:Fmt.(any " ") (quote string)) argv); - let ctx = { ctx with argv = Array.of_list argv; subshell = true } in + (* Add new variable scope for locals *) + let new_state = S.push ctx.state in + let ctx = + { + ctx with + argv = Array.of_list argv; + (* subshell = true; *) + state = new_state; + } + in let v = - try Option.some @@ handle_compound_command ctx commands + Option.some @@ fun () -> + try + let ctx = handle_compound_command ctx commands in + let ctx = + Exit.map ~f:(fun ctx -> { ctx with state = S.pop ctx.state }) ctx + in + Debug.Log.debug (fun f -> f "function leave: %s" name); + ctx with Return ctx -> - Debug.Log.info (fun f -> - f "function %s returned %a" name Exit.pp ctx); - Some ctx + Exit.map ~f:(fun ctx -> { ctx with state = S.pop ctx.state }) ctx in - Debug.Log.debug (fun f -> f "function leave: %s" name); v and command_substitution (ctx : ctx) (cc : Ast.complete_commands) = @@ -1469,7 +1822,11 @@ module Make (S : Types.State) (E : Types.Exec) = struct Eio.Fiber.fork ~sw (fun () -> Trace.name "command-sub-copy"; Eio.Flow.copy r stdout); - let subshell_ctx = { ctx with stdout = w; subshell = true } in + let rdrs = + Types.Redirect (false, 1, Eio_unix.Resource.fd w, `Blocking) + :: ctx.rdrs + in + let subshell_ctx = { ctx with subshell = true; rdrs } in let sub_ctx, _ = run (Exit.zero subshell_ctx) s in Eio.Flow.close w; sub_ctx @@ -1505,37 +1862,10 @@ module Make (S : Types.State) (E : Types.Exec) = struct | Exit.Nonzero _ -> ctx | Exit.Zero ctx -> ( match prefix with - | Ast.Prefix_assignment (Name param, v) -> ( - (* Expand the values *) - let ctx, v = word_expansion ctx v in - match ctx with - | Exit.Nonzero _ as ctx -> ctx - | Exit.Zero ctx -> ( - let s = Ast.Fragment.join_list ~sep:"" @@ List.concat v in - Debug.Log.debug (fun f -> - f "collect assignment: %s is %a : %i chars" param - Fmt.(quote string) - s (String.length s)); - let state = - (* TODO: Overhaul... need to collect assignments after word expansion...*) - if update || String.equal "IFS" param then - S.update ctx.state ~param - (Ast.Fragment.join_list ~sep:"" @@ List.concat v) - else Ok ctx.state - in - match state with - | Error message -> Exit.nonzero ~message ctx 1 - | Ok state -> - Exit.zero - { - ctx with - state; - local_state = - ( param, - Ast.Fragment.join_list ~sep:"" @@ List.concat v - ) - :: ctx.local_state; - })) + | Ast.Prefix_assignment (Name param, v) -> + (* Expand the values but update the state too. *) + let ctx, _v = word_expansion ~collect:param ~update ctx v in + ctx | _ -> Exit.zero ctx)) (Exit.zero ctx) vs @@ -1558,19 +1888,20 @@ module Make (S : Types.State) (E : Types.Exec) = struct in let arguments = List.map Ast.Fragment.to_string (List.concat fs) in (* TODO: Proper handling of escaped stuff? *) - let arguments = - List.map - (fun s -> - match String.get s 0 with - | '\\' -> String.sub s 1 (String.length s - 1) - | (exception _) | _ -> s) - arguments - in + (* let arguments = *) + (* List.map *) + (* (fun s -> *) + (* match String.get s 0 with *) + (* | '\\' -> String.sub s 1 (String.length s - 1) *) + (* | (exception _) | _ -> s) *) + (* arguments *) + (* in *) (ctx, arguments) - and handle_built_in ~rdrs ~(stdout : Eio_unix.sink_ty Eio.Flow.sink) - (ctx : ctx) v = - let rdrs = ctx.rdrs @ rdrs in + and handle_built_in : + rdrs:Types.redirect list -> ctx -> Built_ins.t -> ctx Exit.t = + fun ~rdrs (ctx : ctx) v -> + let rdrs = make_child_rdrs_for_parent rdrs in Eunix.with_redirections ~restore:true rdrs @@ fun () -> Debug.Log.debug (fun f -> f "built-in: %s" (Built_ins.to_string v)); match v with @@ -1597,7 +1928,7 @@ module Make (S : Types.State) (E : Types.Exec) = struct let () = Eio.Flow.copy_string (Fmt.str "%a\n%!" Fpath.pp (S.cwd ctx.state)) - stdout + ctx.stdout in Exit.zero ctx | Exit n -> @@ -1617,7 +1948,7 @@ module Make (S : Types.State) (E : Types.Exec) = struct if print_options then Eio.Flow.copy_string (Fmt.str "%a" Built_ins.Options.pp ctx.options) - stdout; + ctx.stdout; v | Wait i -> ( match Unix.waitpid [] i with @@ -1626,7 +1957,7 @@ module Make (S : Types.State) (E : Types.Exec) = struct | Dot file -> ( let hash, prog = Eunix.resolve_program - ?path:(S.lookup ctx.state ~param:"PATH") + ?path:(lookup_and_join ctx.state ~param:"PATH") ctx.hash file in let ctx = { ctx with hash } in @@ -1660,18 +1991,20 @@ module Make (S : Types.State) (E : Types.Exec) = struct match v with | Built_ins.Hash_remove -> Exit.zero { ctx with hash = Hash.empty } | Built_ins.Hash_stats -> - Eio.Flow.copy_string (Fmt.str "%a" Hash.pp ctx.hash) stdout; + Eio.Flow.copy_string (Fmt.str "%a" Hash.pp ctx.hash) ctx.stdout; Exit.zero ctx | _ -> assert false) | Alias | Unalias -> Exit.zero ctx (* Morbig handles this for us *) | Eval args -> let script = String.concat " " args in + (* TODO: Hmmm, might be a Morbig issue... *) + let script = unescape_eval script in let ast = Ast.of_string script in let ctx, _ = run (Exit.zero ctx) ast in ctx | Echo args -> let str = String.concat " " args ^ "\n" in - Eio.Flow.copy_string str stdout; + Eio.Flow.copy_string str ctx.stdout; Exit.zero ctx | Trap (action, signals) -> let saved_ctx = ctx in @@ -1724,7 +2057,7 @@ module Make (S : Types.State) (E : Types.Exec) = struct ctx signals | Umask None -> let str = Fmt.str "0%o\n" ctx.umask in - Eio.Flow.copy_string str stdout; + Eio.Flow.copy_string str ctx.stdout; Exit.zero ctx | Umask (Some i) -> Exit.zero { ctx with umask = i } | Shift n -> @@ -1735,7 +2068,10 @@ module Make (S : Types.State) (E : Types.Exec) = struct Exit.nonzero ctx 1 end else - let argv = Array.init new_len (fun i -> Array.get ctx.argv (i + n)) in + let argv = + Array.init new_len (fun i -> + Array.get ~label:"shift" ctx.argv (i + n)) + in Exit.zero { ctx with argv } | Read (_backslash, vars) -> ( let line = @@ -1748,7 +2084,6 @@ module Make (S : Types.State) (E : Types.Exec) = struct | "\n" -> Some acc | c -> loop (acc ^ c) | exception End_of_file -> - Debug.Log.debug (fun f -> f "Read EOF"); if String.equal acc "" then None else Some acc in loop "" @@ -1775,7 +2110,9 @@ module Make (S : Types.State) (E : Types.Exec) = struct let state = List.fold_left (fun st (k, v) -> - S.update ?id:ctx.current_pipeline st ~param:k v + (* TODO: Maybe just return the raw fragments from the loop... *) + S.update ?id:ctx.current_pipeline st ~param:k + [ Ast.Fragment.make v ] |> Result.get_ok) ctx.state vars in @@ -1799,7 +2136,8 @@ module Make (S : Types.State) (E : Types.Exec) = struct in match handle_and_or ~sw ~async ctx c with | Exit.Zero ctx -> loop sw ctx cs - | v -> v) + | Exit.Nonzero { value = ctx; _ } as v -> + if should_exit ctx v then v else loop sw ctx cs) in match sep with | Some Semicolon | None -> diff --git a/src/lib/eval.mli b/src/lib/eval.mli index b6ffad8..4b8a353 100644 --- a/src/lib/eval.mli +++ b/src/lib/eval.mli @@ -13,17 +13,14 @@ module Make (S : Types.State) (E : Types.Exec) : sig val make_ctx : ?interactive:bool -> ?subshell:bool -> - ?local_state:(string * string) list -> ?background_jobs:ctx J.t list -> ?last_background_process:string -> ?current_pipeline:string -> ?last_pipeline_status:int -> ?functions:(string * Sast.compound_command) list -> - ?rdrs:Types.redirect list -> ?exit_handler:(unit -> unit) -> ?options:Built_ins.Options.t -> ?hash:Hash.t -> - ?in_double_quotes:bool -> ?umask:int -> fs:Eio.Fs.dir_ty Eio.Path.t -> stdin:Eio_unix.source_ty r -> @@ -51,6 +48,11 @@ module Make (S : Types.State) (E : Types.Exec) : sig (** {2 Private} *) - val word_expansion : ctx -> Ast.word_cst -> ctx Exit.t * Ast.fragments list + val word_expansion : + ?collect:string -> + ?update:bool -> + ctx -> + Ast.word_cst -> + ctx Exit.t * S.variable list (* Mostly for testing purposes, this exposes the logic for expanding words. *) end diff --git a/src/lib/import.ml b/src/lib/import.ml index 2e36619..10b04b7 100644 --- a/src/lib/import.ml +++ b/src/lib/import.ml @@ -10,6 +10,28 @@ module Fmt = struct include Fmt let lst pp ppf = (brackets @@ list ~sep:comma pp) ppf + + let ifs ppf v = + let pp_char ppf = function + | '\n' -> Fmt.string ppf "" + | ' ' -> Fmt.string ppf "" + | '\t' -> Fmt.string ppf "" + | c -> Fmt.char ppf c + in + lst pp_char ppf (String.fold_left (fun acc c -> acc @ [ c ]) [] v) + + let string ?(max = 80) ppf v = Fmt.truncated ~max ppf v + let fd ppf o = Fmt.int ppf (Obj.magic (o : Unix.file_descr)) +end + +module Array = struct + include Array + + let get ~label arr i = + match Array.get arr i with + | v -> v + | exception Invalid_argument msg -> + raise (Invalid_argument (label ^ ": " ^ msg)) end module Promise = struct @@ -82,15 +104,27 @@ let yojson_pp = Yojson.Safe.pretty_print ~std:true module String = struct include String + let get ~label s i = + match String.get s i with + | v -> v + | exception Invalid_argument msg -> + raise (Invalid_argument (label ^ ": " ^ msg)) + let cut_prefix ~prefix s = match Astring.String.cut ~sep:prefix s with | Some ("", rest) -> Some rest | _ -> None let cut_suffix ~suffix s = - match Astring.String.cut ~sep:suffix s with - | Some (start, "") -> Some start - | _ -> None + let exception Found of int in + let s_len = String.length s in + try + for i = s_len - 1 downto 0 do + let v = String.sub s i (s_len - i) in + if String.equal suffix v then raise (Found i) + done; + None + with Found i -> Some (String.sub s 0 i) end module Glob = struct diff --git a/src/lib/interactive.ml b/src/lib/interactive.ml index 794ff2e..800e741 100644 --- a/src/lib/interactive.ml +++ b/src/lib/interactive.ml @@ -81,6 +81,10 @@ module Make (S : Types.State) (E : Types.Exec) (H : Types.History) = struct | S_DIR -> completions path None | _ -> []) + let fragments_to_string = function + | None -> None + | Some lst -> Some (Ast.Fragment.join_list ~sep:"" lst) + let run ?(prompt = default_prompt) initial_ctx = Sys.set_signal Sys.sigttou Sys.Signal_ignore; Sys.set_signal Sys.sigttin Sys.Signal_ignore; @@ -96,7 +100,8 @@ module Make (S : Types.State) (E : Types.Exec) (H : Types.History) = struct in let rec loop (ctx : Eval.ctx Exit.t) = Option.iter (Fmt.epr "%s%!") - (S.lookup (Exit.value ctx |> Eval.state) ~param:"PS1"); + (S.lookup (Exit.value ctx |> Eval.state) ~param:"PS1" + |> fragments_to_string); let p = prompt ctx in Fmt.pr "%s\r%!" p; let hint command = diff --git a/src/lib/merry.ml b/src/lib/merry.ml index 44c89e6..bbe14e6 100644 --- a/src/lib/merry.ml +++ b/src/lib/merry.ml @@ -1,4 +1,5 @@ module Import = Import +module Stack = Stack module Hash = Hash module Exit = Exit module Eunix = Eunix diff --git a/src/lib/merry.mli b/src/lib/merry.mli index 29e4365..8ee0b2c 100644 --- a/src/lib/merry.mli +++ b/src/lib/merry.mli @@ -1,4 +1,5 @@ module Ast = Ast +module Stack = Stack module Hash = Hash module Exit = Exit module Eunix = Eunix diff --git a/src/lib/posix/exec.ml b/src/lib/posix/exec.ml index 445fe92..f6eafcf 100644 --- a/src/lib/posix/exec.ml +++ b/src/lib/posix/exec.ml @@ -192,7 +192,8 @@ let rec with_fds mapping k = match mapping with | [] -> k [] | (dst, src, _) :: xs -> - Eio_unix.Fd.use_exn "inherit_fds" src @@ fun src -> + Eio_unix.Fd.use ~if_closed:(fun () -> with_fds xs @@ fun xs -> k xs) src + @@ fun src -> with_fds xs @@ fun xs -> k ((dst, (Obj.magic src : int)) :: xs) let inherit_fds m = @@ -267,8 +268,7 @@ let run ~mode ?delay_reap _ ?stdin ?stdout ?stderr ?(fds = []) Sys.set_signal Sys.sigint Sys.Signal_default; with_close_list @@ fun to_close -> let check_fd n = function - | Merry.Types.Parent_redirect (m, _, _) -> Int.equal n m - | Merry.Types.Child_redirect (m, _, _) -> Int.equal n m + | Merry.Types.Redirect (_, m, _, _) -> Int.equal n m | Merry.Types.Close fd -> fd_equal_int fd n in let fd_exists n = List.exists (check_fd n) fds in @@ -301,9 +301,9 @@ let run ~mode ?delay_reap _ ?stdin ?stdout ?stderr ?(fds = []) let need_close, fds = List.fold_left (fun (cs, fs) -> function - | Merry.Types.Child_redirect (a, b, c) -> (cs, (a, b, c) :: fs) - | Merry.Types.Parent_redirect _ -> (cs, fs) - | Close fd -> (fd :: cs, fs)) + | Merry.Types.Redirect (false, a, b, c) -> (cs, (a, b, c) :: fs) + | Close fd -> (fd :: cs, fs) + | _ -> (cs, fs)) ([], []) fds |> fun (cs, fs) -> (List.rev cs, List.rev fs) in diff --git a/src/lib/posix/state.ml b/src/lib/posix/state.ml index b3765eb..1bcc774 100644 --- a/src/lib/posix/state.ml +++ b/src/lib/posix/state.ml @@ -1,43 +1,109 @@ +open Merry module Variables = Map.Make (String) +module Stack = Merry.Stack type attributes = { export : bool; readonly : bool; id : string } let default_attribute = { export = false; readonly = false; id = "id" } +type scopes = (attributes * Ast.fragments) Variables.t Stack.t + type t = { cwd : Fpath.t; functions : Merry.Function.t list; root : int; outermost : bool; home : string; - variables : (attributes * string) Variables.t; + variables : (attributes * Ast.fragments) Variables.t; + scopes : scopes; } -let update ?(id = "") ?(export = false) ?(readonly = false) t ~param v = - match Variables.find_opt param t.variables with - | Some ({ readonly = true; _ }, _) -> - Error (Fmt.str "%s: readonly variable" param) - | _ -> - let attr = { export; readonly; id } in - let variables' = Variables.add param (attr, v) t.variables in - Ok { t with variables = variables' } +type variable = Ast.fragments + +let pp_attr ppf attr = + Fmt.pf ppf "{ export = %b; readonly = %b; id = %a }" attr.export attr.readonly + Fmt.(quote string) + attr.id + +let pp_variable ppf (k, (attr, v)) = + Fmt.pf ppf "%s={ value = %a; attr = %a }" k + Import.Fmt.(lst Ast.Fragment.pp) + v pp_attr attr + +let pp_variables ppf vs = + Merry.Import.Fmt.(lst pp_variable) ppf (Variables.to_list vs) + +let update ?(id = "") ?(export = false) ?(readonly = false) ?(local = false) t + ~param (v : Ast.fragments) = + let add_non_local param = + (* First check if the variable has been defined locally *) + let is_local scopes = + match Stack.pop scopes with + | Some (h, rest) -> ( + match Variables.find_opt param h with + | Some v -> Some (v, h, rest) + | None -> None) + | None -> None + in + match is_local t.scopes with + | Some ((attr, _), vs, rest) -> + let variables' = Variables.add param (attr, v) vs in + Ok { t with scopes = Stack.push variables' rest } + | None -> ( + match Variables.find_opt param t.variables with + | Some ({ readonly = true; _ }, _) -> + Error (Fmt.str "%s: readonly variable" param) + | _ -> + let attr = { export; readonly; id } in + let variables' = Variables.add param (attr, v) t.variables in + Ok { t with variables = variables' }) + in + let add_local param = + let attr = default_attribute in + match Stack.pop t.scopes with + | Some (vs, rest) -> + let variables' = Variables.add param (attr, v) vs in + Ok { t with scopes = Stack.push variables' rest } + | None -> + let variables' = Variables.add param (attr, v) Variables.empty in + Ok { t with scopes = Stack.push variables' t.scopes } + in + if local then add_local param else add_non_local param let seed_env () = let env = Merry.Eunix.env () in List.fold_left (fun vars (param, v) -> + let v = [ Ast.Fragment.make v ] in Variables.add param ({ default_attribute with export = true }, v) vars) Variables.empty env let make ?(functions = []) ?(root = 0) ?(outermost = true) ?(home = "/root") ?variables cwd = let variables = match variables with None -> seed_env () | Some v -> v in - { cwd; functions; root; outermost; home; variables } + { cwd; functions; root; outermost; home; variables; scopes = Stack.empty } + +let pop t = + match Stack.pop t.scopes with + | None -> t + | Some (_, scopes) -> { t with scopes } + +let push t = + let scopes = Stack.push Variables.empty t.scopes in + { t with scopes } let cwd t = t.cwd let set_cwd t cwd = { t with cwd } let expand t = function `Tilde -> t.home -let lookup t ~param = Variables.find_opt param t.variables |> Option.map snd + +let lookup t ~param = + match Stack.peek t.scopes with + | None -> Variables.find_opt param t.variables |> Option.map snd + | Some vs -> ( + let locals = Variables.find_opt param vs |> Option.map snd in + match locals with + | Some _ as v -> v + | None -> Variables.find_opt param t.variables |> Option.map snd) let remove ~param t = match Variables.find_opt param t.variables with @@ -64,6 +130,12 @@ let exports t = | p, ({ export = true; _ }, v) -> Some (p, v) | _ -> None) +let locals t = + match Stack.pop t.scopes with + | None -> [] + | Some (vars, _) -> + Variables.to_list vars |> List.map (fun (n, (_, v)) -> (n, v)) + let readonly t = Variables.to_list t.variables |> List.filter_map (function @@ -72,25 +144,26 @@ let readonly t = let pp_readonly fmt t = let rs = readonly t in - let rs = List.map (fun (p, cst) -> ("readonly " ^ p, cst)) rs in + let rs = + List.map + (fun (p, cst) -> ("readonly " ^ p, Ast.Fragment.join_list ~sep:"" cst)) + rs + in Fmt.(list ~sep:(Fmt.any "\n") (pair ~sep:(Fmt.any "=") string (quote string))) fmt rs let pp_export fmt t = let rs = exports t in - let rs = List.map (fun (p, cst) -> ("export " ^ p, cst)) rs in + let rs = + List.map + (fun (p, cst) -> ("export " ^ p, Ast.Fragment.join_list ~sep:"" cst)) + rs + in Fmt.(list ~sep:(Fmt.any "\n") (pair ~sep:(Fmt.any "=") string (quote string))) fmt rs -let pp_attr ppf attr = - Fmt.pf ppf "{ export = %b; readonly = %b; id = %a }" attr.export attr.readonly - Fmt.(quote string) - attr.id - -let pp_variable ppf (k, (attr, v)) = - Fmt.pf ppf "%s={ value = %s; attr = %a }" k v pp_attr attr - let dump ppf s = - Fmt.pf ppf "Variables:[%a]" + Fmt.pf ppf "Variables:[%a]\nLocals:%a" Fmt.(list ~sep:Fmt.comma pp_variable) (Variables.to_list s.variables) + (Stack.pp pp_variables) s.scopes diff --git a/src/lib/sast.ml b/src/lib/sast.ml index 77f96ff..dd9e6e8 100644 --- a/src/lib/sast.ml +++ b/src/lib/sast.ml @@ -124,6 +124,7 @@ and word_component = and fragment = { txt : string; + escaping : bool; splittable : bool; globbable : bool; tilde_expansion : bool; diff --git a/src/lib/stack.ml b/src/lib/stack.ml new file mode 100644 index 0000000..a989a78 --- /dev/null +++ b/src/lib/stack.ml @@ -0,0 +1,11 @@ +open Import + +(* A functional stack. *) +type 'a t = 'a List.t + +let empty = [] +let push v t = v :: t +let pop = function [] -> None | x :: ts -> Some (x, ts) +let peek = function [] -> None | x :: _ -> Some x +let pp pp ppf = Fmt.lst pp ppf +let to_list v = v diff --git a/src/lib/stack.mli b/src/lib/stack.mli new file mode 100644 index 0000000..5a42e34 --- /dev/null +++ b/src/lib/stack.mli @@ -0,0 +1,18 @@ +type 'a t +(** A functional stack *) + +val push : 'a -> 'a t -> 'a t +(** Push a new element to the stack. *) + +val pop : 'a t -> ('a * 'a t) option +(** Pop an element from the stack, and the new smaller stack. Returns [None] if + the stack is empty. *) + +val peek : 'a t -> 'a option +(** Peek at the top of the stack. *) + +val to_list : 'a t -> 'a list +(** Converts a stack to a list. *) + +val empty : 'a t +val pp : 'a Fmt.t -> 'a t Fmt.t diff --git a/src/lib/types.ml b/src/lib/types.ml index 5dedf2f..0a80f97 100644 --- a/src/lib/types.ml +++ b/src/lib/types.ml @@ -20,21 +20,27 @@ module type State = sig val expand : t -> [ `Tilde ] -> string (** Expansions *) - val lookup : t -> param:string -> string option + val lookup : t -> param:string -> Ast.fragments option (** Parameter lookup. [None] means [unset]. *) + type variable = Ast.fragments + val update : ?id:string -> ?export:bool -> ?readonly:bool -> + ?local:bool -> t -> param:string -> - string -> + variable -> (t, string) result (** Update the state with a new parameter mapping and whether or not it should exported to the environment (default false), if it is readonly (default false). + If [local] is [false] then the variable is globally scoped (the default), + otherwise it will be added to the current scope. + [id] can be used to group variables together (for example, all of the variable that belong to a particular function call or pipeline). *) @@ -45,27 +51,38 @@ module type State = sig val remove_group : id:string -> t -> t (** [remove_group ~id t] removes all variables with the [id] group. *) - val exports : t -> (string * string) list + val exports : t -> (string * variable) list (** All of the variables that must be exported to the environment *) - val readonly : t -> (string * string) list + val readonly : t -> (string * variable) list (** All of the variables that must be exported to the environment *) + val locals : t -> (string * variable) list + (** All of the currently scoped local variables. *) + + (** {2 Local variables} *) + + val push : t -> t + (** Push a new frame of local variables. *) + + val pop : t -> t + (** Pop local variables from the stack. *) + val pp_readonly : t Fmt.t val pp_export : t Fmt.t val dump : t Fmt.t end type redirect = - | Parent_redirect of - int * Eio_unix.Fd.t * Eio_unix.Private.Fork_action.blocking - | Child_redirect of - int * Eio_unix.Fd.t * Eio_unix.Private.Fork_action.blocking + | Redirect of + bool * int * Eio_unix.Fd.t * Eio_unix.Private.Fork_action.blocking | Close of Eio_unix.Fd.t +let redirect ?(for_parent = false) (i, j, b) = Redirect (for_parent, i, j, b) + let pp_redirect ppf = function - | Parent_redirect (i, fd, _) -> Fmt.pf ppf "%i <=p=> %a" i Eio_unix.Fd.pp fd - | Child_redirect (i, fd, _) -> Fmt.pf ppf "%i <=c=> %a" i Eio_unix.Fd.pp fd + | Redirect (fp, i, fd, _) -> + Fmt.pf ppf "%i <=%s=> %a" i (if fp then "P" else "C") Eio_unix.Fd.pp fd | Close fd -> Fmt.pf ppf "close %a" Eio_unix.Fd.pp fd type exec_mode = diff --git a/test/all.sh b/test/all.sh new file mode 100755 index 0000000..48253e5 --- /dev/null +++ b/test/all.sh @@ -0,0 +1,5 @@ +#!/bin/sh +for i in ./test/*.t; do + echo "Testing $i" + dune build "@$(basename --suffix='.t' $i)" +done diff --git a/test/arith.t b/test/arith.t new file mode 100644 index 0000000..4e13099 --- /dev/null +++ b/test/arith.t @@ -0,0 +1,13 @@ +Some specific tests for handling arithmetic expansion. + + $ cat > test.sh << EOF + > VAR="debian 5" + > totalpkgs=5 + > echo "\$(( totalpkgs + \${VAR#* }))" + > EOF + + $ sh test.sh + 10 + $ msh test.sh + 10 + diff --git a/test/built_ins.t b/test/built_ins.t index f63d448..8c220ce 100644 --- a/test/built_ins.t +++ b/test/built_ins.t @@ -426,3 +426,18 @@ Simply replacing the process entirely. no more args done +17. Eval + +The parsing for eval might be a little broken w.r.t quotes. + + $ cat > test.sh << EOF + > eval " + > HELLO=\"hey\" + > " + > echo \$HELLO + > EOF + + $ sh test.sh + hey + $ msh test.sh + hey diff --git a/test/docker/Dockerfile.debootstrap b/test/docker/Dockerfile.debootstrap index 7da21bc..65efbfb 100644 --- a/test/docker/Dockerfile.debootstrap +++ b/test/docker/Dockerfile.debootstrap @@ -11,5 +11,6 @@ RUN opam exec -- dune build --profile=release FROM debian:13 COPY --from=builder /home/opam/src/_build/default/src/bin/main.exe /bin/msh RUN ln -sf /bin/msh /bin/sh -RUN apt-get update && apt-get install -y vim debootstrap +RUN apt-get update && apt-get install -y vim debootstrap fakeroot fakechroot +COPY ./test/docker/fakechroot.sh /fakechroot.sh ENTRYPOINT [ "msh" ] diff --git a/test/docker/fakechroot.sh b/test/docker/fakechroot.sh new file mode 100755 index 0000000..9082b10 --- /dev/null +++ b/test/docker/fakechroot.sh @@ -0,0 +1,12 @@ +#!/bin/sh + +# Debian fakechroot script: https://wiki.debian.org/fakechroot +mkdir -p fakechroot/debian +fakechroot # sets environment variables required by debootstrap --variant=fakechroot +fakeroot +export PATH=/usr/sbin:/sbin:$PATH +debootstrap --foreign --variant=fakechroot --exclude dhcp3-server,dhcp3-server-ldap sid fakechroot/debian +echo "int main() { return 0; }" | gcc -x c - -o fakechroot/debian/usr/sbin/chown +echo "int main() { return 0; }" | gcc -x c - -o fakechroot/debian/usr/sbin/chmod +echo "int main() { return 0; }" | gcc -x c - -o fakechroot/debian/usr/sbin/chgrp +DEBOOTSTRAP_DIR=fakechroot/debian/debootstrap debootstrap --second-stage --second-stage-target=fakechroot/debian diff --git a/test/dune b/test/dune index f40f174..e51fbe8 100644 --- a/test/dune +++ b/test/dune @@ -1,7 +1,6 @@ -; (cram -; (package merry) -; (deps %{bin:msh})) -; +(cram + (package merry) + (deps %{bin:msh})) (test (name wordexp) diff --git a/test/escaping.t b/test/escaping.t new file mode 100644 index 0000000..bf36cc6 --- /dev/null +++ b/test/escaping.t @@ -0,0 +1,16 @@ +Some very simple examples related to escaping. A lot more rigour is needed here. + + $ cat > test.sh << EOF + > echo \; + > echo "\;" + > echo hello\\; + > EOF + + $ sh test.sh + ; + \; + hello; + $ msh test.sh + ; + \; + hello; diff --git a/test/exitting.t b/test/exitting.t new file mode 100644 index 0000000..af24abf --- /dev/null +++ b/test/exitting.t @@ -0,0 +1,28 @@ +Exitting from a shell is tricky -- there are many times a shell should fully +exit and many times that it should return a non-zero exit code and carry on. +We try to catch some of the edge cases here. + + + $ cat > test.sh << EOF + > err () { + > echo \$1 + > exit \$2 + > } + > + > f () { + > if true; then + > err "please exit" 123 + > fi + > } + > + > f + > echo "never" + > EOF + + + $ sh test.sh + please exit + [123] + $ msh test.sh + please exit + [123] diff --git a/test/forloops.t b/test/forloops.t index d4822f9..1ec2e51 100644 --- a/test/forloops.t +++ b/test/forloops.t @@ -98,3 +98,18 @@ For loops $ msh test.sh ok is true +1.8 Handling of empty expansions + + $ cat > test.sh << EOF + > SUITE="stable" + > EXTRA_SUITES="" + > for s in \$SUITE \$EXTRA_SUITES \$UNASSIGNED; do + > echo "Downloading /foo/\$s/bar" + > done + > EOF + + $ sh test.sh + Downloading /foo/stable/bar + $ msh test.sh + Downloading /foo/stable/bar + diff --git a/test/functions.t b/test/functions.t index 7638e84..49eef4b 100644 --- a/test/functions.t +++ b/test/functions.t @@ -51,3 +51,65 @@ Redirection and exit codes should be preserved to just like any other command. goodbye eybdoog [128] + +Local variables scopes. + + $ cat > test.sh << EOF + > f () { + > local dest + > dest="hello from f" + > echo \$dest + > } + > + > g () { + > local dest + > dest="hello from g" + > echo \$dest + > f + > echo \$dest + > } + > + > g + > echo "Outer dest: \$dest" + > EOF + + $ sh test.sh + hello from g + hello from f + hello from g + Outer dest: + $ msh test.sh + hello from g + hello from f + hello from g + Outer dest: + +Local variable scopes from the pipeline position. + + $ cat > test.sh << EOF + > f () { + > echo "F: ABC \$ABC DEF \$DEF" + > } + > g () { + > echo "G: ABC \$ABC" + > DEF=bar f + > echo "G: Env Grep ABC \$(env | grep ABC)" + > } + > + > ABC=foo echo "ABC is \$ABC" + > ABC=foo g + > ABC=foo env | grep ABC + > EOF + + $ sh test.sh + ABC is + G: ABC foo + F: ABC foo DEF bar + G: Env Grep ABC ABC=foo + ABC=foo + $ msh test.sh + ABC is + G: ABC foo + F: ABC foo DEF bar + G: Env Grep ABC ABC=foo + ABC=foo diff --git a/test/nofork.t b/test/nofork.t index 71a028d..f313102 100644 --- a/test/nofork.t +++ b/test/nofork.t @@ -18,10 +18,5 @@ do not block the rest of the pipeline from running. hello hello - $ msh test.sh - hello - hello - hello - hello - hello - Net Connection_reset Unix_error (Broken pipe, "writev", "") +TODO: Currently with `msh` this is non-deterministic because we need to await the job +to be ready like processes do. diff --git a/test/redirections.t b/test/redirections.t new file mode 100644 index 0000000..33fffd2 --- /dev/null +++ b/test/redirections.t @@ -0,0 +1,55 @@ +Redirections are tricky. Especially w.r.t to rentrancy in this, for now, +forkless shell. + +But just getting them right in the first place is also hard. + +1. Exec redirects. + + $ cat > test.sh << EOF + > f () { + > for i in \$1; do + > echo "Line: \$i" + > done + > } + > + > exec 1>"stdout.log" + > f + > f "hello world" + > echo "all done" + > cat stdout.log >&2 + > EOF + + $ sh test.sh + Line: hello + Line: world + all done + $ msh test.sh + Line: hello + Line: world + all done + +2. Redirects in if-then-else. + + $ cat > test.sh << EOF + > if [ "\$FOO" = "bar" ]; then + > echo "hopefully not" + > else + > exec 4>&1 + > exec >"log" + > exec 2>&1 + > fi + > + > echo "to the log" + > echo "to stdout" >&4 + > echo "also to log" >&2 + > cat "log" >&4 + > EOF + + $ sh test.sh + to stdout + to the log + also to log + $ msh test.sh + to stdout + to the log + also to log diff --git a/test/regressions.t b/test/regressions.t new file mode 100644 index 0000000..92a47e8 --- /dev/null +++ b/test/regressions.t @@ -0,0 +1,55 @@ +A bunch of regression tests. + + $ cat > test.sh << EOF + > COMPONENTS=" main" + > g () { + > for c in \$COMPONENTS; do + > echo "/foo/\$c" + > done + > } + > + > FOO="\$(g)" + > echo \$FOO + > EOF + + $ sh test.sh + /foo/main + $ msh test.sh + /foo/main + +Dev/null handling. + +An overhaul was needed so we stored variables using their expanded result and +not a string. + + $ cat > test.sh < iter () { + > echo "a" + > echo "b" + > echo "c" + > } + > + > base=\$(iter) + > + > for n in \$base; do + > echo "Got \$n" + > done + > for n in "\$base"; do + > echo "Got \$n" + > done + > EOF + + $ sh test.sh + Got a + Got b + Got c + Got a + b + c + $ msh test.sh + Got a + Got b + Got c + Got a + b + c diff --git a/test/scripts/README.md b/test/scripts/README.md new file mode 100644 index 0000000..b7a62d8 --- /dev/null +++ b/test/scripts/README.md @@ -0,0 +1 @@ +These tests are for longer form scripts that are harder to wrap in CRAM tests. diff --git a/test/scripts/checksum.expected b/test/scripts/checksum.expected new file mode 100644 index 0000000..4824f54 --- /dev/null +++ b/test/scripts/checksum.expected @@ -0,0 +1,5 @@ +abc def +this one +====msh==== +abc def +this one diff --git a/test/scripts/checksum.sh b/test/scripts/checksum.sh new file mode 100644 index 0000000..920d23a --- /dev/null +++ b/test/scripts/checksum.sh @@ -0,0 +1,24 @@ +SHA_SIZE=256 + +echo "SHA256:" > out.txt +echo " abc def hello" >> out.txt +echo " not this one" >> out.txt +echo " this one hello" >> out.txt + +get_release_checksum () { + local reldest path + reldest="$1" + path="$2" + if [ "$DEBOOTSTRAP_CHECKSUM_FIELD" = MD5SUM ]; then + local match="^[Mm][Dd]5[Ss][Uu][Mm]" + else + local match="^[Ss][Hh][Aa]$SHA_SIZE:" + fi + sed -n "/$match/,/^[^ ]/p" < "$reldest" | \ + while read -r a b c; do + if [ "$c" = "$path" ]; then echo "$a $b"; fi + done +} + +get_release_checksum "out.txt" "hello" + diff --git a/test/scripts/debfor_pkgs.expected b/test/scripts/debfor_pkgs.expected new file mode 100644 index 0000000..c7f332d --- /dev/null +++ b/test/scripts/debfor_pkgs.expected @@ -0,0 +1,9 @@ +Progress: 1 +Pkgname: pkg-a is at /path/to/pkg-a +Progress: 2 +Pkgname: pkg-b is at /path/to/pkg-b +====msh==== +Progress: 1 +Pkgname: pkg-a is at /path/to/pkg-a +Progress: 2 +Pkgname: pkg-b is at /path/to/pkg-b diff --git a/test/scripts/debfor_pkgs.sh b/test/scripts/debfor_pkgs.sh new file mode 100644 index 0000000..a7c6844 --- /dev/null +++ b/test/scripts/debfor_pkgs.sh @@ -0,0 +1,31 @@ +DEBFOR_PATH=debpaths + +echo "pkg-a /path/to/pkg-a" > $DEBFOR_PATH +echo "pkg-b /path/to/pkg-b" >> $DEBFOR_PATH + +debfor () { + (while read -r pkg path; do + for p in "$@"; do + [ "$p" = "$pkg" ] || continue; + echo "$path" + done + done < "$DEBFOR_PATH" + ) +} + +extract () { ( + local p cat_cmd pkg + p=0 + for pkg in $(debfor "$@"); do + p=$((p + 1)) + echo "Progress: $p" + packagename="$(echo "$pkg" | sed 's,^.*/,,;s,_.*$,,')" + echo "Pkgname: $packagename is at $pkg" + done + ) +} + +extract "pkg-a" "pkg-b" + + + diff --git a/test/scripts/dune b/test/scripts/dune new file mode 100644 index 0000000..c42a4f8 --- /dev/null +++ b/test/scripts/dune @@ -0,0 +1,16 @@ +(rule + (targets dune.inc.gen) + (deps + (glob_files *.sh)) + (action + (with-stdout-to + %{targets} + (run ./gen_rules.sh)))) + +(rule + (alias runtest) + (package merry) + (action + (diff dune.inc dune.inc.gen))) + +(include dune.inc) diff --git a/test/scripts/dune.inc b/test/scripts/dune.inc new file mode 100644 index 0000000..783ac8e --- /dev/null +++ b/test/scripts/dune.inc @@ -0,0 +1,64 @@ +(rule + (alias runtest) + (deps %{bin:msh} checksum.sh) + (action + (with-stdout-to checksum.actual + (progn + (run sh ./checksum.sh) + (run sh -c "echo ====msh====") + (run msh ./checksum.sh) + )))) + +(rule + (alias runtest) + (action + (diff checksum.expected checksum.actual))) + +(rule + (alias runtest) + (deps %{bin:msh} debfor_pkgs.sh) + (action + (with-stdout-to debfor_pkgs.actual + (progn + (run sh ./debfor_pkgs.sh) + (run sh -c "echo ====msh====") + (run msh ./debfor_pkgs.sh) + )))) + +(rule + (alias runtest) + (action + (diff debfor_pkgs.expected debfor_pkgs.actual))) + +(rule + (alias runtest) + (deps %{bin:msh} funcdefs.sh) + (action + (with-stdout-to funcdefs.actual + (progn + (run sh ./funcdefs.sh) + (run sh -c "echo ====msh====") + (run msh ./funcdefs.sh) + )))) + +(rule + (alias runtest) + (action + (diff funcdefs.expected funcdefs.actual))) + +(rule + (alias runtest) + (deps %{bin:msh} subshell.sh) + (action + (with-stdout-to subshell.actual + (progn + (run sh ./subshell.sh) + (run sh -c "echo ====msh====") + (run msh ./subshell.sh) + )))) + +(rule + (alias runtest) + (action + (diff subshell.expected subshell.actual))) + diff --git a/test/scripts/funcdefs.expected b/test/scripts/funcdefs.expected new file mode 100644 index 0000000..b2d8908 --- /dev/null +++ b/test/scripts/funcdefs.expected @@ -0,0 +1,5 @@ +world +hello +====msh==== +world +hello diff --git a/test/scripts/funcdefs.sh b/test/scripts/funcdefs.sh new file mode 100644 index 0000000..739624f --- /dev/null +++ b/test/scripts/funcdefs.sh @@ -0,0 +1,17 @@ +func () { + case $1 in + bar) + debs () { echo "hello"; } + ;; + *) + debs () { echo "world"; } + ;; + esac +} + +func "nope" +debs +func bar +debs + + diff --git a/test/scripts/gen_rules.sh b/test/scripts/gen_rules.sh new file mode 100755 index 0000000..7cfb747 --- /dev/null +++ b/test/scripts/gen_rules.sh @@ -0,0 +1,29 @@ +#!/bin/sh +# A script to generate dune rules for the rest. +for script in *.sh; do + if [ "$script" = "gen_rules.sh" ]; then + continue + fi + + base="${script%.sh}" + + cat < "b" "c" + (echo "$1" | tr ' ' '\n' | sort | uniq; + echo "$2" "$2" | tr ' ' '\n') | sort | uniq -u | tr '\n' ' ' + echo +} + +base="pkg-a pkg-b" + +ADDITIONAL="pkg-c pkg-d pkg-e" +EXCLUDE="pkg-d" + +base=$(without "$base $ADDITIONAL" "$EXCLUDE") + +echo "Base is $base" + diff --git a/test/simple.t b/test/simple.t index e7a3a42..aa45082 100644 --- a/test/simple.t +++ b/test/simple.t @@ -278,3 +278,28 @@ A simple, semicolon sequence. hello world that is all + +3. Field splitting + + $ cat > test.sh << EOF + > IFS=":" + > ARGS="apple:banana" + > echo \$ARGS + > ARGS="apple:banana:" + > echo \$ARGS + > ARGS="apple::banana" + > echo \$ARGS + > ARGS=":apple:banana" + > echo \$ARGS + > EOF + + $ sh test.sh + apple banana + apple banana + apple banana + apple banana + $ msh test.sh + apple banana + apple banana + apple banana + apple banana diff --git a/test/subshell.t b/test/subshell.t index 1c929f1..1a10a1d 100644 --- a/test/subshell.t +++ b/test/subshell.t @@ -13,3 +13,44 @@ A simple test. $ msh -c "`which echo` hello" hello + + +Subshells like these must respect the current redirections in the shell too! + + $ cat > test.sh << EOF + > exec 6>"log" + > f () { + > echo hello + > } + > + > pkgs="\$(f 1>&6)" + > echo "Pkgs is: \$pkgs" + > EOF + + $ sh test.sh + Pkgs is: + $ msh test.sh + Pkgs is: + +A more complex example. + + $ cat > test.sh << EOF + > exec 4>&1 + > exec >"log" + > exec 2>&1 + > + > f () { + > echo "f: \$1" + > } + > + > if true; then + > pkgs="\$(f hello 1>&6)" + > fi 6>&1 + > echo "Pkgs is empty \$pkgs" >&4 + > EOF + + $ sh test.sh + Pkgs is empty + $ msh test.sh + Pkgs is empty + diff --git a/test/test_merry.ml b/test/test_merry.ml deleted file mode 100644 index e69de29..0000000 diff --git a/test/wordexp.ml b/test/wordexp.ml index bf2e9f5..bbef18d 100644 --- a/test/wordexp.ml +++ b/test/wordexp.ml @@ -8,7 +8,7 @@ let expand ctx cst = let fragment = Alcotest.of_pp Merry.Ast.Fragment.pp let fragments = Alcotest.list fragment -let frags = List.map Ast.Fragment.make +let frags ?(escaping = true) v = List.map (Ast.Fragment.make ~escaping) v let with_default_ctx ?(args = []) ?(params = []) ?(home = "/home/merry/") env fn = @@ -20,7 +20,9 @@ let with_default_ctx ?(args = []) ?(params = []) ?(home = "/home/merry/") env fn let state = Merry_posix.State.make ~home (Fpath.v (Merry.Eunix.cwd ())) in let state = List.fold_left - (fun s (k, v) -> Merry_posix.State.update s ~param:k v |> Result.get_ok) + (fun s (k, v) -> + Merry_posix.State.update s ~param:k [ Ast.Fragment.make v ] + |> Result.get_ok) state params in let ctx = @@ -54,12 +56,24 @@ let test_no_expansions env () = let actual = expand ctx cargs in Alcotest.check fragments "same fragments" expected actual +let test_empty_expansion env () = + let args = [ "$FOO" ] in + let cargs = W.[ [ var "FOO" ] ] in + with_default_ctx ~args env @@ fun ctx -> + let expected = frags [] in + let actual = expand ctx cargs in + Alcotest.check fragments "same fragments" expected actual + let test_dquote env () = let args = [ "echo"; "\"hello there\"" ] in let cargs = W.[ [ name "echo" ]; [ dquote [ lit "hello there" ] ] ] in with_default_ctx ~args env @@ fun ctx -> let expected = - Ast.[ Fragment.make "echo"; Fragment.make ~join:`No "hello there" ] + Ast. + [ + Fragment.make ~escaping:true "echo"; + Fragment.make ~escaping:false ~join:`No "hello there"; + ] in let actual = expand ctx cargs in Alcotest.check fragments "same fragments" expected actual @@ -70,7 +84,10 @@ let test_dquote_expansion env () = W.[ [ name "echo" ]; [ dquote [ lit "hello "; var "FOO"; lit "..." ] ] ] in with_default_ctx ~args ~params:[ ("FOO", "there") ] env @@ fun ctx -> - let expected = Ast.Fragment.[ make "echo"; make "hello there..." ] in + let expected = + Ast.Fragment. + [ make ~escaping:true "echo"; make ~escaping:false "hello there..." ] + in let actual = expand ctx cargs in Alcotest.check fragments "same fragments" expected actual @@ -78,14 +95,23 @@ let test_single_expansion env () = let args = [ "echo"; "$FOO" ] in let cargs = W.[ [ name "echo" ]; [ var "FOO" ] ] in with_default_ctx ~args ~params:[ ("FOO", "bar") ] env @@ fun ctx -> - let expected = [ Ast.Fragment.make "echo"; Ast.Fragment.make "bar" ] in + let expected = + [ + Ast.Fragment.make ~escaping:true "echo"; + Ast.Fragment.make ~escaping:false "bar"; + ] + in let actual = expand ctx cargs in Alcotest.check fragments "same fragments" expected actual let test_argv_expansion env () = let cargs = W.[ [ name "echo" ]; [ var "@" ] ] in with_default_ctx ~args:[ "echo"; "a"; "b"; "c d" ] env @@ fun ctx -> - let expected = frags [ "echo"; "a"; "b"; "c"; "d" ] in + (* Escaping? *) + let expected = + Ast.Fragment.make ~escaping:true "echo" + :: frags ~escaping:false [ "a"; "b"; "c"; "d" ] + in let actual = expand ctx cargs in Alcotest.check fragments "same fragments" expected actual @@ -95,7 +121,8 @@ let test_argv_in_quotes_expansion env () = in with_default_ctx ~args:[ "echo"; "a"; "b"; "c" ] env @@ fun ctx -> let expected = - Ast.Fragment.[ make "echo"; make "got [a"; make "b"; make "c]" ] + Ast.Fragment. + [ make ~escaping:true "echo"; make "got [a"; make "b"; make "c]" ] in let actual = expand ctx cargs in Alcotest.check fragments "same fragments" expected actual @@ -122,7 +149,7 @@ let test_arg_in_quotes_expansion env () = let test_glob env () = let cargs = W.[ [ glob_all; lit ".ml" ] ] in with_default_ctx ~args:[ "*.ml" ] env @@ fun ctx -> - let expected = Ast.Fragment.[ make "test_merry.ml"; make "wordexp.ml" ] in + let expected = Ast.Fragment.[ make "wordexp.ml" ] in let actual = expand ctx cargs in Alcotest.check fragments "same fragments" expected actual @@ -136,6 +163,7 @@ let test_tilde env () = let simple env = [ ("no expansions", `Quick, test_no_expansions env); + ("empty expansion", `Quick, test_empty_expansion env); ("double quote", `Quick, test_dquote env); ("double quote expansion", `Quick, test_dquote_expansion env); ("single expansion", `Quick, test_single_expansion env); -- 2.51.2