diff --git a/src/lib/built_ins.ml b/src/lib/built_ins.ml index 760250e..c56749f 100644 --- a/src/lib/built_ins.ml +++ b/src/lib/built_ins.ml @@ -43,12 +43,12 @@ module Options = struct let update t options = List.fold_left (fun d -> function - | `Pipefail -> with_options ~pipefail:true d - | `Noclobber -> with_options ~noclobber:true d - | `Noglob -> with_options ~no_path_expansion:true d - | `Errexit -> with_options ~errexit:true d - | `Nounset -> with_options ~no_unset:true d - | `Async -> with_options ~async:true d) + | `Pipefail, pipefail -> with_options ~pipefail d + | `Noclobber, noclobber -> with_options ~noclobber d + | `Noglob, no_path_expansion -> with_options ~no_path_expansion d + | `Errexit, errexit -> with_options ~errexit d + | `Nounset, no_unset -> with_options ~no_unset d + | `Async, async -> with_options ~async d) t options let pp ppf opt = @@ -71,7 +71,7 @@ module Options = struct Fmt.pf ppf "@[%a@]" Fmt.(list pp_option) opts end -type set = { update : Options.option list; print_options : bool } +type set = { update : (Options.option * bool) list; print_options : bool } type hash = Hash_remove | Hash_stats | Hash_add of string list type trap = Int of int | Action of string | Ignore | Default @@ -213,17 +213,45 @@ module Set = struct let doc = "No unset, like -o nounset." in Arg.(value & flag & info [ "u" ] ~docv:"NOUNSET" ~doc) + let rest = + let doc = "Arguments" in + Arg.(value & pos_all string [] & info [] ~docv:"ARGUMENTS" ~doc) + + let classify_args args = + let plus_flags, args = + List.fold_left + (fun (p, a) v -> + if String.starts_with ~prefix:"+" v then (v :: p, a) else (p, v :: a)) + ([], []) args + in + (List.rev plus_flags, List.rev args) + let t = - let make_set update noglob noclobber nounset errexit = - let extra = if noglob then [ `Noglob ] else [] in - let extra = if noclobber then `Noclobber :: extra else extra in - let extra = if nounset then `Nounset :: extra else extra in - let extra = if errexit then `Errexit :: extra else extra in + let make_set update noglob noclobber nounset errexit rest = + let update = List.map (fun u -> (u, true)) update in + let extra = if noglob then [ (`Noglob, true) ] else [] in + let extra = if noclobber then (`Noclobber, true) :: extra else extra in + let extra = if nounset then (`Nounset, true) :: extra else extra in + let extra = if errexit then (`Errexit, true) :: extra else extra in let update = extra @ update in + let unset, _args = classify_args rest in + let unset = + List.filter_map + (function + | "+f" -> Some (`Noglob, false) + | "+u" -> Some (`Nounset, false) + | "+e" -> Some (`Errexit, false) + | e -> + Debug.Log.err (fun f -> f "Missed set arg: %s" e); + None) + unset + in + let update = update @ unset in Set { update; print_options = false } in let term = - Term.(const make_set $ option $ noglob $ noclobber $ nounset $ errexit) + Term.( + const make_set $ option $ noglob $ noclobber $ nounset $ errexit $ rest) in let info = let doc = "Set or unset options and positional parameters." in diff --git a/src/lib/built_ins.mli b/src/lib/built_ins.mli index f79487b..cedbed9 100644 --- a/src/lib/built_ins.mli +++ b/src/lib/built_ins.mli @@ -26,11 +26,11 @@ module Options : sig t -> t - val update : t -> option list -> t + val update : t -> (option * bool) list -> t val pp : t Fmt.t end -type set = { update : Options.option list; print_options : bool } +type set = { update : (Options.option * bool) list; print_options : bool } type hash = Hash_remove | Hash_stats | Hash_add of string list type trap = Int of int | Action of string | Ignore | Default diff --git a/src/lib/dune b/src/lib/dune index 679e01c..554752a 100644 --- a/src/lib/dune +++ b/src/lib/dune @@ -22,5 +22,6 @@ bruit fpath cmdliner - xdge - merry.glob)) + re + globlon + xdge)) diff --git a/src/lib/eval.ml b/src/lib/eval.ml index ea60340..5a5e4c4 100644 --- a/src/lib/eval.ml +++ b/src/lib/eval.ml @@ -52,6 +52,12 @@ module Make (S : Types.State) (E : Types.Exec) = struct umask : int; } + exception Continue of ctx + (* Used for the [continue] non-POSIX keyword *) + + exception Return of ctx Exit.t + (* Used for the [return] non-POSIX keyword *) + let _stdin ctx = ctx.stdin let make_ctx ?(interactive = false) ?(subshell = false) ?(local_state = []) @@ -346,6 +352,7 @@ module Make (S : Types.State) (E : Types.Exec) = struct Fmt.invalid_arg "Exec with args not yet supported..."; ({ ctx with rdrs }, job) + | "continue" (* non-POSIX *) -> raise (Continue ctx) | _ -> ( let saved_ctx = ctx in let func_app = @@ -466,12 +473,13 @@ module Make (S : Types.State) (E : Types.Exec) = struct match handle_redirections ~sw:pipeline_switch ctx rdrs with | Error ctx -> (ctx, handle_job job (`Rdr (Exit.nonzero () 1))) | Ok rdrs -> + let saved_rdrs = ctx.rdrs in (* TODO: No way this is right *) - let ctx = { ctx with rdrs } in + let ctx = { ctx with rdrs = rdrs @ saved_rdrs } in let ctx = handle_compound_command ctx c in let job = handle_job job (`Built_in (ctx >|= fun _ -> ())) in let actual_ctx = Exit.value ctx in - loop { actual_ctx with rdrs = [] } job None rest) + loop { actual_ctx with rdrs = saved_rdrs } job None rest) | FunctionDefinition (name, (body, _rdrs)) :: rest -> let ctx = { ctx with functions = (name, body) :: ctx.functions } in loop ctx job None rest @@ -593,9 +601,9 @@ module Make (S : Types.State) (E : Types.Exec) = struct | Some s when kind = `Smallest -> (so_far, Some s) | _ -> ( let s = so_far ^ String.make 1 c in - match Glob.tests ~pattern [ s ] with - | [ s ] -> (s, Some s) - | _ -> (s, acc))) + match Glob.test ~pattern s with + | true -> (s, Some s) + | false -> (s, acc))) ("", None) param in prefix @@ -608,9 +616,9 @@ module Make (S : Types.State) (E : Types.Exec) = struct | Some s when kind = `Smallest -> (so_far, Some s) | _ -> ( let s = String.make 1 c ^ so_far in - match Glob.tests ~pattern [ s ] with - | [ s ] -> (s, Some s) - | _ -> (s, acc))) + match Glob.test ~pattern s with + | true -> (s, Some s) + | false -> (s, acc))) ("", None) (String.fold_left (fun acc c -> String.make 1 c ^ acc) "" param) in @@ -1013,7 +1021,8 @@ module Make (S : Types.State) (E : Types.Exec) = struct List.fold_left (fun _ word -> update ctx ~param:name word.Ast.txt >>= fun ctx -> - exec ctx (term, Some sep)) + try exec ctx (term, Some sep) + with Continue ctx -> Exit.zero ctx) (Exit.zero ctx) (List.concat words)) (Exit.zero ctx) wdlist @@ -1102,7 +1111,10 @@ module Make (S : Types.State) (E : Types.Exec) = struct let running_ctx = Exit.value exit_so_far in match exec running_ctx (term, Some sep) with | Exit.Nonzero _ -> exit_so_far (* TODO: Context? *) - | Exit.Zero ctx -> loop (exec ctx (term', Some sep')) + | Exit.Zero ctx -> + loop + (try exec ctx (term', Some sep') + with Continue ctx -> Exit.zero ctx) in loop (Exit.zero ctx) @@ -1112,7 +1124,10 @@ module Make (S : Types.State) (E : Types.Exec) = struct let running_ctx = Exit.value exit_so_far in match exec running_ctx (term, Some sep) with | Exit.Zero _ -> exit_so_far (* TODO: Context? *) - | Exit.Nonzero { value = ctx; _ } -> loop (exec ctx (term', Some sep')) + | Exit.Nonzero { value = ctx; _ } -> + loop + (try exec ctx (term', Some sep') + with Continue ctx -> Exit.zero ctx) in loop (Exit.zero ctx) @@ -1136,7 +1151,10 @@ module Make (S : Types.State) (E : Types.Exec) = struct argv); let ctx = { ctx with argv = Array.of_list argv } in let v = - Option.some @@ (handle_compound_command ctx commands >|= fun _ -> ctx) + try + Option.some + @@ (handle_compound_command ctx commands >|= fun _ -> ctx) + with Return ctx -> Some ctx in Debug.Log.debug (fun f -> f "function leave: %s" name); v @@ -1164,10 +1182,18 @@ module Make (S : Types.State) (E : Types.Exec) = struct and glob_expand ctx pattern : ctx * Ast.fragment list = ( ctx, - match Glob.glob_dir ~pattern (cwd_of_ctx ctx) with - | [] -> [ Ast.Fragment.make pattern ] - | exception _ -> [ Ast.Fragment.make pattern ] - | xs -> List.map Ast.Fragment.make xs ) + match Glob.glob_dir pattern with + | [] -> + Debug.Log.debug (fun f -> f "Glob %s returned nothing" pattern); + [ Ast.Fragment.make pattern ] + | exception e -> + Debug.Log.debug (fun f -> + f "Glob expand exception: %s" (Printexc.to_string e)); + [ Ast.Fragment.make pattern ] + | xs -> + Debug.Log.debug (fun f -> + f "Globbed %s to [%a]" pattern Fmt.(list (quote string)) xs); + List.map Ast.Fragment.make xs ) and collect_assignments ?(update = true) ctx vs : ctx Exit.t = List.fold_left @@ -1183,7 +1209,8 @@ module Make (S : Types.State) (E : Types.Exec) = struct | Exit.Nonzero _ as ctx -> ctx | Exit.Zero ctx -> ( let state = - if update then + (* 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 @@ -1259,7 +1286,8 @@ module Make (S : Types.State) (E : Types.Exec) = struct { Exit.default_should_exit with interactive = `Yes } in Exit.nonzero ~should_exit ctx n - | Return n -> Exit.nonzero ctx n + | Return 0 -> raise (Return (Exit.zero ctx)) + | Return n -> raise (Return (Exit.nonzero ctx n)) | Set { update; print_options } -> let v = Exit.zero @@ -1388,7 +1416,9 @@ module Make (S : Types.State) (E : Types.Exec) = struct with | "\n" -> Some acc | c -> loop (acc ^ c) - | exception End_of_file -> None + | exception End_of_file -> + Debug.Log.debug (fun f -> f "Read EOF"); + if String.equal acc "" then None else Some acc in loop "" in @@ -1402,7 +1432,10 @@ module Make (S : Types.State) (E : Types.Exec) = struct :: acc) in let fields = - Option.map (fun s -> field_splitting ctx [ Ast.Fragment.make s ]) line + Option.map + (fun s -> + field_splitting ctx [ Ast.Fragment.make ~splittable:true s ]) + line in match fields with | None -> Exit.nonzero ctx 1 diff --git a/src/lib/glob/dune b/src/lib/glob/dune deleted file mode 100644 index 6799ec9..0000000 --- a/src/lib/glob/dune +++ /dev/null @@ -1,6 +0,0 @@ -(library - (public_name merry.glob) - (name glob) - (libraries re)) - -(ocamllex lexer) diff --git a/src/lib/glob/glob.ml b/src/lib/glob/glob.ml deleted file mode 100644 index 849a0cf..0000000 --- a/src/lib/glob/glob.ml +++ /dev/null @@ -1,47 +0,0 @@ -(* From dune-glob library - -The MIT License - -Copyright (c) 2016 Jane Street Group, LLC - -Permission is hereby granted, free of charge, to any person obtaining a copy -of this software and associated documentation files (the "Software"), to deal -in the Software without restriction, including without limitation the rights -to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -copies of the Software, and to permit persons to whom the Software is -furnished to do so, subject to the following conditions: - -The above copyright notice and this permission notice shall be included in all -copies or substantial portions of the Software. - -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, -OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE -SOFTWARE. *) - -type t = Re of { re : Re.re; repr : string } | Literal of string - -let test t s = - match t with - | Literal t -> String.equal t s - | Re { re; repr = _ } -> Re.execp re s - -let empty = Re { re = Re.compile Re.empty; repr = "\000" } -let universal = Re { re = Re.compile (Re.rep Re.any); repr = "**" } - -let of_string_result repr = - Lexer.parse_string repr - |> Result.map (function - | Lexer.Literal s -> Literal s - | Re re -> Re { re = Re.compile re; repr }) - -let of_string repr = - match of_string_result repr with - | Error (_, msg) -> invalid_arg (Printf.sprintf "invalid glob: :%s" msg) - | Ok t -> t - -let to_string t = match t with Re { repr; re = _ } -> repr | Literal s -> s -let hash t = String.hash (to_string t) diff --git a/src/lib/glob/glob.mli b/src/lib/glob/glob.mli deleted file mode 100644 index 1f0d942..0000000 --- a/src/lib/glob/glob.mli +++ /dev/null @@ -1,21 +0,0 @@ -(** Simple glob support library. *) - -type t - -val empty : t -(** A glob that matches nothing *) - -val universal : t -(** A glob that matches anything (including the strings starting with a ".") *) - -val test : t -> string -> bool -(** Tests if string matches the glob. *) - -val to_string : t -> string -(** Returns textual representation of a glob. *) - -val of_string : string -> t -(** Converts string to glob. Throws [Invalid_argument] exception if string is - not a valid glob. *) - -val hash : t -> int diff --git a/src/lib/glob/lexer.mll b/src/lib/glob/lexer.mll deleted file mode 100644 index 4a1584b..0000000 --- a/src/lib/glob/lexer.mll +++ /dev/null @@ -1,91 +0,0 @@ -{ -open Re - -let string_of_list chars = - let s = Bytes.make (List.length chars) '0' in - List.iteri (fun i c -> Bytes.set s i c) chars; - Bytes.to_string s - -type t = - | Literal of string - | Re of Re.t - -let no_slash = diff any (char '/') -let no_slash_no_dot = diff any (set "./") - -type stack = - | Bottom - | Lbrace of stack - | Char of char * stack - | Re of Re.t * stack - | Comma of stack - -let make_group st = - let rec loop current_re full_res st = - match st with - | Bottom -> failwith "'}' without opening '{'" - | Re (re, st) -> loop (re :: current_re) full_res st - | Char (c, st) -> loop (char c :: current_re) full_res st - | Comma st -> loop [] (seq current_re :: full_res) st - | Lbrace st -> Re (alt (seq current_re :: full_res), st) - in - loop [] [] st - -let finalize st = - let rec loop acc st = - match st with - | Bottom -> seq (start :: acc) - | Re (re, st) -> loop (re :: acc) st - | Char (c, st) -> loop (char c :: acc) st - | Comma st -> loop (char ',' :: acc) st - | Lbrace _ -> failwith "unclosed '{'" - in - let rec try_str (acc : char list) st = - match st with - | Bottom -> Literal (string_of_list acc) - | Comma st -> try_str (',' :: acc) st - | Char (c, st) -> try_str (c :: acc) st - | st -> - let re = - let re = [stop] in - match acc with - | [] -> re - | _ :: _ -> str (string_of_list acc) :: re - in - Re (loop re st) - in - try_str [] st -} - -rule initial = parse - (* | "**" { glob (Re (rep any, Bottom)) lexbuf } *) - | "*" { glob (Re (rep any, Bottom)) lexbuf } - | "" { glob Bottom lexbuf } - -and glob st = parse - | eof - | '\\' eof { finalize st } - | '\\' (_ as c) { glob (Char (c , st)) lexbuf } - | "**" { glob (Re (seq [no_slash_no_dot; rep no_slash] , st)) lexbuf } - | '*' { glob (Re (rep no_slash , st)) lexbuf } - | '?' { glob (Re (no_slash , st)) lexbuf } - | '{' { glob (Lbrace st ) lexbuf } - | ',' { glob (Comma st ) lexbuf } - | '}' { glob (make_group st) lexbuf } - | '[' { char_set st lexbuf } - | ']' { failwith "']' without opening '['" } - | _ as c { glob (Char (c , st)) lexbuf } - -and char_set st = parse - | '!' ([^ ']']* as s) "]" { glob (Re (diff any (set s) , st)) lexbuf } - | ([^ ']']* as s) "]" { glob (Re (set s , st)) lexbuf } - | "" { failwith "unclosed character set" } - -{ - let parse_string s = - let lb = Lexing.from_string s in - match initial lb with - | re -> Result.Ok re - | exception Failure msg -> - Error (Lexing.lexeme_start lb, msg) -} diff --git a/src/lib/import.ml b/src/lib/import.ml index a2d88e9..57b27bf 100644 --- a/src/lib/import.ml +++ b/src/lib/import.ml @@ -75,10 +75,11 @@ module String = struct end module Glob = struct - let tests ~pattern s = List.filter Glob.(test (of_string pattern)) s + let glob_dir pattern = Globlon.glob pattern |> Array.to_list let test ~pattern s = - match tests ~pattern [ s ] with [ _ ] -> true | _ :: _ | [] -> false - - let glob_dir ~pattern dir = tests ~pattern (Eio.Path.read_dir dir) + let pat = + Re.Glob.glob ~anchored:true ~pathname:false pattern |> Re.compile + in + Re.execp pat s end diff --git a/test/non-posix.t b/test/non-posix.t new file mode 100644 index 0000000..d7ffbc5 --- /dev/null +++ b/test/non-posix.t @@ -0,0 +1,38 @@ +Some non-POSIX pieces that we've brought into merry to make +it more useful. + +1. Continue + + $ cat > test.sh << EOF + > for i in "hello" "the" "world"; do + > if [ \${#i} -lt 4 ]; then + > continue + > fi + > echo "Got \$i" + > done + > EOF + + $ sh test.sh + Got hello + Got world + $ msh test.sh + Got hello + Got world + +A very specific example coming from /usr/sbin/update-shells + + $ cat > test.sh << EOF + > echo "# /etc/shells: valud login shells" > file.txt + > echo "/bin/sh" >> file.txt + > + > while IFS='#' read -r line _; do + > echo "Line \$line" + > done < file.txt + > EOF + + $ sh test.sh + Line + Line /bin/sh + $ msh test.sh + Line + Line /bin/sh diff --git a/test/wordexp.ml b/test/wordexp.ml index 732017b..1363558 100644 --- a/test/wordexp.ml +++ b/test/wordexp.ml @@ -91,7 +91,7 @@ let test_argv_in_quotes_expansion env () = let actual = expand ctx cargs in Alcotest.check fragments "same fragments" expected actual -let _test_glob 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 @@ -113,7 +113,7 @@ let simple env = ("single expansion", `Quick, test_single_expansion env); ("argv expansion", `Quick, test_argv_expansion env); ("argv expansion dquote", `Quick, test_argv_in_quotes_expansion env); - (* ("glob all", `Quick, test_glob env); *) + ("glob all", `Quick, test_glob env); ("tilde", `Quick, test_tilde env); ]