diff --git a/lib_eio/unix/fork_action.c b/lib_eio/unix/fork_action.c index 170b0c29..6c4495ba 100644 --- a/lib_eio/unix/fork_action.c +++ b/lib_eio/unix/fork_action.c @@ -237,3 +237,24 @@ static void action_dups(int errors, value v_config) { CAMLprim value eio_unix_fork_dups(value v_unit) { return Val_fork_fn(action_dups); } + +static void action_setpgid(int errors, value v_config) { + #ifdef _WIN32 + eio_unix_fork_error(errors, "setpgid", "Unsupported operation on windows"); + _exit(1); + #else + value vpid = Field(v_config, 1); + value vpgid = Field(v_config, 2); + + int r; + r = setpgid(Int_val(vpid), Int_val(vpgid)); + if (r != 0) { + eio_unix_fork_error(errors, "setpgid", strerror(errno)); + _exit(1); + } + #endif +} + +CAMLprim value eio_unix_fork_setpgid(value v_unit) { + return Val_fork_fn(action_setpgid); +} diff --git a/lib_eio/unix/fork_action.ml b/lib_eio/unix/fork_action.ml index c0441363..99c5e6b2 100644 --- a/lib_eio/unix/fork_action.ml +++ b/lib_eio/unix/fork_action.ml @@ -68,3 +68,9 @@ let inherit_fds m = with_fds m @@ fun m -> let plan : action list = Inherit_fds.plan m in { run = fun k -> k (Obj.repr (action_dups, plan, blocking)) } + +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)) } diff --git a/lib_eio/unix/fork_action.mli b/lib_eio/unix/fork_action.mli index fc9357d4..d1108df8 100644 --- a/lib_eio/unix/fork_action.mli +++ b/lib_eio/unix/fork_action.mli @@ -58,3 +58,9 @@ val inherit_fds : (int * Fd.t * [< blocking]) list -> t A mapping from an FD to itself simply clears the close-on-exec flag. After this, the new FDs may also be set as blocking or non-blocking, depending on [flags]. *) + +val setpgid : int -> t +(** [setpgid pgid] sets the child's process group ID to [pgid]. + + If [pgid] is [0] the child's process ID will be used as the PGID, placing + the child in a {e new} process group. *) diff --git a/lib_eio/unix/process.ml b/lib_eio/unix/process.ml index 4cf9b1ea..ee24b121 100644 --- a/lib_eio/unix/process.ml +++ b/lib_eio/unix/process.ml @@ -83,6 +83,7 @@ module Pi = struct t -> sw:Switch.t -> ?cwd:Eio.Fs.dir_ty Eio.Path.t -> + ?pgid:int -> env:string array -> fds:(int * Fd.t * Fork_action.blocking) list -> executable:string -> @@ -107,6 +108,7 @@ module Make_mgr (X : sig t -> sw:Switch.t -> ?cwd:Eio.Fs.dir_ty Eio.Path.t -> + ?pgid:int -> env:string array -> fds:(int * Fd.t * Fork_action.blocking) list -> executable:string -> @@ -138,11 +140,11 @@ end) = struct let spawn_unix = X.spawn_unix end -let spawn_unix ~sw (Eio.Resource.T (v, ops)) ?cwd ~fds ?env ?executable args = +let spawn_unix ~sw (Eio.Resource.T (v, ops)) ?cwd ?pgid ~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 ~fds ~env ~executable args + X.spawn_unix v ~sw ?cwd ?pgid ~fds ~env ~executable args let sigchld = Eio.Condition.create () diff --git a/lib_eio/unix/process.mli b/lib_eio/unix/process.mli index 8dbe5547..93c51e6c 100644 --- a/lib_eio/unix/process.mli +++ b/lib_eio/unix/process.mli @@ -20,6 +20,7 @@ module Pi : sig t -> sw:Switch.t -> ?cwd:Eio.Fs.dir_ty Eio.Path.t -> + ?pgid:int -> env:string array -> fds:(int * Fd.t * Fork_action.blocking) list -> executable:string -> @@ -42,6 +43,7 @@ module Make_mgr (X : sig t -> sw:Switch.t -> ?cwd:Eio.Fs.dir_ty Eio.Path.t -> + ?pgid:int -> env:string array -> fds:(int * Fd.t * Fork_action.blocking) list -> executable:string -> @@ -53,6 +55,7 @@ val spawn_unix : sw:Switch.t -> _ mgr -> ?cwd:Eio.Fs.dir_ty Eio.Path.t -> + ?pgid:int -> fds:(int * Fd.t * Fork_action.blocking) list -> ?env:string array -> ?executable:string -> diff --git a/lib_eio_linux/eio_linux.ml b/lib_eio_linux/eio_linux.ml index ec9c8eb0..67605289 100644 --- a/lib_eio_linux/eio_linux.ml +++ b/lib_eio_linux/eio_linux.ml @@ -219,11 +219,15 @@ module Process_mgr = struct module T = struct type t = unit - let spawn_unix () ~sw ?cwd ~env ~fds ~executable args = + let spawn_unix () ~sw ?cwd ?pgid ~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 ] in + let actions = match pgid with + | None -> actions + | Some pgid -> Eio_unix.Private.Fork_action.setpgid pgid :: actions + in let with_actions cwd fn = match cwd with | None -> fn actions | Some (fd, s) -> diff --git a/lib_eio_posix/process.ml b/lib_eio_posix/process.ml index 3f9cd71c..630d6573 100644 --- a/lib_eio_posix/process.ml +++ b/lib_eio_posix/process.ml @@ -23,11 +23,15 @@ module Impl = struct module T = struct type t = unit - let spawn_unix () ~sw ?cwd ~env ~fds ~executable args = + let spawn_unix () ~sw ?cwd ?pgid ~env ~fds ~executable args = let actions = Low_level.Process.Fork_action.[ inherit_fds fds; execve executable ~argv:(Array.of_list args) ~env ] in + let actions = match pgid with + | None -> actions + | Some pgid -> Low_level.Process.Fork_action.setpgid pgid :: actions + in let with_actions cwd fn = match cwd with | None -> fn actions | Some ((dir, path) : Eio.Fs.dir_ty Eio.Path.t) ->