From f6b45d2ec1c7bcba46e46dfe0ea9c6c6d876f186 Mon Sep 17 00:00:00 2001 From: Patrick Ferris Date: Thu, 18 Mar 2021 17:19:44 +0000 Subject: [PATCH] reuse get-base with sandbox-specifc from function --- lib/build.ml | 37 +++++++++---------- lib/runc_sandbox.ml | 38 +++++++++---------- lib/runc_sandbox.mli | 11 ++++++ lib/s.ml | 26 +++---------- main.ml | 2 +- test/mock_sandbox.ml | 86 +------------------------------------------ test/mock_sandbox.mli | 10 +---- test/test.ml | 2 +- 8 files changed, 57 insertions(+), 155 deletions(-) diff --git a/lib/build.ml b/lib/build.ml index a825d496..3ebe0f56 100644 --- a/lib/build.ml +++ b/lib/build.ml @@ -221,7 +221,22 @@ module Make (Raw_store : S.STORE) (Sandbox : S.SANDBOX) = struct | `Shell shell -> k ~base ~context:{context with shell} - let rec build ~scope t context { Obuilder_spec.child_builds; from; ops } = +let get_base t ~log base = + log `Heading (Fmt.strf "(from %a)" Sexplib.Sexp.pp_hum (Atom base)); + let id = Sha256.to_hex (Sha256.string base) in + Store.build t.store ~id ~log (fun ~cancelled:_ ~log tmp -> + Log.info (fun f -> f "Base image not present; importing %S..." base); + Sandbox.from ~log ~base tmp >>!= fun env -> + Os.write_file ~path:(tmp / "env") + (Sexplib.Sexp.to_string_hum Saved_context.(sexp_of_t {env})) >>= fun () -> + Lwt_result.return () + ) + >>!= fun id -> + let path = Option.get (Store.result t.store id) in + let { Saved_context.env } = Saved_context.t_of_sexp (Sexplib.Sexp.load_sexp (path / "env")) in + Lwt_result.return (id, env) + + let rec build ~scope t context { Obuilder_spec.child_builds; from = base; ops } = let rec aux context = function | [] -> Lwt_result.return context | (name, child_spec) :: child_builds -> @@ -232,18 +247,7 @@ module Make (Raw_store : S.STORE) (Sandbox : S.SANDBOX) = struct aux context child_builds in aux context child_builds >>!= fun context -> - let log = context.Context.log in - let id = Sha256.to_hex (Sha256.string from) in - let f = Sandbox.from ~from ~log t.sandbox in - (Store.build t.store ~id ~log f >>!= fun id -> - (match Store.result t.store id with - | Some path -> - if Sys.file_exists @@ path / "env" then begin - let { Saved_context.env } = Saved_context.t_of_sexp (Sexplib.Sexp.load_sexp (path / "env")) in - Lwt_result.return (id, env) - end else Lwt_result.return (id, []) - | None -> Lwt_result.return (id, []))) - >>!= fun (id, env) -> + get_base t ~log:context.Context.log base >>!= fun (id, env) -> let context = { context with env = context.env @ env } in run_steps t ~context ~base:id ops @@ -277,12 +281,7 @@ module Make (Raw_store : S.STORE) (Sandbox : S.SANDBOX) = struct (* Get the base image first, before starting the timer. *) let switch = Lwt_switch.create () in let context = Context.v ~switch ~log ~src_dir:"/tmp" () in - let id = Sha256.to_hex (Sha256.string healthcheck_base) in - let f = Sandbox.from ~from:healthcheck_base ~log t.sandbox in - (Store.build t.store ~id ~log f >>!= fun id -> - let path = Option.get (Store.result t.store id) in - let { Saved_context.env } = Saved_context.t_of_sexp (Sexplib.Sexp.load_sexp (path / "env")) in - Lwt_result.return (id, env)) >>= function + get_base t ~log healthcheck_base >>= function | Error (`Msg _) as x -> Lwt.return x | Error `Cancelled -> failwith "Cancelled getting base image (shouldn't happen!)" | Ok (id, env) -> diff --git a/lib/runc_sandbox.ml b/lib/runc_sandbox.ml index eca16d0a..f0278c06 100644 --- a/lib/runc_sandbox.ml +++ b/lib/runc_sandbox.ml @@ -315,26 +315,22 @@ let with_container ~log base fn = (fun () -> fn cid) (fun () -> Os.exec ~stdout:`Dev_null ["docker"; "rm"; "--"; cid]) -let from ~log ~from _t = - let base = from in - log `Heading (Fmt.strf "(from %a)" Sexplib.Sexp.pp_hum (Atom base)); - (fun ~cancelled:_ ~log tmp -> - Log.info (fun f -> f "Base image not present; importing %S...@." base); - let rootfs = tmp / "rootfs" in - Os.sudo ["mkdir"; "--mode=755"; "--"; rootfs] >>= fun () -> - (* Lwt_process.exec ("", [| "docker"; "pull"; "--"; base |]) >>= fun _ -> *) - with_container ~log base (fun cid -> - Os.with_pipe_between_children @@ fun ~r ~w -> - let exporter = Os.exec ~stdout:(`FD_move_safely w) ["docker"; "export"; "--"; cid] in - let tar = Os.sudo ~stdin:(`FD_move_safely r) ["tar"; "-C"; rootfs; "-xf"; "-"] in - exporter >>= fun () -> - tar - ) >>= fun () -> - export_env base >>= fun env -> - Os.write_file ~path:(tmp / "env") - (Sexplib.Sexp.to_string_hum Saved_context.(sexp_of_t {env})) >>= fun () -> - Lwt_result.return () - ) +let from ~log ~base tmp = + Log.info (fun f -> f "Base image not present; importing %S...@." base); + let rootfs = tmp / "rootfs" in + Os.sudo ["mkdir"; "--mode=755"; "--"; rootfs] >>= fun () -> + (* Lwt_process.exec ("", [| "docker"; "pull"; "--"; base |]) >>= fun _ -> *) + with_container ~log base (fun cid -> + Os.with_pipe_between_children @@ fun ~r ~w -> + let exporter = Os.exec ~stdout:(`FD_move_safely w) ["docker"; "export"; "--"; cid] in + let tar = Os.sudo ~stdin:(`FD_move_safely r) ["tar"; "-C"; rootfs; "-xf"; "-"] in + exporter >>= fun () -> + tar + ) >>= fun () -> + export_env base >>= fun env -> + Os.write_file ~path:(tmp / "env") + (Sexplib.Sexp.to_string_hum Saved_context.(sexp_of_t {env})) >>= fun () -> + Lwt_result.return env let run ~cancelled ?stdin:stdin ~log t config results_dir = Lwt_io.with_temp_dir ~prefix:"obuilder-runc-" @@ fun tmp -> @@ -402,7 +398,7 @@ let fast_sync = Arg.value @@ Arg.opt Arg.bool false @@ Arg.info - ~doc:"Install a seccomp filter that skips all synchronous syscalls" + ~doc:"Ignore sync syscalls (requires runc >= 1.0.0-rc92)" ~docv:"FAST_SYNC" ["fast-sync"] diff --git a/lib/runc_sandbox.mli b/lib/runc_sandbox.mli index f0f85b48..618eca63 100644 --- a/lib/runc_sandbox.mli +++ b/lib/runc_sandbox.mli @@ -2,3 +2,14 @@ include S.SANDBOX +type config [@@deriving sexp] +(** The type of sandbox configurations *) + +val cmdliner : config Cmdliner.Term.t +(** [cmdliner] is used for command-line interfaces to generate the necessary flags + and parameters to setup a specific sandbox's configuration. *) + +val create : ?state_dir:string -> config -> t Lwt.t +(** [create ?state_dir config] generates a new sandbox -- the state directory is used for + runc environments where the store's state directory can be passed in, otherwise just leave + it out. *) diff --git a/lib/s.ml b/lib/s.ml index d5709dd9..d43d4aad 100644 --- a/lib/s.ml +++ b/lib/s.ml @@ -64,31 +64,15 @@ end module type SANDBOX = sig type t - type config [@@deriving sexp] - (** The type of sandbox configurations *) - - val cmdliner : config Cmdliner.Term.t - (** [cmdliner] is used for command-line interfaces to generate the necessary flags - and parameters to setup a specific sandbox's configuration. *) - - val create : ?state_dir:string -> config -> t Lwt.t - (** [create ?state_dir config] generates a new sandbox -- the state directory is used for - runc environments where the store's state directory can be passed in, otherwise just leave - it out. *) - val from : - log:logger -> - from:string -> - t -> - cancelled:unit Lwt.t -> log:Build_log.t -> - string -> (unit, [ `Cancelled | `Msg of string ]) result Lwt.t - (** [from t ~log ~from_stage] generates the function to be run as the initial build-step - for the sandboxing environment using Obuilder's from stage. + base:string -> + string -> + (Config.env, [ `Cancelled | `Msg of string ]) result Lwt.t + (** [from ~log ~base tmp] should fetch the [base] image and configure it in [tmp] @param log Used for writing logs. - @param from The base template to build a new sandbox from (e.g. docker image hash). + @param base The base template to build a new sandbox from (e.g. docker image hash). *) - val run : cancelled:unit Lwt.t -> ?stdin:Os.unix_fd -> diff --git a/main.ml b/main.ml index 0a0f8653..703df4cc 100644 --- a/main.ml +++ b/main.ml @@ -18,7 +18,7 @@ let log tag msg = let create_builder spec conf = Obuilder.Store_spec.to_store spec >>= fun (Store ((module Store), store)) -> let module Builder = Obuilder.Builder(Store)(Sandbox) in - Sandbox.create ~state_dir:(Store.state_dir store / "runc") conf >|= fun sandbox -> + Sandbox.create ~state_dir:(Store.state_dir store / "sandbox") conf >|= fun sandbox -> let builder = Builder.v ~store ~sandbox in Builder ((module Builder), builder) diff --git a/test/mock_sandbox.ml b/test/mock_sandbox.ml index 3b62c0dd..157d7bc1 100644 --- a/test/mock_sandbox.ml +++ b/test/mock_sandbox.ml @@ -1,7 +1,3 @@ -open Sexplib.Conv -open Lwt.Infix -open Obuilder - type t = { dir : string; expect : @@ -13,88 +9,12 @@ type t = { (unit, [`Msg of string | `Cancelled]) Lwt_result.t) Queue.t; } -type config = { - dir : string; -}[@@deriving sexp] - -module Saved_context = struct - type t = { - env : Config.env; - } [@@deriving sexp] -end - -open Cmdliner -let dir = - Arg.required @@ - Arg.opt Arg.(some file) None @@ - Arg.info - ~doc:"Directory" - ~docv:"DIR" - ["dir"] -let cmdliner : config Term.t = - let make dir = - { dir } - in - Term.(const make $ dir) let expect t x = Queue.add x t.expect -let export_env base = - Os.pread ["docker"; "image"; "inspect"; - "--format"; {|{{range .Config.Env}}{{print . "\x00"}}{{end}}|}; - "--"; base] >|= fun env -> - String.split_on_char '\x00' env - |> List.filter_map (function - | "\n" -> None - | kv -> - match Astring.String.cut ~sep:"=" kv with - | None -> Fmt.failwith "Invalid environment in Docker image %S (should be 'K=V')" kv - | Some _ as pair -> pair - ) -let copy_to_log ~src ~dst = - let buf = Bytes.create 4096 in - let rec aux () = - Lwt_unix.read src buf 0 (Bytes.length buf) >>= function - | 0 -> Lwt.return_unit - | n -> Build_log.write dst (Bytes.sub_string buf 0 n) >>= aux - in - aux () - -let with_container ~log base fn = - Os.with_pipe_from_child (fun ~r ~w -> - (* We might need to do a pull here, so log the output to show progress. *) - let copy = copy_to_log ~src:r ~dst:log in - Os.pread ~stderr:(`FD_move_safely w) ["docker"; "create"; "--"; base] >>= fun cid -> - copy >|= fun () -> - String.trim cid - ) >>= fun cid -> - Lwt.finalize - (fun () -> fn cid) - (fun () -> Os.exec ~stdout:`Dev_null ["docker"; "rm"; "--"; cid]) - -let from ~log ~from _t = - let ( / ) = Filename.concat in - let base = from in - log `Heading (Fmt.strf "(from %a)" Sexplib.Sexp.pp_hum (Atom base)); - (fun ~cancelled:_ ~log tmp -> - Logs.info (fun f -> f "Base image not present; importing %S...@." base); - let rootfs = tmp / "rootfs" in - Os.sudo ["mkdir"; "--mode=755"; "--"; rootfs] >>= fun () -> - (* Lwt_process.exec ("", [| "docker"; "pull"; "--"; base |]) >>= fun _ -> *) - with_container ~log base (fun cid -> - Os.with_pipe_between_children @@ fun ~r ~w -> - let exporter = Os.exec ~stdout:(`FD_move_safely w) ["docker"; "export"; "--"; cid] in - let tar = Os.sudo ~stdin:(`FD_move_safely r) ["tar"; "-C"; rootfs; "-xf"; "-"] in - exporter >>= fun () -> - tar - ) >>= fun () -> - export_env base >>= fun env -> - Os.write_file ~path:(tmp / "env") - (Sexplib.Sexp.to_string_hum Saved_context.(sexp_of_t {env})) >>= fun () -> - Lwt_result.return () - ) +let from = Obuilder.Runc_sandbox.from let run ~cancelled ?stdin ~log t (config:Obuilder.Config.t) dir = @@ -108,6 +28,4 @@ let run ~cancelled ?stdin ~log t (config:Obuilder.Config.t) dir = | ex -> Lwt_result.fail (`Msg (Printexc.to_string ex)) ) -let create ?state_dir:_ conf = Lwt.return { dir = conf.dir; expect = Queue.create () } - -let mock_create conf = { dir = conf.dir; expect = Queue.create () } +let create dir = { dir; expect = Queue.create () } \ No newline at end of file diff --git a/test/mock_sandbox.mli b/test/mock_sandbox.mli index ca9baae3..eaaf9fb9 100644 --- a/test/mock_sandbox.mli +++ b/test/mock_sandbox.mli @@ -1,12 +1,6 @@ -type config = { dir : string } [@@derivign sexp] -(** Exposing the configuration so testing can generate them rather than - relying on cmdliner *) - -include Obuilder.S.SANDBOX with type config := config - -val mock_create : config -> t -(** To simplify test sandbox creation, this is an Lwt free [create] function *) +include Obuilder.S.SANDBOX +val create : string -> t val expect : t -> (cancelled:unit Lwt.t -> ?stdin:Obuilder.Os.unix_fd -> diff --git a/test/test.ml b/test/test.ml index 515d2d32..82f78f0c 100644 --- a/test/test.ml +++ b/test/test.ml @@ -24,7 +24,7 @@ let get store path id = let with_config fn = Mock_store.with_store @@ fun store -> - let sandbox = Mock_sandbox.mock_create { dir = Mock_store.state_dir store / "sandbox" } in + let sandbox = Mock_sandbox.create (Mock_store.state_dir store / "sandbox") in let builder = B.v ~store ~sandbox in let src_dir = Mock_store.state_dir store / "src" in Os.ensure_dir src_dir;