From 95c108b268b3ec48742fd66865ed578995bb5f9c Mon Sep 17 00:00:00 2001 From: Michael Dales Date: Sat, 6 Jul 2024 20:48:32 +0100 Subject: [PATCH] Address subset of review comments. --- src/bin/main.ml | 10 ++--- src/lib/ast/leaf.mli | 2 +- src/lib/md.ml | 29 +++++++------ src/lib/md.mli | 2 +- src/lib/{execution => }/run_block.ml | 47 +++++++++++---------- src/lib/{execution => }/run_block.mli | 39 +++++++++++------ src/test/run_block.ml | 61 +++++++++++++++++++-------- src/test/test.ml | 2 +- 8 files changed, 115 insertions(+), 77 deletions(-) rename src/lib/{execution => }/run_block.ml (74%) rename src/lib/{execution => }/run_block.mli (56%) diff --git a/src/bin/main.ml b/src/bin/main.ml index bbf3f2b8..ac269598 100644 --- a/src/bin/main.ml +++ b/src/bin/main.ml @@ -123,7 +123,7 @@ let edit ~proc ~net ~fs () file port = Cohttp_eio.Server.run socket server ~on_error:log_warning let md ~fs ~net ~domain_mgr ~proc () no_run store conf file port fetcher jobs - src_dir env_override input_override = + src_dir environment_override input_override = let import_map = List.map (fun (k, v) -> @@ -220,8 +220,8 @@ let md ~fs ~net ~domain_mgr ~proc () no_run store conf file port fetcher jobs | Error (msg, cb) -> (cb, `Stop msg)) | `Run -> let cb, _result_block, stop = - Shark.Md.process_run_block ~env_override ~fs ~build_cache ~pool - store ast obuilder (code_block, block) + Shark.Md.process_run_block ~environment_override ~fs ~build_cache + ~pool store ast obuilder (code_block, block) in (cb, stop) in @@ -346,7 +346,7 @@ let secrets = @@ Arg.info ~doc:"Provide a secret under the form $(b,id:file)." ~docv:"SECRET" [ "secret" ] -let env_override = +let environment_override = Arg.value @@ Arg.(opt_all (pair ~sep:'=' string string)) [] @@ Arg.info @@ -384,7 +384,7 @@ let md ~fs ~net ~domain_mgr ~proc ~clock = Term.( const (md ~fs ~net ~domain_mgr ~proc ~clock) $ setup_log $ no_run $ store $ Obuilder.Native_sandbox.cmdliner - $ markdown_file $ port $ fetcher $ jobs $ src_dir $ env_override + $ markdown_file $ port $ fetcher $ jobs $ src_dir $ environment_override $ input_override) let editor ~proc ~net ~fs ~clock = diff --git a/src/lib/ast/leaf.mli b/src/lib/ast/leaf.mli index 6cba3b45..d7a094f6 100644 --- a/src/lib/ast/leaf.mli +++ b/src/lib/ast/leaf.mli @@ -1,4 +1,4 @@ -(** A Leaf is an atomic exection unit the in the pipeline graph. *) +(** A Leaf is an atomic execution unit the in the pipeline graph. *) type style = Command | Map type t [@@deriving sexp] diff --git a/src/lib/md.ml b/src/lib/md.ml index df440c31..79b6de2c 100644 --- a/src/lib/md.ml +++ b/src/lib/md.ml @@ -152,8 +152,8 @@ let get_paths ~fs (Obuilder.Store_spec.Store ((module Store), store)) hash in List.map find_files_in_store outputs -let process_run_block ?(env_override = []) ~fs ~build_cache ~pool store ast - (Builder ((module Builder), builder)) (_code_block, block) = +let process_run_block ?(environment_override = []) ~fs ~build_cache ~pool store + ast (Builder ((module Builder), builder)) (_code_block, block) = let hyperblock = Ast.find_hyperblock_from_block ast block |> Option.get ~err:"No hyperblock for run block" @@ -222,9 +222,9 @@ let process_run_block ?(env_override = []) ~fs ~build_cache ~pool store ast | Error (`Failed (id, msg)) -> Error (Some id, msg) in - let process_single_command acc leaf = - let _, prev_state = acc in - let inputs = Leaf.inputs leaf in + let process_single_command acc command_leaf = + let _, previous_state = acc in + let inputs = Leaf.inputs command_leaf in let input_and_hashes = List.map (fun i -> (i, List.assoc_opt (Datafile.id i) input_map)) @@ -250,7 +250,7 @@ let process_run_block ?(env_override = []) ~fs ~build_cache ~pool store ast | Some hash -> get_paths ~fs store hash true !ref_fd_list | None -> let current_hash = - Run_block.ExecutionState.build_hash prev_state + Run_block.ExecutionState.build_hash previous_state in get_paths ~fs store current_hash false !ref_fd_list) hash_to_input_map @@ -274,14 +274,15 @@ let process_run_block ?(env_override = []) ~fs ~build_cache ~pool store ast match s with | [] -> Fmt.failwith "Failed to find source files for input %s of %s" i - (Command.name (Leaf.command leaf)) + (Command.name (Leaf.command command_leaf)) | _ -> ()) l; - let inputs = Leaf.to_string_for_inputs leaf l in + let inputs = Leaf.to_string_for_inputs command_leaf l in let processed_blocks = Fiber.List.map - (Run_block.process_single_command_execution prev_state env_override - leaf l obuilder_command_runner) + (Run_block.process_single_command_execution ~previous_state + ~environment_override ~command_leaf ~file_subs_map:l + ~run_f:obuilder_command_runner) inputs in let results, _es = acc in @@ -290,7 +291,7 @@ let process_run_block ?(env_override = []) ~fs ~build_cache ~pool store ast | hd :: _ -> hd | [] -> Fmt.failwith "There were no processed blocks for %s" - (Command.name (Leaf.command leaf)) + (Command.name (Leaf.command command_leaf)) in (processed_blocks :: results, es) in @@ -298,9 +299,9 @@ let process_run_block ?(env_override = []) ~fs ~build_cache ~pool store ast let ids_and_output_and_cmd, _es = List.fold_left process_single_command ( [], - Run_block.ExecutionState.init build - (Fpath.to_string (Ast.default_container_path ast)) - [] ) + Run_block.ExecutionState.init ~build_hash:build + ~workdir:(Fpath.to_string (Ast.default_container_path ast)) + ~environment:[] ) commands in let last = List.hd ids_and_output_and_cmd in diff --git a/src/lib/md.mli b/src/lib/md.mli index 16d8519f..7edfae1c 100644 --- a/src/lib/md.mli +++ b/src/lib/md.mli @@ -31,7 +31,7 @@ val process_build_block : Cmarkit.Block.Code_block.t * Block.t * [ `Stop of string | `Continue ] val process_run_block : - ?env_override:(string * string) list -> + ?environment_override:(string * string) list -> fs:_ Eio.Path.t -> build_cache:Build_cache.t -> pool:unit Eio.Pool.t -> diff --git a/src/lib/execution/run_block.ml b/src/lib/run_block.ml similarity index 74% rename from src/lib/execution/run_block.ml rename to src/lib/run_block.ml index a6251fc5..264e6d84 100644 --- a/src/lib/execution/run_block.ml +++ b/src/lib/run_block.ml @@ -23,21 +23,23 @@ module ExecutionState = struct } [@@deriving sexp] - let v result build_hash success workdir environment = + let v ~result ~build_hash ~success ~workdir ~environment = { result; build_hash; success; workdir; environment } - let init build_hash default_path default_env = + let init ~build_hash ~workdir ~environment = { result = CommandResult.v ~build_hash ""; build_hash; success = true; - workdir = default_path; - environment = default_env; + workdir; + environment; } let change_dir e dst = - let res = CommandResult.v ~build_hash:e.build_hash (Fmt.str "cd %s" dst) in - { e with result = res; workdir = dst } + let result = + CommandResult.v ~build_hash:e.build_hash (Fmt.str "cd %s" dst) + in + { e with result; workdir = dst } let update_env e key value = let res = @@ -47,6 +49,7 @@ module ExecutionState = struct let updated_env = (key, value) :: List.remove_assoc key e.environment in { e with result = res; environment = updated_env } + let command_fail e result = { e with result; success = false } let result e = e.result let build_hash e = e.build_hash let success e = e.success @@ -55,9 +58,9 @@ module ExecutionState = struct let pp ppf t = Sexplib.Sexp.pp_hum ppf (sexp_of_t t) end -let process_single_command_execution previous_state env_override leaf - file_subs_map run_f expanded_command_string = - let command = Leaf.command leaf in +let process_single_command_execution ~previous_state ~environment_override + ~command_leaf ~file_subs_map ~run_f expanded_command_string = + let command = Leaf.command command_leaf in match Command.name command with | "cd" -> (* If a command block is a call to `cd` we treat this similarly to Docker's @@ -77,7 +80,8 @@ let process_single_command_execution previous_state env_override leaf let path = Fpath.to_string (List.nth args 0) in match List.assoc_opt path file_subs_map with | None -> path - | Some pl -> ( match pl with [] -> path | _ -> List.nth pl 0)) + | Some [] -> path + | Some pl -> List.nth pl 0) in ExecutionState.change_dir previous_state inspected_path | "export" -> @@ -90,7 +94,7 @@ let process_single_command_execution previous_state env_override leaf | None -> Fmt.failwith "Malformed export command: %a" Command.pp command in let value = - match List.assoc_opt key env_override with + match List.assoc_opt key environment_override with | None -> default_value | Some v -> v in @@ -98,15 +102,16 @@ let process_single_command_execution previous_state env_override leaf | _ -> ( (* Otherwise we run a command using obuilder or such *) let buf = Buffer.create 128 in - let res = run_f previous_state leaf expanded_command_string buf in + let res = run_f previous_state command_leaf expanded_command_string buf in match res with | Ok id -> ExecutionState.v - (CommandResult.v ~build_hash:id ~output:(Buffer.contents buf) - expanded_command_string) - id true - (ExecutionState.workdir previous_state) - (ExecutionState.env previous_state) + ~result: + (CommandResult.v ~build_hash:id ~output:(Buffer.contents buf) + expanded_command_string) + ~build_hash:id ~success:true + ~workdir:(ExecutionState.workdir previous_state) + ~environment:(ExecutionState.env previous_state) | Error (id_opt, msg) -> ( match id_opt with | Some id -> @@ -115,9 +120,7 @@ let process_single_command_execution previous_state env_override leaf ~output:(msg ^ "\n" ^ Buffer.contents buf) expanded_command_string in - ExecutionState.v cmd_result id false - (ExecutionState.workdir previous_state) - (ExecutionState.env previous_state) + ExecutionState.command_fail previous_state cmd_result | None -> let old_id = ExecutionState.build_hash previous_state in let cmd_result = @@ -125,6 +128,4 @@ let process_single_command_execution previous_state env_override leaf ~output:(msg ^ "\n" ^ Buffer.contents buf) expanded_command_string in - ExecutionState.v cmd_result old_id false - (ExecutionState.workdir previous_state) - (ExecutionState.env previous_state))) + ExecutionState.command_fail previous_state cmd_result)) diff --git a/src/lib/execution/run_block.mli b/src/lib/run_block.mli similarity index 56% rename from src/lib/execution/run_block.mli rename to src/lib/run_block.mli index d0751e93..013f11e2 100644 --- a/src/lib/execution/run_block.mli +++ b/src/lib/run_block.mli @@ -12,9 +12,19 @@ module ExecutionState : sig type t [@@deriving sexp] val v : - CommandResult.t -> string -> bool -> string -> (string * string) list -> t + result:CommandResult.t -> + build_hash:string -> + success:bool -> + workdir:string -> + environment:(string * string) list -> + t + + val init : + build_hash:string -> + workdir:string -> + environment:(string * string) list -> + t - val init : string -> string -> (string * string) list -> t val result : t -> CommandResult.t val build_hash : t -> string val success : t -> bool @@ -24,21 +34,22 @@ module ExecutionState : sig end val process_single_command_execution : - ExecutionState.t -> - (string * string) list -> - Leaf.t -> - (string * string list) list -> - (ExecutionState.t -> - Leaf.t -> - string -> - Buffer.t -> - (string, string option * string) result) -> + previous_state:ExecutionState.t -> + environment_override:(string * string) list -> + command_leaf:Leaf.t -> + file_subs_map:(string * string list) list -> + run_f: + (ExecutionState.t -> + Leaf.t -> + string -> + Buffer.t -> + (string, string option * string) result) -> string -> ExecutionState.t -(** [process_single_command_execution previous_state environment_override leaf file_map task_runner command_string] - evaluates the [command_string] based on the state of the previous exection [previous_state]. Certain commands +(** [process_single_command_execution previous_state environment_override command_leaf file_map task_runner command_string] + evaluates the [command_string] based on the state of the previous execution [previous_state]. Certain commands will just update the state machine (e.g., cd and export), but commands that are side effect driven will - invoke [task_runner] to do the actual exection - most likely with Obuilder, but the point here is to keep + invoke [task_runner] to do the actual execution - most likely with Obuilder, but the point here is to keep that stuff external to allow for easier testing. Currently this has a complicated interface as it was before part of the main md run look - the aim is over diff --git a/src/test/run_block.ml b/src/test/run_block.ml index 24cf2294..23cd80be 100644 --- a/src/test/run_block.ml +++ b/src/test/run_block.ml @@ -1,5 +1,8 @@ let test_initial_block () = - let es = Shark.Run_block.ExecutionState.init "id" "/some/path" [] in + let es = + Shark.Run_block.ExecutionState.init ~build_hash:"id" ~workdir:"/some/path" + ~environment:[] + in Alcotest.(check string) "Check id" "id" (Shark.Run_block.ExecutionState.build_hash es); @@ -16,18 +19,22 @@ let test_simple_change_dir () = let raw_command = "cd /data/arg1" in let command = Shark.Command.of_string raw_command in let inputs = [ Shark.Datafile.v 0 (Fpath.v "/data/arg1") ] in - let leaf = + let command_leaf = Shark.Leaf.v 42 (Option.get command) Shark.Leaf.Command inputs [] in - let es = Shark.Run_block.ExecutionState.init "id" "/some/path" [] in + let es = + Shark.Run_block.ExecutionState.init ~build_hash:"id" ~workdir:"/some/path" + ~environment:[] + in Alcotest.(check string) "Check path" "/some/path" (Shark.Run_block.ExecutionState.workdir es); let updated = - Shark.Run_block.process_single_command_execution es [] leaf [] null_runner - raw_command + Shark.Run_block.process_single_command_execution ~previous_state:es + ~environment_override:[] ~command_leaf ~file_subs_map:[] + ~run_f:null_runner raw_command in Alcotest.(check string) "Check id" "id" @@ -42,16 +49,22 @@ let test_simple_change_dir () = let test_simple_env_udpate () = let raw_command = "export SOMEKEY=SOMEVALUE" in let command = Shark.Command.of_string raw_command in - let leaf = Shark.Leaf.v 42 (Option.get command) Shark.Leaf.Command [] [] in + let command_leaf = + Shark.Leaf.v 42 (Option.get command) Shark.Leaf.Command [] [] + in - let es = Shark.Run_block.ExecutionState.init "id" "/some/path" [] in + let es = + Shark.Run_block.ExecutionState.init ~build_hash:"id" ~workdir:"/some/path" + ~environment:[] + in Alcotest.(check (list (pair string string))) "Check env" [] (Shark.Run_block.ExecutionState.env es); let updated = - Shark.Run_block.process_single_command_execution es [] leaf [] null_runner - raw_command + Shark.Run_block.process_single_command_execution ~previous_state:es + ~environment_override:[] ~command_leaf ~file_subs_map:[] + ~run_f:null_runner raw_command in Alcotest.(check string) "Check id" "id" @@ -67,18 +80,24 @@ let test_simple_env_udpate () = let test_override_env_udpate () = let raw_command = "export SOMEKEY=SOMEVALUE" in let command = Shark.Command.of_string raw_command in - let leaf = Shark.Leaf.v 42 (Option.get command) Shark.Leaf.Command [] [] in + let command_leaf = + Shark.Leaf.v 42 (Option.get command) Shark.Leaf.Command [] [] + in - let es = Shark.Run_block.ExecutionState.init "id" "/some/path" [] in + let es = + Shark.Run_block.ExecutionState.init ~build_hash:"id" ~workdir:"/some/path" + ~environment:[] + in Alcotest.(check (list (pair string string))) "Check env" [] (Shark.Run_block.ExecutionState.env es); - let env_override = [ ("SOMEKEY", "OTHERVALUE") ] in + let environment_override = [ ("SOMEKEY", "OTHERVALUE") ] in let updated = - Shark.Run_block.process_single_command_execution es env_override leaf [] - null_runner raw_command + Shark.Run_block.process_single_command_execution ~previous_state:es + ~environment_override ~command_leaf ~file_subs_map:[] ~run_f:null_runner + raw_command in Alcotest.(check string) "Check id" "id" @@ -94,9 +113,14 @@ let test_override_env_udpate () = let test_simple_command_execute () = let raw_command = "mycommand.exe" in let command = Shark.Command.of_string raw_command in - let leaf = Shark.Leaf.v 42 (Option.get command) Shark.Leaf.Command [] [] in + let command_leaf = + Shark.Leaf.v 42 (Option.get command) Shark.Leaf.Command [] [] + in - let es = Shark.Run_block.ExecutionState.init "id" "/some/path" [] in + let es = + Shark.Run_block.ExecutionState.init ~build_hash:"id" ~workdir:"/some/path" + ~environment:[] + in let runner_called = ref false in let runner _es _l _s _b = @@ -105,7 +129,8 @@ let test_simple_command_execute () = in let updated = - Shark.Run_block.process_single_command_execution es [] leaf [] runner + Shark.Run_block.process_single_command_execution ~previous_state:es + ~environment_override:[] ~command_leaf ~file_subs_map:[] ~run_f:runner raw_command in Alcotest.(check string) @@ -127,5 +152,5 @@ let tests = ( "Test env update with command line override", `Quick, test_override_env_udpate ); - ("Test a simple command exection", `Quick, test_simple_command_execute); + ("Test a simple command execution", `Quick, test_simple_command_execute); ] diff --git a/src/test/test.ml b/src/test/test.ml index c1596856..71a24a4e 100644 --- a/src/test/test.ml +++ b/src/test/test.ml @@ -7,5 +7,5 @@ let () = ("frontmatter parsing", Frontmatter.tests); ("AST parsing", Ast.tests); ("AST leaf processing", Leaf.tests); - ("Command exection", Run_block.tests); + ("Command execution", Run_block.tests); ]