Purge Obuilder Docker store when Docker is pruned

worker/cluster_worker.ml

@@ -220,7 +220,7 @@ let check_docker_partition t =
         if max_df_size < gb then Error `Disk_space_low
         else Ok ()
 
-let rec maybe_prune t queue =
+let rec maybe_prune obuilder t queue =
   check_docker_partition t >>= function
   | Ok () -> Lwt.return_unit
   | Error `Disk_space_low ->
@@ -236,6 +236,13 @@ let rec maybe_prune t queue =
       (fun () ->
          Lwt_process.exec ("", [| "docker"; "system"; "prune"; "-af" |]) >>= function
          | Unix.WEXITED 0 ->
+           (match obuilder with
+           | None -> Lwt.return 0
+           | Some obuilder ->
+             match Obuilder_build.backend obuilder with
+             | `Native _ -> Lwt.return 0
+             | `Docker _ -> Obuilder_build.purge obuilder) >>= fun n ->
+           Log.info (fun f -> f "%i items prune from Obuilder" n);
            Lwt_process.exec ("", [| "docker"; "builder"; "prune"; "-af" |])
          | e -> Lwt.return e
       )
@@ -249,12 +256,12 @@ let rec maybe_prune t queue =
         | Error `Disk_space_low ->
           Log.warn (fun f -> f "Disk-space still low after pruning! Will retry in one hour.");
           Unix.sleep (60 * 60);
-          maybe_prune t queue
+          maybe_prune obuilder t queue
       end
     | _ ->
       Log.warn (fun f -> f "docker prune command failed! Will retry in one hour.");
       Unix.sleep (60 * 60);
-      maybe_prune t queue
+      maybe_prune obuilder t queue
 
 let healthcheck obuilder =
   let t0 = Unix.gettimeofday () in
@@ -306,7 +313,7 @@ let loop ~switch ?obuilder t queue =
         Log.info (fun f -> f "At capacity. Waiting for a build to finish before requesting more…");
         Lwt_condition.wait t.cond >>= loop
       ) else (
-        maybe_prune t queue >>= fun () ->
+        maybe_prune obuilder t queue >>= fun () ->
         check_health t ~last_healthcheck ~queue obuilder >>= fun () ->
         let outcome, set_outcome = Lwt.wait () in
         let log = Log_data.create () in

worker/context.ml

@@ -197,7 +197,7 @@ let build_context t ~log ~tmpdir descr =
         if include_git descr then (
           let cmd, is_success =
             if Sys.win32 then
-              ["robocopy"; clone / ".git"; tmpdir / ".git"; "/COPY:DATSO"; "/E"; "/R:0"; "/DCOPY:T"],
+              ["robocopy"; clone / ".git"; tmpdir / ".git"; "/COPY:DATSO"; "/E"; "/R:0"; "/DCOPY:T"; "/NDL"; "/NFL"],
               fun s -> s = 1
             else
               ["cp"; "-a"; clone / ".git"; tmpdir / ".git"],

worker/obuilder_build.ml

@@ -21,6 +21,8 @@ type t = {
   prune_threshold : float option;
   prune_item_threshold : int64 option;  (* Threshold number of items to hold in obuilder store *)
   prune_limit : int option;             (* Number of items to prune from obuilder when threshold is reached *)
+  sandbox_config : [ `Native of Obuilder.Native_sandbox.config
+                   | `Docker of Obuilder.Docker_sandbox.config ]
 }
 
 let ( / ) = Filename.concat
@@ -65,6 +67,7 @@ let create ?prune_threshold ?prune_item_threshold ?prune_limit config =
       prune_item_threshold;
       prune_limit;
       cond = Lwt_condition.create ();
+      sandbox_config;
     }
 
 (* Prune [t] until free space rises above [prune_threshold]
@@ -143,3 +146,13 @@ let healthcheck t =
 let cache_stats t =
   let Builder ((module Builder), builder) = t.builder in
   Builder.cache_stats builder
+
+let purge t =
+  let Builder ((module Builder), builder) = t.builder in
+  let before = Unix.gettimeofday () +. prune_margin |> Unix.gmtime in
+  (* set a future time and a big number to ensure everything is deleted *)
+  Builder.prune builder ~before Int.max_int >>= fun n ->
+  Lwt.return n
+
+let backend t =
+  t.sandbox_config

worker/obuilder_build.mli

@@ -20,3 +20,7 @@ val build : t ->
 val healthcheck : t -> (unit, [> `Msg of string]) Lwt_result.t
 
 val cache_stats : t -> int * int
+
+val purge : t -> int Lwt.t
+
+val backend : t -> [`Native of Obuilder.Native_sandbox.config | `Docker of Obuilder.Docker_sandbox.config ]