(*----------------------------------------------------------------- Copyright (c) 2025 The merry programmers. All rights reserved. SPDX-License-Identifier: ISC -----------------------------------------------------------------*) 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" let make_child_rdrs_for_parent = List.map (function | Types.Child_redirect (a, b, c) -> Types.Parent_redirect (a, b, c) | v -> v) (** 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). It starts from point (4), completing a series of expansions on the AST, then redirection is setup, and finally functions/built-ins/commands are executed. *) module J = Job.Make (E) module A = Arith.Make (S) type signal_handler = { run : (unit -> unit) -> unit; sigint_set : bool } type ctx = { interactive : bool; subshell : bool; state : S.t; local_state : (string * string) list; executor : E.t; fs : Eio.Fs.dir_ty Eio.Path.t; options : Built_ins.Options.t; stdin : Eio_unix.source_ty Eio.Flow.source; stdout : Eio_unix.sink_ty Eio.Flow.sink; background_jobs : J.t list; last_background_process : string; last_pipeline_status : int option; async_switch : Eio.Switch.t; program : string; argv : string array; functions : (string * Ast.compound_command) list; hash : Hash.t; rdrs : Types.redirect list; signal_handler : signal_handler; exit_handler : (unit -> unit) option; in_double_quotes : bool; umask : int; fd_pool : Fd_pool.t; } exception Continue of int * ctx (* Used for the [continue] non-POSIX keyword *) exception Break of int * ctx (* Used for the [break] non-POSIX keyword *) exception Return of ctx Exit.t (* Used for the [return] non-POSIX keyword *) let make_ctx ?(interactive = false) ?(subshell = false) ?(local_state = []) ?(background_jobs = []) ?(last_background_process = "") ?last_pipeline_status ?(functions = []) ?(rdrs = []) ?exit_handler ?(options = Built_ins.Options.default) ?(hash = Hash.empty) ?(in_double_quotes = false) ?(umask = 0o22) ~fs ~stdin ~stdout ~async_switch ~program ~argv ~signal_handler state executor = let signal_handler = { run = signal_handler; sigint_set = false } in { interactive; subshell; state; local_state; executor; fs; options; stdin; stdout; background_jobs; last_background_process; last_pipeline_status; async_switch; program; argv; functions; hash; rdrs; signal_handler; exit_handler; in_double_quotes; umask; fd_pool = Fd_pool.make 256; } let state ctx = ctx.state let sigint_set ctx = ctx.signal_handler.sigint_set let fs ctx = ctx.fs let clear_local_state ctx = { ctx with local_state = [] } let tilde_expansion ctx = function | Ast.WordTildePrefix _ -> Ast.WordTildePrefix (S.expand ctx.state `Tilde) | v -> v let word_cst_to_string ?field_splitting v = Ast.word_components_to_strings ?field_splitting v |> String.concat "" let arithmetic_expansion ctx word = let expr = word_cst_to_string word in let aexpr = Arith_parser.main Arith_lexer.read (Lexing.from_string expr) in let state, i = A.eval ctx.state aexpr in ({ ctx with state }, Ast.Fragment.make (string_of_int i)) let stdout_for_pipeline ~sw ctx = function | [] -> (None, `Global ctx.stdout) | _ -> let r, w = Fd_pool.pipe ctx.fd_pool sw in (Some r, `Local (w :> Eio_unix.sink_ty Eio.Flow.sink)) let fd_of_int ?(close_unix = true) ~sw (n : int) = Eio_unix.Fd.of_unix ~close_unix ~sw (Obj.magic n : Unix.file_descr) 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 = let v = if not (String.contains name '/') then begin S.lookup ctx.state ~param:"PATH" |> Option.value ~default:"/bin:/usr/bin" |> String.split_on_char ':' |> List.find_map (fun dir -> let p = Filename.concat dir name in if Sys.file_exists p then Some p else None) end else if Sys.file_exists name then Some name else None in match (update, v) with | true, Some loc -> let hash = Hash.add ~utility:name ~loc ctx.hash in ({ ctx with hash }, Some loc) | false, Some loc -> (ctx, Some loc) | _, None -> (ctx, None) let get_env ?(extra = []) ctx = let extra = extra @ List.map (fun (k, v) -> (k, v)) @@ S.exports ctx.state in let env = Eunix.env () in List.fold_left (fun acc (k, _) -> List.remove_assoc k acc) env extra |> List.append extra let update ?export ?readonly ctx ~param v = match S.update ?export ?readonly ctx.state ~param v with | Ok state -> Exit.zero { ctx with state } | Error msg -> Fmt.epr "%s\n%!" msg; Exit.nonzero ctx 1 let remove_quotes s = let s_len = String.length s in let s = if s.[0] = '"' then String.sub s 1 (s_len - 1) else s in let s_len = String.length s in if s.[s_len - 1] = '"' then String.sub s 0 (s_len - 1) else s let exit ctx code = Option.iter (fun f -> f ()) ctx.exit_handler; exit code 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) } else ctx in let on_process ?process ~async ctx = let ctx = clear_local_state ctx in match process with | None -> ctx | Some process -> set_last_background ~async process ctx in let handle_job j = function | `Process p -> J.add_process p j | `Rdr p -> J.add_rdr p j | `Built_in p -> J.add_built_in p j | `Error p -> J.add_error p j | `Exit p -> J.add_exit 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 ~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 fds = ctx.rdrs @ Option.value ~default:[] fds in let ctx, process = match (executable, resolve_program ctx executable) with | _, (ctx, None) | "", (ctx, _) -> Eio.Flow.copy_string (Fmt.str "msh: command not found: %s\n" executable) stdout; (ctx, Error (127, `Not_found)) | _, (ctx, Some full_path) -> Debug.Log.debug (fun f -> f "executing %a\n%a" Fmt.(list ~sep:(Fmt.any " ") (quote string)) (full_path :: args) Fmt.(list Types.pp_redirect) fds); ( 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 job (`Error n) in (on_process ~async ctx, job) | Ok process -> let pgid = if Int.equal pgid 0 then E.pid process else pgid in let job = handle_job job (`Process process) |> J.set_id pgid in (on_process ~async ~process ctx, job) in let job_pgid (t : J.t) = J.get_id t 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 -> Debug.Log.debug (fun f -> f "assignment-only: %a" yojson_pp (Ast.cmd_prefix_to_yojson prefix)); let ctx = collect_assignments ctx prefix in let job = handle_job job (`Built_in (Exit.ignore ctx)) in loop (Exit.value ctx) job stdout_of_previous rest | Ast.SimpleCommand (Prefixed (prefix, Some executable, suffix)) :: rest -> let ctx = collect_assignments ~update:false ctx prefix in let job = handle_job job (`Built_in (Exit.ignore ctx)) in loop (Exit.value ctx) job stdout_of_previous (Ast.SimpleCommand (Named (executable, suffix)) :: rest) | Ast.SimpleCommand (Named (executable, suffix)) :: rest -> ( let ctx, executable = word_expansion ctx executable in match ctx with | Exit.Nonzero _ as ctx -> let job = handle_job job (`Built_in (Exit.ignore ctx)) in loop (Exit.value ctx) job stdout_of_previous rest | Exit.Zero ctx -> ( let executable, extra_args = (* This is a side-effect of the alias command with something like alias ls="ls -la" *) match Ast.Fragment.join_list ~sep:"" (List.concat executable) |> String.split_on_char ' ' |> List.map Ast.Fragment.make with | [] -> ("", []) | exec :: args -> ( remove_quotes exec.txt, List.map (fun v -> Ast.Suffix_word [ Ast.WordLiteral (remove_quotes v.Ast.txt) ]) args ) in let ctx, suffix = match suffix with | None -> (ctx, []) | Some suffix -> expand_redirects (ctx, []) suffix in let ctx, args = args ctx (extra_args @ suffix) in match ctx with | Exit.Nonzero _ as ctx -> let job = handle_job job (`Built_in (Exit.ignore ctx)) in loop (Exit.value ctx) job stdout_of_previous rest | Exit.Zero ctx -> ( let some_read, some_write = stdout_for_pipeline ~sw:pipeline_switch ctx rest in let is_global, some_write = match some_write with | `Global p -> (true, p) | `Local p -> (false, p) in let rdrs = List.fold_left (fun acc -> function | Ast.Suffix_word _ -> acc | Ast.Suffix_redirect rdr -> rdr :: acc) [] suffix |> List.rev in match handle_redirections ~sw: (if String.equal executable "exec" then ctx.async_switch else pipeline_switch) ctx rdrs with | Error ctx -> (ctx, handle_job job (`Rdr (Exit.nonzero () 1))) | Ok rdrs -> ( match Built_ins.of_args (executable :: args) with | Some (Error _) -> (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 | Some (Ok (Command { print_command; args })) -> (true, args, print_command) | _ -> (false, [], false) in (* We handle the [export] built_in explicitly as we need access to the raw CST *) match executable with | "export" -> let updated = handle_assignments `Export ctx args in let job = 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" -> let updated = handle_assignments `Readonly ctx args in let job = 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" -> let updated = handle_assignments `Local ctx args in let job = handle_job job (`Built_in (updated >|= fun _ -> ())) in loop (Exit.value updated) job stdout_of_previous rest | "exec" -> (* let _ = Sys.command "ls -la /proc/self/fd" in *) Debug.Log.debug (fun f -> f "exec [%a] [%a]" pp_args args Fmt.(list Types.pp_redirect) rdrs); let rdrs = make_child_rdrs_for_parent rdrs in Eunix.with_redirections ~restore:false rdrs @@ fun () -> if args <> [] then Fmt.invalid_arg "Exec with args not yet supported..."; (ctx, job) | ":" -> (ctx, job) | _ -> ( let saved_ctx = ctx in let func_app = if is_command then None else let ctx = { ctx with stdout = some_write } in handle_function_application ctx ~name:executable (ctx.program :: args) in match func_app with | Some ctx -> close_stdout ~is_global some_write; (* TODO: Proper job stuff and redirects etc. *) let job = handle_job job (`Built_in (Exit.ignore ctx)) in loop { saved_ctx with state = (Exit.value ctx).state; } job some_read rest | None -> ( match Built_ins.of_args command_args with | Some (Error _) -> ( ctx, handle_job job (`Built_in (Exit.nonzero () 1)) ) | Some (Ok bi) -> let rdrs = make_child_rdrs_for_parent rdrs in let ctx = handle_built_in ~rdrs ~stdout:some_write ctx bi in let ctx = ctx >|= fun ctx -> clear_local_state ctx in close_stdout ~is_global some_write; let job = match bi with | Built_ins.Exit _ -> let v_ctx = Exit.value ctx in if not v_ctx.subshell then exit v_ctx (Exit.code ctx) else handle_job job (`Exit (Exit.ignore ctx)) | _ -> handle_job job (`Built_in (Exit.ignore ctx)) in loop (Exit.value ctx) job some_read rest | _ -> ( let exec_and_args = if is_command then begin match command_args with | [] -> assert false | x :: xs -> ( match resolve_program ~update:false ctx x with | _, None -> Exit.nonzero ("", []) 1 | _, Some prog -> if print_command then Exit.zero ("echo", [ prog ]) else Exit.zero (x, xs)) end else Exit.zero (executable, args) in match exec_and_args with | Exit.Nonzero _ as v -> let job = handle_job job (`Built_in (Exit.ignore v)) in loop ctx job some_read rest | Exit.Zero (executable, args) -> ( match stdout_of_previous with | None -> let ctx, job = 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 some_read rest | Some stdout -> let ctx, job = exec_process ~sw:pipeline_switch ctx job ~fds:rdrs ~stdin:stdout ~stdout:some_write ~pgid:(job_pgid job) executable args in close_stdout ~is_global some_write; loop ctx job some_read rest))))) | Some (Ok bi) -> let rdrs = make_child_rdrs_for_parent rdrs in let ctx = handle_built_in ~rdrs ~stdout:some_write ctx bi in let ctx = ctx >|= fun ctx -> clear_local_state ctx in close_stdout ~is_global some_write; let job = match bi with | Built_ins.Exit _ -> let v_ctx = Exit.value ctx in if not v_ctx.subshell then begin if (Exit.value ctx).interactive then Fmt.pr "exit\n%!"; exit v_ctx (Exit.code ctx) end else handle_job job (`Exit (Exit.ignore ctx)) | _ -> handle_job job (`Built_in (Exit.ignore ctx)) in loop (Exit.value ctx) job some_read rest)))) | CompoundCommand (c, rdrs) :: rest -> ( 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 let rdrs = make_child_rdrs_for_parent rdrs in (* TODO: No way this is right *) 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 = 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 | [] -> (clear_local_state ctx, job) in Eio.Switch.run @@ fun sw -> let initial_job = J.make 0 [] in let saved_ctx = initial_ctx in let subshell = saved_ctx.subshell || List.length p > 1 in let ctx = { initial_ctx with subshell } in let ctx, job = loop sw ctx initial_job None p in match J.size job with | 0 -> Exit.zero ctx | _ -> if not async then begin let e = J.await_exit ~pipefail:ctx.options.pipefail ~interactive:ctx.interactive job in let ctx = { ctx with last_pipeline_status = Some (Exit.code e) } in e >|= fun () -> { ctx with subshell = saved_ctx.subshell } end else begin Exit.zero { ctx with background_jobs = job :: ctx.background_jobs; subshell = saved_ctx.subshell; } end and handle_one_redirection ?(for_parent = false) ~sw ctx v = let redirect (s, d, b) = if for_parent then Types.Parent_redirect (s, d, b) else Types.Child_redirect (s, d, b) in match v with | Ast.IoRedirect_IoFile (n, (op, file)) -> ( let _ctx, file = word_expansion ctx file in let file = Ast.Fragment.join_list ~sep:"" (List.concat 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 [ 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 [ 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 [ 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 [ 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 [ redirect (1, fd, `Blocking); 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 [ redirect (n, fd, `Blocking) ] | Io_op_lessgreat -> Fmt.failwith "<> not support yet.") | Ast.IoRedirect_IoHere (i, Ast.IoHere (_, v)) -> let _ctx, cst = word_expansion ctx v in let s = List.concat cst |> Ast.Fragment.join_list ~sep:"" in let r, w = Fd_pool.pipe ctx.fd_pool sw in Eio.Flow.copy_string s w; Eio.Flow.close w; let fd = Eio_unix.Resource.fd_opt r |> Option.get in [ redirect (i, fd, `Blocking) ] | Ast.IoRedirect_IoHere (i, Ast.IoHere_Dash (_, v)) -> let _ctx, cst = word_expansion ctx v in let strip_tab (Ast.{ txt; _ } as v) = let txt = String.split_on_char '\n' txt |> List.map String.trim |> String.concat "\n" in { v with txt } in let s = List.concat cst |> List.map strip_tab |> Ast.Fragment.join_list ~sep:"" in let r, w = Fd_pool.pipe ctx.fd_pool sw in Eio.Flow.copy_string s w; Eio.Flow.close w; let fd = Eio_unix.Resource.fd_opt r |> Option.get in [ redirect (i, fd, `Blocking) ] and handle_redirections ?(for_parent = false) ~sw ctx rdrs = try Ok (List.concat_map (handle_one_redirection ~for_parent ~sw ctx) rdrs) with Eio.Io (Eio.Fs.E (Already_exists _), _) -> Fmt.epr "msh: cannot overwrite existing file\n%!"; Error ctx and parameter_expansion ctx ast : ctx Exit.t * Ast.fragment list list = let get_prefix ~pattern ~kind param = let _, prefix = String.fold_left (fun (so_far, acc) c -> match acc with | Some s when kind = `Smallest -> (so_far, Some s) | _ -> ( let s = so_far ^ String.make 1 c in match Glob.test ~pattern s with | true -> (s, Some s) | false -> (s, acc))) ("", None) param in prefix in let get_suffix ~pattern ~kind param = let _, prefix = String.fold_left (fun (so_far, acc) c -> match acc with | Some s when kind = `Smallest -> (so_far, Some s) | _ -> ( let s = String.make 1 c ^ so_far in 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 prefix in let tl_or_empty v = try List.tl v with _ -> [] in let lookup_variable ctx ~param = match int_of_string_opt param with | Some n -> ( match Array.get ctx.argv n with | v -> Some v | exception Invalid_argument _ -> None) | None -> S.lookup ctx.state ~param in let expand ctx v : ctx Exit.t * Ast.fragment list list = let module Fragment = struct include Ast.Fragment let make ?(join = if ctx.in_double_quotes then `With_previous else `No) ?globbable ?splittable ?tilde_expansion v = Ast.Fragment.make ~join ?splittable ?tilde_expansion ?globbable v end in match v with | Ast.WordVariable v -> ( match v with | Ast.VariableAtom ("!", NoAttribute) -> (Exit.zero ctx, [ [ Fragment.make ctx.last_background_process ] ]) | Ast.VariableAtom ("?", NoAttribute) -> let status = match ctx.last_pipeline_status with | None -> [] | Some i -> [ Fragment.make (string_of_int i) ] in (Exit.zero ctx, [ status ]) | Ast.VariableAtom ("-", NoAttribute) -> let i = if ctx.interactive then "i" else "" in ( Exit.zero ctx, [ [ Fragment.make (Built_ins.Options.to_letters ctx.options ^ i); ]; ] ) | Ast.VariableAtom ("@", NoAttribute) -> let args = tl_or_empty @@ Array.to_list ctx.argv in Debug.Log.debug (fun f -> f "expanding %@: %a\n%!" Fmt.(list string) args); let args = if not ctx.in_double_quotes then List.map (fun v -> [ Fragment.make ~join:`No ~splittable:true v ]) args else let l = List.length args in List.mapi (fun idx arg -> if idx = 0 then [ Fragment.make ~join:`With_previous arg ] else if idx = l - 1 then [ Fragment.make ~join:`With_next arg ] else [ Fragment.make ~join:`No arg ]) args in (Exit.zero ctx, args) | Ast.VariableAtom ("*", NoAttribute) -> let args = tl_or_empty @@ Array.to_list ctx.argv in Debug.Log.debug (fun f -> f "expanding *: %a\n%!" Fmt.(list string) args); let args = if not ctx.in_double_quotes then [ List.map Ast.Fragment.make args ] else [ [ Ast.Fragment.make ~join:`With_previous (String.concat (Option.value ~default:" " (S.lookup ctx.state ~param:"IFS")) args); ]; ] in (Exit.zero ctx, args) | Ast.VariableAtom ("#", NoAttribute) -> ( Exit.zero ctx, [ [ Fragment.make (string_of_int (List.length @@ tl_or_empty (Array.to_list ctx.argv))); ]; ] ) | Ast.VariableAtom (n, NoAttribute) when Option.is_some (int_of_string_opt n) -> ( let n = int_of_string n in match Array.get ctx.argv n with | v -> (Exit.zero ctx, [ [ Fragment.make v ] ]) | exception Invalid_argument _ -> (Exit.zero ctx, [ [ Fragment.make "" ] ])) | Ast.VariableAtom (s, NoAttribute) -> ( match lookup_variable ctx ~param:s with | None -> if ctx.options.no_unset then begin ( Exit.nonzero_msg ctx ~exit_code:1 "%s: unbound variable" s, [ [ Fragment.make "" ] ] ) end else (Exit.zero ctx, [ [ Fragment.make "" ] ]) | Some cst -> ( Exit.zero ctx, [ [ Fragment.make ~splittable:(not ctx.in_double_quotes) cst; ]; ] )) | Ast.VariableAtom (s, ParameterLength) -> ( match lookup_variable ctx ~param:s with | None -> (Exit.zero ctx, [ [ Fragment.make "0" ] ]) | Some cst -> ( Exit.zero ctx, [ [ Fragment.make (string_of_int (String.length cst)) ] ] )) | Ast.VariableAtom (s, UseDefaultValues (_, cst)) -> ( match lookup_variable ctx ~param:s with | None -> (Exit.zero ctx, [ [ Fragment.make (word_cst_to_string cst) ] ]) | Some cst -> (Exit.zero ctx, [ [ Fragment.make cst ] ])) | Ast.VariableAtom ( s, (( RemoveSmallestPrefixPattern cst | RemoveLargestPrefixPattern cst ) as v) ) -> ( let ctx, spp = word_expansion ctx cst in match ctx with | Exit.Nonzero _ as ctx -> (ctx, [ [ Fragment.make "" ] ]) | Exit.Zero ctx -> ( let pattern = Fragment.join_list ~sep:"" (List.concat spp) in match lookup_variable ctx ~param:s with | None -> ( Exit.zero ctx, [ [ Fragment.make (word_cst_to_string cst) ] ] ) | Some cst -> ( let kind = match v with | RemoveSmallestPrefixPattern _ -> `Smallest | RemoveLargestPrefixPattern _ -> `Largest | _ -> assert false in let param = cst in let prefix = get_prefix ~pattern ~kind param in match prefix with | None -> (Exit.zero ctx, [ [ Fragment.make param ] ]) | Some s -> ( match String.cut_prefix ~prefix:s param with | Some s -> (Exit.zero ctx, [ [ Fragment.make s ] ]) | None -> (Exit.zero ctx, [ [ Fragment.make param ] ]) )))) | Ast.VariableAtom ( s, (( RemoveSmallestSuffixPattern cst | RemoveLargestSuffixPattern cst ) as v) ) -> ( let ctx, spp = word_expansion ctx cst in let pattern = Fragment.join_list ~sep:"" (List.concat spp) in match ctx with | Exit.Nonzero _ as ctx -> (ctx, [ [ Fragment.empty ] ]) | Exit.Zero ctx -> ( match lookup_variable ctx ~param:s with | None -> ( Exit.zero ctx, [ [ Fragment.make (word_cst_to_string cst) ] ] ) | Some cst -> ( let kind = match v with | RemoveSmallestSuffixPattern _ -> `Smallest | RemoveLargestSuffixPattern _ -> `Largest | _ -> assert false in let param = cst in let suffix = get_suffix ~pattern ~kind param in match suffix with | None -> (Exit.zero ctx, [ [ Fragment.make param ] ]) | Some s -> ( match String.cut_suffix ~suffix:s param with | Some s -> (Exit.zero ctx, [ [ Fragment.make s ] ]) | None -> (Exit.zero ctx, [ [ Fragment.make param ] ]) )))) | Ast.VariableAtom (s, UseAlternativeValue (_, alt)) -> ( let ctx, alt = word_expansion ctx alt in match lookup_variable (Exit.value ctx) ~param:s with | Some "" | None -> (ctx, [ [] ]) | Some _ -> (ctx, alt)) | Ast.VariableAtom (s, AssignDefaultValues (_, value)) -> ( let new_ctx, value = word_expansion ctx value in match lookup_variable (Exit.value new_ctx) ~param:s with | Some "" | None -> ( match S.update ctx.state ~param:s (List.concat value |> Ast.Fragment.join_list ~sep:"") with | Ok state -> let new_ctx = { (Exit.value new_ctx) with state } in (Exit.zero new_ctx, value) | Error m -> (Exit.nonzero_msg ~exit_code:1 ctx "%s" m, [ [] ]) ) | Some cst -> (new_ctx, [ [ Fragment.make cst ] ])) | Ast.VariableAtom (_, IndicateErrorifNullorUnset (_, _)) -> Fmt.failwith "TODO: Indicate Error") | Ast.WordDoubleQuoted [] -> (Exit.zero ctx, [ [ Ast.Fragment.empty ] ]) | Ast.WordDoubleQuoted cst -> ( let saved_dqoute = ctx.in_double_quotes in let ctx = { ctx with in_double_quotes = true } in let new_ctx, cst_acc = word_expansion ctx cst in let new_ctx = Exit.map ~f:(fun ctx -> { ctx with in_double_quotes = saved_dqoute }) new_ctx in match new_ctx with | Exit.Nonzero _ -> (new_ctx, cst_acc) | Exit.Zero new_ctx -> (Exit.zero new_ctx, cst_acc)) | Ast.WordSingleQuoted [] -> (Exit.zero ctx, [ [ Ast.Fragment.empty ] ]) | Ast.WordSingleQuoted cst -> ( let saved_dqoute = ctx.in_double_quotes in let new_ctx, cst_acc = word_expansion ctx cst in let new_ctx = Exit.map ~f:(fun ctx -> { ctx with in_double_quotes = saved_dqoute }) new_ctx in match new_ctx with | Exit.Nonzero _ -> (new_ctx, cst_acc) | Exit.Zero new_ctx -> (Exit.zero new_ctx, cst_acc)) | Ast.WordAssignmentWord (Name n, w) -> ( let new_ctx, cst_acc = word_expansion ctx w in match new_ctx with | Exit.Nonzero _ -> (new_ctx, cst_acc) | Exit.Zero _ -> ( new_ctx, [ [ Fragment.make (n ^ "=" ^ Fragment.join_list ~sep:"" (List.concat cst_acc)); ]; ] )) | Ast.WordSubshell sub -> (* Command substitution *) let s = command_substitution ctx sub in (Exit.zero ctx, [ [ Fragment.make s ] ]) | Ast.WordArithmeticExpression cst -> arithmetic_expansion ctx cst |> fun (ctx, v) -> (Exit.zero ctx, [ [ v ] ]) | Ast.WordName s -> (Exit.zero ctx, [ [ Fragment.make s ] ]) | Ast.WordLiteral s -> let v = Fragment.make s in (Exit.zero ctx, [ [ v ] ]) | Ast.WordGlobAll -> (Exit.zero ctx, [ [ Fragment.make ~globbable:true "*" ] ]) | Ast.WordGlobAny -> (Exit.zero ctx, [ [ Fragment.make ~globbable:true "?" ] ]) | Ast.WordTildePrefix s -> (Exit.zero ctx, [ [ Fragment.make ~tilde_expansion:true s ] ]) | v -> Fmt.failwith "TODO: expansion of %a" yojson_pp (Ast.word_component_to_yojson v) 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; 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 = let cst = tilde_expansion ctx cst in parameter_expansion ctx cst and word_expansion ctx cst : ctx Exit.t * Ast.fragments list = let rec aux ctx = function | [] -> (ctx, []) (* one empty word *) | c :: rest -> let new_ctx, l = word_expansion' (Exit.value ctx) c in let next_ctx, r = aux new_ctx rest in let combined = l @ r in (next_ctx, combined) in let ctx, cst = aux (Exit.zero ctx) cst in match ctx with | Exit.Nonzero _ -> (ctx, cst) | Exit.Zero ctx -> let fields = cst in let fields = List.map (field_splitting ctx) fields in let (ctx, cst) : ctx * Ast.fragments list = begin let glob = Ast.Fragment.join_list ~sep:"" (List.concat fields) in let vs : Ast.fragments list = let has_glob = List.exists (fun (f : Ast.fragment) -> f.globbable) (List.concat fields) in let _new_ctx, s = if (not ctx.options.no_path_expansion) && has_glob then glob_expand ctx glob else if ctx.options.no_path_expansion && has_glob then (ctx, [ Ast.Fragment.make glob ]) else (ctx, List.concat fields) in [ s ] in (ctx, vs) end in (Exit.zero ctx, List.map Ast.Fragment.handle_joins cst) and handle_assignments kind ctx (assignments : string list) = let flags, assignments = List.fold_left (fun (fs, args) v -> match Astring.String.cut ~sep:"-" v with | Some ("", f) -> (f :: fs, args) | _ -> (fs, v :: args)) ([], []) assignments in let update = match kind with | `Export -> update ~export:true ~readonly:false | `Readonly -> update ~export:false ~readonly:true | `Local -> update ~export:false ~readonly:false in let read_arg acc_ctx param = (* TODO: quoting? *) match Astring.String.cut ~sep:"=" param with | Some (param, v) -> update acc_ctx ~param v | None -> ( match S.lookup acc_ctx.state ~param with | Some v -> update acc_ctx ~param v | None -> Exit.zero acc_ctx) in match flags with | [] -> List.fold_left (fun ctx w -> match ctx with Exit.Zero ctx -> read_arg ctx w | _ -> ctx) (Exit.zero ctx) assignments | fs -> if List.mem "p" fs then begin match kind with | `Readonly -> S.pp_readonly Fmt.stdout ctx.state | `Export -> S.pp_export Fmt.stdout ctx.state | `Local -> () end; Exit.zero ctx and expand_redirects ((ctx, acc) : ctx * Ast.cmd_suffix_item list) (c : Ast.cmd_suffix_item list) = match c with | [] -> (ctx, List.rev acc) | Ast.Suffix_redirect (IoRedirect_IoFile (num, (op, file))) :: rest -> ( let ctx, cst = word_expansion ctx file in match ctx with | Exit.Nonzero _ -> Fmt.failwith "Redirect expansion" | Exit.Zero ctx -> let cst = List.map (fun Ast.{ txt; _ } -> Ast.WordLiteral txt) (List.concat cst) in let v = Ast.Suffix_redirect (IoRedirect_IoFile (num, (op, cst))) in expand_redirects (ctx, v :: acc) rest) | (Ast.Suffix_redirect _ as v) :: rest -> expand_redirects (ctx, v :: acc) rest | s :: rest -> expand_redirects (ctx, s :: acc) rest and handle_and_or ~sw:_ ~async ctx c = let pipeline = function | Ast.Pipeline p -> (Fun.id, p) | Ast.Pipeline_Bang p -> (Exit.not, p) in let rec fold : Ast.and_or * ctx Exit.t -> Ast.pipeline Ast.and_or_list -> ctx Exit.t = fun (sep, exit_so_far) pipe -> match (sep, pipe) with | And, Nlist.Singleton (p, _) -> ( match exit_so_far with | Exit.Zero ctx -> let f, p = pipeline p in 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 p) | Noand_or, Nlist.Singleton (p, _) -> let f, p = pipeline p in 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 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 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 p)) rest) in fold (Noand_or, Exit.zero ctx) c and handle_for_clause ctx v : ctx Exit.t = match v with | Ast.For_Name_DoGroup (_, (term, sep)) -> exec ctx (term, Some sep) | Ast.For_Name_In_WordList_DoGroup (Name name, wdlist, (term, sep)) -> ( let wdlist = Nlist.map (word_expansion ctx) wdlist in try Nlist.fold_left (fun _ (_, words) -> List.fold_left (fun _ word -> update ctx ~param:name word.Ast.txt >>= fun ctx -> try exec ctx (term, Some sep) with | Continue (1, ctx) -> Exit.zero ctx | Continue (n, ctx) -> raise (Continue (n - 1, ctx))) (Exit.zero ctx) (List.concat words)) (Exit.zero ctx) wdlist with | Break (1, ctx) -> Exit.zero ctx | Break (n, ctx) -> raise (Break (n - 1, ctx))) and handle_if_clause ctx = function | Ast.If_then ((e1, sep1), (e2, sep2)) -> ( let ctx = exec ctx (e1, Some sep1) in match ctx with | Exit.Zero ctx -> exec ctx (e2, Some sep2) | Exit.Nonzero { value = ctx; _ } -> Exit.zero ctx) | Ast.If_then_else ((e1, sep1), (e2, sep2), else_part) -> ( let ctx = exec ctx (e1, Some sep1) in match ctx with | Exit.Zero ctx -> exec ctx (e2, Some sep2) | Exit.Nonzero { value = ctx; _ } -> handle_else_part ctx else_part) and handle_else_part ctx = function | Ast.Else (c, sep) -> exec ctx (c, Some sep) | Ast.Elif_then ((e1, sep1), (e2, sep2)) -> ( let ctx = exec ctx (e1, Some sep1) in match ctx with | Exit.Zero ctx -> exec ctx (e2, Some sep2) | Exit.Nonzero { value = ctx; _ } -> Exit.zero ctx) | Ast.Elif_then_else ((e1, sep1), (e2, sep2), else_part) -> ( let ctx = exec ctx (e1, Some sep1) in match ctx with | Exit.Zero ctx -> exec ctx (e2, Some sep2) | Exit.Nonzero { value = ctx; _ } -> handle_else_part ctx else_part) and handle_case_clause ctx = function | Ast.Case _ -> Exit.zero ctx | Cases (word, case_list) -> ( let ctx, word = word_expansion ctx word in match ctx with | Exit.Nonzero _ as ctx -> ctx | Exit.Zero ctx -> ( let scrutinee = Ast.Fragment.join_list ~sep:"" @@ List.concat word in let res = Nlist.fold_left (fun acc pat -> match acc with | Some _ as ctx -> ctx | None -> ( match pat with | Ast.Case_pattern (p, sub) -> Nlist.fold_left (fun inner_acc pattern -> match inner_acc with | Some _ as v -> v | None -> let _, pattern = word_expansion { ctx with options = Built_ins.Options.with_options ~no_path_expansion:true ctx.options; } pattern in let pattern = Ast.Fragment.join_list ~sep:"" (List.concat pattern) in if Glob.test ~pattern scrutinee then begin match sub with | Some (c, sep) -> Some (exec ctx (c, Some sep)) | None -> Some (Exit.zero ctx) end else inner_acc) None p)) None case_list in match res with Some ctx -> ctx | None -> Exit.zero ctx)) and exec_subshell ctx (term, sep) = let saved_ctx = ctx in let e = exec ctx (term, Some sep) in let v = e >|= fun _ -> saved_ctx in v and handle_while_clause ctx (While ((term, sep), (term', sep')) : Ast.while_clause) = let rec loop exit_so_far = 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 (try exec ctx (term', Some sep') with | Continue (1, ctx) -> Exit.zero ctx | Continue (n, ctx) -> raise (Continue (n - 1, ctx))) in try loop (Exit.zero ctx) with | Break (1, ctx) -> Exit.zero ctx | Break (n, ctx) -> raise (Break (n - 1, ctx)) and handle_until_clause ctx (Until ((term, sep), (term', sep')) : Ast.until_clause) = let rec loop exit_so_far = 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 (try exec ctx (term', Some sep') with | Continue (1, ctx) -> Exit.zero ctx | Continue (n, ctx) -> raise (Continue (n - 1, ctx))) in try loop (Exit.zero ctx) with | Break (1, ctx) -> Exit.zero ctx | Break (n, ctx) -> raise (Break (n - 1, ctx)) and handle_compound_command ctx v : ctx Exit.t = match v with | Ast.ForClause fc -> handle_for_clause ctx fc | Ast.IfClause if_ -> handle_if_clause ctx if_ | Ast.BraceGroup (term, sep) -> exec ctx (term, Some sep) | Ast.Subshell s -> exec_subshell ctx s | Ast.CaseClause cases -> handle_case_clause ctx cases | Ast.WhileClause while_ -> handle_while_clause ctx while_ | Ast.UntilClause until -> handle_until_clause ctx until and handle_function_application (ctx : ctx) ~name argv : ctx Exit.t option = 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 let v = try Option.some @@ handle_compound_command ctx commands with Return ctx -> Some 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 = let buf = Buffer.create 16 in let stdout = Eio.Flow.buffer_sink buf in let sub_ctx = Eio.Switch.run @@ fun sw -> let r, w = Fd_pool.pipe ctx.fd_pool sw in Eio.Fiber.fork ~sw (fun () -> Eio.Flow.copy r stdout); let subshell_ctx = { ctx with stdout = w; subshell = true } in let sub_ctx, _ = run (Exit.zero subshell_ctx) s in Eio.Flow.close w; sub_ctx in ((sub_ctx >|= fun _ -> ctx), Buffer.contents buf) in let run_subshells s = let _ctx, std = exec_subshell ctx s in String.trim std in run_subshells cc and glob_expand ctx pattern : ctx * Ast.fragment list = ( ctx, 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 (fun ctx prefix -> match ctx with | Exit.Nonzero _ -> ctx | Exit.Zero ctx -> ( match prefix with | Ast.Prefix_assignment (Name param, v) -> ( (* Expand the values *) let ctx, v = word_expansion ctx v in match ctx with | Exit.Nonzero _ as ctx -> ctx | Exit.Zero ctx -> ( let state = (* TODO: Overhaul... need to collect assignments after word expansion...*) if update || String.equal "IFS" param then S.update ctx.state ~param (Ast.Fragment.join_list ~sep:"" @@ List.concat v) else Ok ctx.state in match state with | Error message -> Exit.nonzero ~message ctx 1 | Ok state -> Exit.zero { ctx with state; local_state = ( param, Ast.Fragment.join_list ~sep:"" @@ List.concat v ) :: ctx.local_state; })) | _ -> Exit.zero ctx)) (Exit.zero ctx) vs and args ctx swc : ctx Exit.t * string list = let ctx, fs = List.fold_left (fun (ctx, acc) -> function | Ast.Suffix_redirect _ -> (ctx, acc) | Suffix_word wc -> ( match ctx with | Exit.Nonzero _ as ctx -> (ctx, acc) | Exit.Zero ctx -> ( let ctx, cst = word_expansion ctx wc in match ctx with | Exit.Nonzero _ as ctx -> (ctx, acc) | Exit.Zero _ as ctx -> (ctx, acc @ cst)))) (Exit.zero ctx, []) swc in (ctx, List.map Ast.Fragment.to_string @@ List.concat fs) and handle_built_in ~rdrs ~(stdout : Eio_unix.sink_ty Eio.Flow.sink) (ctx : ctx) v = let rdrs = ctx.rdrs @ rdrs in Eunix.with_redirections ~restore:true rdrs @@ fun () -> Debug.Log.debug (fun f -> f "built-in: %s" (Built_ins.to_string v)); match v with | Built_ins.Cd { path } -> let cwd = S.cwd ctx.state in let+ state = match path with | Some p -> let fp = Fpath.append cwd (Fpath.v p) in if Eio.Path.is_directory (ctx.fs / Fpath.to_string fp) then begin Unix.chdir (Fpath.to_string fp); Exit.zero @@ S.set_cwd ctx.state fp end else Exit.nonzero_msg ~exit_code:1 ctx.state "cd: not a directory: %a" Fpath.pp fp | None -> ( match Eunix.find_env "HOME" with | None -> Exit.nonzero_msg ctx.state "HOME not set" | Some p -> Exit.zero (S.set_cwd ctx.state @@ Fpath.v p)) in { ctx with state } | Pwd -> let () = Eio.Flow.copy_string (Fmt.str "%a\n%!" Fpath.pp (S.cwd ctx.state)) stdout in Exit.zero ctx | Exit n -> let should_exit = { Exit.default_should_exit with interactive = `Yes } in Exit.nonzero ~should_exit ctx n | Return 0 -> raise (Return (Exit.zero ctx)) | Return n -> raise (Return (Exit.nonzero ctx n)) | Break n -> raise (Break (n, ctx)) | Continue n -> raise (Continue (n, ctx)) | Set { update; print_options } -> let v = Exit.zero { ctx with options = Built_ins.Options.update ctx.options update } in if print_options then Eio.Flow.copy_string (Fmt.str "%a" Built_ins.Options.pp ctx.options) stdout; v | Wait i -> ( match Unix.waitpid [] i with | _, WEXITED 0 -> Exit.zero ctx | _, (WEXITED n | WSIGNALED n | WSTOPPED n) -> Exit.nonzero ctx n) | Dot file -> ( match resolve_program ctx file with | ctx, None -> Exit.nonzero ctx 127 | 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 | `Variables names -> let state = List.fold_left (fun t param -> S.remove ~param t |> snd) ctx.state names in Exit.zero { ctx with state } | `Functions names -> let functions = List.fold_left (fun t param -> List.remove_assoc param t) ctx.functions names in Exit.zero { ctx with functions }) | Hash v -> ( match v with | Built_ins.Hash_remove -> Exit.zero { ctx with hash = Hash.empty } | Built_ins.Hash_stats -> Eio.Flow.copy_string (Fmt.str "%a" Hash.pp ctx.hash) stdout; Exit.zero ctx | _ -> assert false) | Alias | Unalias -> Exit.zero ctx (* Morbig handles this for us *) | Eval args -> let script = String.concat "" args in let ast = Ast.of_string script in let ctx, _ = run (Exit.zero ctx) ast in ctx | Echo args -> let str = String.concat " " (List.map String.trim args) ^ "\n" in Eio.Flow.copy_string str stdout; Exit.zero ctx | Trap (action, signals) -> let saved_ctx = ctx in let action = match action with | Action m -> let ast = Ast.of_string m in let f _ = saved_ctx.signal_handler.run @@ fun () -> let _, _ = run (Exit.zero saved_ctx) ast in () in Sys.Signal_handle f | Default -> Sys.Signal_default | Ignore -> Sys.Signal_ignore | Int _ -> assert false in Exit.zero @@ List.fold_left (fun ctx signal -> match signal with | `Exit -> let action = match action with | Sys.Signal_default | Sys.Signal_ignore -> None | Sys.Signal_handle f -> Some (fun () -> f 0) in { ctx with exit_handler = action } | `Signal signal -> let action = (* Handle sigint separately for interactive mode *) match (action, signal) with | Sys.Signal_default, Eunix.Signals.Interrupt -> if ctx.interactive then Sys.Signal_ignore else action | _ -> action in let setting_sigint = ctx.signal_handler.sigint_set = false && match action with | Sys.Signal_handle _ -> true | _ -> false in Sys.set_signal (Eunix.Signals.to_int signal) action; { ctx with signal_handler = { 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 } | Read (_backslash, vars) -> ( let line = let buf = Cstruct.create 1 in let rec loop acc = match Eio.Flow.read_exact ctx.stdin buf; Cstruct.to_string buf with | "\n" -> Some acc | c -> loop (acc ^ c) | exception End_of_file -> Debug.Log.debug (fun f -> f "Read EOF"); if String.equal acc "" then None else Some acc in loop "" in let rec loop acc = function | v :: vars, Ast.{ txt; _ } :: fs -> loop ((v, txt) :: acc) (vars, fs) | _, [] -> List.rev acc | [], lines -> let last_var, last_line = List.hd acc in List.rev ((last_var, last_line ^ Ast.Fragment.join_list ~sep:"" lines) :: acc) in let fields = Option.map (fun s -> field_splitting ctx [ Ast.Fragment.make ~splittable:true s ]) line in match fields with | None -> Exit.nonzero ctx 1 | Some fs -> let vars = loop [] (vars, fs) in let state = List.fold_left (fun st (k, v) -> S.update st ~param:k v |> Result.get_ok) ctx.state vars in Exit.zero { ctx with state }) | Command _ -> (* Handled separately *) assert false and exec initial_ctx ((command, sep) : Ast.complete_command) = let rec loop : Eio.Switch.t -> ctx -> Ast.clist -> ctx Exit.t = fun sw ctx -> function | Nlist.Singleton (c, sep) -> let async = match sep with Semicolon -> false | Ampersand -> true in handle_and_or ~sw ~async ctx c | Nlist.Cons ((c, sep), cs) -> ( let async = match sep with Semicolon -> false | Ampersand -> true in match handle_and_or ~sw ~async ctx c with | Exit.Zero ctx -> loop sw ctx cs | v -> v) in match sep with | Some Semicolon | None -> Eio.Switch.run @@ fun sw -> loop sw initial_ctx command | Some Ampersand -> Fiber.fork ~sw:initial_ctx.async_switch (fun () -> Fiber.yield (); let _ : ctx Exit.t = loop initial_ctx.async_switch initial_ctx command in ()); Exit.zero initial_ctx and execute ctx ast = exec ctx ast and run ctx ast = run' ~make_process_group:true ctx ast and run' ?(make_process_group = true) ctx ast = (* Make the shell its own 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 | [] -> (ctx, cs) | command :: commands -> ( let ctx = Exit.value ctx in (* For our sanity *) let has_async = Ast.has_async command in if has_async && not ctx.options.async then begin Fmt.epr "You are using asynchronous operators and [set -o async] has \ not been called.\n\ %!"; exit ctx 1 end; let exit = try execute ctx command with | Eio.Io (Eio.Process.E (Eio.Process.Executable_not_found m), _ctx) -> Exit.nonzero_msg ctx ~exit_code:127 "command not found: %s" m in match exit with | Exit.Nonzero { exit_code; message; should_exit; _ } -> ( Option.iter (Fmt.epr "%s\n%!") message; match ( should_exit.interactive, should_exit.non_interactive, ctx.subshell, ctx.interactive, commands ) with | `Yes, _, false, true, [] | _, `Yes, false, false, [] -> if should_exit.interactive = `Yes then Fmt.epr "exit\n%!"; Stdlib.exit exit_code | _ -> loop_commands (exit, c :: cs) commands) | Exit.Zero _ as ctx -> loop_commands (ctx, c :: cs) commands) in loop_commands (ctx, []) ast in (ctx, List.rev cs) end