Skip to content

Commit

Permalink
chore: update spawn bindings
Browse files Browse the repository at this point in the history
Signed-off-by: Rudi Grinberg <me@rgrinberg.com>

<!-- ps-id: de8f3b4c-9a76-46bf-b106-8f0cac1ff405 -->
  • Loading branch information
rgrinberg committed Jul 3, 2023
1 parent 6467301 commit 49aba8c
Show file tree
Hide file tree
Showing 4 changed files with 86 additions and 15 deletions.
6 changes: 4 additions & 2 deletions vendor/spawn/src/spawn.ml
Original file line number Diff line number Diff line change
Expand Up @@ -100,6 +100,7 @@ external spawn_unix :
-> stderr:Unix.file_descr
-> use_vfork:bool
-> setpgid:int option
-> sigprocmask:(Unix.sigprocmask_command * int list) option
-> int = "spawn_unix_byte" "spawn_unix"

external spawn_windows :
Expand All @@ -122,7 +123,7 @@ let maybe_quote f =
f

let spawn_windows ~env ~cwd ~prog ~argv ~stdin ~stdout ~stderr ~use_vfork:_
~setpgid:_ =
~setpgid:_ ~sigprocmask:_ =
let cwd =
match (cwd : Working_dir.t) with
| Path p -> Some p
Expand All @@ -146,7 +147,7 @@ let no_null s =

let spawn ?env ?(cwd = Working_dir.Inherit) ~prog ~argv ?(stdin = Unix.stdin)
?(stdout = Unix.stdout) ?(stderr = Unix.stderr)
?(unix_backend = Unix_backend.default) ?setpgid () =
?(unix_backend = Unix_backend.default) ?setpgid ?sigprocmask () =
(match cwd with
| Path s -> no_null s
| Fd _
Expand All @@ -166,6 +167,7 @@ let spawn ?env ?(cwd = Working_dir.Inherit) ~prog ~argv ?(stdin = Unix.stdin)
| Fork -> false
in
backend ~env ~cwd ~prog ~argv ~stdin ~stdout ~stderr ~use_vfork ~setpgid
~sigprocmask

external safe_pipe : unit -> Unix.file_descr * Unix.file_descr = "spawn_pipe"

Expand Down
11 changes: 10 additions & 1 deletion vendor/spawn/src/spawn.mli
Original file line number Diff line number Diff line change
Expand Up @@ -96,7 +96,14 @@ end
{b Signals}
On Unix, the sub-process will have all its signals unblocked.
On Unix, by default, the sub-process will have all its signals unblocked. If
[sigprocmask] is passed, the sub-process will have its sigprocmask modified
with the given [sigprocmask_command], relative to the calling thread. At no
point will any OCaml function observe any intermediate signal mask.
Attempts to unblock a signal that is not blocked, to block a signal that is
already blocked, or to block a signal that cannot be blocked (e.g., SIGSTOP,
SIGKILL) are allowed and will be silently ignored.
{b Implementation}
Expand All @@ -113,6 +120,8 @@ val spawn :
-> ?stderr:Unix.file_descr
-> ?unix_backend:Unix_backend.t (* default: [Unix_backend.default] *)
-> ?setpgid:Pgid.t
-> ?sigprocmask:Unix.sigprocmask_command * int list
(** default: unblock all signals in child *)
-> unit
-> int

Expand Down
80 changes: 70 additions & 10 deletions vendor/spawn/src/spawn_stubs.c
Original file line number Diff line number Diff line change
Expand Up @@ -4,11 +4,13 @@
#include <caml/memory.h>
#include <caml/alloc.h>
#include <caml/unixsupport.h>
#include <caml/signals.h>
#include <caml/fail.h>

#include <errno.h>

#include <caml/signals.h>
CAMLextern int caml_convert_signal_number(int);

#if defined(__APPLE__)

CAMLprim value spawn_is_osx()
Expand Down Expand Up @@ -46,6 +48,13 @@ CAMLprim value spawn_is_osx()

#if defined(__APPLE__)

/* vfork(2) is deprecated on macOS >= 12, so we use fork(2) instead. */
# if defined(__MAC_OS_X_VERSION_MAX_ALLOWED)
# if __MAC_OS_X_VERSION_MAX_ALLOWED >= 120000
# define vfork fork
# endif
# endif

static int safe_pipe(int fd[2])
{
int i;
Expand Down Expand Up @@ -170,7 +179,7 @@ static void subprocess_failure(int failure_fd,

/* Block all signals to avoid being interrupted in write.
Although most of the call sites of [subprocess_failure] already block
signals, the one after the [exec] does not. */
signals, the one after the [exec] might not. */
sigfillset(&sigset);
pthread_sigmask(SIG_SETMASK, &sigset, NULL);

Expand Down Expand Up @@ -212,13 +221,13 @@ struct spawn_info {
int std_fds[3];
int set_pgid;
pid_t pgid;
sigset_t child_sigmask;
};

static void subprocess(int failure_fd, struct spawn_info *info)
{
int i, fd, tmp_fds[3];
struct sigaction sa;
sigset_t sigset;

if (info->set_pgid) {
if (setpgid(0, info->pgid) == -1) {
Expand All @@ -227,8 +236,9 @@ static void subprocess(int failure_fd, struct spawn_info *info)
}
}

/* Restore all signals to their default behavior before unblocking
them, to avoid invoking handlers from the parent */
/* Restore all signals to their default behavior before setting the
desired signal mask for the subprocess to avoid invoking handlers
from the parent */
sa.sa_handler = SIG_DFL;
sigemptyset(&sa.sa_mask);
sa.sa_flags = 0;
Expand Down Expand Up @@ -264,8 +274,7 @@ static void subprocess(int failure_fd, struct spawn_info *info)
close(tmp_fds[fd]);
}

sigemptyset(&sigset);
pthread_sigmask(SIG_SETMASK, &sigset, NULL);
pthread_sigmask(SIG_SETMASK, &info->child_sigmask, NULL);

execve(info->prog, info->argv, info->env);
subprocess_failure(failure_fd, "execve", PROG);
Expand Down Expand Up @@ -353,6 +362,12 @@ static void free_spawn_info(struct spawn_info *info)

extern char ** environ;

enum caml_unix_sigprocmask_command {
CAML_SIG_SETMASK,
CAML_SIG_BLOCK,
CAML_SIG_UNBLOCK,
};

CAMLprim value spawn_unix(value v_env,
value v_cwd,
value v_prog,
Expand All @@ -361,7 +376,8 @@ CAMLprim value spawn_unix(value v_env,
value v_stdout,
value v_stderr,
value v_use_vfork,
value v_setpgid)
value v_setpgid,
value v_sigprocmask)
{
CAMLparam4(v_env, v_cwd, v_prog, v_argv);
pid_t ret;
Expand Down Expand Up @@ -436,6 +452,47 @@ CAMLprim value spawn_unix(value v_env,
sigfillset(&sigset);
pthread_sigmask(SIG_SETMASK, &sigset, &saved_procmask);

if (v_sigprocmask == Val_long(0)) {
sigemptyset(&info.child_sigmask);
} else {
v_sigprocmask = Field(v_sigprocmask, 0);
value v_sigprocmask_command = Field(v_sigprocmask, 0);
enum caml_unix_sigprocmask_command sigprocmask_command = Long_val(v_sigprocmask_command);

switch (sigprocmask_command) {
case CAML_SIG_SETMASK:
sigemptyset(&info.child_sigmask);
break;

case CAML_SIG_BLOCK:
case CAML_SIG_UNBLOCK:
info.child_sigmask = saved_procmask;
break;

default:
caml_failwith("Unknown sigprocmask action");
}

for (value v_signals_list = Field(v_sigprocmask, 1);
v_signals_list != Val_emptylist;
v_signals_list = Field(v_signals_list, 1)) {
int signal = caml_convert_signal_number(Long_val(Field(v_signals_list, 0)));
switch (sigprocmask_command) {
case CAML_SIG_SETMASK:
case CAML_SIG_BLOCK:
sigaddset(&info.child_sigmask, signal);
break;

case CAML_SIG_UNBLOCK:
sigdelset(&info.child_sigmask, signal);
break;

default:
assert(0);
}
}
}

ret = Bool_val(v_use_vfork) ? vfork() : fork();

if (ret == 0) {
Expand Down Expand Up @@ -525,7 +582,8 @@ CAMLprim value spawn_unix(value v_env,
value v_stdout,
value v_stderr,
value v_use_vfork,
value v_setpgid)
value v_setpgid,
value v_sigprocmask)
{
(void)v_env;
(void)v_cwd;
Expand All @@ -536,6 +594,7 @@ CAMLprim value spawn_unix(value v_env,
(void)v_stderr;
(void)v_use_vfork;
(void)v_setpgid;
(void)v_sigprocmask;
unix_error(ENOSYS, "spawn_unix", Nothing);
}

Expand Down Expand Up @@ -617,7 +676,8 @@ CAMLprim value spawn_unix_byte(value * argv)
argv[5],
argv[6],
argv[7],
argv[8]);
argv[8],
argv[9]);
}

CAMLprim value spawn_windows_byte(value * argv)
Expand Down
4 changes: 2 additions & 2 deletions vendor/update-spawn.sh
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
#!/bin/bash

version=e159092e9941ec3972c836927232f5680b6cb487
version=48a7145ca41e60d7124e6215bb19139b846985be

set -e -o pipefail

Expand All @@ -12,7 +12,7 @@ mkdir -p spawn/src

(
cd $TMP
git clone https://github.com/janestreet/spawn.git
git clone https://github.com/ocaml-dune/spawn.git
cd spawn
git checkout $version
)
Expand Down

0 comments on commit 49aba8c

Please sign in to comment.