MacOS ZFS Sandbox

lib/build.ml

@@ -204,7 +204,7 @@ module Make (Raw_store : S.STORE) (Sandbox : S.SANDBOX) (Fetch : S.FETCHER) = st
       (resolved_secret :: result) ) (Ok []) secrets
 
   let rec run_steps t ~(context:Context.t) ~base = function
-    | [] -> Lwt_result.return base
+    | [] -> Sandbox.finished () >>= fun () -> Lwt_result.return base
     | op :: ops ->
       context.log `Heading Fmt.(str "%a" (pp_op ~context) op);
       let k = run_steps t ops in

lib/docker_sandbox.ml

@@ -451,6 +451,9 @@ let create (c : config) =
   let+ () = if Result.is_error volume_exists then create_tar_volume t else Lwt.return_unit in
   t
 
+let finished () =
+  Lwt.return ()
+
 open Cmdliner
 
 let docs = "DOCKER BACKEND"

lib/macos.ml

@@ -1,5 +1,6 @@
 (* Extensions to the Os module for macOS *)
 open Lwt.Syntax
+open Lwt.Infix
 open Os
 
 let ( / ) = Filename.concat
@@ -17,11 +18,10 @@ let create_new_user ~username ~home_dir ~uid ~gid =
     let pp s ppf = Fmt.pf ppf "[ Mac ] %s\n" s in
     let dscl = [ "dscl"; "."; "-create"; user ] in
     sudo_result ~pp:(pp "UniqueID") (dscl @ [ "UniqueID"; uid ]) >>!= fun _ ->
-    sudo_result ~pp:(pp "PrimaryGroupID") (dscl @ [ "PrimaryGroupID"; gid ])
-    >>!= fun _ ->
-    sudo_result ~pp:(pp "UserShell") (dscl @ [ "UserShell"; "/bin/bash" ])
-    >>!= fun _ ->
-    sudo_result ~pp:(pp "NFSHomeDirectory") (dscl @ [ "NFSHomeDirectory"; home_dir ])
+    sudo_result ~pp:(pp "PrimaryGroupID") (dscl @ [ "PrimaryGroupID"; gid ]) >>!= fun _ ->
+    sudo_result ~pp:(pp "UserShell") (dscl @ [ "UserShell"; "/bin/bash" ]) >>!= fun _ ->
+    sudo_result ~pp:(pp "NFSHomeDirectory") (dscl @ [ "NFSHomeDirectory"; home_dir ]) >>!= fun _ ->
+    Lwt_result.return ()
 
 let delete_user ~user =
   let* exists = user_exists ~user in
@@ -33,48 +33,41 @@ let delete_user ~user =
       let user = "/Users" / user in
       let pp s ppf = Fmt.pf ppf "[ Mac ] %s\n" s in
       let delete = ["dscl"; "."; "-delete"; user ] in
-        sudo_result ~pp:(pp "Deleting") delete
+        sudo_result ~pp:(pp "Deleting") delete >>!= fun _ ->
+        Lwt_result.return ()
 
-let descendants ~pid =
-  Lwt.catch
-    (fun () ->
-      let+ s = pread ["sudo"; "pgrep"; "-P"; string_of_int pid ] in
-      let pids = Astring.String.cuts ~sep:"\n" s in
-      List.filter_map int_of_string_opt pids)
-    (* Errors if there are none, probably errors for other reasons too… *)
-    (fun _ -> Lwt.return_nil)
+let rec kill_users_processes ~uid =
+  let pp _ ppf = Fmt.pf ppf "[ PKILL ]" in
+  let delete = ["pkill"; "-9"; "-U"; string_of_int uid ] in
+  let* t = sudo_result ~pp:(pp "PKILL") delete in
+    match t with
+    | Ok _ -> kill_users_processes ~uid
+    | Error (`Msg _) ->
+      Log.info (fun f -> f "pkill all killed");
+      Lwt.return ()
 
-let kill ~pid =
-  let pp _ ppf = Fmt.pf ppf "[ KILL ]" in
-  let delete = ["kill"; "-9";  string_of_int pid ] in
-  let* t = sudo_result ~pp:(pp "KILL") delete in
+let rec sudo_fallback cmds cmds2 ~uid =
+  let pp f = pp_cmd f ("", cmds) in
+  let* t = sudo_result ~pp cmds in
     match t with
-    | Ok () -> Lwt.return_unit
+    | Ok _ -> Lwt.return ()
     | Error (`Msg m) ->
-      Log.warn (fun f -> f "Failed to kill process %i because %s" pid m);
-      Lwt.return_unit
-
-let kill_all_descendants ~pid =
-  let rec kill_all pid : unit Lwt.t =
-    let* ds = descendants ~pid in
-    let* () = Lwt_list.iter_s kill_all ds in
-    kill ~pid
-  in
-    kill_all pid
-
-let copy_template ~base ~local =
-  let pp s ppf = Fmt.pf ppf "[ %s ]" s in
-  sudo_result ~pp:(pp "RSYNC") ["rsync"; "-avq"; base ^ "/"; local]
-
-let change_home_directory_for ~user ~home_dir =
-  ["dscl"; "."; "-create"; "/Users/" ^ user ; "NFSHomeDirectory"; home_dir ]
+      Log.warn (fun f -> f "failed with %s" m);
+      (* wait a second then try to kill any user processes and retry *)
+      Lwt_unix.sleep 2.0 >>= fun () ->
+      kill_users_processes ~uid >>= fun () ->
+      sudo cmds2 >>= fun () ->
+      sudo_fallback cmds cmds2 ~uid
 
-(* Used by the FUSE filesystem to indicate where a users home directory should be …*)
-let update_scoreboard ~uid ~scoreboard ~home_dir =
-  ["ln"; "-Fhs"; home_dir; scoreboard ^ "/" ^ string_of_int uid]
-
-let remove_link ~uid ~scoreboard =
-  [ "rm"; scoreboard ^ "/" ^ string_of_int uid ]
+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 get_tmpdir ~user =
   ["sudo"; "-u"; user; "-i"; "getconf"; "DARWIN_USER_TEMP_DIR"]

lib/os.ml

@@ -114,9 +114,9 @@ let sudo ?stdin args =
   let args = if running_as_root then args else "sudo" :: "--" :: args in
   exec ?stdin args
 
-let sudo_result ?cwd ?stdin ?stdout ?stderr ~pp args =
+let sudo_result ?cwd ?stdin ?stdout ?stderr ?is_success ~pp args =
   let args = if running_as_root then args else "sudo" :: "--" :: args in
-  exec_result ?cwd ?stdin ?stdout ?stderr ~pp args
+  exec_result ?cwd ?stdin ?stdout ?stderr ?is_success ~pp args
 
 let rec write_all fd buf ofs len =
   assert (len >= 0);

lib/s.ml

@@ -88,6 +88,8 @@ module type SANDBOX = sig
       @param stdin Passed to child as its standard input.
       @param log Used for child's stdout and stderr.
   *)
+
+  val finished : unit -> unit Lwt.t
 end
 
 module type BUILDER = sig

lib/sandbox.macos.ml

@@ -4,30 +4,16 @@ open Cmdliner
 type t = {
   uid: int;
   gid: int;
-  (* Where zfs dynamic libraries are -- can't be in /usr/local/lib
-     see notes in .mli file under "Various Gotchas"… *)
-  fallback_library_path : string;
-  (* FUSE file system mount point *)
-  fuse_path : string;
-  (* Scoreboard -- where we keep our symlinks for knowing homedirs for users *)
-  scoreboard : string;
-  (* Should the sandbox mount and unmount the FUSE filesystem *)
-  no_fuse : bool;
-  (* Whether or not the FUSE filesystem is mounted *)
-  mutable fuse_mounted : bool;
-  (* Whether we have chowned/chmoded the data *)
-  mutable chowned : bool;
+  (* mount point where Homebrew is installed. Either /opt/homebrew or /usr/local depending upon architecture *)
+  brew_path : string;
   lock : Lwt_mutex.t;
 }
 
 open Sexplib.Conv
 
 type config = {
   uid: int;
-  fallback_library_path : string;
-  fuse_path : string;
-  scoreboard : string;
-  no_fuse : bool;
+  brew_path : string;
 }[@@deriving sexp]
 
 let run_as ~env ~user ~cmd =
@@ -49,66 +35,34 @@ let copy_to_log ~src ~dst =
   in
   aux ()
 
-(* HACK: Unmounting and remounting the FUSE filesystem seems to "fix"
-   some weird cachining bug, see https://github.com/patricoferris/obuilder/issues/9
-
-   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 efficient, but is necessary.*)
-
-let unmount_fuse t =
-  if not t.fuse_mounted || t.no_fuse then Lwt.return_unit
-  else
-    let f = ["umount"; "-f"; t.fuse_path] in
-    Os.sudo f >>= fun _ -> t.fuse_mounted <- false;
-    Lwt.return_unit
-
-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 =
-  Os.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 =
-  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 () ->
-  (if t.chowned then Lwt.return_unit
-   else begin
-     Os.sudo [ "chown"; "-R"; ":" ^ (string_of_int t.gid); home_dir ] >>= fun () ->
-     Os.sudo [ "chmod"; "-R"; "g+w"; home_dir ] >>= fun () ->
-     t.chowned <- true;
-     Lwt.return_unit
-   end) >>= fun () ->
-  if t.fuse_mounted || t.no_fuse then Lwt.return_unit
-  else
-    let f = [ "obuilderfs"; t.scoreboard ; t.fuse_path; "-o"; "allow_other" ] in
-    Os.sudo f >>= fun _ -> t.fuse_mounted <- true;
-    Lwt.return_unit
-
 let user_name ~prefix ~uid =
   Fmt.str "%s%i" prefix uid
 
-let home_directory user = Filename.concat "/Users/" user
+let zfs_volume_from path =
+  String.split_on_char '/' path
+  |> List.filter (fun x -> String.length x > 0)
+  |> List.tl
+  |> String.concat "/"
 
-(* A build step in macos:
-   - Should be properly sandboxed using sandbox-exec (coming soon…)
-   - Umask g+w to work across users if restored from a snapshot
-   - 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 () ->
+  Log.info (fun f -> f "result_tmp = %s" result_tmp);
   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
-  let home_dir = home_directory user in
+  let zfs_volume = zfs_volume_from result_tmp in
+  let home_dir = Filename.concat "/Users/" user in
+  let zfs_home_dir = Filename.concat zfs_volume "home" in
+  let zfs_brew = Filename.concat zfs_volume "brew" in
+  Os.sudo [ "zfs"; "set"; "mountpoint=" ^ home_dir; zfs_home_dir ] >>= fun () ->
+  Os.sudo [ "zfs"; "set"; "mountpoint=" ^ t.brew_path; zfs_brew ] >>= fun () ->
+  Lwt_list.iter_s (fun { Config.Mount.src; dst; readonly; _ } ->
+    Log.info (fun f -> f "src = %s, dst = %s, type %s" src dst (if readonly then "ro" else "rw") );
+    if Sys.file_exists dst then
+      Os.sudo [ "zfs"; "set"; "mountpoint=" ^ dst; zfs_volume_from src ]
+    else Lwt.return_unit) config.Config.mounts >>= fun () ->
   let uid = string_of_int t.uid in
-  Macos.create_new_user ~username:user ~home_dir ~uid ~gid:"1000" >>= fun _ ->
-  let set_homedir = Macos.change_home_directory_for ~user ~home_dir in
-  let update_scoreboard = Macos.update_scoreboard ~uid:t.uid ~home_dir ~scoreboard:t.scoreboard in
+  let gid = string_of_int t.gid in
+  Macos.create_new_user ~username:user ~home_dir ~uid ~gid >>= fun _ ->
   let osenv = config.Config.env in
   let stdout = `FD_move_safely out_w in
   let stderr = stdout in
@@ -117,9 +71,6 @@ let run ~cancelled ?stdin:stdin ~log (t : t) config result_tmp =
   let proc =
     let stdin = Option.map (fun x -> `FD_move_safely x) stdin in
     let pp f = Os.pp_cmd f ("", config.Config.argv) in
-    Os.sudo_result ~pp set_homedir >>= fun _ ->
-    Os.sudo_result ~pp update_scoreboard >>= fun _ ->
-    pre_build ~result_dir ~home_dir t >>= fun _ ->
     Os.pread @@ Macos.get_tmpdir ~user >>= fun tmpdir ->
     let tmpdir = List.hd (String.split_on_char '\n' tmpdir) in
     let env = ("TMPDIR", tmpdir) :: osenv in
@@ -128,38 +79,41 @@ let run ~cancelled ?stdin:stdin ~log (t : t) config result_tmp =
     let pid, proc = Os.open_process ?stdin ~stdout ~stderr ~pp ~cwd:config.Config.cwd cmd in
     proc_id := Some pid;
     Os.process_result ~pp proc >>= fun r ->
-    post_build ~result_dir ~home_dir t >>= fun () ->
     Lwt.return r
   in
   Lwt.on_termination cancelled (fun () ->
     let aux () =
-      (if Lwt.is_sleeping proc then
-         match !proc_id with
-         | 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_unit
-       else Lwt.return_unit) (* Process has already finished *)
-      >>= fun () -> post_cancellation ~result_tmp t
+      if Lwt.is_sleeping proc then
+        match !proc_id with
+          | Some _ -> Macos.kill_users_processes ~uid:t.uid
+          | None -> Log.warn (fun f -> f "Failed to find pid…"); Lwt.return ()
+      else Lwt.return_unit (* Process has already finished *)
     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)
+    Lwt_list.iter_s (fun { Config.Mount.src; dst = _; readonly = _; ty = _ } ->
+      Os.sudo [ "zfs"; "inherit"; "mountpoint"; zfs_volume_from src ]) config.Config.mounts >>= fun () ->
+    Macos.sudo_fallback [ "zfs"; "set"; "mountpoint=none"; zfs_home_dir ] [ "zfs"; "unmount"; "-f"; zfs_home_dir ] ~uid:t.uid >>= fun () ->
+    Macos.sudo_fallback [ "zfs"; "set"; "mountpoint=none"; zfs_brew ] [ "zfs"; "unmount"; "-f"; zfs_brew ] ~uid:t.uid >>= fun () ->
+    if Lwt.is_sleeping cancelled then
+      Lwt.return (r :> (unit, [`Msg of string | `Cancelled]) result)
+    else Lwt_result.fail `Cancelled)
 
 let create ~state_dir:_ c =
   Lwt.return {
     uid = c.uid;
     gid = 1000;
-    fallback_library_path = c.fallback_library_path;
-    fuse_path = c.fuse_path;
-    scoreboard = c.scoreboard;
-    no_fuse = c.no_fuse;
-    fuse_mounted = false;
-    chowned = false;
+    brew_path = c.brew_path;
     lock = Lwt_mutex.create ();
   }
 
+let finished () =
+  Os.sudo [ "zfs"; "unmount"; "obuilder/result" ] >>= fun () ->
+  Os.sudo [ "zfs"; "mount"; "obuilder/result" ] >>= fun () ->
+  Lwt.return ()
+
 let uid =
   Arg.required @@
   Arg.opt Arg.(some int) None @@
@@ -169,43 +123,16 @@ let uid =
     ~docv:"UID"
     ["uid"]
 
-let fallback_library_path =
+let brew_path =
   Arg.required @@
   Arg.opt Arg.(some file) None @@
   Arg.info
-    ~doc:"The fallback path of the dynamic libraries. This is used whenever the FUSE filesystem \
-          is in place preventing anything is /usr/local from being accessed."
-    ~docv:"FALLBACK"
-    ["fallback"]
-
-let fuse_path =
-  Arg.required @@
-  Arg.opt Arg.(some file) None @@
-  Arg.info
-    ~doc:"Directory to mount FUSE filesystem on, typically this is either /usr/local or /opt/homebrew."
-    ~docv:"FUSE_PATH"
-    ["fuse-path"]
-
-let scoreboard =
-  Arg.required @@
-  Arg.opt Arg.(some file) None @@
-  Arg.info
-    ~doc:"The scoreboard directory which is used by the FUSE filesystem to record \
-          the association between user id and home directory."
-    ~docv:"SCOREBOARD"
-    ["scoreboard"]
-
-let no_fuse =
-  Arg.value @@
-  Arg.flag @@
-  Arg.info
-    ~doc:"Whether the macOS sandbox should mount and unmount the FUSE filesystem. \
-          This is useful for testing."
-    ~docv:"NO-FUSE"
-    ["no-fuse"]
+    ~doc:"Directory where Homebrew is installed. Typically this is either /usr/local or /opt/homebrew."
+    ~docv:"BREW_PATH"
+    ["brew-path"]
 
 let cmdliner : config Term.t =
-  let make uid fallback_library_path fuse_path scoreboard no_fuse =
-    { uid; fallback_library_path; fuse_path; scoreboard; no_fuse }
+  let make uid brew_path =
+    { uid; brew_path }
   in
-  Term.(const make $ uid $ fallback_library_path $ fuse_path $ scoreboard $ no_fuse)
+  Term.(const make $ uid $ brew_path)

lib/sandbox.mli

@@ -12,3 +12,5 @@ val cmdliner : config Cmdliner.Term.t
 val create : state_dir:string -> config -> t Lwt.t
 (** [create ~state_dir config] is a sandboxing system that keeps state in [state_dir]
     and is configured using [config]. *)
+
+val finished : unit -> unit Lwt.t

lib/sandbox.runc.ml

@@ -333,6 +333,9 @@ let create ~state_dir (c : config) =
   clean_runc state_dir >|= fun () ->
   { runc_state_dir = state_dir; fast_sync = c.fast_sync; arches }
 
+let finished () =
+  Lwt.return ()
+
 open Cmdliner
 
 let docs = "RUNC SANDBOX"