Duplicate Build code for standard backend and Docker backend

Author: MisterDA

lib/build.ml

@@ -27,3 +27,9 @@ module Make (Store : S.STORE) (Sandbox : S.SANDBOX) (Fetch : S.FETCHER) : sig
 
   val v : store:Store.t -> sandbox:Sandbox.t -> t
 end
+
+module Docker : sig
+  include S.BUILDER with type context := Context.t
+
+  val v : store:Docker_store.t -> sandbox:Docker_sandbox.t -> t
+end

lib/build.mli

@@ -166,12 +166,3 @@ module Extract = struct
     in
     export_env base
 end
-
-module Pull = struct
-  let fetch ~log ~rootfs base =
-    ignore rootfs;
-    ignore log;
-    Log.debug (fun f -> f "Docker fetcher pull rootfs:%s base:%s" rootfs base);
-    let* () = pull (`Docker_image base) in
-    Lwt.return_nil
-end

lib/docker.ml

@@ -85,8 +85,3 @@ val obuilder_containers : unit -> [ `Docker_container of string ] list Lwt.t
 module Extract : sig
   include S.FETCHER
 end
-
-(** Fetch (pull) base images using Docker *)
-module Pull : sig
-  include S.FETCHER
-end

lib/docker.mli

@@ -1,23 +1,3 @@
-(rule
- (target sandbox.detected.ml)
- (enabled_if
-  (= %{os_type} Win32))
- (action
-  (copy# sandbox.docker.ml %{target})))
-
-(rule
- (target sandbox.detected.ml)
- (enabled_if
-  (<> %{os_type} Win32))
- (action
-  (copy# sandbox.runc.ml %{target})))
-
-(rule
- (target sandbox.ml)
- (mode fallback)
- (action
-  (copy sandbox.detected.ml %{target})))
-
 (rule
  (target Static_files.ml)
  (deps
@@ -31,7 +11,7 @@
  (preprocess
   (pps ppx_sexp_conv))
   (modules Btrfs_store Build Build_log Config Dao Db Db_store Docker
-   Docker_store Escape Log Manifest Obuilder Os S Sandbox Static_files
+   Docker_store Escape Log Manifest Obuilder Os S Runc_sandbox Docker_sandbox Static_files
    Store_spec Tar_transfer Zfs_store)
  (libraries lwt lwt.unix fmt yojson tar-unix sexplib sqlite3 astring logs sha
    obuilder-spec cmdliner))

lib/sandbox.docker.ml lib/docker_sandbox.mllib/sandbox.docker.ml renamed to lib/docker_sandbox.ml

@@ -11,19 +11,22 @@ module Context = Build.Context
 module Btrfs_store = Btrfs_store
 module Zfs_store = Zfs_store
 module Store_spec = Store_spec
+module Docker_store = Docker_store
 
 (** {2 Fetchers} *)
-module Docker = Docker
+module Docker_extract = Docker.Extract
 
 (** {2 Sandboxes} *)
 
 module Config = Config
-module Sandbox = Sandbox
+module Runc_sandbox = Runc_sandbox
+module Docker_sandbox = Docker_sandbox
 
 (** {2 Builders} *)
 
 module type BUILDER = S.BUILDER with type context := Build.Context.t
 module Builder = Build.Make
+module Docker_builder = Build.Docker
 module Build_log = Build_log
 
 (**/**)

lib/dune

@@ -1,8 +1,6 @@
 open Lwt.Infix
 open Sexplib.Conv
 
-let backend = `Runc
-
 let ( / ) = Filename.concat
 
 type t = {

lib/obuilder.ml

@@ -64,8 +64,6 @@ end
 module type SANDBOX = sig
   type t
 
-  val backend : [ `Runc | `Docker | `Mock ]
-
   val run :
     cancelled:unit Lwt.t ->
     ?stdin:Os.unix_fd ->

lib/sandbox.runc.ml lib/runc_sandbox.mllib/sandbox.runc.ml renamed to lib/runc_sandbox.ml

@@ -2,7 +2,7 @@ open Lwt.Infix
 
 let ( / ) = Filename.concat
 
-module Sandbox = Obuilder.Sandbox
+module Runc_sandbox = Obuilder.Runc_sandbox
 
 type builder = Builder : (module Obuilder.BUILDER with type t = 'a) * 'a -> builder
 
@@ -13,26 +13,39 @@ let log tag msg =
   | `Output -> output_string stdout msg; flush stdout
 
 let create_builder spec conf =
-  Obuilder.Store_spec.to_store spec >>= fun (Store ((module Store), store)) ->
-  let (module Fetcher : Obuilder.S.FETCHER) =
-    match Sandbox.backend with
-    | `Runc | `Mock -> (module Obuilder.Docker.Extract : Obuilder.S.FETCHER)
-    | `Docker -> (module Obuilder.Docker.Pull : Obuilder.S.FETCHER)
-  in
-  let module Builder = Obuilder.Builder(Store)(Sandbox)(Fetcher) in
-  Sandbox.create ~state_dir:(Store.state_dir store / "sandbox") conf >|= fun sandbox ->
+  let open Obuilder in
+  Store_spec.to_store spec >>= fun (Store ((module Store), store)) ->
+  let module Builder = Builder (Store) (Runc_sandbox) (Docker_extract) in
+  Runc_sandbox.create ~state_dir:(Store.state_dir store / "sandbox") conf >|= fun sandbox ->
   let builder = Builder.v ~store ~sandbox in
   Builder ((module Builder), builder)
 
+let create_docker_builder path conf =
+  let open Obuilder in
+  let module Builder = Docker_builder in
+  Docker_store.create path >>= fun store ->
+  Docker_sandbox.create ~state_dir:(Docker_store.state_dir store / "sandbox") conf >|= fun sandbox ->
+  let builder = Docker_builder.v ~store ~sandbox in
+  Builder ((module Docker_builder), builder)
+
 let read_whole_file path =
   let ic = open_in_bin path in
   Fun.protect ~finally:(fun () -> close_in ic) @@ fun () ->
   let len = in_channel_length ic in
   really_input_string ic len
 
-let build () store spec conf src_dir secrets =
+let build () store docker_backend spec runc_conf docker_conf src_dir secrets =
   Lwt_main.run begin
-    create_builder store conf >>= fun (Builder ((module Builder), builder)) ->
+    begin match store, docker_backend with
+    | None, None ->
+       Fmt.epr "Must select either a store or the Docker backend@.";
+       exit 1
+    | Some _, Some _ ->
+       Fmt.epr "Cannot select a store and the Docker backend@.";
+       exit 1
+    | Some store, None -> create_builder store runc_conf
+    | None, Some path -> create_docker_builder path docker_conf
+    end >>= fun (Builder ((module Builder), builder)) ->
     let spec =
       try Obuilder.Spec.t_of_sexp (Sexplib.Sexp.load_sexp spec)
       with Failure msg ->
@@ -107,14 +120,30 @@ let src_dir =
 let store_t =
   Arg.conv Obuilder.Store_spec.(of_string, pp)
 
-let store =
+let store_required =
   Arg.required @@
   Arg.opt Arg.(some store_t) None @@
   Arg.info
-    ~doc:"zfs:pool or btrfs:/path or docker:/path for build cache"
+    ~doc:"zfs:pool or btrfs:/path for build cache"
     ~docv:"STORE"
     ["store"]
 
+let store =
+  Arg.value @@
+  Arg.opt Arg.(some store_t) None @@
+  Arg.info
+    ~doc:"zfs:pool or btrfs:/path for build cache"
+    ~docv:"STORE"
+    ["store"]
+
+let docker_backend =
+  Arg.value @@
+  Arg.opt Arg.(some string) None @@
+  Arg.info
+    ~doc:"Use the Docker store and sandbox backend. Use $(docv) for temporary files."
+    ~docv:"path"
+    ["docker-backend"]
+
 let id =
   Arg.required @@
   Arg.pos 0 Arg.(some string) None @@
@@ -133,12 +162,13 @@ let secrets =
 
 let build =
   let doc = "Build a spec file." in
-  Term.(const build $ setup_log $ store $ spec_file $ Sandbox.cmdliner $ src_dir $ secrets),
+  Term.(const build $ setup_log $ store $ docker_backend $ spec_file
+        $ Obuilder.Runc_sandbox.cmdliner $ Obuilder.Docker_sandbox.cmdliner $ src_dir $ secrets),
   Term.info "build" ~doc
 
 let delete =
   let doc = "Recursively delete a cached build result." in
-  Term.(const delete $ setup_log $ store $ Sandbox.cmdliner $ id),
+  Term.(const delete $ setup_log $ store_required $ Runc_sandbox.cmdliner $ id),
   Term.info "delete" ~doc
 
 let buildkit =
@@ -155,7 +185,7 @@ let dockerfile =
 
 let healthcheck =
   let doc = "Perform a self-test" in
-  Term.(const healthcheck $ setup_log $ store $ Sandbox.cmdliner),
+  Term.(const healthcheck $ setup_log $ store_required $ Runc_sandbox.cmdliner),
   Term.info "healthcheck" ~doc
 
 let cmds = [build; delete; dockerfile; healthcheck]