Add setuid and setgid fork action

lib_eio/unix/fork_action.c

@@ -258,3 +258,41 @@ static void action_setpgid(int errors, value v_config) {
 CAMLprim value eio_unix_fork_setpgid(value v_unit) {
   return Val_fork_fn(action_setpgid);
 }
+
+static void action_setuid(int errors, value v_config) {
+  #ifdef _WIN32
+  eio_unix_fork_error(errors, "action_setuid", "Unsupported operation on windows");
+  _exit(1);
+  #else
+  value v_uid = Field(v_config, 1);
+  int r;
+  r = setuid(Int_val(v_uid));
+  if (r != 0) {
+    eio_unix_fork_error(errors, "setuid", strerror(errno));
+    _exit(1);
+  }
+  #endif
+}
+
+CAMLprim value eio_unix_fork_setuid(value v_unit) {
+  return Val_fork_fn(action_setuid);
+}
+
+static void action_setgid(int errors, value v_config) {
+  #ifdef _WIN32
+  eio_unix_fork_error(errors, "action_setgid", "Unsupported operation on windows");
+  _exit(1);
+  #else
+  value v_gid = Field(v_config, 1);
+  int r;
+  r = setgid(Int_val(v_gid));
+  if (r != 0) {
+    eio_unix_fork_error(errors, "setgid", strerror(errno));
+    _exit(1);
+  }
+  #endif
+}
+
+CAMLprim value eio_unix_fork_setgid(value v_unit) {
+  return Val_fork_fn(action_setgid);
+}

lib_eio/unix/fork_action.ml

@@ -71,6 +71,15 @@ let inherit_fds m =
 
 external action_setpgid : unit -> fork_fn = "eio_unix_fork_setpgid"
 let action_setpgid = action_setpgid ()
-
 let setpgid pgid =
   { run = fun k -> k (Obj.repr (action_setpgid, 0, pgid)) }
+
+external action_setuid : unit -> fork_fn = "eio_unix_fork_setuid"
+let action_setuid = action_setuid ()
+let setuid uid = {
+  run = fun k -> k (Obj.repr (action_setuid, uid)) }
+
+external action_setgid : unit -> fork_fn = "eio_unix_fork_setgid"
+let action_setgid = action_setgid ()
+let setgid gid = {
+  run = fun k -> k (Obj.repr (action_setgid, gid)) }

lib_eio/unix/fork_action.mli

@@ -64,3 +64,9 @@ val setpgid : int -> t
 
     If [pgid] is [0] the child's process ID will be used as the PGID, placing
     the child in a {e new} process group. *)
+
+val setuid : int -> t
+(** [setuid uid] sets the user ID to [uid]. *)
+
+val setgid : int -> t
+(** [setgid gid] sets the group ID to [gid]. *)

lib_eio/unix/process.ml

@@ -84,6 +84,8 @@ module Pi = struct
       sw:Switch.t ->
       ?cwd:Eio.Fs.dir_ty Eio.Path.t ->
       ?pgid:int ->
+      ?uid:int ->
+      ?gid:int ->
       env:string array ->
       fds:(int * Fd.t * Fork_action.blocking) list ->
       executable:string ->
@@ -109,6 +111,8 @@ module Make_mgr (X : sig
     sw:Switch.t ->
     ?cwd:Eio.Fs.dir_ty Eio.Path.t ->
     ?pgid:int ->
+    ?uid:int ->
+    ?gid:int ->
     env:string array ->
     fds:(int * Fd.t * Fork_action.blocking) list ->
     executable:string ->
@@ -140,11 +144,11 @@ end) = struct
   let spawn_unix = X.spawn_unix
 end
 
-let spawn_unix ~sw (Eio.Resource.T (v, ops)) ?cwd ?pgid ~fds ?env ?executable args =
+let spawn_unix ~sw (Eio.Resource.T (v, ops)) ?cwd ?pgid ?uid ?gid ~fds ?env ?executable args =
   let module X = (val (Eio.Resource.get ops Pi.Mgr_unix)) in
   let executable = get_executable executable ~args in
   let env = get_env env in
-  X.spawn_unix v ~sw ?cwd ?pgid ~fds ~env ~executable args
+  X.spawn_unix v ~sw ?cwd ?pgid ?uid ?gid ~fds ~env ~executable args
 
 let sigchld = Eio.Condition.create ()
 

lib_eio/unix/process.mli

@@ -21,6 +21,8 @@ module Pi : sig
       sw:Switch.t ->
       ?cwd:Eio.Fs.dir_ty Eio.Path.t ->
       ?pgid:int ->
+      ?uid:int ->
+      ?gid:int ->
       env:string array ->
       fds:(int * Fd.t * Fork_action.blocking) list ->
       executable:string ->
@@ -44,6 +46,8 @@ module Make_mgr (X : sig
     sw:Switch.t ->
     ?cwd:Eio.Fs.dir_ty Eio.Path.t ->
     ?pgid:int ->
+    ?uid:int ->
+    ?gid:int ->
     env:string array ->
     fds:(int * Fd.t * Fork_action.blocking) list ->
     executable:string ->
@@ -56,6 +60,8 @@ val spawn_unix :
     _ mgr ->
     ?cwd:Eio.Fs.dir_ty Eio.Path.t ->
     ?pgid:int ->
+    ?uid:int ->
+    ?gid:int ->
     fds:(int * Fd.t * Fork_action.blocking) list ->
     ?env:string array ->
     ?executable:string ->

lib_eio_linux/eio_linux.ml

@@ -219,7 +219,7 @@ module Process_mgr = struct
   module T = struct
     type t = unit 
 
-    let spawn_unix () ~sw ?cwd ?pgid ~env ~fds ~executable args =
+    let spawn_unix () ~sw ?cwd ?pgid ?uid ?gid ~env ~fds ~executable args =
       let actions = Low_level.Process.Fork_action.[
           Eio_unix.Private.Fork_action.inherit_fds fds;
           execve executable ~argv:(Array.of_list args) ~env
@@ -228,6 +228,14 @@ module Process_mgr = struct
         | None -> actions
         | Some pgid -> Eio_unix.Private.Fork_action.setpgid pgid :: actions
       in
+      let actions = match uid with
+        | None -> actions
+        | Some uid -> Eio_unix.Private.Fork_action.setuid uid :: actions
+      in
+      let actions = match gid with
+        | None -> actions
+        | Some gid -> Eio_unix.Private.Fork_action.setgid gid :: actions
+      in
       let with_actions cwd fn = match cwd with
         | None -> fn actions
         | Some (fd, s) ->

lib_eio_posix/process.ml

@@ -23,7 +23,7 @@ module Impl = struct
   module T = struct
     type t = unit
 
-    let spawn_unix () ~sw ?cwd ?pgid ~env ~fds ~executable args =
+    let spawn_unix () ~sw ?cwd ?pgid ?uid ?gid ~env ~fds ~executable args =
       let actions = Low_level.Process.Fork_action.[
           inherit_fds fds;
           execve executable ~argv:(Array.of_list args) ~env
@@ -32,6 +32,14 @@ module Impl = struct
         | None -> actions
         | Some pgid -> Low_level.Process.Fork_action.setpgid pgid :: actions
       in
+      let actions = match uid with
+        | None -> actions
+        | Some uid -> Eio_unix.Private.Fork_action.setuid uid :: actions
+      in
+      let actions = match gid with
+        | None -> actions
+        | Some gid -> Eio_unix.Private.Fork_action.setgid gid :: actions
+      in
       let with_actions cwd fn = match cwd with
         | None -> fn actions
         | Some ((dir, path) : Eio.Fs.dir_ty Eio.Path.t) ->