User specification / Operating system split

lib/btrfs_store.ml

@@ -191,9 +191,10 @@ let cache ~user t name : (string * (unit -> unit Lwt.t)) Lwt.t =
  let gen = cache.gen in
  Btrfs.subvolume_snapshot `RW ~src:snapshot tmp >>= fun () ->
  begin match user with
- | `Unix { Obuilder_spec.uid; gid } ->
+ | `ById { Obuilder_spec.uid; gid } ->
  Os.sudo ["chown"; Printf.sprintf "%d:%d" uid gid; tmp]
- | `Windows _ -> assert false (* btrfs not supported on Windows*)
+ | `ByName { Obuilder_spec.name } ->
+ Os.sudo ["chown"; name; tmp]
  end >>= fun () ->
  let release () =
  Lwt_mutex.with_lock cache.lock @@ fun () ->

lib/docker_sandbox.ml

@@ -43,9 +43,8 @@ module Docker_config = struct
  let network = network |> List.concat_map (fun network -> ["--network"; network]) in
  let user =
  match user with
- | `Unix { Obuilder_spec.uid; gid } when not Sys.win32 -> ["--user"; strf "%d:%d" uid gid]
- | `Windows { name } when Sys.win32 -> ["--user"; name]
- | _ -> assert false
+ | `ById { Obuilder_spec.uid; gid } -> ["--user"; strf "%d:%d" uid gid]
+ | `ByName { name } -> ["--user"; name]
  in
  let mount_secrets =
  let id = ref (-1) in

lib/docker_store.ml

@@ -178,10 +178,13 @@ let cache ~user t name : (string * (unit -> unit Lwt.t)) Lwt.t =
  let gen = cache.gen in
  let* () = Cache.snapshot ~src:snapshot tmp in
  let+ () = match user with
- | `Unix { Obuilder_spec.uid; gid } ->
+ | `ById { Obuilder_spec.uid; gid } ->
  let* tmp = Docker.Cmd.mount_point tmp in
  Os.sudo ["chown"; strf "%d:%d" uid gid; tmp]
- | `Windows _ -> Lwt.return_unit (* FIXME: does Windows need special treatment? *)
+ | `ByName _ when Sys.win32 -> Lwt.return_unit (* FIXME: does Windows need special treatment? *)
+ | `ByName { Obuilder_spec.name } ->
+ let* tmp = Docker.Cmd.mount_point tmp in
+ Os.sudo ["chown"; name; tmp]
  in
  let release () =
  Lwt_mutex.with_lock cache.lock @@ fun () ->

lib/rsync_store.ml

@@ -153,13 +153,13 @@ let cache ~user t name =
  end >>= fun () ->
  (* Create writeable clone. *)
  let gen = cache.gen in
- let { Obuilder_spec.uid; gid } = match user with
- | `Unix user -> user
- | `Windows _ -> assert false (* rsync not supported on Windows *)
+ let chown_argument = match user with
+ | `ById { Obuilder_spec.uid; gid } -> Printf.sprintf "%d:%d" uid gid
+ | `ByName { Obuilder_spec.name } -> name
  in
  (* 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 () ->
+ Os.sudo [ "chown"; chown_argument; tmp ] >>= fun () ->
  let release () =
  Lwt_mutex.with_lock cache.lock @@ fun () ->
  begin

lib/sandbox.jail.ml

@@ -15,8 +15,8 @@ type config = unit [@@deriving sexp]
  Note that the gid is currently ignored. *)
 let jail_username rootdir config =
  match config.Config.user with
- | `Windows w -> w.name
- | `Unix { uid; _ } ->
+ | `ByName { name } -> name
+ | `ById { Obuilder_spec.uid; _ } ->
  let pwdfile = rootdir / "etc" / "passwd" in
  let uidstr = string_of_int uid in
  let rec parse_line ch =

lib/sandbox.runc.ml

@@ -108,8 +108,9 @@ module Json_config = struct
  assert (entrypoint = None);
  let user =
  let { Obuilder_spec.uid; gid } = match user with
- | `Unix user -> user
- | `Windows _ -> assert false (* runc not supported on Windows *) in
+ | `ById user -> user
+ | `ByName _ -> failwith "runc sandbox requires numerical user ids"
+ in
  `Assoc [
  "uid", `Int uid;
  "gid", `Int gid;

lib/tar_transfer.ml

@@ -56,12 +56,21 @@ let copy_to ~dst src =
  aux ()
 
 let get_ids = function
- | `Unix user -> Some user.Obuilder_spec.uid, Some user.gid, None, None
- | `Windows user when user.Obuilder_spec.name = "ContainerAdministrator" ->
- (* https://cygwin.com/cygwin-ug-net/ntsec.html#ntsec-mapping *)
- let x = 93 and rid = 1 in
- Some (0x1000 * x + rid), Some (0x1000 * x + rid), Some user.name, Some user.name
- | `Windows _ -> None, None, None, None
+ | `ById user -> Some user.Obuilder_spec.uid, Some user.gid, None, None
+ | `ByName user when Sys.win32 ->
+ if user.Obuilder_spec.name = "ContainerAdministrator" then
+ (* https://cygwin.com/cygwin-ug-net/ntsec.html#ntsec-mapping *)
+ let x = 93 and rid = 1 in
+ Some (0x1000 * x + rid), Some (0x1000 * x + rid), Some user.name, Some user.name
+ else
+ None, None, None, None
+ | `ByName user ->
+ let name = user.Obuilder_spec.name in
+ try
+ let pwent = Unix.getpwnam name in
+ Some pwent.pw_uid, Some pwent.pw_gid, Some name, None
+ with Not_found ->
+ None, None, Some name, None
 
 let copy_file ~src ~dst ~to_untar ~user =
  Lwt_unix.LargeFile.lstat src >>= fun stat ->
@@ -144,14 +153,22 @@ let send_file ~src_dir ~src_manifest ~dst ~user ~to_untar =
 let transform ~user fname hdr =
  (* Make a copy to erase unneeded data from the tar headers. *)
  let hdr' = Tar.Header.(make ~file_mode:hdr.file_mode ~mod_time:hdr.mod_time hdr.file_name hdr.file_size) in
- let hdr' = match user with
- | `Unix user ->
- { hdr' with Tar.Header.user_id = user.Obuilder_spec.uid; group_id = user.gid; }
- | `Windows user when user.Obuilder_spec.name = "ContainerAdministrator" ->
- (* https://cygwin.com/cygwin-ug-net/ntsec.html#ntsec-mapping *)
- let id = let x = 93 and rid = 1 in 0x1000 * x + rid in
- { hdr' with user_id = id; group_id = id; uname = user.name; gname = user.name; }
- | `Windows _ -> hdr'
+ let user_id, group_id, uname, gname = get_ids user in
+ let hdr' = match user_id with
+ | Some uid -> { hdr' with Tar.Header.user_id = uid }
+ | None -> hdr'
+ in
+ let hdr' = match group_id with
+ | Some gid -> { hdr' with Tar.Header.group_id = gid }
+ | None -> hdr'
+ in
+ let hdr' = match uname with
+ | Some name -> { hdr' with Tar.Header.uname = name }
+ | None -> hdr'
+ in
+ let hdr' = match gname with
+ | Some name -> { hdr' with Tar.Header.gname = name }
+ | None -> hdr'
  in
  match hdr.Tar.Header.link_indicator with
  | Normal ->

lib/zfs_store.ml

@@ -93,12 +93,15 @@ end = struct
  | false -> fn ()
 end
 
-let user = `Unix { Obuilder_spec.uid = Unix.getuid (); gid = Unix.getgid () }
+let user = `ById { Obuilder_spec.uid = Unix.getuid (); gid = Unix.getgid () }
 
 module Zfs = struct
  let chown ~user t ds =
- let { Obuilder_spec.uid; gid } = match user with `Unix user -> user | `Windows _ -> assert false in
- Os.sudo ["chown"; strf "%d:%d" uid gid; Dataset.path t ds]
+ let chown_argument = match user with
+ | `ById { Obuilder_spec.uid; gid } -> strf "%d:%d" uid gid
+ | `ByName { Obuilder_spec.name } -> name
+ in
+ Os.sudo ["chown"; chown_argument; Dataset.path t ds]
 
  let create t ds =
  Os.sudo ["zfs"; "create"; "--"; Dataset.full_name t ds]

lib_spec/docker.ml

@@ -18,8 +18,8 @@ let pp_wrap ~escape =
 
 let pp_cache ~ctx f { Cache.id; target; buildkit_options } =
  let buildkit_options = match ctx.user with
- | `Unix {uid; gid = _} -> ("uid", string_of_int uid) :: buildkit_options
- | `Windows _ -> assert false
+ | `ById {uid; gid = _} -> ("uid", string_of_int uid) :: buildkit_options
+ | `ByName _ -> failwith "Docker usage requires numerical user ids"
  in
  let buildkit_options =
  ("--mount=type", "cache") ::
@@ -31,8 +31,8 @@ let pp_cache ~ctx f { Cache.id; target; buildkit_options } =
 
 let pp_mount_secret ~ctx f { Secret.id; target; buildkit_options } =
  let buildkit_options = match ctx.user with
- | `Unix {uid; gid = _} -> ("uid", string_of_int uid) :: buildkit_options
- | `Windows _ -> assert false
+ | `ById {uid; gid = _} -> ("uid", string_of_int uid) :: buildkit_options
+ | `ByName _ -> failwith "Docker usage requires numerical user ids"
  in
  let buildkit_options =
  ("--mount=type", "secret") ::
@@ -51,7 +51,7 @@ let pp_run ~escape ~ctx f { Spec.cache; shell; secrets; network = _ } =
 let is_root user =
  user = (Spec.root_windows :> Spec.user) || user = (Spec.root_unix :> Spec.user)
 
-let pp_copy ~ctx f { Spec.from; src; dst; exclude = _ } =
+let pp_copy ~os ~ctx f { Spec.from; src; dst; exclude = _ } =
  let from = match from with
  | `Build name -> Some name
  | `Context -> None
@@ -60,8 +60,8 @@ let pp_copy ~ctx f { Spec.from; src; dst; exclude = _ } =
  if is_root ctx.user then None
  else (
  match ctx.user with
- | `Unix { uid; gid } -> Some (Printf.sprintf "%d:%d" uid gid)
- | `Windows _ -> None
+ | `ById { uid; gid } -> Some (Printf.sprintf "%d:%d" uid gid)
+ | `ByName { name } -> match os with `Unix -> Some name | `Windows -> None
  )
  in
  Fmt.pf f "COPY %a%a%a %s"
@@ -84,26 +84,26 @@ let quote ~escape v =
  Buffer.add_substring buf v !j (len - !j);
  Buffer.contents buf
 
-let pp_op ~buildkit ~escape ctx f : Spec.op -> ctx = function
+let pp_op ~buildkit ~escape ~os ctx f : Spec.op -> ctx = function
  | `Comment x -> Fmt.pf f "# %s" x; ctx
  | `Workdir x -> Fmt.pf f "WORKDIR %s" x; ctx
  | `Shell xs -> Fmt.pf f "SHELL [ %a ]" Fmt.(list ~sep:comma (quote string)) xs; ctx
  | `Run x when buildkit -> pp_run ~escape ~ctx f x; ctx
  | `Run x -> pp_run ~escape ~ctx f { x with cache = []; secrets = []}; ctx
- | `Copy x -> pp_copy ~ctx f x; ctx
- | `User (`Unix { uid; gid } as u) -> Fmt.pf f "USER %d:%d" uid gid; { user = u }
- | `User (`Windows { name } as u) -> Fmt.pf f "USER %s" name; { user = u }
+ | `Copy x -> pp_copy ~os ~ctx f x; ctx
+ | `User (`ById { uid; gid } as u) -> Fmt.pf f "USER %d:%d" uid gid; { user = u }
+ | `User (`ByName { name } as u) -> Fmt.pf f "USER %s" name; { user = u }
  | `Env (k, v) -> Fmt.pf f "ENV %s=\"%s\"" k (quote ~escape v); ctx
 
-let rec convert ~buildkit ~escape ~ctx f (name, { Spec.child_builds; from; ops }) =
+let rec convert ~buildkit ~escape ~os ~ctx f (name, { Spec.child_builds; from; ops }) =
  child_builds |> List.iter (fun (name, spec) ->
- convert ~buildkit ~escape ~ctx f (Some name, spec);
+ convert ~buildkit ~escape ~os ~ctx f (Some name, spec);
  Format.pp_print_newline f ();
  );
  Fmt.pf f "@[<h>FROM %s%a@]@." from Fmt.(option (const string " as " ++ string)) name;
  let (_ : ctx) = List.fold_left (fun ctx op ->
  Format.pp_open_hbox f ();
- let ctx = pp_op ~buildkit ~escape ctx f op in
+ let ctx = pp_op ~buildkit ~escape ~os ctx f op in
  Format.pp_close_box f ();
  Format.pp_print_newline f ();
  ctx
@@ -116,7 +116,7 @@ let dockerfile_of_spec ~buildkit ~os t =
  | `Windows ->
  let ctx = { user = (Spec.root_windows :> Spec.user) } in
  (Fmt.pf f "@[<h>#escape=`@]@.";
- convert ~buildkit ~escape:'`' ~ctx f)
+ convert ~buildkit ~escape:'`' ~os ~ctx f)
  | `Unix ->
  let ctx = { user = (Spec.root_unix :> Spec.user) } in
- convert ~buildkit ~escape:'\\' ~ctx f) (None, t)
+ convert ~buildkit ~escape:'\\' ~os ~ctx f) (None, t)

lib_spec/spec.ml

@@ -56,27 +56,27 @@ let copy_inlined = function
 let copy_of_sexp x = copy_of_sexp (inflate_record copy_inlined x)
 let sexp_of_copy x = deflate_record copy_inlined (sexp_of_copy x)
 
-type unix_user = {
+type numeric_user = {
  uid : int;
  gid : int;
 } [@@deriving sexp]
 
-type windows_user = {
+type named_user = {
  name : string;
 } [@@deriving sexp]
 
 type user = [
- | `Unix of unix_user
- | `Windows of windows_user
+ | `ById of numeric_user
+ | `ByName of named_user
 ] [@@deriving sexp]
 
 let user_of_sexp x =
  let open Sexplib.Sexp in
  match x with
  | List [List [Atom "name"; _]] ->
- `Windows (windows_user_of_sexp x)
+ `ByName (named_user_of_sexp x)
  | List [List [Atom "uid"; _]; List [Atom "gid"; _]] ->
- `Unix (unix_user_of_sexp x)
+ `ById (numeric_user_of_sexp x)
  | x -> Fmt.failwith "Invalid op: %a" Sexplib.Sexp.pp_hum x
 
 let sexp_of_user x : Sexplib.Sexp.t =
@@ -175,11 +175,9 @@ let shell xs = `Shell xs
 let run ?(cache=[]) ?(network=[]) ?(secrets=[]) fmt = fmt |> Printf.ksprintf (fun x -> `Run { shell = x; cache; network; secrets })
 let copy ?(from=`Context) ?(exclude=[]) src ~dst = `Copy { from; src; dst; exclude }
 let env k v = `Env (k, v)
-let user_unix ~uid ~gid = `User (`Unix { uid; gid })
-let user_windows ~name = `User (`Windows { name })
 
-let root_unix = `Unix { uid = 0; gid = 0 }
-let root_windows = `Windows { name = "ContainerAdministrator" }
+let root_unix = `ById { uid = 0; gid = 0 }
+let root_windows = `ByName { name = "ContainerAdministrator" }
 let root = if Sys.win32 then root_windows else root_unix
 
 let rec pp_no_boxes f : Sexplib.Sexp.t -> unit = function

lib_spec/spec.mli

@@ -5,18 +5,18 @@ type copy = {
  exclude : string list;
 } [@@deriving sexp]
 
-type unix_user = {
+type numeric_user = {
  uid : int;
  gid : int;
 } [@@deriving sexp]
 
-type windows_user = {
+type named_user = {
  name : string;
 } [@@deriving sexp]
 
 type user = [
- | `Unix of unix_user
- | `Windows of windows_user
+ | `ById of numeric_user
+ | `ByName of named_user
 ] [@@deriving sexp]
 
 type run = {
@@ -50,11 +50,9 @@ val shell : string list -> op
 val run : ?cache:Cache.t list -> ?network:string list -> ?secrets:Secret.t list -> ('a, unit, string, op) format4 -> 'a
 val copy : ?from:[`Context | `Build of string] -> ?exclude:string list -> string list -> dst:string -> op
 val env : string -> string -> op
-val user_unix : uid:int -> gid:int -> op
-val user_windows : name:string -> op
 
-val root_unix : [`Unix of unix_user]
-val root_windows : [`Windows of windows_user]
+val root_unix : [`ById of numeric_user]
+val root_windows : [`ByName of named_user]
 val root : user
 
 val pp : t Fmt.t

main.ml

@@ -181,7 +181,7 @@ let buildkit =
  ["buildkit"]
 
 let escape =
- let styles = [("unix", `Unix); ("windows", `Windows)] in
+ let styles = [ ("unix", `Unix); ("windows", `Windows)] in
  let doc = Arg.doc_alts_enum styles |> Printf.sprintf "Dockerfile escape style, must be %s." in
  Arg.value @@
  Arg.opt Arg.(enum styles) (if Sys.unix then `Unix else `Windows) @@

stress/stress.ml

@@ -56,15 +56,15 @@ module Test(Store : S.STORE) = struct
  let test_cache t =
  let uid = Unix.getuid () in
  let gid = Unix.getgid () in
- let user = `Unix { Spec.uid = 123; gid = 456 } in
+ let user = `ById { Spec.uid = 123; gid = 456 } in
  let id = "c1" in
  (* Create a new cache *)
  Store.delete_cache t id >>= fun x ->
  assert (x = Ok ());
  Store.cache ~user t id >>= fun (c, r) ->
  assert ((Unix.lstat c).Unix.st_uid = 123);
  assert ((Unix.lstat c).Unix.st_gid = 456);
- let user = `Unix { Spec.uid; gid } in
+ let user = `ById { Spec.uid; gid } in
  Os.exec ["sudo"; "chown"; Printf.sprintf "%d:%d" uid gid; "--"; c] >>= fun () ->
  assert (Sys.readdir c = [| |]);
  write ~path:(c / "data") "v1" >>= fun () ->

test/test.ml

@@ -443,7 +443,7 @@ let test_tar_long_filename _switch () =
  with_file (dst_dir / "out.tar") Lwt_unix.[O_WRONLY; O_CREAT; O_CLOEXEC] 0
  @@ fun to_untar ->
  let src_manifest = Manifest.generate ~exclude:[] ~src_dir "." |> Result.get_ok in
- let user = Spec.(`Unix { uid=1000; gid=1000 }) in
+ let user = Spec.(`ById { uid=1000; gid=1000 }) in
  Tar_transfer.send_file
  ~src_dir
  ~src_manifest