Add Obuilder Docker backend

.gitmodules

@@ -1,4 +1,4 @@
 [submodule "obuilder"]
 	path = obuilder
-	url = https://github.com/ocurrent/obuilder.git
-	branch = master
+	url = https://github.com/MisterDA/obuilder.git
+	branch = docker2

CHANGES.md

@@ -1,5 +1,6 @@
 ### unreleased
 
+- Support Obuilder Docker backend on Windows and Linux (@MisterDA #143)
 - Make rsync-mode mandatory when using rsync store (@tmcgilchrist #202, reviewed by @MisterDA)
 - Windows service bugfixes (@MisterDA #200, reviewed by @tmcgilchrist)
 - Fix build and opam metadata (@MisterDA @tmcgilchrist #199 #203)

bin/worker.ml

@@ -127,6 +127,7 @@ let obuilder_prune_threshold =
   Arg.info
     ~doc:"If using OBuilder, this threshold is used to prune the stored builds if the free space falls below this (0-100)."
     ~docv:"PERCENTAGE"
+    ~docs:"OBUILDER"
     ["obuilder-prune-threshold"]
 
 let allow_push =
@@ -163,9 +164,23 @@ let additional_metrics =
     ["additional-metrics"]
 
 module Obuilder_config = struct
+  (** Parse cli arguments for Obuilder.Store_spec.t *)
   let v =
-    let make sandbox_config store = Some (Cluster_worker.Obuilder_config.v sandbox_config store) in
-    Term.(const make $ Obuilder.Sandbox.cmdliner $ Obuilder.Store_spec.v)
+    let open Obuilder.Store_spec in
+    Term.(const of_t
+          $ Arg.value @@ store ~docs:"OBUILDER" ["obuilder-store"]
+          $ Arg.value @@ rsync_mode_opt)
+
+  (** Parse cli arguments for t and initialise a [store]. *)
+  let cmdliner =
+    Term.(const Obuilder.Store_spec.to_store $ v)
+
+  let v =
+    let make native_conf docker_conf = function
+      | `Native, store -> Some (Cluster_worker.Obuilder_config.v (`Native native_conf) store)
+      | `Docker, store -> Some (Cluster_worker.Obuilder_config.v (`Docker docker_conf) store)
+    in
+    Term.(const make $ Obuilder.Native_sandbox.cmdliner $ Obuilder.Docker_sandbox.cmdliner $ cmdliner)
 end
 
 let worker_opts_t =

worker/cluster_worker.mli

@@ -4,11 +4,7 @@ type job_spec = [
   | `Custom of Cluster_api.Custom.recv
 ]
 
-module Obuilder_config : sig
-  type t
-
-  val v : Obuilder.Sandbox.config -> Obuilder.Store_spec.t -> t
-end
+module Obuilder_config = Obuilder_build.Config
 
 type build =
   switch:Lwt_switch.t ->

worker/fetcher.docker.ml

@@ -1 +1 @@
-include Obuilder.Docker
+include Obuilder.Docker.Extract

worker/fetcher.mli

@@ -1 +1 @@
-include Obuilder.S.FETCHER
+include Obuilder.S.FETCHER

worker/obuilder_build.ml

@@ -6,23 +6,22 @@ type builder = Builder : (module Obuilder.BUILDER with type t = 'a) * 'a -> buil
 
 module Config = struct
   type t = {
-    store_spec : Obuilder.Store_spec.t;
-    sandbox_config : Obuilder.Sandbox.config;
+    store : Obuilder.Store_spec.store Lwt.t;
+    sandbox_config : [ `Native of Obuilder.Native_sandbox.config
+                     | `Docker of Obuilder.Docker_sandbox.config ]
   }
 
-  let v sandbox_config store_spec = { store_spec; sandbox_config }
+  let v sandbox_config store = { store; sandbox_config }
 end
 
 type t = {
   builder : builder;
-  config : Config.t;
+  root : string;
   mutable pruning : bool;
   cond : unit Lwt_condition.t;          (* Fires when we finish pruning *)
   prune_threshold : float option;
 }
 
-module Sandbox = Obuilder.Sandbox
-
 let ( / ) = Filename.concat
 
 let pp_timestamp f x =
@@ -38,21 +37,31 @@ let log_to log_data tag msg =
   | `Output -> Log_data.write log_data msg
 
 let create ?prune_threshold config =
-  let { Config.store_spec; sandbox_config } = config in
-  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 builder = Builder.v ~store ~sandbox in
+  let { Config.store; sandbox_config } = config in
+  store >>= fun (Obuilder.Store_spec.Store ((module Store), store)) ->
+  begin match sandbox_config with
+  | `Native conf ->
+     let module Builder = Obuilder.Builder (Store) (Obuilder.Native_sandbox) (Obuilder.Docker_extract) in
+     Obuilder.Native_sandbox.create ~state_dir:(Store.state_dir store / "sandbox") conf >|= fun sandbox ->
+     let builder = Builder.v ~store ~sandbox in
+     Builder ((module Builder), builder)
+  | `Docker conf ->
+     let module Builder = Obuilder.Docker_builder (Store) in
+     Obuilder.Docker_sandbox.create conf >|= fun sandbox ->
+     let builder = Builder.v ~store ~sandbox in
+     Builder ((module Builder), builder)
+  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
   | Ok () ->
     Log.info (fun f -> f "OBuilder self-test passed");
     {
       builder = Builder ((module Builder), builder);
+      root = Store.root store;
       pruning = false;
       prune_threshold;
-      config;
       cond = Lwt_condition.create ();
     }
 
@@ -76,12 +85,6 @@ let do_prune ~path ~prune_threshold t =
   in
   aux ()
 
-let store_path t =
-  match t.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).
    If less than half that is remaining, also wait for it to finish.
@@ -90,7 +93,7 @@ let check_free_space t =
   match t.prune_threshold with
   | None -> Lwt.return_unit
   | Some prune_threshold ->
-    let path = store_path t in
+    let path = t.root in
     let rec aux () =
       let free = Df.free_space_percent path in
       Log.info (fun f -> f "OBuilder partition: %.0f%% free" free);

worker/obuilder_build.mli

@@ -3,7 +3,9 @@ type t
 module Config : sig
   type t
 
-  val v : Obuilder.Sandbox.config -> Obuilder.Store_spec.t -> t
+  val v : [ `Native of Obuilder.Native_sandbox.config
+          | `Docker of Obuilder.Docker_sandbox.config ]
+          -> Obuilder.Store_spec.store Lwt.t -> t
 end
 
 val create : ?prune_threshold:float -> Config.t -> t Lwt.t