Hook Obuilder Docker backend

.gitignore

@@ -1,4 +1,5 @@
 **/.merlin
 _build
+_opam
 capnp-secrets
 var

bin/worker.ml

@@ -122,15 +122,31 @@ module Obuilder_config = struct
     Arg.info
       ~doc:"btrfs:/path or rsync:/path or zfs:pool for the OBuilder cache"
       ~docv:"STORE"
+      ~docs:"RUNC SANDBOX"
       ["obuilder-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"
+      ~docs:"DOCKER BACKEND"
+      ["obuilder-docker-backend"]
+
   let v =
-    let make sandbox_config = function
-      | None -> None
-      | Some store -> Some (Cluster_worker.Obuilder_config.v sandbox_config store)
+    let make runc_conf docker_conf store docker_backend =
+      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 -> Some (Cluster_worker.Obuilder_config.runc runc_conf store)
+      | None, Some path -> Some (Cluster_worker.Obuilder_config.docker docker_conf path)
     in
-    let open Cmdliner.Term in
-    Term.pure make $ Obuilder.Runc_sandbox.cmdliner $ store
+    Cmdliner.Term.(const make $ Obuilder.Runc_sandbox.cmdliner $ Obuilder.Docker_sandbox.cmdliner $ store $ docker_backend)
 end
 
 let worker_opts_t =

worker/cluster_worker.mli

@@ -6,7 +6,8 @@ type job_spec = [
 module Obuilder_config : sig
   type t
 
-  val v : Obuilder.Runc_sandbox.config -> [ `Btrfs of string | `Rsync of string | `Zfs of string ] -> t
+  val runc : Obuilder.Runc_sandbox.config -> [ `Btrfs of string | `Rsync of string | `Zfs of string ] -> t
+  val docker : Obuilder.Docker_sandbox.config -> string -> t
 end
 
 val run :

worker/obuilder_build.ml

@@ -5,12 +5,20 @@ let prune_margin = 600.0        (* Don't prune anything used less than 10 minute
 type builder = Builder : (module Obuilder.BUILDER with type t = 'a) * 'a -> builder
 
 module Config = struct
-  type t = {
+  type runc = {
     store_spec : [ `Btrfs of string | `Rsync of string | `Zfs of string ];
     sandbox_config : Obuilder.Runc_sandbox.config;
   }
 
-  let v sandbox_config store_spec = { store_spec; sandbox_config }
+  type docker = {
+    state_dir : string;
+    config : Obuilder.Docker_sandbox.config;
+  }
+
+  type t = [ `Runc of runc | `Docker of docker ]
+
+  let runc sandbox_config store_spec = `Runc { store_spec; sandbox_config }
+  let docker config state_dir = `Docker { state_dir; config }
 end
 
 type t = {
@@ -21,9 +29,6 @@ type t = {
   prune_threshold : float option;
 }
 
-module Sandbox = Obuilder.Runc_sandbox
-module Fetcher = Obuilder.Docker
-
 let ( / ) = Filename.concat
 
 let pp_timestamp f x =
@@ -38,12 +43,28 @@ let log_to log_data tag msg =
   | `Note -> Log_data.info log_data "\027[01;2m\027[01;35m%a %s\027[0m" pp_timestamp (Unix.gettimeofday ()) msg
   | `Output -> Log_data.write log_data msg
 
-let create ?prune_threshold config =
-  let { Config.store_spec; sandbox_config } = config in
+module Runc_sandbox = Obuilder.Runc_sandbox
+
+let create_builder { Config.store_spec; sandbox_config } =
   Obuilder.Store_spec.to_store store_spec >>= fun (Store ((module Store), store)) ->
-  let module Builder = Obuilder.Builder(Store)(Sandbox)(Fetcher) in
-  Sandbox.create ~state_dir:(Store.state_dir store / "runc") sandbox_config >>= fun sandbox ->
+  let module Builder = Obuilder.Builder(Store)(Runc_sandbox)(Obuilder.Docker_extract) in
+  Runc_sandbox.create ~state_dir:(Store.state_dir store / "runc") sandbox_config >>= fun sandbox ->
   let builder = Builder.v ~store ~sandbox in
+  Lwt.return (Builder ((module Builder), builder))
+
+let create_docker_builder { Config.state_dir; config } =
+  let open Obuilder in
+  let module Builder = Docker_builder in
+  Docker_store.create state_dir >>= fun store ->
+  Docker_sandbox.create ~state_dir:(Docker_store.state_dir store / "sandbox") config >|= fun sandbox ->
+  let builder = Docker_builder.v ~store ~sandbox in
+  Builder ((module Docker_builder), builder)
+
+let create ?prune_threshold config =
+  begin match config with
+  | `Runc config -> create_builder config
+  | `Docker config -> create_docker_builder config
+  end >>= fun (Builder ((module Builder), builder)) ->
   Log.info (fun f -> f "Performing OBuilder self-test...");
   Builder.healthcheck builder >|= function
   | Error (`Msg m) -> Fmt.failwith "Initial OBuilder healthcheck failed: %s" m
@@ -78,10 +99,13 @@ let do_prune ~path ~prune_threshold t =
   aux ()
 
 let store_path t =
-  match t.config.store_spec with
-  | `Btrfs path -> path
-  | `Rsync path -> path
-  | `Zfs pool -> "/" ^ pool
+  match t.config with
+  | `Docker config -> config.state_dir
+  | `Runc config ->
+    match config.store_spec with
+    | `Btrfs path -> path
+    | `Rsync path -> path
+    | `Zfs pool -> "/" ^ pool
 
 (* Check the free space in [t]'s store.
    If less than [t.prune_threshold], spawn a prune operation (if not already running).

worker/obuilder_build.mli

@@ -3,7 +3,8 @@ type t
 module Config : sig
   type t
 
-  val v : Obuilder.Runc_sandbox.config -> [ `Btrfs of string | `Rsync of string | `Zfs of string ] -> t
+  val runc : Obuilder.Runc_sandbox.config -> [ `Btrfs of string | `Rsync of string | `Zfs of string ] -> t
+  val docker : Obuilder.Docker_sandbox.config -> string -> t
 end
 
 val create : ?prune_threshold:float -> Config.t -> t Lwt.t