diff --git a/lib/overlayfs_store.ml b/lib/overlayfs_store.ml index 6b5e4cfb..e962133b 100644 --- a/lib/overlayfs_store.ml +++ b/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,27 +149,28 @@ 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 @@ -170,12 +178,14 @@ let build t ?base ~id fn = | 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