Handle named users whenever possible

lib/btrfs_store.ml

@@ -193,7 +193,8 @@ let cache ~user t name : (string * (unit -> unit Lwt.t)) Lwt.t =
  begin match user with
  | `ById { Obuilder_spec.uid; gid } ->
  Os.sudo ["chown"; Printf.sprintf "%d:%d" uid gid; tmp]
- | `ByName _ -> 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
- | `ById { Obuilder_spec.uid; gid } when not Sys.win32 -> ["--user"; strf "%d:%d" uid gid]
- | `ByName { 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

@@ -181,7 +181,10 @@ let cache ~user t name : (string * (unit -> unit Lwt.t)) Lwt.t =
  | `ById { Obuilder_spec.uid; gid } ->
  let* tmp = Docker.Cmd.mount_point tmp in
  Os.sudo ["chown"; strf "%d:%d" uid gid; tmp]
- | `ByName _ -> 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
- | `ById user -> user
- | `ByName _ -> 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.runc.ml

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

lib/tar_transfer.ml

@@ -57,11 +57,20 @@ let copy_to ~dst src =
 
 let get_ids = function
  | `ById user -> Some user.Obuilder_spec.uid, Some user.gid, None, None
- | `ByName 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
- | `ByName _ -> None, None, 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
- | `ById user ->
- { hdr' with Tar.Header.user_id = user.Obuilder_spec.uid; group_id = user.gid; }
- | `ByName 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; }
- | `ByName _ -> 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

@@ -97,8 +97,11 @@ 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 `ById user -> user | `ByName _ -> 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

@@ -19,7 +19,7 @@ let pp_wrap ~escape =
 let pp_cache ~ctx f { Cache.id; target; buildkit_options } =
  let buildkit_options = match ctx.user with
  | `ById {uid; gid = _} -> ("uid", string_of_int uid) :: buildkit_options
- | `ByName _ -> assert false
+ | `ByName _ -> failwith "Docker usage requires numerical user ids"
  in
  let buildkit_options =
  ("--mount=type", "cache") ::
@@ -32,7 +32,7 @@ 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
  | `ById {uid; gid = _} -> ("uid", string_of_int uid) :: buildkit_options
- | `ByName _ -> assert false
+ | `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
@@ -61,7 +61,7 @@ let pp_copy ~ctx f { Spec.from; src; dst; exclude = _ } =
  else (
  match ctx.user with
  | `ById { uid; gid } -> Some (Printf.sprintf "%d:%d" uid gid)
- | `ByName _ -> None
+ | `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
+ | `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
@@ -113,10 +113,10 @@ let rec convert ~buildkit ~escape ~ctx f (name, { Spec.child_builds; from; ops }
 let dockerfile_of_spec ~buildkit ~os t =
  Fmt.str "%a" (fun f ->
  match os with
- | `ByName ->
+ | `Windows ->
  let ctx = { user = (Spec.root_windows :> Spec.user) } in
  (Fmt.pf f "@[<h>#escape=`@]@.";
- convert ~buildkit ~escape:'`' ~ctx f)
- | `ById ->
+ 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/docker.mli

@@ -1,4 +1,4 @@
-val dockerfile_of_spec : buildkit:bool -> os:[`ById | `ByName] -> Spec.t -> string
+val dockerfile_of_spec : buildkit:bool -> os:[`Unix | `Windows] -> Spec.t -> string
 (** [dockerfile_of_spec ~buildkit ~os x] produces a Dockerfile
  that aims to be equivalent to [x].
 

lib_spec/spec.ml

@@ -175,8 +175,6 @@ 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 (`ById { uid; gid })
-let user_windows ~name = `User (`ByName { name })
 
 let root_unix = `ById { uid = 0; gid = 0 }
 let root_windows = `ByName { name = "ContainerAdministrator" }

lib_spec/spec.mli

@@ -50,8 +50,6 @@ 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 : [`ById of numeric_user]
 val root_windows : [`ByName of named_user]

main.ml

@@ -181,10 +181,10 @@ let buildkit =
  ["buildkit"]
 
 let escape =
- let styles = [("unix", `ById); ("windows", `ByName)] 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 `ById else `ByName) @@
+ Arg.opt Arg.(enum styles) (if Sys.unix then `Unix else `Windows) @@
  Arg.info ~doc
  ~docv:"STYLE"
  ["escape"]

test/test.ml

@@ -503,7 +503,7 @@ let test_sexp () =
 let test_docker_unix () =
  let test ~buildkit name expect sexp =
  let spec = Spec.t_of_sexp (Sexplib.Sexp.of_string sexp) in
- let got = Obuilder_spec.Docker.dockerfile_of_spec ~buildkit ~os:`ById spec in
+ let got = Obuilder_spec.Docker.dockerfile_of_spec ~buildkit ~os:`Unix spec in
  let expect = remove_indent expect in
  Alcotest.(check string) name expect got
  in
@@ -600,7 +600,7 @@ let test_docker_unix () =
 let test_docker_windows () =
  let test ~buildkit name expect sexp =
  let spec = Spec.t_of_sexp (Sexplib.Sexp.of_string sexp) in
- let got = Obuilder_spec.Docker.dockerfile_of_spec ~buildkit ~os:`ByName spec in
+ let got = Obuilder_spec.Docker.dockerfile_of_spec ~buildkit ~os:`Windows spec in
  let expect = remove_indent expect in
  Alcotest.(check string) name expect got
  in