Rather than build in the results directory, the builds now happen i…

…n the

`in-progress` directory.  This is necessary as, without it, interupted
builds appear in the result directory and the `get_build` function in
lib/db_store.ml assumes that there is valid build based only on the
existence of the output directory (it does not query the database).

lib/overlayfs_store.ml

@@ -49,6 +49,9 @@ module Overlayfs = struct
     | [] -> Lwt.return_unit
     | d -> Os.exec ([ "rm"; "-rf" ] @ d)
 
+  let rename ~src ~dst =
+    Os.exec [ "mv"; src; dst ]
+
   let overlay ~lower ~upper ~work ~merged =
     Os.sudo [ "mount"; "-t"; "overlay"; "overlay"; "-olowerdir=" ^ lower ^ ",upperdir=" ^ upper ^ ",workdir=" ^ work; merged; ]
 
@@ -64,6 +67,7 @@ module Path = struct
   let cache_work_dirname = "cache-work"
   let cache_merged_dirname = "cache-merged"
   let result_dirname = "result"
+  let in_progress_dirname = "in-progress"
   let merged_dirname = "merged"
   let work_dirname = "work"
 
@@ -75,10 +79,12 @@ module Path = struct
         cache_work_dirname;
         cache_merged_dirname;
         result_dirname;
+        in_progress_dirname;
         merged_dirname;
         work_dirname; ]
 
   let result t id = t.path / result_dirname / id
+  let in_progress t id = t.path / in_progress_dirname / id
   let merged t id = t.path / merged_dirname / id
   let work t id = t.path / work_dirname / id
 
@@ -132,7 +138,8 @@ let create ~path =
       Sys.readdir path |> Array.to_list
       |> List.map (Filename.concat path)
       |> Overlayfs.delete)
-    [ path / Path.merged_dirname;
+    [ path / Path.in_progress_dirname;
+      path / Path.merged_dirname;
       path / Path.cache_result_dirname;
       path / Path.cache_work_dirname;
       path / Path.cache_merged_dirname;
@@ -142,40 +149,43 @@ let create ~path =
 let build t ?base ~id fn =
   Log.debug (fun f -> f "overlayfs: build %S" id);
   let result = Path.result t id in
+  let in_progress = Path.in_progress t id in
   let merged = Path.merged t id in
   let work = Path.work t id in
-  Overlayfs.create [ result; work; merged ] >>= fun () ->
-  let _ = Option.map (Path.result t) base in
+  Overlayfs.create [ in_progress; work; merged ] >>= fun () ->
+  let _ = Option.map (Path.in_progress t) base in
   (match base with
   | None ->
       Lwt.return_unit
   | Some src ->
       let src = Path.result t src in
-      Unix.symlink src (result / "parent");
-      Unix.symlink (src / "env") (result / "env");
+      Unix.symlink src (in_progress / "parent");
+      Unix.symlink (src / "env") (in_progress / "env");
       let rec ancestors src = src :: (match Os.read_link (src / "parent") with
           | Some p -> ancestors p
           | None -> [])
       in
       let lower = ancestors src |> String.concat ":" in
-      Overlayfs.overlay ~lower ~upper:result ~work ~merged)
+      Overlayfs.overlay ~lower ~upper:in_progress ~work ~merged)
   >>= fun () ->
   Lwt.try_bind
     (fun () -> match base with
-      | None -> fn result
+      | None -> fn in_progress
       | Some _ -> fn merged)
     (fun r ->
       (match base with
       | None -> Lwt.return_unit
       | Some _ -> Overlayfs.umount ~merged)
       >>= fun () ->
       (match r with
-      | Ok () -> Overlayfs.delete [ merged; work ]
-      | Error _ -> Overlayfs.delete [ merged; work; result ])
+      | Ok () ->
+        Overlayfs.rename ~src:in_progress ~dst:result >>= fun () ->
+        Overlayfs.delete [ merged; work ]
+      | Error _ -> Overlayfs.delete [ merged; work; in_progress ])
       >>= fun () -> Lwt.return r)
     (fun ex ->
       Log.warn (fun f -> f "Uncaught exception from %S build function: %a" id Fmt.exn ex);
-      Overlayfs.delete [ merged; work; result ] >>= fun () -> Lwt.fail ex)
+      Overlayfs.delete [ merged; work; in_progress ] >>= fun () -> Lwt.fail ex)
 
 let delete t id =
   let path = Path.result t id in
@@ -203,7 +213,7 @@ let result t id =
 let log_file t id =
   result t id >|= function
   | Some dir -> dir / "log"
-  | None -> Path.result t id / "log"
+  | None -> Path.in_progress t id / "log"
 
 let state_dir t = t.path / Path.state_dirname