diff --git a/src/lib/built_ins.ml b/src/lib/built_ins.ml index 5d7effb..a23db9f 100644 --- a/src/lib/built_ins.ml +++ b/src/lib/built_ins.ml @@ -196,24 +196,21 @@ module Hash = struct end module Command = struct - open Cmdliner - - let args = - let doc = "Arguments to command." in - Arg.(value & pos_all string [] & info [] ~docv:"ARGS" ~doc) - - let print_command = - let doc = "Write a string to stdout of the command we would use." in - Arg.(value & flag & info [ "v"; "V" ] ~docv:"V" ~doc) - - let t = - let make_command print_command args = Command { print_command; args } in - let term = Term.(const make_command $ print_command $ args) in - let info = - let doc = "Execute a simple command." in - Cmd.info "command" ~doc + (* Given the nature of how command works, we need to parse the strings + of the arguments by ourself. *) + + let of_strings args = + let any_flags, args = + let rec loop acc = function + | [] -> (acc, []) + | arg :: args -> + if String.starts_with ~prefix:"-" arg then loop (arg :: acc) args + else (List.rev acc, arg :: args) + in + loop [] args in - Cmd.v info term + let print_command = List.mem "-v" any_flags in + Some (Ok (Command { args; print_command })) end module Make_dot (T : sig @@ -281,7 +278,7 @@ let of_args (w : string list) = | "." :: _ as cmd -> exec_cmd cmd Dot.t | "unset" :: _ as cmd -> exec_cmd cmd Unset.t | "hash" :: _ as cmd -> exec_cmd cmd Hash.t - | "command" :: _ as cmd -> exec_cmd cmd Command.t + | "command" :: cmd -> Command.of_strings cmd | "alias" :: _ -> Some (Ok Alias) | "unalias" :: _ -> Some (Ok Unalias) | "eval" :: _ as cmd -> exec_cmd cmd Eval.t diff --git a/src/lib/eval.ml b/src/lib/eval.ml index 1d8183f..79d213b 100644 --- a/src/lib/eval.ml +++ b/src/lib/eval.ml @@ -235,8 +235,7 @@ module Make (S : Types.State) (E : Types.Exec) = struct let s_len = String.length s in if s.[0] = '"' && s.[s_len - 1] = '"' then String.sub s 1 (s_len - 2) else s - let rec handle_pipeline ~async initial_ctx pipeline_switch p : ctx Exit.t = - let mode = if async then Types.Async else Types.Switched pipeline_switch in + let rec handle_pipeline ~async initial_ctx p : ctx Exit.t = let set_last_background ~async process ctx = if async then { ctx with last_background_process = string_of_int (E.pid process) } @@ -248,20 +247,26 @@ module Make (S : Types.State) (E : Types.Exec) = struct | None -> ctx | Some process -> set_last_background ~async process ctx in - let handle_job ~pgid j p = - match (j, p) with - | None, _ -> - Option.some @@ J.make ~state:`Running pgid (Nlist.Singleton p) - | Some j, `Process p -> Option.some @@ J.add_process p j - | Some j, `Built_in p -> Option.some @@ J.add_built_in p j - | Some j, `Error p -> Option.some @@ J.add_error p j + let handle_job j p = + match p with + (* | None, _ -> *) + (* let pgid = match pgid with Some p -> p | None -> Unix.getpid () in *) + (* Option.some *) + (* @@ J.make ~state:`Running ~reap:(Option.get reap) pgid *) + (* (Nlist.Singleton p) *) + | `Process p -> J.add_process p j + | `Built_in p -> J.add_built_in p j + | `Error p -> J.add_error p j in let close_stdout ~is_global some_write = if not is_global then begin Eio.Flow.close some_write end in - let exec_process ctx job ?fds ?stdin ~stdout ~pgid executable args = + let exec_process ~sw ctx job ?fds ?stdin ~stdout ?pgid executable args = + let pgid = match pgid with None -> 0 | Some p -> p in + let reap = J.get_reaper job in + let mode = if async then Types.Async else Types.Switched sw in let ctx, process = match (executable, resolve_program ctx executable) with | _, (ctx, None) | "", (ctx, _) -> @@ -274,32 +279,36 @@ module Make (S : Types.State) (E : Types.Exec) = struct (ctx, Error (127, `Not_found)) | _, (ctx, Some full_path) -> ( ctx, - E.exec ctx.executor ?fds ?stdin ~stdout ~pgid ~mode - ~cwd:(cwd_of_ctx ctx) + E.exec ctx.executor ~delay_reap:(fst reap) ?fds ?stdin ~stdout + ~pgid ~mode ~cwd:(cwd_of_ctx ctx) ~env:(get_env ~extra:ctx.local_state ctx) ~executable:full_path (executable :: args) ) in match process with | Error (n, _) -> - let job = handle_job ~pgid job (`Error n) in + let job = handle_job job (`Error n) in (on_process ~async ctx, job) | Ok process -> - let job = handle_job ~pgid job (`Process process) in + let pgid = if Int.equal pgid 0 then E.pid process else pgid in + let job = + handle_job job (`Process process) |> fun j -> { j with id = pgid } + in (on_process ~async ~process ctx, job) in - let rec loop (ctx : ctx) (job : J.t option) - ((pgid, stdout_of_previous) : - int * Eio_unix.source_ty Eio_unix.source option) : - Ast.command list -> ctx * J.t option = + let job_pgid (t : J.t) = t.id in + let rec loop pipeline_switch (ctx : ctx) (job : J.t) + (stdout_of_previous : Eio_unix.source_ty Eio_unix.source option) : + Ast.command list -> ctx * J.t = fun c -> + let loop = loop pipeline_switch in match c with | Ast.SimpleCommand (Prefixed (prefix, None, _suffix)) :: rest -> let ctx = collect_assignments ctx prefix in - loop ctx job (pgid, stdout_of_previous) rest + loop ctx job stdout_of_previous rest | Ast.SimpleCommand (Prefixed (prefix, Some executable, suffix)) :: rest -> let ctx = collect_assignments ~update:false ctx prefix in - loop ctx job (pgid, stdout_of_previous) + loop ctx job stdout_of_previous (Ast.SimpleCommand (Named (executable, suffix)) :: rest) | Ast.SimpleCommand (Named (executable, suffix)) :: rest -> ( let ctx, executable = expand_cst ctx executable in @@ -345,7 +354,7 @@ module Make (S : Types.State) (E : Types.Exec) = struct in match Built_ins.of_args (executable :: args_as_strings) with | Some (Error _) -> - (ctx, handle_job ~pgid job (`Built_in (Exit.nonzero () 1))) + (ctx, handle_job job (`Built_in (Exit.nonzero () 1))) | (None | Some (Ok (Command _))) as v -> ( let is_command, command_args, print_command = match v with @@ -359,9 +368,9 @@ module Make (S : Types.State) (E : Types.Exec) = struct | "export" -> let updated = handle_export ctx args in let job = - handle_job ~pgid job (`Built_in (updated >|= fun _ -> ())) + handle_job job (`Built_in (updated >|= fun _ -> ())) in - loop (Exit.value updated) job (pgid, stdout_of_previous) rest + loop (Exit.value updated) job stdout_of_previous rest | _ -> ( let saved_ctx = ctx in let func_app = @@ -376,23 +385,21 @@ module Make (S : Types.State) (E : Types.Exec) = struct close_stdout ~is_global some_write; (* TODO: Proper job stuff and redirects etc. *) let job = - handle_job ~pgid job (`Built_in (ctx >|= fun _ -> ())) + handle_job job (`Built_in (ctx >|= fun _ -> ())) in - loop saved_ctx job (pgid, some_read) rest + loop saved_ctx job some_read rest | None -> ( match Built_ins.of_args command_args with | Some (Error _) -> - ( ctx, - handle_job ~pgid job (`Built_in (Exit.nonzero () 1)) - ) + (ctx, handle_job job (`Built_in (Exit.nonzero () 1))) | Some (Ok bi) -> let ctx = handle_built_in ~rdrs ~stdout:some_write ctx bi in close_stdout ~is_global some_write; let built_in = ctx >|= fun _ -> () in - let job = handle_job ~pgid job (`Built_in built_in) in - loop (Exit.value ctx) job (pgid, some_read) rest + let job = handle_job job (`Built_in built_in) in + loop (Exit.value ctx) job some_read rest | _ -> ( let exec_and_args = if is_command then begin @@ -412,69 +419,57 @@ module Make (S : Types.State) (E : Types.Exec) = struct match exec_and_args with | Exit.Nonzero _ as v -> let job = - handle_job ~pgid job - (`Built_in (v >|= fun _ -> ())) + handle_job job (`Built_in (v >|= fun _ -> ())) in - loop ctx job (pgid, some_read) rest + loop ctx job some_read rest | Exit.Zero (executable, args) -> ( match stdout_of_previous with | None -> let ctx, job = - exec_process ctx job ~fds:rdrs - ~stdout:some_write ~pgid executable args + exec_process ~sw:pipeline_switch ctx job + ~fds:rdrs ~stdout:some_write + ~pgid:(job_pgid job) executable args in close_stdout ~is_global some_write; - loop ctx job (pgid, some_read) rest + loop ctx job some_read rest | Some stdout -> let ctx, job = - exec_process ctx job ~fds:rdrs ~stdin:stdout - ~stdout:some_write ~pgid executable + exec_process ~sw:pipeline_switch ctx job + ~fds:rdrs ~stdin:stdout ~stdout:some_write + ~pgid:(job_pgid job) executable args_as_strings in close_stdout ~is_global some_write; - loop ctx job (pgid, some_read) rest))))) + loop ctx job some_read rest))))) | Some (Ok bi) -> let ctx = handle_built_in ~rdrs ~stdout:some_write ctx bi in close_stdout ~is_global some_write; let built_in = ctx >|= fun _ -> () in - let job = handle_job ~pgid job (`Built_in built_in) in - loop (Exit.value ctx) job (pgid, some_read) rest) + let job = handle_job job (`Built_in built_in) in + loop (Exit.value ctx) job some_read rest) | CompoundCommand (c, rdrs) :: rest -> let _rdrs = List.map (handle_one_redirection ~sw:pipeline_switch ctx) rdrs in (* TODO: No way this is right *) let ctx = handle_compound_command ctx c in - let job = handle_job ~pgid job (`Built_in (ctx >|= fun _ -> ())) in - loop (Exit.value ctx) job (pgid, None) rest + let job = handle_job job (`Built_in (ctx >|= fun _ -> ())) in + loop (Exit.value ctx) job None rest | FunctionDefinition (name, (body, _rdrs)) :: rest -> let ctx = { ctx with functions = (name, body) :: ctx.functions } in - loop ctx job (pgid, None) rest + loop ctx job None rest | [] -> (clear_local_state ctx, job) in (* HACK: when running the pipeline, we need a process group to put everything in. Eio's model of execution is nice, but we cannot safely delay execution of a process. So instead we create a ghost process that last just until all of the processes are setup. *) - let ctx, job = - let ghost_process = - match resolve_program ~update:false initial_ctx "sleep" with - | _, None -> Fmt.failwith "Sleep not found\n%!" - | ctx, Some sleep -> ( - E.exec ~mode:(Types.Switched pipeline_switch) ~pgid:0 - ~cwd:(cwd_of_ctx ctx) ctx.executor ~executable:sleep - [ "sleep"; "99999999" ] - |> function - | Ok p -> p - | Error (n, `Not_found) -> - Fmt.epr "Interal error ghost process: not found"; - exit n) - in - loop initial_ctx None (E.pid ghost_process, None) p - in - match job with - | None -> Exit.zero ctx - | Some job -> + Eio.Switch.run @@ fun sw -> + let initial_job = J.make 0 [] in + let ctx, job = loop sw initial_ctx initial_job None p in + match job.processes with + | [] -> Exit.zero ctx + | _ :: _ -> if not async then begin J.await_exit ~pipefail:false ~interactive:ctx.interactive job >|= fun () -> ctx @@ -670,7 +665,7 @@ module Make (S : Types.State) (E : Types.Exec) = struct expand_redirects (ctx, v :: acc) rest | s :: rest -> expand_redirects (ctx, s :: acc) rest - and handle_and_or ~sw ~async ctx c = + and handle_and_or ~sw:_ ~async ctx c = let pipeline = function | Ast.Pipeline p -> (Fun.id, p) | Ast.Pipeline_Bang p -> (Exit.not, p) @@ -684,33 +679,33 @@ module Make (S : Types.State) (E : Types.Exec) = struct match exit_so_far with | Exit.Zero ctx -> let f, p = pipeline p in - f @@ handle_pipeline ~async ctx sw p + f @@ handle_pipeline ~async ctx p | v -> v) | Or, Nlist.Singleton (p, _) -> ( match exit_so_far with | Exit.Zero _ as ctx -> ctx | _ -> let f, p = pipeline p in - f @@ handle_pipeline ~async ctx sw p) + f @@ handle_pipeline ~async ctx p) | Noand_or, Nlist.Singleton (p, _) -> let f, p = pipeline p in - f @@ handle_pipeline ~async ctx sw p + f @@ handle_pipeline ~async ctx p | Noand_or, Nlist.Cons ((p, next_sep), rest) -> let f, p = pipeline p in - let exit_status = f (handle_pipeline ~async ctx sw p) in + let exit_status = f (handle_pipeline ~async ctx p) in fold (next_sep, exit_status) rest | And, Nlist.Cons ((p, next_sep), rest) -> ( match exit_so_far with | Exit.Zero ctx -> let f, p = pipeline p in - fold (next_sep, f (handle_pipeline ~async ctx sw p)) rest + fold (next_sep, f (handle_pipeline ~async ctx p)) rest | Exit.Nonzero _ as v -> v) | Or, Nlist.Cons ((p, next_sep), rest) -> ( match exit_so_far with | Exit.Zero _ as exit_so_far -> fold (next_sep, exit_so_far) rest | Exit.Nonzero _ -> let f, p = pipeline p in - fold (next_sep, f (handle_pipeline ~async ctx sw p)) rest) + fold (next_sep, f (handle_pipeline ~async ctx p)) rest) in fold (Noand_or, Exit.zero ctx) c diff --git a/src/lib/job.ml b/src/lib/job.ml index 314cade..d614fcf 100644 --- a/src/lib/job.ml +++ b/src/lib/job.ml @@ -1,27 +1,31 @@ -open Import - module Make (E : Types.Exec) = struct type t = { state : [ `Running ]; + reap : unit Eio.Promise.t * unit Eio.Promise.u; id : int; (* Process list is in reverse order *) processes : - [ `Process of E.process | `Built_in of unit Exit.t | `Error of int ] - Nlist.t; + [ `Process of E.process | `Built_in of unit Exit.t | `Error of int ] list; } - let make ?(state = `Running) id processes = { state; id; processes } + let get_reaper t = t.reap + + let make ?(state = `Running) id processes = + let reap = Eio.Promise.create () in + { state; id; processes; reap } let add_process proc t = - { t with processes = Nlist.cons (`Process proc) t.processes } + { t with processes = List.cons (`Process proc) t.processes } let add_built_in b t = - { t with processes = Nlist.cons (`Built_in b) t.processes } + { t with processes = List.cons (`Built_in b) t.processes } - let add_error b t = { t with processes = Nlist.cons (`Error b) t.processes } + let add_error b t = { t with processes = List.cons (`Error b) t.processes } (* Section 2.9.2 https://pubs.opengroup.org/onlinepubs/9799919799/ *) let await_exit ~pipefail ~interactive t = + Eio.Promise.resolve (snd t.reap) (); + Eio.Fiber.yield (); let await = function | `Process p -> if interactive then @@ -30,7 +34,7 @@ module Make (E : Types.Exec) = struct | `Built_in b -> b | `Error n -> Exit.nonzero () n in - match pipefail with - | false -> await (Nlist.hd t.processes) - | _ -> Fmt.failwith "TODO: pipefail" + match (pipefail, t.processes) with + | false, x :: _ -> await x + | _ -> Fmt.failwith "TODO: pipefail or no processes" end diff --git a/src/lib/posix/exec.ml b/src/lib/posix/exec.ml index 1d3ba72..690367f 100644 --- a/src/lib/posix/exec.ml +++ b/src/lib/posix/exec.ml @@ -70,7 +70,7 @@ module Process = struct | Merry.Types.Async -> () | Merry.Types.Switched sw -> f sw - let spawn ~mode actions = + let spawn ?delay_reap ~mode actions = with_pipe @@ fun errors_r errors_w -> Eio_unix.Private.Fork_action.with_actions actions @@ fun c_actions -> iter_switch ~f:Switch.check mode; @@ -98,6 +98,7 @@ module Process = struct reap t set_exit_status) in Fiber.fork_daemon ~sw (fun () -> + Option.iter Eio.Promise.await delay_reap; reap t set_exit_status; Switch.remove_hook hook; `Stop_daemon)) @@ -207,8 +208,8 @@ let inherit_fds m = Eio_unix.Private.Fork_action. { run = (fun k -> k (Obj.repr (action_dups, plan, blocking))) } -let spawn_unix () ~mode ~fork_actions ?pgid ?uid ?gid ~env ~fds ~executable ~cwd - args = +let spawn_unix () ?delay_reap ~mode ~fork_actions ?pgid ?uid ?gid ~env ~fds + ~executable ~cwd args = let open Eio_posix in let actions = [ @@ -248,7 +249,8 @@ let spawn_unix () ~mode ~fork_actions ?pgid ?uid ?gid ~env ~fds ~executable ~cwd in fn (Low_level.Process.Fork_action.fchdir cwd :: actions) in - with_actions cwd @@ fun actions -> process (Process.spawn ~mode actions) + with_actions cwd @@ fun actions -> + process (Process.spawn ?delay_reap ~mode actions) let fd_equal_int fd i = Eio_unix.Fd.use_exn "fd_equal_int" fd @@ fun ufd -> @@ -257,8 +259,8 @@ let fd_equal_int fd i = let pp_redirections ppf (i, fd, _) = Fmt.pf ppf "(%i,%a)" i Eio_unix.Fd.pp fd -let run ~mode _ ?stdin ?stdout ?stderr ?(fds = []) ?(fork_actions = []) ~pgid - ~cwd ?env ?executable args = +let run ~mode ?delay_reap _ ?stdin ?stdout ?stderr ?(fds = []) + ?(fork_actions = []) ~pgid ~cwd ?env ?executable args = with_close_list @@ fun to_close -> let check_fd n = function | Merry.Types.Redirect (m, _, _) -> Int.equal n m @@ -302,4 +304,5 @@ let run ~mode _ ?stdin ?stdout ?stderr ?(fds = []) ?(fork_actions = []) ~pgid let fds = std_fds @ fds in let executable = get_executable executable ~args in let env = get_env env in - spawn_unix ~mode ~fork_actions ~cwd ~pgid ~fds ~env ~executable () args + spawn_unix ?delay_reap ~mode ~fork_actions ~cwd ~pgid ~fds ~env ~executable () + args diff --git a/src/lib/posix/merry_posix.ml b/src/lib/posix/merry_posix.ml index 2f3cacd..e7e1f8d 100644 --- a/src/lib/posix/merry_posix.ml +++ b/src/lib/posix/merry_posix.ml @@ -15,8 +15,8 @@ module Exec = struct | `Exited n -> Merry.Exit.nonzero () n | `Signaled n -> Merry.Exit.nonzero () n - let exec ?(fork_actions = []) ?(fds = []) ?stdin ?stdout ?stderr ?env ~mode - ~pgid ~cwd ~executable t args = + let exec ?delay_reap ?(fork_actions = []) ?(fds = []) ?stdin ?stdout ?stderr + ?env ~mode ~pgid ~cwd ~executable t args = let env = Option.map (fun lst -> List.map (fun (a, b) -> a ^ "=" ^ b) lst |> Array.of_list) @@ -24,8 +24,8 @@ module Exec = struct in try Ok - (Exec.run ~fork_actions ~mode ~fds ~pgid ~cwd ?stdin ?stdout ?stderr - ?env t ~executable args) + (Exec.run ?delay_reap ~fork_actions ~mode ~fds ~pgid ~cwd ?stdin ?stdout + ?stderr ?env t ~executable args) with Eio.Io (Eio.Process.E (Eio.Process.Executable_not_found m), _ctx) -> Fmt.epr "msh: command not found: %s\n%!" m; Error (127, `Not_found) diff --git a/src/lib/types.ml b/src/lib/types.ml index 3dac835..806ec6c 100644 --- a/src/lib/types.ml +++ b/src/lib/types.ml @@ -61,6 +61,7 @@ module type Exec = sig val pid : process -> int val exec : + ?delay_reap:unit Eio.Promise.t -> ?fork_actions:Eio_unix__.Fork_action.t list -> ?fds:redirect list -> ?stdin:_ Eio.Flow.source ->