patrick.sirref.org / merry
Shells in OCaml
3
fork

Configure Feed

Select the types of activity you want to include in your feed.

More built-ins and better debug logging

Patrick Ferris 108baa00 16fa9c1b

+414 -108
+5 -1
src/bin/main.ml
··· 25 25 let ast = 26 26 match (file, command_flag, rest) with 27 27 | None, false, _ -> assert false 28 - | Some file, false, _ -> Merry.Ast.of_file Eio.Path.(env#fs / file) 28 + | Some file, false, _ -> 29 + Merry.Debug.Log.debug (fun f -> f "msh executing %s" file); 30 + Merry.Ast.of_file Eio.Path.(env#fs / file) 29 31 | _, true, c :: _ -> Merry.Ast.of_string c 30 32 | _, b, cs -> Fmt.failwith "Bad usage: %b %a" b Fmt.(list string) cs 31 33 in ··· 55 57 let setup_log style_renderer level = 56 58 Fmt_tty.setup_std_outputs ?style_renderer (); 57 59 Logs.set_level level; 60 + let override = Sys.getenv_opt "MSH_DEBUG" in 61 + let level = match override with Some _ -> Some Logs.Debug | None -> level in 58 62 Logs.Src.set_level Merry.Debug.src level; 59 63 Logs.set_reporter (Logs_fmt.reporter ()); 60 64 ()
+16 -6
src/lib/ast.ml
··· 765 765 "This is an error in Merry, subshells should already have been \ 766 766 expanded by now!" 767 767 | v -> 768 - Fmt.failwith "Conversion of %a" Yojson.Safe.pp 768 + Fmt.failwith "conversion of %a" Yojson.Safe.pp 769 769 (word_component_to_yojson v) 770 770 771 771 and word_components_to_strings ?(field_splitting = true) ws = ··· 839 839 840 840 let empty = make "" 841 841 let to_string { txt; _ } = txt 842 - let join ~sep f1 f2 = { f1 with txt = f1.txt ^ sep ^ f2.txt } 842 + 843 + let join ~sep f1 f2 = 844 + { 845 + f1 with 846 + txt = f1.txt ^ sep ^ f2.txt; 847 + globbable = f1.globbable || f2.globbable; 848 + } 849 + 843 850 let join_list ~sep fs = List.fold_left (join ~sep) empty fs |> to_string 844 851 845 852 let pp_join ppf = function ··· 854 861 let handle_joins cst = 855 862 let rec loop = function 856 863 | [] -> [] 857 - | x :: { txt; join = `With_previous; _ } :: rest -> 858 - loop ({ x with txt = x.txt ^ txt } :: rest) 859 - | { txt; join = `With_next; _ } :: y :: rest -> 860 - { y with txt = txt ^ y.txt } :: loop rest 864 + | x :: { txt; join = `With_previous; globbable; _ } :: rest -> 865 + loop 866 + ({ x with txt = x.txt ^ txt; globbable = x.globbable || globbable } 867 + :: rest) 868 + | { txt; join = `With_next; globbable; _ } :: y :: rest -> 869 + { y with txt = txt ^ y.txt; globbable = globbable || y.globbable } 870 + :: loop rest 861 871 | x :: xs -> x :: loop xs 862 872 in 863 873 loop cst
+58 -1
src/lib/built_ins.ml
··· 92 92 | Echo of string list 93 93 | Trap of trap * [ `Signal of Eunix.Signals.t | `Exit ] list 94 94 | Return of int 95 + | Umask of int option 96 + | Shift of int option 95 97 98 + let reserved = [ "fg"; "bg"; "jobs" ] 96 99 let pp_args = Fmt.(list ~sep:(Fmt.any " ") string) 97 100 98 101 let to_string = function ··· 111 114 | Unalias -> "unalias" 112 115 | Eval s -> Fmt.str "eval %a" pp_args s 113 116 | Echo s -> Fmt.str "echo %a" pp_args s 114 - | Trap _ -> "trap" 117 + | Umask None -> "umask" 118 + | Umask (Some i) -> Fmt.str "umask %o" i 119 + | Shift None -> "shift" 120 + | Shift (Some i) -> Fmt.str "shift %o" i 121 + | Trap (trap, _) -> 122 + Fmt.str "trap %s" 123 + (match trap with 124 + | Int i -> string_of_int i 125 + | Action a -> a 126 + | Ignore -> "ignore" 127 + | Default -> "default") 115 128 | Set _ -> "set" 116 129 117 130 (* Change Directory *) ··· 446 459 Cmd.v info term 447 460 end 448 461 462 + module Umask = struct 463 + open Cmdliner 464 + 465 + let mask = 466 + let doc = "Mask for file creation." in 467 + Arg.(value & pos 0 (some string) None & info [] ~docv:"MASK" ~doc) 468 + 469 + let t = 470 + let make_umask i = 471 + Umask (Option.map (fun i -> Scanf.sscanf i "%o" Fun.id) i) 472 + in 473 + let term = Term.(const make_umask $ mask) in 474 + let info = 475 + let doc = "Get or set the file mode creation mask." in 476 + Cmd.info "umask" ~doc 477 + in 478 + Cmd.v info term 479 + end 480 + 481 + module Shift = struct 482 + open Cmdliner 483 + 484 + let mask = 485 + let doc = "shift positional parameters by n." in 486 + Arg.(value & pos 0 (some int) None & info [] ~docv:"N" ~doc) 487 + 488 + let t = 489 + let make_shift i = Shift i in 490 + let term = Term.(const make_shift $ mask) in 491 + let info = 492 + let doc = "Shift positional parameters." in 493 + Cmd.info "shift" ~doc 494 + in 495 + Cmd.v info term 496 + end 497 + 449 498 let of_args (w : string list) = 450 499 let open Cmdliner in 451 500 let exec_cmd cmd v = ··· 473 522 | "echo" :: _ as cmd -> exec_cmd cmd Echo.t 474 523 | "trap" :: _ as cmd -> exec_cmd cmd Trap.t 475 524 | "return" :: _ as cmd -> exec_cmd cmd Return.t 525 + | "umask" :: _ as cmd -> exec_cmd cmd Umask.t 526 + | "shift" :: _ as cmd -> exec_cmd cmd Shift.t 527 + | cmd :: _ -> 528 + if List.mem cmd reserved then begin 529 + Debug.Log.err (fun f -> f "Unimplemented built-in: %s" cmd); 530 + Some (Error (Fmt.str "Unimplemented built-in: %s" cmd)) 531 + end 532 + else None 476 533 | _ -> None
+2
src/lib/built_ins.mli
··· 51 51 | Echo of string list 52 52 | Trap of trap * [ `Signal of Eunix.Signals.t | `Exit ] list 53 53 | Return of int 54 + | Umask of int option 55 + | Shift of int option 54 56 55 57 val to_string : t -> string 56 58 (** Serialises a built-in to a string *)
+15 -4
src/lib/eunix.ml
··· 11 11 let put_env ~key ~value = 12 12 Eio_unix.run_in_systhread ~label:"put_env" @@ fun () -> Unix.putenv key value 13 13 14 - let get_user_and_host () = 15 - Eio_unix.run_in_systhread ~label:"get_user_and_host" @@ fun () -> 16 - let name = 17 - try Unix.getlogin () with Unix.Unix_error (Unix.ENOENT, _, _) -> "root" 14 + let get_user_and_host fs = 15 + let passwd = 16 + Eio.Path.(load (fs / "/etc/passwd")) 17 + |> String.split_on_char '\n' 18 + |> List.map (String.split_on_char ':') 19 + in 20 + let uid = Unix.getuid () in 21 + let username = 22 + List.find_map 23 + (function 24 + | name :: _ :: m :: _ -> 25 + if int_of_string m = uid then Some name else None 26 + | _ -> None) 27 + passwd 18 28 in 29 + let name = Option.value ~default:"?" username in 19 30 let host = Unix.gethostname () in 20 31 Fmt.str "%s@%s" name host 21 32
+163 -92
src/lib/eval.ml
··· 6 6 open Import 7 7 open Exit.Syntax 8 8 9 + let pp_args = Fmt.(list ~sep:(Fmt.any " ") string) 10 + 11 + let pp_fs_create ppf (v : Eio.Fs.create) = 12 + match v with 13 + | `If_missing o -> Fmt.pf ppf "if-missing %o" o 14 + | `Exclusive o -> Fmt.pf ppf "exclusive %o" o 15 + | `Or_truncate o -> Fmt.pf ppf "or-truncate %o" o 16 + | `Never -> Fmt.pf ppf "never" 17 + 9 18 (** An evaluator over the AST *) 10 19 module Make (S : Types.State) (E : Types.Exec) = struct 11 20 (* What follows uses the POSIX definition of what a shell does ($ 2.1). ··· 40 49 signal_handler : signal_handler; 41 50 exit_handler : (unit -> unit) option; 42 51 in_double_quotes : bool; 52 + umask : int; 43 53 } 44 54 45 55 let _stdin ctx = ctx.stdin ··· 47 57 let make_ctx ?(interactive = false) ?(subshell = false) ?(local_state = []) 48 58 ?(background_jobs = []) ?(last_background_process = "") ?(functions = []) 49 59 ?(rdrs = []) ?exit_handler ?(options = Built_ins.Options.default) 50 - ?(hash = Hash.empty) ?(in_double_quotes = false) ~fs ~stdin ~stdout 51 - ~async_switch ~program ~argv ~signal_handler state executor = 60 + ?(hash = Hash.empty) ?(in_double_quotes = false) ?(umask = 0o22) ~fs 61 + ~stdin ~stdout ~async_switch ~program ~argv ~signal_handler state executor 62 + = 52 63 let signal_handler = { run = signal_handler; sigint_set = false } in 53 64 { 54 65 interactive; ··· 71 82 signal_handler; 72 83 exit_handler; 73 84 in_double_quotes; 85 + umask; 74 86 } 75 87 76 88 let state ctx = ctx.state ··· 100 112 let fd_of_int ?(close_unix = true) ~sw n = 101 113 Eio_unix.Fd.of_unix ~close_unix ~sw (Obj.magic n : Unix.file_descr) 102 114 103 - let handle_one_redirection ~sw ctx = function 104 - | Ast.IoRedirect_IoFile (n, (op, file)) -> ( 105 - match op with 106 - | Io_op_less -> 107 - (* Simple redirection for input *) 108 - let r = Eio.Path.open_in ~sw (ctx.fs / word_cst_to_string file) in 109 - let fd = Eio_unix.Resource.fd_opt r |> Option.get in 110 - [ Types.Redirect (n, fd, `Blocking) ] 111 - | Io_op_lessand -> ( 112 - match file with 113 - | [ WordLiteral "-" ] -> 114 - if n = 0 then [ Types.Close Eio_unix.Fd.stdin ] 115 - else 116 - let fd = fd_of_int ~sw n in 117 - [ Types.Close fd ] 118 - | [ WordLiteral m ] when Option.is_some (int_of_string_opt m) -> 119 - let m = int_of_string m in 120 - [ 121 - Types.Redirect 122 - (n, fd_of_int ~close_unix:false ~sw m, `Blocking); 123 - ] 124 - | _ -> []) 125 - | (Io_op_great | Io_op_dgreat) as v -> 126 - (* Simple file creation *) 127 - let append = v = Io_op_dgreat in 128 - let create = 129 - if append then `Never 130 - else if ctx.options.noclobber then `Exclusive 0o644 131 - else `Or_truncate 0o644 132 - in 133 - let w = 134 - Eio.Path.open_out ~sw ~append ~create 135 - (ctx.fs / word_cst_to_string file) 136 - in 137 - let fd = Eio_unix.Resource.fd_opt w |> Option.get in 138 - [ Types.Redirect (n, fd, `Blocking) ] 139 - | Io_op_greatand -> ( 140 - match file with 141 - | [ WordLiteral "-" ] -> 142 - if n = 0 then [ Types.Close Eio_unix.Fd.stdout ] 143 - else 144 - let fd = fd_of_int ~sw n in 145 - [ Types.Close fd ] 146 - | [ WordLiteral m ] when Option.is_some (int_of_string_opt m) -> 147 - let m = int_of_string m in 148 - [ 149 - Types.Redirect 150 - (n, fd_of_int ~close_unix:false ~sw m, `Blocking); 151 - ] 152 - | _ -> []) 153 - | Io_op_andgreat -> 154 - (* Yesh, not very POSIX *) 155 - (* Simple file creation *) 156 - let w = 157 - Eio.Path.open_out ~sw ~create:(`If_missing 0o644) 158 - (ctx.fs / word_cst_to_string file) 159 - in 160 - let fd = Eio_unix.Resource.fd_opt w |> Option.get in 161 - [ 162 - Types.Redirect (1, fd, `Blocking); 163 - Types.Redirect (2, fd, `Blocking); 164 - ] 165 - | Io_op_clobber -> 166 - let w = 167 - Eio.Path.open_out ~sw ~create:(`Or_truncate 0o644) 168 - (ctx.fs / word_cst_to_string file) 169 - in 170 - let fd = Eio_unix.Resource.fd_opt w |> Option.get in 171 - [ Types.Redirect (n, fd, `Blocking) ] 172 - | Io_op_lessgreat -> Fmt.failwith "<> not support yet.") 173 - | Ast.IoRedirect_IoHere _ -> 174 - Fmt.failwith "HERE documents not yet implemented!" 175 - 176 - let handle_redirections ~sw ctx rdrs = 177 - try Ok (List.concat_map (handle_one_redirection ~sw ctx) rdrs) 178 - with Eio.Io (Eio.Fs.E (Already_exists _), _) -> 179 - Fmt.epr "msh: cannot overwrite existing file\n%!"; 180 - Error ctx 181 - 115 + let file_creation_mode ctx = 0o666 - ctx.umask 182 116 let cwd_of_ctx ctx = S.cwd ctx.state |> Fpath.to_string |> ( / ) ctx.fs 183 117 184 118 let resolve_program ?(update = true) ctx name = ··· 265 199 (ctx, Error (127, `Not_found)) 266 200 | _, (ctx, Some full_path) -> 267 201 Debug.Log.debug (fun f -> 268 - f "executing %a" Fmt.(list string) (executable :: args)); 202 + f "executing %a" 203 + Fmt.(list ~sep:(Fmt.any " ") string) 204 + (full_path :: args)); 269 205 ( ctx, 270 206 E.exec ctx.executor ~delay_reap:(fst reap) ~fds ?stdin ~stdout 271 207 ~pgid ~mode ~cwd:(cwd_of_ctx ctx) ··· 351 287 [] suffix 352 288 |> List.rev 353 289 in 354 - match handle_redirections ~sw:pipeline_switch ctx rdrs with 290 + match handle_redirections ~sw:ctx.async_switch ctx rdrs with 355 291 | Error ctx -> (ctx, handle_job job (`Rdr (Exit.nonzero () 1))) 356 292 | Ok rdrs -> ( 357 293 match Built_ins.of_args (executable :: args) with ··· 375 311 handle_job job 376 312 (`Built_in (updated >|= fun _ -> ())) 377 313 in 314 + Debug.Log.debug (fun f -> 315 + f "export %a" pp_args args); 378 316 loop (Exit.value updated) job stdout_of_previous 379 317 rest 380 318 | "readonly" -> ··· 385 323 handle_job job 386 324 (`Built_in (updated >|= fun _ -> ())) 387 325 in 326 + Debug.Log.debug (fun f -> 327 + f "readonly %a" pp_args args); 388 328 loop (Exit.value updated) job stdout_of_previous 389 329 rest 390 330 | "local" -> ··· 397 337 in 398 338 loop (Exit.value updated) job stdout_of_previous 399 339 rest 340 + | "exec" -> 341 + Debug.Log.debug (fun f -> 342 + f "exec [%a] [%a]" pp_args args 343 + Fmt.(list Types.pp_redirect) 344 + rdrs); 345 + if args <> [] then 346 + Fmt.invalid_arg 347 + "Exec with args not yet supported..."; 348 + ({ ctx with rdrs }, job) 400 349 | _ -> ( 401 350 let saved_ctx = ctx in 402 351 let func_app = ··· 551 500 } 552 501 end 553 502 503 + and handle_one_redirection ~sw ctx = function 504 + | Ast.IoRedirect_IoFile (n, (op, file)) -> ( 505 + let _ctx, file = word_expansion ctx file in 506 + let file = Ast.Fragment.join_list ~sep:"" file in 507 + match op with 508 + | Io_op_less -> 509 + (* Simple redirection for input *) 510 + let r = Eio.Path.open_in ~sw (ctx.fs / file) in 511 + let fd = Eio_unix.Resource.fd_opt r |> Option.get in 512 + [ Types.Redirect (n, fd, `Blocking) ] 513 + | Io_op_lessand -> ( 514 + match file with 515 + | "-" -> 516 + if n = 0 then [ Types.Close Eio_unix.Fd.stdin ] 517 + else 518 + let fd = fd_of_int ~sw n in 519 + [ Types.Close fd ] 520 + | m when Option.is_some (int_of_string_opt m) -> 521 + let m = int_of_string m in 522 + [ 523 + Types.Redirect 524 + (n, fd_of_int ~close_unix:false ~sw m, `Blocking); 525 + ] 526 + | _ -> []) 527 + | (Io_op_great | Io_op_dgreat) as v -> 528 + (* Simple file creation *) 529 + let append = v = Io_op_dgreat in 530 + let create = 531 + if append then `If_missing (file_creation_mode ctx) 532 + else if ctx.options.noclobber then 533 + `Exclusive (file_creation_mode ctx) 534 + else `Or_truncate (file_creation_mode ctx) 535 + in 536 + Debug.Log.debug (fun f -> 537 + f "Creating file (append:%b, %a): %s" append pp_fs_create create 538 + file); 539 + let w = Eio.Path.open_out ~sw ~append ~create (ctx.fs / file) in 540 + let fd = Eio_unix.Resource.fd_opt w |> Option.get in 541 + [ Types.Redirect (n, fd, `Blocking) ] 542 + | Io_op_greatand -> ( 543 + match file with 544 + | "-" -> 545 + if n = 0 then [ Types.Close Eio_unix.Fd.stdout ] 546 + else 547 + let fd = fd_of_int ~sw n in 548 + [ Types.Close fd ] 549 + | m when Option.is_some (int_of_string_opt m) -> 550 + let m = int_of_string m in 551 + [ 552 + Types.Redirect 553 + (n, fd_of_int ~close_unix:false ~sw m, `Blocking); 554 + ] 555 + | _ -> []) 556 + | Io_op_andgreat -> 557 + (* Yesh, not very POSIX *) 558 + (* Simple file creation *) 559 + let w = 560 + Eio.Path.open_out ~sw 561 + ~create:(`If_missing (file_creation_mode ctx)) 562 + (ctx.fs / file) 563 + in 564 + let fd = Eio_unix.Resource.fd_opt w |> Option.get in 565 + [ 566 + Types.Redirect (1, fd, `Blocking); 567 + Types.Redirect (2, fd, `Blocking); 568 + ] 569 + | Io_op_clobber -> 570 + let w = 571 + Eio.Path.open_out ~sw 572 + ~create:(`Or_truncate (file_creation_mode ctx)) 573 + (ctx.fs / file) 574 + in 575 + let fd = Eio_unix.Resource.fd_opt w |> Option.get in 576 + [ Types.Redirect (n, fd, `Blocking) ] 577 + | Io_op_lessgreat -> Fmt.failwith "<> not support yet.") 578 + | Ast.IoRedirect_IoHere _ -> 579 + Fmt.failwith "HERE documents not yet implemented!" 580 + 581 + and handle_redirections ~sw ctx rdrs = 582 + try Ok (List.concat_map (handle_one_redirection ~sw ctx) rdrs) 583 + with Eio.Io (Eio.Fs.E (Already_exists _), _) -> 584 + Fmt.epr "msh: cannot overwrite existing file\n%!"; 585 + Error ctx 586 + 554 587 and parameter_expansion ctx ast : ctx Exit.t * Ast.fragment list list = 555 588 let get_prefix ~pattern ~kind param = 556 589 let _, prefix = ··· 801 834 in 802 835 expand ctx ast 803 836 837 + and split_fields ifs s = 838 + let v, ls = 839 + String.fold_left 840 + (fun (so_far, ls) c -> 841 + if String.contains ifs c then ("", so_far :: ls) 842 + else (so_far ^ String.make 1 c, ls)) 843 + ("", []) s 844 + in 845 + List.rev (v :: ls) 846 + 804 847 and field_splitting ctx = function 805 848 | [] -> [] 806 - | Ast.{ splittable = true; txt; _ } :: rest -> 807 - (String.split_on_char ' ' txt |> List.map Ast.Fragment.make) 808 - @ field_splitting ctx rest 849 + | Ast.{ splittable = true; txt; globbable; _ } :: rest -> ( 850 + match S.lookup ctx.state ~param:"IFS" with 851 + | Some "" -> [ Ast.Fragment.make ~globbable txt ] 852 + | (None | Some _) as ifs -> 853 + let ifs = Option.value ~default:" \t\n" ifs in 854 + (split_fields ifs txt |> List.map (Ast.Fragment.make ~globbable)) 855 + @ field_splitting ctx rest) 809 856 | txt :: rest -> txt :: field_splitting ctx rest 810 857 811 858 and word_expansion' ctx cst : ctx Exit.t * Ast.fragments list = ··· 1065 1112 match List.assoc_opt name ctx.functions with 1066 1113 | None -> None 1067 1114 | Some commands -> 1115 + Debug.Log.debug (fun f -> 1116 + f "function enter: %s [%a]" name 1117 + Fmt.(list ~sep:Fmt.(any " ") string) 1118 + argv); 1068 1119 let ctx = { ctx with argv = Array.of_list argv } in 1069 - Option.some @@ (handle_compound_command ctx commands >|= fun _ -> ctx) 1120 + let v = 1121 + Option.some @@ (handle_compound_command ctx commands >|= fun _ -> ctx) 1122 + in 1123 + Debug.Log.debug (fun f -> f "function leave: %s" name); 1124 + v 1070 1125 1071 1126 and command_substitution (ctx : ctx) (cc : Ast.complete_commands) = 1072 1127 let exec_subshell ctx s = ··· 1203 1258 | Dot file -> ( 1204 1259 match resolve_program ctx file with 1205 1260 | ctx, None -> Exit.nonzero ctx 127 1206 - | ctx, Some f -> 1207 - let program = Ast.of_file (ctx.fs / f) in 1208 - let ctx, _ = run (Exit.zero ctx) program in 1261 + | ctx, Some fname -> 1262 + Debug.Log.debug (fun f -> f "sourcing..."); 1263 + let program = Ast.of_file (ctx.fs / fname) in 1264 + let ctx, _ = 1265 + run' ~make_process_group:false (Exit.zero ctx) program 1266 + in 1267 + Debug.Log.debug (fun f -> f "finished sourcing %s" fname); 1209 1268 ctx) 1210 1269 | Unset names -> ( 1211 1270 match names with ··· 1289 1348 { ctx.signal_handler with sigint_set = setting_sigint }; 1290 1349 }) 1291 1350 ctx signals 1351 + | Umask None -> 1352 + let str = Fmt.str "0%o\n" ctx.umask in 1353 + Eio.Flow.copy_string str stdout; 1354 + Exit.zero ctx 1355 + | Umask (Some i) -> Exit.zero { ctx with umask = i } 1356 + | Shift n -> 1357 + let n = Option.value ~default:1 n in 1358 + let new_len = Array.length ctx.argv - n in 1359 + assert (new_len >= 0); 1360 + let argv = Array.init new_len (fun i -> Array.get ctx.argv (i + n)) in 1361 + Exit.zero { ctx with argv } 1292 1362 | Command _ -> 1293 1363 (* Handled separately *) 1294 1364 assert false ··· 1322 1392 Exit.zero initial_ctx 1323 1393 1324 1394 and execute ctx ast = exec ctx ast 1395 + and run ctx ast = run' ~make_process_group:true ctx ast 1325 1396 1326 - and run ctx ast = 1397 + and run' ?(make_process_group = true) ctx ast = 1327 1398 (* Make the shell its own process group *) 1328 - Eunix.make_process_group (); 1399 + if make_process_group then Eunix.make_process_group (); 1329 1400 let ctx, cs = 1330 1401 let rec loop_commands (ctx, cs) (c : Ast.complete_commands) = 1331 1402 match c with
+1
src/lib/eval.mli
··· 22 22 ?options:Built_ins.Options.t -> 23 23 ?hash:Hash.t -> 24 24 ?in_double_quotes:bool -> 25 + ?umask:int -> 25 26 fs:Eio.Fs.dir_ty Eio.Path.t -> 26 27 stdin:Eio_unix.source_ty r -> 27 28 stdout:Eio_unix.sink_ty r ->
+2 -1
src/lib/interactive.ml
··· 23 23 | Exit.Nonzero { exit_code; _ } -> 24 24 Fmt.pf ppf "[%a] " (pp_colored `Red Fmt.int) exit_code 25 25 in 26 + let fs = Exit.value ctx |> Eval.fs in 26 27 Fmt.pf Format.str_formatter "%a%a:%s >\n%!" pp_status ctx 27 28 Fmt.(pp_colored `Yellow string) 28 - (Eunix.get_user_and_host ()) 29 + (Eunix.get_user_and_host fs) 29 30 (Fpath.normalize @@ S.cwd state |> subst_tilde |> Fpath.to_string); 30 31 Format.flush_str_formatter () 31 32
+4
src/lib/types.ml
··· 53 53 | Redirect of int * Eio_unix.Fd.t * Eio_unix.Private.Fork_action.blocking 54 54 | Close of Eio_unix.Fd.t 55 55 56 + let pp_redirect ppf = function 57 + | Redirect (i, fd, _) -> Fmt.pf ppf "%i <-> %a" i Eio_unix.Fd.pp fd 58 + | Close fd -> Fmt.pf ppf "close %a" Eio_unix.Fd.pp fd 59 + 56 60 type exec_mode = 57 61 | Switched of Eio.Switch.t 58 62 | Async
+38
test/built_ins.t
··· 290 290 hello 291 291 $ msh test.sh 292 292 hello 293 + 294 + 12. Exec 295 + 296 + Some bits of `exec` (in particular redirects) are supported. 297 + 298 + $ cat > test.sh << EOF 299 + > exec > output.log 300 + > echo hello 301 + > EOF 302 + 303 + $ sh test.sh; cat output.log; rm output.log 304 + hello 305 + $ msh test.sh; cat output.log 306 + hello 307 + 308 + 13. Umask 309 + 310 + $ msh -c "umask; umask 045; umask" 311 + 022 312 + 045 313 + 314 + 14. shift 315 + 316 + $ cat > test.sh << EOF 317 + > echo "args: \$@" 318 + > shift 2 319 + > echo "args 2: \$@" 320 + > echo "args 2: \$#" 321 + > EOF 322 + 323 + $ sh test.sh a b c d 324 + args: a b c d 325 + args 2: c d 326 + args 2: 2 327 + $ msh test.sh a b c d 328 + args: a b c d 329 + args 2: c d 330 + args 2: 2
+1 -1
test/debootstrap/Dockerfile test/docker/Dockerfile.debootstrap
··· 12 12 COPY --from=builder /home/opam/src/_build/default/src/bin/main.exe /bin/msh 13 13 RUN ln -sf /bin/msh /bin/sh 14 14 RUN apt-get update \ 15 - && apt-get install --no-install-recommends --assume-yes debootstrap 15 + && apt-get install --no-install-recommends --assume-yes debootstrap vim 16 16 ENTRYPOINT [ "msh" ]
+92
test/docker/Dockerfile.alpine
··· 1 + FROM ocaml/opam:alpine-ocaml-5.3 AS builder 2 + WORKDIR /home/opam/src 3 + COPY --chown=opam merry.opam . 4 + RUN opam pin . -yn 5 + RUN opam install . --deps-only --with-test 6 + COPY --chown=opam . . 7 + RUN opam exec -- dune build --profile=release 8 + 9 + FROM alpine:3.23 10 + 11 + # Copy across msh as the new shell! 12 + COPY --from=builder /home/opam/src/_build/default/src/bin/main.exe /bin/msh 13 + RUN ln -sf /bin/msh /bin/sh 14 + SHELL [ "/bin/msh", "-c" ] 15 + 16 + LABEL distro_style="apk" 17 + RUN apk update && apk upgrade 18 + RUN apk add build-base bzip2 git tar curl ca-certificates openssl 19 + RUN git config --global user.email "docker@example.com" 20 + RUN git config --global user.name "Docker" 21 + 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 22 + 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 23 + 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 24 + 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 25 + 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 26 + 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 27 + 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 28 + 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 29 + RUN strip /usr/local/bin/opam* 30 + 31 + FROM alpine:3.23 32 + RUN <<-EOF cat >> /etc/apk/repositories 33 + @edge https://dl-cdn.alpinelinux.org/alpine/edge/main 34 + @edgecommunity https://dl-cdn.alpinelinux.org/alpine/edge/community 35 + @testing https://dl-cdn.alpinelinux.org/alpine/edge/testing 36 + EOF 37 + ENV OCAMLRUNPARAM=b 38 + RUN apk update && apk upgrade 39 + RUN apk add build-base patch tar ca-certificates git rsync curl sudo bash libx11-dev nano coreutils xz ncurses-dev bubblewrap 40 + COPY --from=1 [ "/usr/local/bin/opam-2.0", "/usr/bin/opam-2.0" ] 41 + RUN ln /usr/bin/opam-2.0 /usr/bin/opam 42 + COPY --from=1 [ "/usr/local/bin/opam-2.1", "/usr/bin/opam-2.1" ] 43 + COPY --from=1 [ "/usr/local/bin/opam-2.2", "/usr/bin/opam-2.2" ] 44 + COPY --from=1 [ "/usr/local/bin/opam-2.3", "/usr/bin/opam-2.3" ] 45 + COPY --from=1 [ "/usr/local/bin/opam-2.4", "/usr/bin/opam-2.4" ] 46 + COPY --from=1 [ "/usr/local/bin/opam-2.5", "/usr/bin/opam-2.5" ] 47 + COPY --from=1 [ "/usr/local/bin/opam-master", "/usr/bin/opam-dev" ] 48 + RUN addgroup -S -g 1000 opam 49 + RUN adduser -S -u 1000 -G opam opam 50 + COPY <<-EOF /etc/sudoers.d/opam 51 + opam ALL=(ALL:ALL) NOPASSWD:ALL 52 + EOF 53 + RUN chmod 440 /etc/sudoers.d/opam 54 + RUN chown root:root /etc/sudoers.d/opam 55 + RUN sed -i.bak 's/^Defaults.*requiretty//g' /etc/sudoers 56 + USER opam 57 + WORKDIR /home/opam 58 + RUN mkdir .ssh 59 + RUN chmod 700 .ssh 60 + COPY --chown=opam <<-EOF /home/opam/.opamrc-nosandbox 61 + wrap-build-commands: [] 62 + wrap-install-commands: [] 63 + wrap-remove-commands: [] 64 + required-tools: [] 65 + EOF 66 + COPY --chown=opam <<-EOF /home/opam/opam-sandbox-disable 67 + #!/bin/sh 68 + cp ~/.opamrc-nosandbox ~/.opamrc 69 + echo --- opam sandboxing disabled 70 + EOF 71 + RUN chmod a+x /home/opam/opam-sandbox-disable 72 + RUN sudo mv /home/opam/opam-sandbox-disable /usr/bin/opam-sandbox-disable 73 + COPY --chown=opam <<-EOF /home/opam/.opamrc-sandbox 74 + wrap-build-commands: ["%{hooks}%/sandbox.sh" "build"] 75 + wrap-install-commands: ["%{hooks}%/sandbox.sh" "install"] 76 + wrap-remove-commands: ["%{hooks}%/sandbox.sh" "remove"] 77 + EOF 78 + COPY --chown=opam <<-EOF /home/opam/opam-sandbox-enable 79 + #!/bin/sh 80 + cp ~/.opamrc-sandbox ~/.opamrc 81 + echo --- opam sandboxing enabled 82 + EOF 83 + RUN chmod a+x /home/opam/opam-sandbox-enable 84 + RUN sudo mv /home/opam/opam-sandbox-enable /usr/bin/opam-sandbox-enable 85 + RUN git config --global user.email "docker@example.com" 86 + RUN git config --global user.name "Docker" 87 + COPY --link --chown=opam:opam [ ".", "/home/opam/opam-repository" ] 88 + RUN opam-sandbox-disable 89 + RUN opam init -k git -a /home/opam/opam-repository --bare 90 + RUN echo 'archive-mirrors: "https://opam.ocaml.org/cache"' >> ~/.opam/config 91 + RUN rm -rf .opam/repo/default/.git 92 +
+15
test/docker/Dockerfile.alpine-simple
··· 1 + FROM ocaml/opam:alpine-ocaml-5.3 AS builder 2 + WORKDIR /home/opam/src 3 + COPY --chown=opam merry.opam . 4 + RUN opam pin . -yn 5 + RUN opam install . --deps-only --with-test 6 + COPY --chown=opam . . 7 + RUN opam exec -- dune build --profile=release 8 + 9 + FROM ocaml/opam:alpine-ocaml-5.3 10 + 11 + # Copy across msh as the new shell! 12 + COPY --from=builder /home/opam/src/_build/default/src/bin/main.exe /bin/msh 13 + RUN sudo ln -sf /bin/msh /bin/sh 14 + SHELL [ "/bin/msh", "-c" ] 15 + ENTRYPOINT [ "/bin/msh" ]
+2 -2
test/wordexp.ml
··· 82 82 83 83 let test_argv_expansion env () = 84 84 let cargs = W.[ name "echo"; var "@" ] in 85 - with_default_ctx ~args:[ "echo"; "a"; "b"; "c" ] env @@ fun ctx -> 86 - let expected = frags [ "echo"; "a"; "b"; "c" ] in 85 + with_default_ctx ~args:[ "echo"; "a"; "b"; "c d" ] env @@ fun ctx -> 86 + let expected = frags [ "echo"; "a"; "b"; "c"; "d" ] in 87 87 let actual = expand ctx cargs in 88 88 Alcotest.check fragments "same fragments" expected actual 89 89