From c4888c196fd1caa715310a3efbc4fb00bc9a276d Mon Sep 17 00:00:00 2001 From: Patrick Ferris Date: Fri, 31 Jul 2026 17:22:19 +0100 Subject: [PATCH] Allow user defined built-ins --- src/lib/built_ins.ml | 7 +++++-- src/lib/built_ins.mli | 9 +++++++-- src/lib/eval.ml | 25 +++++++++++++++++++++---- src/lib/eval.mli | 8 +++----- src/lib/interactive.ml | 8 ++++---- 5 files changed, 40 insertions(+), 17 deletions(-) diff --git a/src/lib/built_ins.ml b/src/lib/built_ins.ml index 040147a..d30e7aa 100644 --- a/src/lib/built_ins.ml +++ b/src/lib/built_ins.ml @@ -303,6 +303,7 @@ type t = | Read of bool * string list | Getopts of getopts | Test of Test.t + | X of string list let reserved = [ "fg"; "bg"; "jobs" ] let pp_args = Fmt.(list ~sep:(Fmt.any " ") string) @@ -354,6 +355,7 @@ let to_string = function let params = String.concat " " params in Fmt.str "getopts %s %s %s" optstring name params | Test t -> Test.to_string t + | X s -> String.concat " " s (* Change Directory *) module Cd = struct @@ -840,7 +842,7 @@ let test_of_args = function | _ -> Error "Missing closing ]") | _ -> Error "Malformed test command" -let of_args (w : string list) = +let of_args ?(user_built_ins = []) (w : string list) = let open Cmdliner in let exec_cmd cmd v = let t = Cmd.eval_value ~argv:(Array.of_list cmd) v in @@ -874,10 +876,11 @@ let of_args (w : string list) = | "getopts" :: _ as cmd -> exec_cmd cmd Getopts.t | ("test" | "[") :: _ as cmd -> Some (test_of_args cmd) | "msh-info" :: _ -> Some (Ok Msh_info) - | name :: _ -> + | name :: _ as cmd -> if List.mem name reserved then begin Debug.Log.err (fun f -> f "Unimplemented built-in: %s" name); Some (Error (Fmt.str "Unimplemented built-in: %s" name)) end + else if List.mem name user_built_ins then Some (Ok (X cmd)) else None | _ -> None diff --git a/src/lib/built_ins.mli b/src/lib/built_ins.mli index 95450de..05dd153 100644 --- a/src/lib/built_ins.mli +++ b/src/lib/built_ins.mli @@ -103,12 +103,17 @@ type t = | Read of bool * string list | Getopts of getopts | Test of Test.t + | X of string list val to_string : t -> string (** Serialises a built-in to a string *) -val of_args : string list -> (t, string) result option -(** Parses a command-line to the built-ins, errors are returned if parsing. *) +val of_args : + ?user_built_ins:string list -> string list -> (t, string) result option +(** Parses a command-line to the built-ins, errors are returned if parsing. + + If the command name matches something in [user_built_ins] it will be + supplied to the evaluator as [X cmd] *) (* To be shared with shell binary CLIs *) module Set : sig diff --git a/src/lib/eval.ml b/src/lib/eval.ml index 1b6d851..a0c305c 100644 --- a/src/lib/eval.ml +++ b/src/lib/eval.ml @@ -96,9 +96,11 @@ module Make (S : Types.State) (Fd : Types.Fd) (E : Types.Exec) = struct current_pipeline : string option; current_context : [ `Toplevel | `Function | `CompoundCommand ]; fd_opt : Types.fd_opt; + built_ins : (string list * (string list -> ctx -> ctx Exit.t)) option; } let fd_opt ctx r = ctx.fd_opt.fd r + let env ctx = ctx.env let should_exit ?(with_errexit = true) v = match v with @@ -177,8 +179,8 @@ module Make (S : Types.State) (Fd : Types.Fd) (E : Types.Exec) = struct ?(background_jobs = []) ?(last_background_process = "") ?current_pipeline ?last_pipeline_status ?(functions = []) ?exit_handler ?(options = Built_ins.Options.default) ?(hash = Hash.empty) - ?(umask = 0o22) ~async_switch ~program ~argv ~fd_opt state executor - fd_table env = + ?(umask = 0o22) ?built_ins ~async_switch ~program ~argv ~fd_opt state + executor fd_table env = let signal_handler = { run_queue = Queue.create (); sigint_set = false } in let state = S.update state ~param:"IFS" [ Ast.Fragment.make " \t\n" ] |> Result.get_ok @@ -216,6 +218,7 @@ module Make (S : Types.State) (Fd : Types.Fd) (E : Types.Exec) = struct current_pipeline; current_context = `Toplevel; fd_opt; + built_ins; } let state ctx = ctx.state @@ -582,7 +585,11 @@ module Make (S : Types.State) (Fd : Types.Fd) (E : Types.Exec) = struct get_std_with_locality current_stdout, get_std_with_locality next_stdin ) in - match Built_ins.of_args (executable :: args) with + match + Built_ins.of_args + ?user_built_ins:(Option.map fst ctx.built_ins) + (executable :: args) + with | Some (Error _) -> handle_job job (immediate_built_in (Exit.nonzero ctx 1)) @@ -735,7 +742,12 @@ module Make (S : Types.State) (Fd : Types.Fd) (E : Types.Exec) = struct in loop pctx job rest | None -> ( - match Built_ins.of_args command_args with + match + Built_ins.of_args + ?user_built_ins: + (Option.map fst ctx.built_ins) + command_args + with | Some (Error _) -> handle_job job (immediate_built_in (Exit.nonzero ctx 1)) @@ -2305,6 +2317,11 @@ module Make (S : Types.State) (Fd : Types.Fd) (E : Types.Exec) = struct with | Failure msg -> Exit.nonzero ~message:msg ctx 2 | Eio.Io _ -> Exit.nonzero ctx 1) + | X s -> ( + (* User specified built-ins *) + match ctx.built_ins with + | None -> assert false + | Some (_, fn) -> fn s ctx) | Command _ -> (* Handled separately *) assert false diff --git a/src/lib/eval.mli b/src/lib/eval.mli index b473391..f2ceb26 100644 --- a/src/lib/eval.mli +++ b/src/lib/eval.mli @@ -22,6 +22,7 @@ module Make (S : Types.State) (_ : Types.Fd) (E : Types.Exec) : sig ?options:Built_ins.Options.t -> ?hash:Hash.t -> ?umask:int -> + ?built_ins:string list * (string list -> ctx -> ctx Exit.t) -> async_switch:Switch.t -> program:string -> argv:string array -> @@ -35,15 +36,12 @@ module Make (S : Types.State) (_ : Types.Fd) (E : Types.Exec) : sig val exit : ctx Exit.t -> unit (** Will exit with the correct exit code and run any exit handlers. *) - val fs : ctx -> Eio.Fs.dir_ty Eio.Path.t - (** The file system capability *) + val env : ctx -> Types.env + (** Retrieve the current context environment. *) val state : ctx -> S.t (** Return the current state of the context. *) - val stdout : ctx -> Eio_unix.sink_ty Eio.Flow.sink - val stdin : ctx -> Eio_unix.source_ty Eio.Flow.source - val sigint_set : ctx -> bool (** Has the signal SIGINT been set via a trap. *) diff --git a/src/lib/interactive.ml b/src/lib/interactive.ml index d1af53a..3f24962 100644 --- a/src/lib/interactive.ml +++ b/src/lib/interactive.ml @@ -29,7 +29,7 @@ struct | Exit.Nonzero { exit_code; _ } -> Fmt.pf ppf "[%a] " (pp_colored `Red Fmt.int) exit_code in - let fs = Exit.value ctx |> Eval.fs in + let fs = Exit.value ctx |> Eval.env |> fun env -> env#fs in Fmt.pf Format.str_formatter "%a%a:%s >\n%!" pp_status ctx Fmt.(pp_colored `Yellow string) (Eunix.get_user_and_host fs) @@ -104,7 +104,7 @@ struct Sys.set_signal Sys.sigttin Sys.Signal_ignore; Sys.set_signal Sys.sigtstp Sys.Signal_ignore; Sys.set_signal Sys.sigint Sys.Signal_ignore; - let xdg = Xdge.create (Eval.fs (Exit.value initial_ctx)) "merry" in + let xdg = Xdge.create (Eval.env (Exit.value initial_ctx))#fs "merry" in let history = Eio.Path.(Xdge.data_dir xdg / ".merry_history") in let initial_history = try H.load history with _ -> H.empty in let h = ref initial_history in @@ -117,8 +117,8 @@ struct (S.lookup (Exit.value ctx |> Eval.state) ~param:"PS1" |> fragments_to_string); let p = prompt ctx in - Eio.Flow.copy_string p (Exit.value ctx |> Eval.stdout); - Eio.Flow.copy_string "\r" (Exit.value ctx |> Eval.stdout); + Eio.Flow.copy_string p (Exit.value ctx |> Eval.env)#stdout; + Eio.Flow.copy_string "\r" (Exit.value ctx |> Eval.env)#stdout; let hint command = if String.length command < 2 then None else -- 2.51.2