Macos v2

.run-gha-tests.sh

@@ -85,3 +85,4 @@ case "$1" in
         printf "Usage: .run-gha-tests.sh [btrfs|rsync|zfs]" >&2
         exit 1
 esac
+

README.md

@@ -311,6 +311,11 @@ The dockerfile should work the same way as the spec file, except for these limit
 - All `(network ...)` fields are ignored, as Docker does not allow per-step control of
   networking.
 
+## Experimental macOS Support
+
+OBuilder abstracts over a fetching mechanism for the Docker base image, the sandboxing for the execution of build steps and the store for the cache.
+This makes OBuilder extremely portable and there exists a (very) experimental [macOS][] backend.
+
 ## Licensing
 
 OBuilder is licensed under the Apache License, Version 2.0.
@@ -319,6 +324,7 @@ See [LICENSE][] for the full license text.
 [Dockerfile]: https://docs.docker.com/engine/reference/builder/
 [OCluster]: https://github.com/ocurrent/ocluster
 [LICENSE]: ./LICENSE
+[macOS]: ./macOS.md
 
 [github-shield]: https://github.com/ocurrent/obuilder/actions/workflows/main.yml/badge.svg
 [github-ci]: https://github.com/ocurrent/obuilder/actions/workflows/main.yml

lib/build.ml

@@ -227,7 +227,7 @@ module Make (Raw_store : S.STORE) (Sandbox : S.SANDBOX) (Fetch : S.FETCHER) = st
     Store.build t.store ~id ~log (fun ~cancelled:_ ~log tmp ->
         Log.info (fun f -> f "Base image not present; importing %S..." base);
         let rootfs = tmp / "rootfs" in
-        Os.sudo ["mkdir"; "--mode=755"; "--"; rootfs] >>= fun () ->
+        Os.sudo ["mkdir"; "-m"; "755"; "--"; rootfs] >>= fun () ->
         Fetch.fetch ~log ~rootfs base >>= fun env ->
         Os.write_file ~path:(tmp / "env")
           (Sexplib.Sexp.to_string_hum Saved_context.(sexp_of_t {env})) >>= fun () ->

lib/dune

@@ -1,5 +1,18 @@
+(rule
+ (deps sandbox.macos.ml)
+ (target sandbox.ml)
+ (enabled_if (= %{system} macosx))
+ (action (copy %{deps} %{target})))
+
+(rule
+ (deps sandbox.runc.ml)
+ (target sandbox.ml)
+ (enabled_if (<> %{system} macosx))
+ (action (copy %{deps} %{target})))
+
 (library
   (name obuilder)
   (public_name obuilder)
   (preprocess (pps ppx_sexp_conv))
+  (flags (:standard -w -69))
   (libraries lwt lwt.unix fmt yojson tar-unix sexplib sqlite3 astring logs sha obuilder-spec cmdliner))

lib/macos.ml

@@ -0,0 +1,80 @@
+(* Extensions to the Os module for macOS *)
+open Lwt.Syntax
+open Os
+
+let ( / ) = Filename.concat
+
+let user_exists ~user =
+  let+ s = pread ["sudo"; "dscl"; "."; "list"; "/Users"] in
+  List.exists (Astring.String.equal user) (Astring.String.cuts ~sep:"\n" s)
+
+(* Generates a new MacOS user called `<prefix><uid>' *)
+let create_new_user ~username ~home_dir ~uid ~gid =
+  let* exists = user_exists ~user:username in
+  if exists then Lwt.return_ok ()
+  else
+    let user = "/Users" / username in
+    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 ])
+
+let delete_user ~user =
+  let* exists = user_exists ~user in
+  match exists with
+    | false ->
+      Log.info (fun f -> f "Not deleting %s as they don't exist" user);
+      Lwt_result.return ()
+    | true ->
+      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
+
+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 [])
+
+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
+    match t with
+    | Ok () -> Lwt.return ()
+    | Error (`Msg m) ->
+      Log.warn (fun f -> f "Failed to kill process %i because %s" pid m);
+      Lwt.return ()
+
+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 ]
+
+(* 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 get_tmpdir ~user =
+  ["sudo"; "-u"; user; "-i"; "getconf"; "DARWIN_USER_TEMP_DIR"]

lib/obuilder.ml

@@ -15,11 +15,12 @@ module Store_spec = Store_spec
 
 (** {2 Fetchers} *)
 module Docker = Docker
+module User_temp = User_temp
 
 (** {2 Sandboxes} *)
 
 module Config = Config
-module Runc_sandbox = Runc_sandbox
+module Sandbox = Sandbox
 
 (** {2 Builders} *)
 

lib/os.ml

@@ -53,6 +53,32 @@ let default_exec ?cwd ?stdin ?stdout ?stderr ~pp argv =
   | Unix.WSIGNALED x -> Fmt.error_msg "%t failed with signal %d" pp x
   | Unix.WSTOPPED x -> Fmt.error_msg "%t stopped with signal %a" pp pp_signal x
 
+(* Similar to default_exec except using open_process_none in order to get the
+   pid of the forked process. On macOS this allows for cleaner job cancellations *)
+let open_process ?cwd ?stdin ?stdout ?stderr ?pp:_ argv =
+  Logs.info (fun f -> f "Fork exec %a" pp_cmd argv);
+  let proc =
+    let stdin  = Option.map redirection stdin in
+    let stdout = Option.map redirection stdout in
+    let stderr = Option.map redirection stderr in
+    let process = Lwt_process.open_process_none ?cwd ?stdin ?stdout ?stderr ("", (Array.of_list argv)) in
+  (process#pid, process#status)
+  in
+    Option.iter close_redirection stdin;
+    Option.iter close_redirection stdout;
+    Option.iter close_redirection stderr;
+    proc
+
+let process_result ~pp proc =
+  proc >|= (function
+  | Unix.WEXITED n -> Ok n
+  | Unix.WSIGNALED x -> Fmt.error_msg "%t failed with signal %d" pp x
+  | Unix.WSTOPPED x -> Fmt.error_msg "%t stopped with signal %a" pp pp_signal x)
+  >>= function
+  | Ok 0 -> Lwt_result.return ()
+  | Ok n -> Lwt.return @@ Fmt.error_msg "%t failed with exit status %d" pp n
+  | Error e -> Lwt_result.fail (e : [`Msg of string] :> [> `Msg of string])
+
 (* Overridden in unit-tests *)
 let lwt_process_exec = ref default_exec
 

lib/rsync_store.ml

@@ -145,7 +145,9 @@ let cache ~user t name =
   (* Create writeable clone. *)
   let gen = cache.gen in
   let { Obuilder_spec.uid; gid } = user in
-  Rsync.copy_children ~chown:(Printf.sprintf "%d:%d" uid gid) ~src:snapshot ~dst:tmp () >>= fun () ->
+  (* rsync --chown not supported by the rsync that macOS ships with *)
+  Rsync.copy_children ~src:snapshot ~dst:tmp () >>= fun () ->
+  Os.sudo [ "chown"; Printf.sprintf "%d:%d" uid gid; tmp ] >>= fun () ->
   let release () =
       Lwt_mutex.with_lock cache.lock @@ fun () ->
       begin

lib/sandbox.macos.ml

@@ -0,0 +1,182 @@
+open Lwt.Infix
+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;
+  (* 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;
+}
+
+open Sexplib.Conv
+
+type config = {
+  uid: int;
+  fallback_library_path : string;
+  scoreboard : string;
+  no_fuse : bool;
+}[@@deriving sexp]
+
+let run_as ~env ~user ~cmd =
+  let command =
+    let env = String.concat " " (List.map (fun (k, v) -> Filename.quote (k^"="^v)) env) in
+    "sudo" :: "su" :: "-l" :: user :: "-c" :: "--" ::
+    Printf.sprintf {|source ~/.obuilder_profile.sh && env %s "$0" "$@"|} env ::
+    cmd
+  in
+  Log.debug (fun f -> f "Running: %s" (String.concat " " command));
+  command
+
+let copy_to_log ~src ~dst =
+  let buf = Bytes.create 4096 in
+  let rec aux () =
+    Lwt_unix.read src buf 0 (Bytes.length buf) >>= function
+    | 0 -> Lwt.return_unit
+    | n -> Build_log.write dst (Bytes.sub_string buf 0 n) >>= aux
+  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 efficienct, but is necessary.*)
+let post_build ~result_dir ~home_dir (t : t) =
+  Os.sudo ["rsync"; "-aHq"; "--delete"; home_dir ^ "/"; result_dir ] >>= fun () ->
+  if not t.fuse_mounted || t.no_fuse then Lwt.return () else
+  let f = ["umount"; "-f"; "/usr/local"] in
+  Os.sudo f >>= fun _ -> t.fuse_mounted <- false; Lwt.return ()
+
+(* Using rsync to delete old files seems to be a good deal faster. *)
+let pre_build ~result_dir ~home_dir (t : 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 () else begin
+    Os.sudo [ "chown"; "-R"; ":" ^ (string_of_int t.gid); home_dir ] >>= fun () ->
+    Os.sudo [ "chmod"; "-R"; "g+w"; home_dir ] >>= fun () ->
+    Lwt.return (t.chowned <- true)
+  end) >>= fun () ->
+  if t.fuse_mounted || t.no_fuse then Lwt.return () else
+  let f = [ "obuilderfs"; t.scoreboard ; "/usr/local"; "-o"; "allow_other" ] in
+  Os.sudo f >>= fun _ -> t.fuse_mounted <- true; Lwt.return ()
+
+let user_name ~prefix ~uid =
+  Fmt.str "%s%i" prefix uid
+
+let home_directory user = Filename.concat "/Users/" user
+
+(* 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 =
+  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 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 osenv = config.Config.env in
+  let stdout = `FD_move_safely out_w in
+  let stderr = stdout in
+  let copy_log = copy_to_log ~src:out_r ~dst:log in
+  let proc_id = ref None in
+  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
+    let cmd = run_as ~env ~user ~cmd:config.Config.argv in
+    Os.ensure_dir config.Config.cwd;
+    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
+          | 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
+
+let create ~state_dir:_ c =
+  Lwt.return {
+    uid = c.uid;
+    gid = 1000;
+    fallback_library_path = c.fallback_library_path;
+    scoreboard = c.scoreboard;
+    no_fuse = c.no_fuse;
+    fuse_mounted = false;
+    chowned = false;
+  }
+
+let uid =
+  Arg.required @@
+  Arg.opt Arg.(some int) None @@
+  Arg.info
+    ~doc:"The uid of the user that will be used as the builder. This should be unique and not in use. \
+    You can run `dscl . -list /Users uid` to see all of the currently active users and their uids."
+    ~docv:"UID"
+    ["uid"]
+
+let fallback_library_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 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"]
+
+let cmdliner : config Term.t =
+  let make uid fallback_library_path scoreboard no_fuse =
+    { uid; fallback_library_path; scoreboard; no_fuse }
+  in
+  Term.(const make $ uid $ fallback_library_path $ scoreboard $ no_fuse)

lib/runc_sandbox.mli → lib/sandbox.mli

@@ -1,4 +1,4 @@
-(** Sandbox builds using runc Linux containers. *)
+(** Sandbox builds. *)
 
 include S.SANDBOX
 
@@ -10,5 +10,5 @@ val cmdliner : config Cmdliner.Term.t
     and parameters to setup a specific sandbox's configuration. *)
 
 val create : state_dir:string -> config -> t Lwt.t
-(** [create ~state_dir config] is a runc sandboxing system that keeps state in [state_dir]
+(** [create ~state_dir config] is a sandboxing system that keeps state in [state_dir]
     and is configured using [config]. *)