diff --git a/src/bin/main.ml b/src/bin/main.ml index 89e3453..d8de8a6 100644 --- a/src/bin/main.ml +++ b/src/bin/main.ml @@ -25,7 +25,9 @@ let sh ~command_flag ~dump ~file ~rest env = let ast = match (file, command_flag, rest) with | None, false, _ -> assert false - | Some file, false, _ -> Merry.Ast.of_file Eio.Path.(env#fs / file) + | Some file, false, _ -> + Merry.Debug.Log.debug (fun f -> f "msh executing %s" file); + Merry.Ast.of_file Eio.Path.(env#fs / file) | _, true, c :: _ -> Merry.Ast.of_string c | _, b, cs -> Fmt.failwith "Bad usage: %b %a" b Fmt.(list string) cs in @@ -55,6 +57,8 @@ let dump = let setup_log style_renderer level = Fmt_tty.setup_std_outputs ?style_renderer (); Logs.set_level level; + let override = Sys.getenv_opt "MSH_DEBUG" in + let level = match override with Some _ -> Some Logs.Debug | None -> level in Logs.Src.set_level Merry.Debug.src level; Logs.set_reporter (Logs_fmt.reporter ()); () diff --git a/src/lib/ast.ml b/src/lib/ast.ml index d53eb7b..950785d 100644 --- a/src/lib/ast.ml +++ b/src/lib/ast.ml @@ -765,7 +765,7 @@ let rec word_component_to_string : "This is an error in Merry, subshells should already have been \ expanded by now!" | v -> - Fmt.failwith "Conversion of %a" Yojson.Safe.pp + Fmt.failwith "conversion of %a" Yojson.Safe.pp (word_component_to_yojson v) and word_components_to_strings ?(field_splitting = true) ws = @@ -839,7 +839,14 @@ module Fragment = struct let empty = make "" let to_string { txt; _ } = txt - let join ~sep f1 f2 = { f1 with txt = f1.txt ^ sep ^ f2.txt } + + let join ~sep f1 f2 = + { + f1 with + txt = f1.txt ^ sep ^ f2.txt; + globbable = f1.globbable || f2.globbable; + } + let join_list ~sep fs = List.fold_left (join ~sep) empty fs |> to_string let pp_join ppf = function @@ -854,10 +861,13 @@ module Fragment = struct let handle_joins cst = let rec loop = function | [] -> [] - | x :: { txt; join = `With_previous; _ } :: rest -> - loop ({ x with txt = x.txt ^ txt } :: rest) - | { txt; join = `With_next; _ } :: y :: rest -> - { y with txt = txt ^ y.txt } :: loop rest + | x :: { txt; join = `With_previous; globbable; _ } :: rest -> + loop + ({ x with txt = x.txt ^ txt; globbable = x.globbable || globbable } + :: rest) + | { txt; join = `With_next; globbable; _ } :: y :: rest -> + { y with txt = txt ^ y.txt; globbable = globbable || y.globbable } + :: loop rest | x :: xs -> x :: loop xs in loop cst diff --git a/src/lib/built_ins.ml b/src/lib/built_ins.ml index 153a577..8e5a863 100644 --- a/src/lib/built_ins.ml +++ b/src/lib/built_ins.ml @@ -92,7 +92,10 @@ type t = | Echo of string list | Trap of trap * [ `Signal of Eunix.Signals.t | `Exit ] list | Return of int + | Umask of int option + | Shift of int option +let reserved = [ "fg"; "bg"; "jobs" ] let pp_args = Fmt.(list ~sep:(Fmt.any " ") string) let to_string = function @@ -111,7 +114,17 @@ let to_string = function | Unalias -> "unalias" | Eval s -> Fmt.str "eval %a" pp_args s | Echo s -> Fmt.str "echo %a" pp_args s - | Trap _ -> "trap" + | Umask None -> "umask" + | Umask (Some i) -> Fmt.str "umask %o" i + | Shift None -> "shift" + | Shift (Some i) -> Fmt.str "shift %o" i + | Trap (trap, _) -> + Fmt.str "trap %s" + (match trap with + | Int i -> string_of_int i + | Action a -> a + | Ignore -> "ignore" + | Default -> "default") | Set _ -> "set" (* Change Directory *) @@ -446,6 +459,42 @@ module Return = struct Cmd.v info term end +module Umask = struct + open Cmdliner + + let mask = + let doc = "Mask for file creation." in + Arg.(value & pos 0 (some string) None & info [] ~docv:"MASK" ~doc) + + let t = + let make_umask i = + Umask (Option.map (fun i -> Scanf.sscanf i "%o" Fun.id) i) + in + let term = Term.(const make_umask $ mask) in + let info = + let doc = "Get or set the file mode creation mask." in + Cmd.info "umask" ~doc + in + Cmd.v info term +end + +module Shift = struct + open Cmdliner + + let mask = + let doc = "shift positional parameters by n." in + Arg.(value & pos 0 (some int) None & info [] ~docv:"N" ~doc) + + let t = + let make_shift i = Shift i in + let term = Term.(const make_shift $ mask) in + let info = + let doc = "Shift positional parameters." in + Cmd.info "shift" ~doc + in + Cmd.v info term +end + let of_args (w : string list) = let open Cmdliner in let exec_cmd cmd v = @@ -473,4 +522,12 @@ let of_args (w : string list) = | "echo" :: _ as cmd -> exec_cmd cmd Echo.t | "trap" :: _ as cmd -> exec_cmd cmd Trap.t | "return" :: _ as cmd -> exec_cmd cmd Return.t + | "umask" :: _ as cmd -> exec_cmd cmd Umask.t + | "shift" :: _ as cmd -> exec_cmd cmd Shift.t + | cmd :: _ -> + if List.mem cmd reserved then begin + Debug.Log.err (fun f -> f "Unimplemented built-in: %s" cmd); + Some (Error (Fmt.str "Unimplemented built-in: %s" cmd)) + end + else None | _ -> None diff --git a/src/lib/built_ins.mli b/src/lib/built_ins.mli index 2433837..9a68473 100644 --- a/src/lib/built_ins.mli +++ b/src/lib/built_ins.mli @@ -51,6 +51,8 @@ type t = | Echo of string list | Trap of trap * [ `Signal of Eunix.Signals.t | `Exit ] list | Return of int + | Umask of int option + | Shift of int option val to_string : t -> string (** Serialises a built-in to a string *) diff --git a/src/lib/eunix.ml b/src/lib/eunix.ml index c84b900..39bcbd9 100644 --- a/src/lib/eunix.ml +++ b/src/lib/eunix.ml @@ -11,11 +11,22 @@ let find_env k = env () |> List.assoc_opt k let put_env ~key ~value = Eio_unix.run_in_systhread ~label:"put_env" @@ fun () -> Unix.putenv key value -let get_user_and_host () = - Eio_unix.run_in_systhread ~label:"get_user_and_host" @@ fun () -> - let name = - try Unix.getlogin () with Unix.Unix_error (Unix.ENOENT, _, _) -> "root" +let get_user_and_host fs = + let passwd = + Eio.Path.(load (fs / "/etc/passwd")) + |> String.split_on_char '\n' + |> List.map (String.split_on_char ':') in + let uid = Unix.getuid () in + let username = + List.find_map + (function + | name :: _ :: m :: _ -> + if int_of_string m = uid then Some name else None + | _ -> None) + passwd + in + let name = Option.value ~default:"?" username in let host = Unix.gethostname () in Fmt.str "%s@%s" name host diff --git a/src/lib/eval.ml b/src/lib/eval.ml index bde653e..22d9e15 100644 --- a/src/lib/eval.ml +++ b/src/lib/eval.ml @@ -6,6 +6,15 @@ open Eio.Std open Import open Exit.Syntax +let pp_args = Fmt.(list ~sep:(Fmt.any " ") string) + +let pp_fs_create ppf (v : Eio.Fs.create) = + match v with + | `If_missing o -> Fmt.pf ppf "if-missing %o" o + | `Exclusive o -> Fmt.pf ppf "exclusive %o" o + | `Or_truncate o -> Fmt.pf ppf "or-truncate %o" o + | `Never -> Fmt.pf ppf "never" + (** An evaluator over the AST *) module Make (S : Types.State) (E : Types.Exec) = struct (* What follows uses the POSIX definition of what a shell does ($ 2.1). @@ -40,6 +49,7 @@ module Make (S : Types.State) (E : Types.Exec) = struct signal_handler : signal_handler; exit_handler : (unit -> unit) option; in_double_quotes : bool; + umask : int; } let _stdin ctx = ctx.stdin @@ -47,8 +57,9 @@ module Make (S : Types.State) (E : Types.Exec) = struct let make_ctx ?(interactive = false) ?(subshell = false) ?(local_state = []) ?(background_jobs = []) ?(last_background_process = "") ?(functions = []) ?(rdrs = []) ?exit_handler ?(options = Built_ins.Options.default) - ?(hash = Hash.empty) ?(in_double_quotes = false) ~fs ~stdin ~stdout - ~async_switch ~program ~argv ~signal_handler state executor = + ?(hash = Hash.empty) ?(in_double_quotes = false) ?(umask = 0o22) ~fs + ~stdin ~stdout ~async_switch ~program ~argv ~signal_handler state executor + = let signal_handler = { run = signal_handler; sigint_set = false } in { interactive; @@ -71,6 +82,7 @@ module Make (S : Types.State) (E : Types.Exec) = struct signal_handler; exit_handler; in_double_quotes; + umask; } let state ctx = ctx.state @@ -100,85 +112,7 @@ module Make (S : Types.State) (E : Types.Exec) = struct let fd_of_int ?(close_unix = true) ~sw n = Eio_unix.Fd.of_unix ~close_unix ~sw (Obj.magic n : Unix.file_descr) - let handle_one_redirection ~sw ctx = function - | Ast.IoRedirect_IoFile (n, (op, file)) -> ( - match op with - | Io_op_less -> - (* Simple redirection for input *) - let r = Eio.Path.open_in ~sw (ctx.fs / word_cst_to_string file) in - let fd = Eio_unix.Resource.fd_opt r |> Option.get in - [ Types.Redirect (n, fd, `Blocking) ] - | Io_op_lessand -> ( - match file with - | [ WordLiteral "-" ] -> - if n = 0 then [ Types.Close Eio_unix.Fd.stdin ] - else - let fd = fd_of_int ~sw n in - [ Types.Close fd ] - | [ WordLiteral m ] when Option.is_some (int_of_string_opt m) -> - let m = int_of_string m in - [ - Types.Redirect - (n, fd_of_int ~close_unix:false ~sw m, `Blocking); - ] - | _ -> []) - | (Io_op_great | Io_op_dgreat) as v -> - (* Simple file creation *) - let append = v = Io_op_dgreat in - let create = - if append then `Never - else if ctx.options.noclobber then `Exclusive 0o644 - else `Or_truncate 0o644 - in - let w = - Eio.Path.open_out ~sw ~append ~create - (ctx.fs / word_cst_to_string file) - in - let fd = Eio_unix.Resource.fd_opt w |> Option.get in - [ Types.Redirect (n, fd, `Blocking) ] - | Io_op_greatand -> ( - match file with - | [ WordLiteral "-" ] -> - if n = 0 then [ Types.Close Eio_unix.Fd.stdout ] - else - let fd = fd_of_int ~sw n in - [ Types.Close fd ] - | [ WordLiteral m ] when Option.is_some (int_of_string_opt m) -> - let m = int_of_string m in - [ - Types.Redirect - (n, fd_of_int ~close_unix:false ~sw m, `Blocking); - ] - | _ -> []) - | Io_op_andgreat -> - (* Yesh, not very POSIX *) - (* Simple file creation *) - let w = - Eio.Path.open_out ~sw ~create:(`If_missing 0o644) - (ctx.fs / word_cst_to_string file) - in - let fd = Eio_unix.Resource.fd_opt w |> Option.get in - [ - Types.Redirect (1, fd, `Blocking); - Types.Redirect (2, fd, `Blocking); - ] - | Io_op_clobber -> - let w = - Eio.Path.open_out ~sw ~create:(`Or_truncate 0o644) - (ctx.fs / word_cst_to_string file) - in - let fd = Eio_unix.Resource.fd_opt w |> Option.get in - [ Types.Redirect (n, fd, `Blocking) ] - | Io_op_lessgreat -> Fmt.failwith "<> not support yet.") - | Ast.IoRedirect_IoHere _ -> - Fmt.failwith "HERE documents not yet implemented!" - - let handle_redirections ~sw ctx rdrs = - try Ok (List.concat_map (handle_one_redirection ~sw ctx) rdrs) - with Eio.Io (Eio.Fs.E (Already_exists _), _) -> - Fmt.epr "msh: cannot overwrite existing file\n%!"; - Error ctx - + let file_creation_mode ctx = 0o666 - ctx.umask let cwd_of_ctx ctx = S.cwd ctx.state |> Fpath.to_string |> ( / ) ctx.fs let resolve_program ?(update = true) ctx name = @@ -265,7 +199,9 @@ module Make (S : Types.State) (E : Types.Exec) = struct (ctx, Error (127, `Not_found)) | _, (ctx, Some full_path) -> Debug.Log.debug (fun f -> - f "executing %a" Fmt.(list string) (executable :: args)); + f "executing %a" + Fmt.(list ~sep:(Fmt.any " ") string) + (full_path :: args)); ( ctx, E.exec ctx.executor ~delay_reap:(fst reap) ~fds ?stdin ~stdout ~pgid ~mode ~cwd:(cwd_of_ctx ctx) @@ -351,7 +287,7 @@ module Make (S : Types.State) (E : Types.Exec) = struct [] suffix |> List.rev in - match handle_redirections ~sw:pipeline_switch ctx rdrs with + match handle_redirections ~sw:ctx.async_switch ctx rdrs with | Error ctx -> (ctx, handle_job job (`Rdr (Exit.nonzero () 1))) | Ok rdrs -> ( match Built_ins.of_args (executable :: args) with @@ -375,6 +311,8 @@ module Make (S : Types.State) (E : Types.Exec) = struct handle_job job (`Built_in (updated >|= fun _ -> ())) in + Debug.Log.debug (fun f -> + f "export %a" pp_args args); loop (Exit.value updated) job stdout_of_previous rest | "readonly" -> @@ -385,6 +323,8 @@ module Make (S : Types.State) (E : Types.Exec) = struct handle_job job (`Built_in (updated >|= fun _ -> ())) in + Debug.Log.debug (fun f -> + f "readonly %a" pp_args args); loop (Exit.value updated) job stdout_of_previous rest | "local" -> @@ -397,6 +337,15 @@ module Make (S : Types.State) (E : Types.Exec) = struct in loop (Exit.value updated) job stdout_of_previous rest + | "exec" -> + Debug.Log.debug (fun f -> + f "exec [%a] [%a]" pp_args args + Fmt.(list Types.pp_redirect) + rdrs); + if args <> [] then + Fmt.invalid_arg + "Exec with args not yet supported..."; + ({ ctx with rdrs }, job) | _ -> ( let saved_ctx = ctx in let func_app = @@ -551,6 +500,90 @@ module Make (S : Types.State) (E : Types.Exec) = struct } end + and handle_one_redirection ~sw ctx = function + | Ast.IoRedirect_IoFile (n, (op, file)) -> ( + let _ctx, file = word_expansion ctx file in + let file = Ast.Fragment.join_list ~sep:"" file in + match op with + | Io_op_less -> + (* 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 + [ Types.Redirect (n, fd, `Blocking) ] + | Io_op_lessand -> ( + match file with + | "-" -> + if n = 0 then [ Types.Close Eio_unix.Fd.stdin ] + else + let fd = fd_of_int ~sw n in + [ Types.Close fd ] + | m when Option.is_some (int_of_string_opt m) -> + let m = int_of_string m in + [ + Types.Redirect + (n, fd_of_int ~close_unix:false ~sw m, `Blocking); + ] + | _ -> []) + | (Io_op_great | Io_op_dgreat) as v -> + (* Simple file creation *) + let append = v = Io_op_dgreat in + let create = + if append then `If_missing (file_creation_mode ctx) + else if ctx.options.noclobber then + `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 + [ Types.Redirect (n, fd, `Blocking) ] + | Io_op_greatand -> ( + match file with + | "-" -> + if n = 0 then [ Types.Close Eio_unix.Fd.stdout ] + else + let fd = fd_of_int ~sw n in + [ Types.Close fd ] + | m when Option.is_some (int_of_string_opt m) -> + let m = int_of_string m in + [ + Types.Redirect + (n, fd_of_int ~close_unix:false ~sw m, `Blocking); + ] + | _ -> []) + | Io_op_andgreat -> + (* Yesh, not very POSIX *) + (* Simple file creation *) + let w = + Eio.Path.open_out ~sw + ~create:(`If_missing (file_creation_mode ctx)) + (ctx.fs / file) + in + let fd = Eio_unix.Resource.fd_opt w |> Option.get in + [ + Types.Redirect (1, fd, `Blocking); + Types.Redirect (2, fd, `Blocking); + ] + | Io_op_clobber -> + let w = + Eio.Path.open_out ~sw + ~create:(`Or_truncate (file_creation_mode ctx)) + (ctx.fs / file) + in + let fd = Eio_unix.Resource.fd_opt w |> Option.get in + [ Types.Redirect (n, fd, `Blocking) ] + | Io_op_lessgreat -> Fmt.failwith "<> not support yet.") + | Ast.IoRedirect_IoHere _ -> + Fmt.failwith "HERE documents not yet implemented!" + + and handle_redirections ~sw ctx rdrs = + try Ok (List.concat_map (handle_one_redirection ~sw ctx) rdrs) + with Eio.Io (Eio.Fs.E (Already_exists _), _) -> + Fmt.epr "msh: cannot overwrite existing file\n%!"; + Error ctx + and parameter_expansion ctx ast : ctx Exit.t * Ast.fragment list list = let get_prefix ~pattern ~kind param = let _, prefix = @@ -801,11 +834,25 @@ module Make (S : Types.State) (E : Types.Exec) = struct in expand ctx ast + and split_fields ifs s = + let v, ls = + String.fold_left + (fun (so_far, ls) c -> + if String.contains ifs c then ("", so_far :: ls) + else (so_far ^ String.make 1 c, ls)) + ("", []) s + in + List.rev (v :: ls) + and field_splitting ctx = function | [] -> [] - | Ast.{ splittable = true; txt; _ } :: rest -> - (String.split_on_char ' ' txt |> List.map Ast.Fragment.make) - @ field_splitting ctx rest + | Ast.{ splittable = true; txt; globbable; _ } :: rest -> ( + match S.lookup ctx.state ~param:"IFS" with + | Some "" -> [ Ast.Fragment.make ~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 word_expansion' ctx cst : ctx Exit.t * Ast.fragments list = @@ -1065,8 +1112,16 @@ module Make (S : Types.State) (E : Types.Exec) = struct match List.assoc_opt name ctx.functions with | None -> None | Some commands -> + Debug.Log.debug (fun f -> + f "function enter: %s [%a]" name + Fmt.(list ~sep:Fmt.(any " ") string) + argv); let ctx = { ctx with argv = Array.of_list argv } in - Option.some @@ (handle_compound_command ctx commands >|= fun _ -> ctx) + let v = + Option.some @@ (handle_compound_command ctx commands >|= fun _ -> ctx) + in + Debug.Log.debug (fun f -> f "function leave: %s" name); + v and command_substitution (ctx : ctx) (cc : Ast.complete_commands) = let exec_subshell ctx s = @@ -1203,9 +1258,13 @@ module Make (S : Types.State) (E : Types.Exec) = struct | Dot file -> ( match resolve_program ctx file with | ctx, None -> Exit.nonzero ctx 127 - | ctx, Some f -> - let program = Ast.of_file (ctx.fs / f) in - let ctx, _ = run (Exit.zero ctx) program in + | ctx, Some fname -> + Debug.Log.debug (fun f -> f "sourcing..."); + let program = Ast.of_file (ctx.fs / fname) in + let ctx, _ = + run' ~make_process_group:false (Exit.zero ctx) program + in + Debug.Log.debug (fun f -> f "finished sourcing %s" fname); ctx) | Unset names -> ( match names with @@ -1289,6 +1348,17 @@ module Make (S : Types.State) (E : Types.Exec) = struct { ctx.signal_handler with sigint_set = setting_sigint }; }) ctx signals + | Umask None -> + let str = Fmt.str "0%o\n" ctx.umask in + Eio.Flow.copy_string str stdout; + Exit.zero ctx + | Umask (Some i) -> Exit.zero { ctx with umask = i } + | Shift n -> + let n = Option.value ~default:1 n in + let new_len = Array.length ctx.argv - n in + assert (new_len >= 0); + let argv = Array.init new_len (fun i -> Array.get ctx.argv (i + n)) in + Exit.zero { ctx with argv } | Command _ -> (* Handled separately *) assert false @@ -1322,10 +1392,11 @@ module Make (S : Types.State) (E : Types.Exec) = struct Exit.zero initial_ctx and execute ctx ast = exec ctx ast + and run ctx ast = run' ~make_process_group:true ctx ast - and run ctx ast = + and run' ?(make_process_group = true) ctx ast = (* Make the shell its own process group *) - Eunix.make_process_group (); + if make_process_group then Eunix.make_process_group (); let ctx, cs = let rec loop_commands (ctx, cs) (c : Ast.complete_commands) = match c with diff --git a/src/lib/eval.mli b/src/lib/eval.mli index 7b282ab..da91b8b 100644 --- a/src/lib/eval.mli +++ b/src/lib/eval.mli @@ -22,6 +22,7 @@ module Make (S : Types.State) (E : Types.Exec) : sig ?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 -> stdout:Eio_unix.sink_ty r -> diff --git a/src/lib/interactive.ml b/src/lib/interactive.ml index b06fc62..f121098 100644 --- a/src/lib/interactive.ml +++ b/src/lib/interactive.ml @@ -23,9 +23,10 @@ module Make (S : Types.State) (E : Types.Exec) (H : Types.History) = struct | Exit.Nonzero { exit_code; _ } -> Fmt.pf ppf "[%a] " (pp_colored `Red Fmt.int) exit_code in + let fs = Exit.value ctx |> Eval.fs in Fmt.pf Format.str_formatter "%a%a:%s >\n%!" pp_status ctx Fmt.(pp_colored `Yellow string) - (Eunix.get_user_and_host ()) + (Eunix.get_user_and_host fs) (Fpath.normalize @@ S.cwd state |> subst_tilde |> Fpath.to_string); Format.flush_str_formatter () diff --git a/src/lib/types.ml b/src/lib/types.ml index 15700a8..69734f3 100644 --- a/src/lib/types.ml +++ b/src/lib/types.ml @@ -53,6 +53,10 @@ type redirect = | Redirect of int * Eio_unix.Fd.t * Eio_unix.Private.Fork_action.blocking | Close of Eio_unix.Fd.t +let pp_redirect ppf = function + | Redirect (i, fd, _) -> Fmt.pf ppf "%i <-> %a" i Eio_unix.Fd.pp fd + | Close fd -> Fmt.pf ppf "close %a" Eio_unix.Fd.pp fd + type exec_mode = | Switched of Eio.Switch.t | Async diff --git a/test/built_ins.t b/test/built_ins.t index 97b112f..af57b73 100644 --- a/test/built_ins.t +++ b/test/built_ins.t @@ -290,3 +290,41 @@ This is mostly handled by Morbig, but we have had to do some fixes... hello $ msh test.sh hello + +12. Exec + +Some bits of `exec` (in particular redirects) are supported. + + $ cat > test.sh << EOF + > exec > output.log + > echo hello + > EOF + + $ sh test.sh; cat output.log; rm output.log + hello + $ msh test.sh; cat output.log + hello + +13. Umask + + $ msh -c "umask; umask 045; umask" + 022 + 045 + +14. shift + + $ cat > test.sh << EOF + > echo "args: \$@" + > shift 2 + > echo "args 2: \$@" + > echo "args 2: \$#" + > EOF + + $ sh test.sh a b c d + args: a b c d + args 2: c d + args 2: 2 + $ msh test.sh a b c d + args: a b c d + args 2: c d + args 2: 2 diff --git a/test/docker/Dockerfile.alpine b/test/docker/Dockerfile.alpine new file mode 100644 index 0000000..81fa020 --- /dev/null +++ b/test/docker/Dockerfile.alpine @@ -0,0 +1,92 @@ +FROM ocaml/opam:alpine-ocaml-5.3 AS builder +WORKDIR /home/opam/src +COPY --chown=opam merry.opam . +RUN opam pin . -yn +RUN opam install . --deps-only --with-test +COPY --chown=opam . . +RUN opam exec -- dune build --profile=release + +FROM alpine:3.23 + +# Copy across msh as the new shell! +COPY --from=builder /home/opam/src/_build/default/src/bin/main.exe /bin/msh +RUN ln -sf /bin/msh /bin/sh +SHELL [ "/bin/msh", "-c" ] + +LABEL distro_style="apk" +RUN apk update && apk upgrade +RUN apk add build-base bzip2 git tar curl ca-certificates openssl +RUN git config --global user.email "docker@example.com" +RUN git config --global user.name "Docker" +RUN git clone https://github.com/ocaml/opam /tmp/opam && cd /tmp/opam && cp -P -R -p . ../opam-sources && git checkout 16116259a7db479cb69f4dbd6c430ec14c5814ad && env MAKE='make -j' shell/bootstrap-ocaml.sh && make -C src_ext cache-archives +RUN cd /tmp/opam-sources && cp -P -R -p . ../opam-build-2.0 && cd ../opam-build-2.0 && git fetch -q && git checkout adc1e1829a2bef5b240746df80341b508290fe3b && ln -s ../opam/src_ext/archives src_ext/archives && env PATH="/tmp/opam/bootstrap/ocaml/bin:$PATH" ./configure --enable-cold-check && env PATH="/tmp/opam/bootstrap/ocaml/bin:$PATH" make lib-ext all && mkdir -p /usr/local/bin && cp /tmp/opam-build-2.0/opam /usr/local/bin/opam-2.0 && chmod a+x /usr/local/bin/opam-2.0 && rm -rf /tmp/opam-build-2.0 +RUN cd /tmp/opam-sources && cp -P -R -p . ../opam-build-2.1 && cd ../opam-build-2.1 && git fetch -q && git checkout 263921263e1f745613e2882745114b7b08f3608b && ln -s ../opam/src_ext/archives src_ext/archives && env PATH="/tmp/opam/bootstrap/ocaml/bin:$PATH" ./configure --enable-cold-check --with-0install-solver && env PATH="/tmp/opam/bootstrap/ocaml/bin:$PATH" make lib-ext all && mkdir -p /usr/local/bin && cp /tmp/opam-build-2.1/opam /usr/local/bin/opam-2.1 && chmod a+x /usr/local/bin/opam-2.1 && rm -rf /tmp/opam-build-2.1 +RUN cd /tmp/opam-sources && cp -P -R -p . ../opam-build-2.2 && cd ../opam-build-2.2 && git fetch -q && git checkout 01e9a24a61e23e42d513b4b775d8c30c807439b2 && ln -s ../opam/src_ext/archives src_ext/archives && env PATH="/tmp/opam/bootstrap/ocaml/bin:$PATH" ./configure --enable-cold-check --with-0install-solver --with-vendored-deps && env PATH="/tmp/opam/bootstrap/ocaml/bin:$PATH" make lib-ext all && mkdir -p /usr/local/bin && cp /tmp/opam-build-2.2/opam /usr/local/bin/opam-2.2 && chmod a+x /usr/local/bin/opam-2.2 && rm -rf /tmp/opam-build-2.2 +RUN cd /tmp/opam-sources && cp -P -R -p . ../opam-build-2.3 && cd ../opam-build-2.3 && git fetch -q && git checkout 35acd0c5abc5e66cdbd5be16ba77aa6c33a4c724 && ln -s ../opam/src_ext/archives src_ext/archives && env PATH="/tmp/opam/bootstrap/ocaml/bin:$PATH" ./configure --enable-cold-check --with-0install-solver --with-vendored-deps && env PATH="/tmp/opam/bootstrap/ocaml/bin:$PATH" make lib-ext all && mkdir -p /usr/local/bin && cp /tmp/opam-build-2.3/opam /usr/local/bin/opam-2.3 && chmod a+x /usr/local/bin/opam-2.3 && rm -rf /tmp/opam-build-2.3 +RUN cd /tmp/opam-sources && cp -P -R -p . ../opam-build-2.4 && cd ../opam-build-2.4 && git fetch -q && git checkout 7c92631391984f698f31ee24f3ae4dc1cd3698ff && ln -s ../opam/src_ext/archives src_ext/archives && env PATH="/tmp/opam/bootstrap/ocaml/bin:$PATH" ./configure --enable-cold-check --with-0install-solver --with-vendored-deps && env PATH="/tmp/opam/bootstrap/ocaml/bin:$PATH" make lib-ext all && mkdir -p /usr/local/bin && cp /tmp/opam-build-2.4/opam /usr/local/bin/opam-2.4 && chmod a+x /usr/local/bin/opam-2.4 && rm -rf /tmp/opam-build-2.4 +RUN cd /tmp/opam-sources && cp -P -R -p . ../opam-build-2.5 && cd ../opam-build-2.5 && git fetch -q && git checkout edf980ebd18ad6b5e990dbf3b6367cffcaf01815 && ln -s ../opam/src_ext/archives src_ext/archives && env PATH="/tmp/opam/bootstrap/ocaml/bin:$PATH" ./configure --enable-cold-check --with-0install-solver --with-vendored-deps && env PATH="/tmp/opam/bootstrap/ocaml/bin:$PATH" make lib-ext all && mkdir -p /usr/local/bin && cp /tmp/opam-build-2.5/opam /usr/local/bin/opam-2.5 && chmod a+x /usr/local/bin/opam-2.5 && rm -rf /tmp/opam-build-2.5 +RUN cd /tmp/opam-sources && cp -P -R -p . ../opam-build-master && cd ../opam-build-master && git fetch -q && git checkout 16116259a7db479cb69f4dbd6c430ec14c5814ad && ln -s ../opam/src_ext/archives src_ext/archives && env PATH="/tmp/opam/bootstrap/ocaml/bin:$PATH" ./configure --enable-cold-check --with-0install-solver --with-vendored-deps && env PATH="/tmp/opam/bootstrap/ocaml/bin:$PATH" make lib-ext all && mkdir -p /usr/local/bin && cp /tmp/opam-build-master/opam /usr/local/bin/opam-master && chmod a+x /usr/local/bin/opam-master && rm -rf /tmp/opam-build-master +RUN strip /usr/local/bin/opam* + +FROM alpine:3.23 +RUN <<-EOF cat >> /etc/apk/repositories + @edge https://dl-cdn.alpinelinux.org/alpine/edge/main + @edgecommunity https://dl-cdn.alpinelinux.org/alpine/edge/community + @testing https://dl-cdn.alpinelinux.org/alpine/edge/testing +EOF +ENV OCAMLRUNPARAM=b +RUN apk update && apk upgrade +RUN apk add build-base patch tar ca-certificates git rsync curl sudo bash libx11-dev nano coreutils xz ncurses-dev bubblewrap +COPY --from=1 [ "/usr/local/bin/opam-2.0", "/usr/bin/opam-2.0" ] +RUN ln /usr/bin/opam-2.0 /usr/bin/opam +COPY --from=1 [ "/usr/local/bin/opam-2.1", "/usr/bin/opam-2.1" ] +COPY --from=1 [ "/usr/local/bin/opam-2.2", "/usr/bin/opam-2.2" ] +COPY --from=1 [ "/usr/local/bin/opam-2.3", "/usr/bin/opam-2.3" ] +COPY --from=1 [ "/usr/local/bin/opam-2.4", "/usr/bin/opam-2.4" ] +COPY --from=1 [ "/usr/local/bin/opam-2.5", "/usr/bin/opam-2.5" ] +COPY --from=1 [ "/usr/local/bin/opam-master", "/usr/bin/opam-dev" ] +RUN addgroup -S -g 1000 opam +RUN adduser -S -u 1000 -G opam opam +COPY <<-EOF /etc/sudoers.d/opam + opam ALL=(ALL:ALL) NOPASSWD:ALL +EOF +RUN chmod 440 /etc/sudoers.d/opam +RUN chown root:root /etc/sudoers.d/opam +RUN sed -i.bak 's/^Defaults.*requiretty//g' /etc/sudoers +USER opam +WORKDIR /home/opam +RUN mkdir .ssh +RUN chmod 700 .ssh +COPY --chown=opam <<-EOF /home/opam/.opamrc-nosandbox + wrap-build-commands: [] + wrap-install-commands: [] + wrap-remove-commands: [] + required-tools: [] +EOF +COPY --chown=opam <<-EOF /home/opam/opam-sandbox-disable + #!/bin/sh + cp ~/.opamrc-nosandbox ~/.opamrc + echo --- opam sandboxing disabled +EOF +RUN chmod a+x /home/opam/opam-sandbox-disable +RUN sudo mv /home/opam/opam-sandbox-disable /usr/bin/opam-sandbox-disable +COPY --chown=opam <<-EOF /home/opam/.opamrc-sandbox + wrap-build-commands: ["%{hooks}%/sandbox.sh" "build"] + wrap-install-commands: ["%{hooks}%/sandbox.sh" "install"] + wrap-remove-commands: ["%{hooks}%/sandbox.sh" "remove"] +EOF +COPY --chown=opam <<-EOF /home/opam/opam-sandbox-enable + #!/bin/sh + cp ~/.opamrc-sandbox ~/.opamrc + echo --- opam sandboxing enabled +EOF +RUN chmod a+x /home/opam/opam-sandbox-enable +RUN sudo mv /home/opam/opam-sandbox-enable /usr/bin/opam-sandbox-enable +RUN git config --global user.email "docker@example.com" +RUN git config --global user.name "Docker" +COPY --link --chown=opam:opam [ ".", "/home/opam/opam-repository" ] +RUN opam-sandbox-disable +RUN opam init -k git -a /home/opam/opam-repository --bare +RUN echo 'archive-mirrors: "https://opam.ocaml.org/cache"' >> ~/.opam/config +RUN rm -rf .opam/repo/default/.git + diff --git a/test/docker/Dockerfile.alpine-simple b/test/docker/Dockerfile.alpine-simple new file mode 100644 index 0000000..dc312a2 --- /dev/null +++ b/test/docker/Dockerfile.alpine-simple @@ -0,0 +1,15 @@ +FROM ocaml/opam:alpine-ocaml-5.3 AS builder +WORKDIR /home/opam/src +COPY --chown=opam merry.opam . +RUN opam pin . -yn +RUN opam install . --deps-only --with-test +COPY --chown=opam . . +RUN opam exec -- dune build --profile=release + +FROM ocaml/opam:alpine-ocaml-5.3 + +# Copy across msh as the new shell! +COPY --from=builder /home/opam/src/_build/default/src/bin/main.exe /bin/msh +RUN sudo ln -sf /bin/msh /bin/sh +SHELL [ "/bin/msh", "-c" ] +ENTRYPOINT [ "/bin/msh" ] diff --git a/test/debootstrap/Dockerfile b/test/docker/Dockerfile.debootstrap similarity index 97% rename from test/debootstrap/Dockerfile rename to test/docker/Dockerfile.debootstrap index e72fb62..bb23c21 100644 --- a/test/debootstrap/Dockerfile +++ b/test/docker/Dockerfile.debootstrap @@ -12,5 +12,5 @@ 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 --no-install-recommends --assume-yes debootstrap + && apt-get install --no-install-recommends --assume-yes debootstrap vim ENTRYPOINT [ "msh" ] diff --git a/test/wordexp.ml b/test/wordexp.ml index 13c6613..84c0e61 100644 --- a/test/wordexp.ml +++ b/test/wordexp.ml @@ -82,8 +82,8 @@ let test_single_expansion env () = let test_argv_expansion env () = let cargs = W.[ name "echo"; var "@" ] in - with_default_ctx ~args:[ "echo"; "a"; "b"; "c" ] env @@ fun ctx -> - let expected = frags [ "echo"; "a"; "b"; "c" ] in + with_default_ctx ~args:[ "echo"; "a"; "b"; "c d" ] env @@ fun ctx -> + let expected = frags [ "echo"; "a"; "b"; "c"; "d" ] in let actual = expand ctx cargs in Alcotest.check fragments "same fragments" expected actual