diff --git a/lib/macos.ml b/lib/macos.ml index b8a01bdd..209b64d7 100644 --- a/lib/macos.ml +++ b/lib/macos.ml @@ -62,6 +62,16 @@ let kill_all_descendants ~pid = in kill_all pid +let rm ~directory = + let pp _ ppf = Fmt.pf ppf "[ RM ]" in + let delete = ["rm"; "-r"; directory ] in + let* t = sudo_result ~pp:(pp "RM") delete in + match t with + | Ok () -> Lwt.return () + | Error (`Msg m) -> + Log.warn (fun f -> f "Failed to remove %s because %s" directory m); + Lwt.return () + let copy_template ~base ~local = let pp s ppf = Fmt.pf ppf "[ %s ]" s in sudo_result ~pp:(pp "RSYNC") ["rsync"; "-avq"; base ^ "/"; local] diff --git a/lib/rsync_store.ml b/lib/rsync_store.ml index 0c628b07..209fdbd7 100644 --- a/lib/rsync_store.ml +++ b/lib/rsync_store.ml @@ -101,15 +101,15 @@ let build t ?base ~id fn = (fun r -> begin match r with | Ok () -> Rsync.rename_with_sharing ~mode:t.mode ~base ~src:result_tmp ~dst:result - | Error _ -> Lwt.return_unit + | Error _ -> Rsync.delete result_tmp end >>= fun () -> Lwt.return r ) - (fun ex -> - Log.warn (fun f -> f "Uncaught exception from %S build function: %a" id Fmt.exn ex); - Rsync.delete result_tmp >>= fun () -> - Lwt.fail ex - ) + (fun ex -> + Log.warn (fun f -> f "Uncaught exception from %S build function: %a" id Fmt.exn ex); + Rsync.delete result_tmp >>= fun () -> + Lwt.fail ex + ) let delete t id = let path = Path.result t id in diff --git a/lib/sandbox.macos.ml b/lib/sandbox.macos.ml index fcc7a264..a9c3f2ab 100644 --- a/lib/sandbox.macos.ml +++ b/lib/sandbox.macos.ml @@ -17,6 +17,7 @@ type t = { mutable fuse_mounted : bool; (* Whether we have chowned/chmoded the data *) mutable chowned : bool; + lock : Lwt_mutex.t; } open Sexplib.Conv @@ -54,14 +55,22 @@ let copy_to_log ~src ~dst = For macOS we also need to create the illusion of building in a static home directory, and to achieve this we copy in the pre-build environment and copy back out the result. It's not super efficienct, but is necessary.*) -let post_build ~result_dir ~home_dir (t : t) = - Os.sudo ["rsync"; "-aHq"; "--delete"; home_dir ^ "/"; result_dir ] >>= fun () -> + +let unmount_fuse t = if not t.fuse_mounted || t.no_fuse then Lwt.return () else let f = ["umount"; "-f"; t.fuse_path] in Os.sudo f >>= fun _ -> t.fuse_mounted <- false; Lwt.return () +let post_build ~result_dir ~home_dir t = + Os.sudo ["rsync"; "-aHq"; "--delete"; home_dir ^ "/"; result_dir ] >>= fun () -> + unmount_fuse t + +let post_cancellation ~result_tmp t = + Macos.rm ~directory:result_tmp >>= fun () -> + unmount_fuse t + (* Using rsync to delete old files seems to be a good deal faster. *) -let pre_build ~result_dir ~home_dir (t : t) = +let pre_build ~result_dir ~home_dir t = Os.sudo [ "mkdir"; "-p"; "/tmp/obuilder-empty" ] >>= fun () -> Os.sudo [ "rsync"; "-aHq"; "--delete"; "/tmp/obuilder-empty/"; home_dir ^ "/" ] >>= fun () -> Os.sudo [ "rsync"; "-aHq"; result_dir ^ "/"; home_dir ] >>= fun () -> @@ -85,6 +94,7 @@ let home_directory user = Filename.concat "/Users/" user - Set the new home directory of the user to something static and copy in the environment - Should be executed by the underlying user (t.uid) *) let run ~cancelled ?stdin:stdin ~log (t : t) config result_tmp = + Lwt_mutex.with_lock t.lock (fun () -> Os.with_pipe_from_child @@ fun ~r:out_r ~w:out_w -> let result_dir = Filename.concat result_tmp "rootfs" in let user = user_name ~prefix:"mac" ~uid:t.uid in @@ -117,19 +127,19 @@ let run ~cancelled ?stdin:stdin ~log (t : t) config result_tmp = in Lwt.on_termination cancelled (fun () -> let aux () = - if Lwt.is_sleeping proc then ( + (if Lwt.is_sleeping proc then match !proc_id with - | Some pid -> Macos.kill_all_descendants ~pid + | Some pid -> Macos.kill_all_descendants ~pid >>= fun () -> Lwt_unix.sleep 5.0 | None -> Log.warn (fun f -> f "Failed to find pid…"); Lwt.return () - ) - else Lwt.return_unit (* Process has already finished *) + else Lwt.return_unit) (* Process has already finished *) + >>= fun () -> post_cancellation ~result_tmp t in Lwt.async aux ); proc >>= fun r -> copy_log >>= fun () -> if Lwt.is_sleeping cancelled then Lwt.return (r :> (unit, [`Msg of string | `Cancelled]) result) - else Lwt_result.fail `Cancelled + else Lwt_result.fail `Cancelled) let create ~state_dir:_ c = Lwt.return { @@ -141,6 +151,7 @@ let create ~state_dir:_ c = no_fuse = c.no_fuse; fuse_mounted = false; chowned = false; + lock = Lwt_mutex.create (); } let uid =