From c66778f84d371152cdfa565d6b864e500220b1c9 Mon Sep 17 00:00:00 2001 From: Michael Dales Date: Mon, 15 Jul 2024 16:35:54 +0100 Subject: [PATCH 1/2] Remove unnecessary duplicate state from command execution. --- src/lib/md.ml | 36 ++++++++++++++++++------------------ 1 file changed, 18 insertions(+), 18 deletions(-) diff --git a/src/lib/md.ml b/src/lib/md.ml index 6a2ab822..6506b3d9 100644 --- a/src/lib/md.ml +++ b/src/lib/md.ml @@ -222,10 +222,17 @@ let process_run_block ?(environment_override = []) ~fs ~build_cache ~pool store | Error (`Failed (id, msg)) -> Error (Some id, msg) in - let process_single_command acc command_leaf = - let previous_results, previous_state = acc in + let process_single_command command_history command_leaf = + let previous_states = List.hd command_history in + let previous_state = + match previous_states with + | hd :: _ -> hd + | [] -> + Fmt.failwith "There were no processed blocks for %s" + (Command.name (Leaf.command command_leaf)) + in match Run_block.ExecutionState.success previous_state with - | false -> acc + | false -> command_history | true -> let inputs = Leaf.inputs command_leaf in let input_and_hashes = @@ -289,23 +296,16 @@ let process_run_block ?(environment_override = []) ~fs ~build_cache ~pool store ~run_f:obuilder_command_runner) inputs in - let es = - match processed_blocks with - | hd :: _ -> hd - | [] -> - Fmt.failwith "There were no processed blocks for %s" - (Command.name (Leaf.command command_leaf)) - in - (processed_blocks :: previous_results, es) + processed_blocks :: command_history in - let ids_and_output_and_cmd, _es = - List.fold_left process_single_command - ( [], - Run_block.ExecutionState.init ~build_hash:build - ~workdir:(Fpath.to_string (Ast.default_container_path ast)) - ~environment:[] ) - commands + let initial_state = + Run_block.ExecutionState.init ~build_hash:build + ~workdir:(Fpath.to_string (Ast.default_container_path ast)) + ~environment:[] + in + let ids_and_output_and_cmd = + List.fold_left process_single_command [ [ initial_state ] ] commands in let last = List.hd ids_and_output_and_cmd in let id = Run_block.ExecutionState.build_hash (List.hd last) in From 47c2e9b2f692677a1b4de4bebf15092b642fdca6 Mon Sep 17 00:00:00 2001 From: Michael Dales Date: Thu, 18 Jul 2024 15:04:18 +0100 Subject: [PATCH 2/2] support multiple imports in a block --- src/bin/main.ml | 8 ++--- src/lib/block.ml | 88 ++++++++++++++++++++++------------------------- src/lib/block.mli | 2 +- src/lib/md.ml | 4 +-- src/lib/md.mli | 7 ++-- src/test/block.ml | 22 +++++------- 6 files changed, 57 insertions(+), 74 deletions(-) diff --git a/src/bin/main.ml b/src/bin/main.ml index ac269598..60708e89 100644 --- a/src/bin/main.ml +++ b/src/bin/main.ml @@ -159,12 +159,8 @@ let md ~fs ~net ~domain_mgr ~proc () no_run store conf file port fetcher jobs (* First we translate the import statement to a build block *) let uid = string_of_int !import_uid in incr import_uid; - let (cb, blk), src_dir_opt = - Shark.Md.translate_import_block ~uid block - in - let import_src_dir = - match src_dir_opt with Some x -> x | None -> src_dir - in + let cb, blk = Shark.Md.translate_import_block ~uid block in + let import_src_dir = "/" in (* Now we build the block *) (* Import block digests need to be mapped to this build hash *) let hb = diff --git a/src/lib/block.ml b/src/lib/block.ml index 7a0738c6..06b5a090 100644 --- a/src/lib/block.ml +++ b/src/lib/block.ml @@ -156,49 +156,45 @@ let digest : t -> string = function let import_spec b = let open Obuilder_spec in - (* TODO: Support multi-import statements *) - let url, target_path = imports b |> List.hd in - match Uri.scheme url with - | None | Some "file" -> - (* Choose better image, just need tools to import? *) - let fpath = - match Fpath.of_string (Uri.path url) with - | Ok p -> p - | Error (`Msg msg) -> - Fmt.failwith "Failed to parse path %s: %s" (Uri.path url) msg - in - let src_dir, path = Fpath.split_base fpath in - let src_dir = Fpath.rem_empty_seg src_dir in - ( stage ~from:(`Image "alpine") - [ - (* shell [ "/bin/sh"; "-c" ]; *) - (* run "mkdir -p %s" (Fpath.to_string (Fpath.parent path)); *) - copy [ Fpath.to_string path ] ~dst:(Fpath.to_string target_path); - ], - Some (Fpath.to_string src_dir) ) - | Some "http" | Some "https" -> ( - let src_path = Uri.path url in - match String.cut ~rev:true ~sep:"." src_path with - | Some (_, "git") -> - (* Choose better image, just need tools to import? *) - ( stage ~from:(`Image "alpine") - [ - shell [ "/bin/sh"; "-c" ]; - run ~network:[ "host" ] "apk add --no-cache git"; - run ~network:[ "host" ] "mkdir -p /data && git clone %s %s" - (Uri.to_string url) - (Fpath.to_string target_path); - ], - None ) - | _ -> - (* Choose better image, just need tools to import? *) - ( stage ~from:(`Image "alpine") - [ - shell [ "/bin/sh"; "-c" ]; - run ~network:[ "host" ] "apk add --no-cache curl"; - run ~network:[ "host" ] "mkdir -p /data && curl -O %s %s" - (Fpath.to_string target_path) - (Uri.to_string url); - ], - None )) - | Some scheme -> Fmt.failwith "Unsupported import scheme %s" scheme + let commands = + imports b + |> List.concat_map (fun (url, target_path) -> + match Uri.scheme url with + | None | Some "file" -> + let fpath = + match Fpath.of_string (Uri.path url) with + | Ok p -> p + | Error (`Msg msg) -> + Fmt.failwith "Failed to parse path %s: %s" (Uri.path url) + msg + in + let relpath = + Option.get (Fpath.relativize ~root:(Fpath.v "/") fpath) + in + [ + copy + [ Fpath.to_string relpath ] + ~dst:(Fpath.to_string target_path); + ] + | Some "http" | Some "https" -> ( + let src_path = Uri.path url in + match String.cut ~rev:true ~sep:"." src_path with + | Some (_, "git") -> + [ + shell [ "/bin/sh"; "-c" ]; + run ~network:[ "host" ] "apk add --no-cache git"; + run ~network:[ "host" ] "mkdir -p /data && git clone %s %s" + (Uri.to_string url) + (Fpath.to_string target_path); + ] + | _ -> + [ + shell [ "/bin/sh"; "-c" ]; + run ~network:[ "host" ] "apk add --no-cache curl"; + run ~network:[ "host" ] "mkdir -p /data && curl -O %s %s" + (Fpath.to_string target_path) + (Uri.to_string url); + ]) + | Some scheme -> Fmt.failwith "Unsupported import scheme %s" scheme) + in + stage ~from:(`Image "alpine") commands diff --git a/src/lib/block.mli b/src/lib/block.mli index 6edc4f89..f1e4a768 100644 --- a/src/lib/block.mli +++ b/src/lib/block.mli @@ -73,5 +73,5 @@ val imports : t -> (Uri.t * Fpath.t) list val digest : t -> string -val import_spec : t -> Obuilder_spec.t * string option +val import_spec : t -> Obuilder_spec.t (** For a shark-import block generate the spec to execute to enact the import. *) diff --git a/src/lib/md.ml b/src/lib/md.ml index 6506b3d9..801138e9 100644 --- a/src/lib/md.ml +++ b/src/lib/md.ml @@ -408,7 +408,7 @@ let process_publish_block (Obuilder.Store_spec.Store ((module Store), store)) let translate_import_block ~uid block = match Block.kind block with | `Import -> - let spec, src_dir_opt = Block.import_spec block in + let spec = Block.import_spec block in Logs.info (fun f -> f "import spec: %a" Obuilder_spec.pp spec); let body = Sexplib.Sexp.to_string_hum (Obuilder_spec.sexp_of_t spec) in let alias = Fmt.str "import-statement-%s" uid in @@ -418,5 +418,5 @@ let translate_import_block ~uid block = ~info_string:(Fmt.str "shark-build:%s" alias, Cmarkit.Meta.none) (Cmarkit.Block_line.list_of_string body) in - ((code_block, block), src_dir_opt) + (code_block, block) | _ -> failwith "Expected Import Block" diff --git a/src/lib/md.mli b/src/lib/md.mli index 7edfae1c..24d3df71 100644 --- a/src/lib/md.mli +++ b/src/lib/md.mli @@ -48,9 +48,6 @@ val process_publish_block : Cmarkit.Block.Code_block.t * Block.t val translate_import_block : - uid:string -> - Block.t -> - (Cmarkit.Block.Code_block.t * Block.t) * string option + uid:string -> Block.t -> Cmarkit.Block.Code_block.t * Block.t (** [translate_import_block uid block] will generate an expanded code block that contains a shark-build spec that - carries out the actual import when evaluated. If the import is from the file system then the optional second - return is the src_dir needed for the file system context when the spec is evaluated. *) + carries out the actual import when evaluated. *) diff --git a/src/test/block.ml b/src/test/block.ml index 88944275..3be5fe80 100644 --- a/src/test/block.ml +++ b/src/test/block.ml @@ -55,12 +55,11 @@ let test_git_import_block () = in Alcotest.(check (list (pair string string))) "Single import" expected test; - let spec, src_dir = Shark.Block.import_spec block in + let spec = Shark.Block.import_spec block in let specbody = Sexplib.Sexp.to_string_hum (Obuilder_spec.sexp_of_t spec) in Alcotest.(check bool) "Found git command" true - (Astring.String.is_infix ~affix:"git clone" specbody); - Alcotest.(check (option string)) "No src_dir change" None src_dir + (Astring.String.is_infix ~affix:"git clone" specbody) let test_http_import_block () = let body = "https://example.com/data/something.csv /data/src.csv" in @@ -75,12 +74,11 @@ let test_http_import_block () = in Alcotest.(check (list (pair string string))) "Single import" expected test; - let spec, src_dir = Shark.Block.import_spec block in + let spec = Shark.Block.import_spec block in let specbody = Sexplib.Sexp.to_string_hum (Obuilder_spec.sexp_of_t spec) in Alcotest.(check bool) "Found git command" true - (Astring.String.is_infix ~affix:"curl -O" specbody); - Alcotest.(check (option string)) "No src_dir change" None src_dir + (Astring.String.is_infix ~affix:"curl -O" specbody) let test_file_import_block_no_schema () = let body = "/home/michael/file.csv /data/file.csv" in @@ -93,13 +91,11 @@ let test_file_import_block_no_schema () = in Alcotest.(check (list (pair string string))) "Single import" expected test; - let spec, src_dir = Shark.Block.import_spec block in + let spec = Shark.Block.import_spec block in let specbody = Sexplib.Sexp.to_string_hum (Obuilder_spec.sexp_of_t spec) in Alcotest.(check bool) "Found git command" true - (Astring.String.is_infix ~affix:"copy" specbody); - Alcotest.(check (option string)) - "Src_dir change" (Some "/home/michael") src_dir + (Astring.String.is_infix ~affix:"copy" specbody) let test_file_import_block_with_schema () = let body = "file:///home/michael/file.csv /data/file.csv" in @@ -112,13 +108,11 @@ let test_file_import_block_with_schema () = in Alcotest.(check (list (pair string string))) "Single import" expected test; - let spec, src_dir = Shark.Block.import_spec block in + let spec = Shark.Block.import_spec block in let specbody = Sexplib.Sexp.to_string_hum (Obuilder_spec.sexp_of_t spec) in Alcotest.(check bool) "Found git command" true - (Astring.String.is_infix ~affix:"copy" specbody); - Alcotest.(check (option string)) - "Src_dir change" (Some "/home/michael") src_dir + (Astring.String.is_infix ~affix:"copy" specbody) let tests = [