-
Notifications
You must be signed in to change notification settings - Fork 71
New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
eio_posix: initial support for subprocesses #461
Changes from 1 commit
0bec10c
fb97c16
3e8f8d6
56da38f
16ec359
d10a720
970833b
File filter
Filter by extension
Conversations
Jump to
Diff view
Diff view
There are no files selected for viewing
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -1,4 +1,8 @@ | ||
(library | ||
(name eio_unix) | ||
(public_name eio.unix) | ||
(foreign_stubs | ||
(language c) | ||
(include_dirs include) | ||
(names fork_action)) | ||
(libraries eio unix threads mtime.clock.os)) |
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,100 @@ | ||
#include <stdlib.h> | ||
#include <unistd.h> | ||
#include <fcntl.h> | ||
#include <string.h> | ||
#include <errno.h> | ||
|
||
#include <caml/mlvalues.h> | ||
|
||
#include "fork_action.h" | ||
|
||
void eio_unix_run_fork_actions(int errors, value v_actions) { | ||
int old_flags = fcntl(errors, F_GETFL, 0); | ||
fcntl(errors, F_SETFL, old_flags & ~O_NONBLOCK); | ||
while (Is_block(v_actions)) { | ||
value v_action = Field(v_actions, 0); | ||
fork_fn *action = (fork_fn *) Nativeint_val(Field(v_action, 0)); | ||
int err = action(errors, v_action); | ||
if (err) { | ||
_exit(err); | ||
} | ||
v_actions = Field(v_actions, 1); | ||
} | ||
_exit(1); | ||
} | ||
|
||
static void try_write_all(int fd, char *buf) { | ||
int len = strlen(buf); | ||
while (len > 0) { | ||
int wrote = write(fd, buf, len); | ||
|
||
if (wrote <= 0) | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. it's worth checking for EINTR here isn't it? Reasonable chance that if there's an error from a forked child, that some signal is coming back to the parent process and interrupting things. There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. This code runs in the child. Possibly we should be masking signals there though. |
||
return; | ||
|
||
buf += wrote; | ||
len -= wrote; | ||
} | ||
} | ||
|
||
void eio_unix_fork_error(int fd, char *fn, char *buf) { | ||
try_write_all(fd, fn); | ||
try_write_all(fd, ": "); | ||
try_write_all(fd, buf); | ||
} | ||
|
||
static char **make_string_array(int errors, value v_array) { | ||
int n = Wosize_val(v_array); | ||
char **c = malloc(sizeof(char *) * (n + 1)); | ||
talex5 marked this conversation as resolved.
Show resolved
Hide resolved
|
||
if (!c) { | ||
eio_unix_fork_error(errors, "make_string_array", "out of memory"); | ||
_exit(1); | ||
} | ||
for (int i = 0; i < n; i++) { | ||
c[i] = (char *) String_val(Field(v_array, i)); | ||
} | ||
c[n] = NULL; | ||
return c; | ||
} | ||
|
||
static int action_execve(int errors, value v_config) { | ||
value v_exe = Field(v_config, 1); | ||
char **argv = make_string_array(errors, Field(v_config, 2)); | ||
char **envp = make_string_array(errors, Field(v_config, 3)); | ||
execve(String_val(v_exe), argv, envp); | ||
eio_unix_fork_error(errors, "execve", strerror(errno)); | ||
return 1; | ||
} | ||
|
||
CAMLprim value eio_unix_fork_execve(value v_unit) { | ||
return Val_fork_fn(action_execve); | ||
} | ||
|
||
static int action_fchdir(int errors, value v_config) { | ||
value v_fd = Field(v_config, 1); | ||
int r; | ||
r = fchdir(Int_val(v_fd)); | ||
if (r != 0) { | ||
eio_unix_fork_error(errors, "fchdir", strerror(errno)); | ||
return 1; | ||
} | ||
return 0; | ||
} | ||
|
||
CAMLprim value eio_unix_fork_fchdir(value v_unit) { | ||
return Val_fork_fn(action_fchdir); | ||
} | ||
|
||
static int action_chdir(int errors, value v_config) { | ||
value v_path = Field(v_config, 1); | ||
int r; | ||
r = chdir(String_val(v_path)); | ||
if (r != 0) { | ||
eio_unix_fork_error(errors, "chdir", strerror(errno)); | ||
return 1; | ||
} | ||
return 0; | ||
} | ||
|
||
CAMLprim value eio_unix_fork_chdir(value v_unit) { | ||
return Val_fork_fn(action_chdir); | ||
} |
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,30 @@ | ||
type c_action = Obj.t | ||
|
||
type t = { run : 'a. ((c_action -> 'a) -> 'a) } [@@unboxed] | ||
|
||
(* A [fork_fn] is a C function that can be executed after forking. It cannot call OCaml code or | ||
run the OCaml GC. It is passed a [Unix.file_descr] for errors and a pointer | ||
to a [fork_action]. On success it should write nothing to the error stream and | ||
return 0. On error, it should write a message to the error FD and return a | ||
non-zero value for the exit status (e.g. 1). *) | ||
type fork_fn | ||
|
||
let rec with_actions actions fn = | ||
match actions with | ||
| [] -> fn [] | ||
| { run } :: xs -> | ||
run @@ fun c_action -> | ||
with_actions xs @@ fun c_actions -> | ||
fn (c_action :: c_actions) | ||
|
||
external action_execve : unit -> fork_fn = "eio_unix_fork_execve" | ||
let action_execve = action_execve () | ||
let execve path ~argv ~env = { run = fun k -> k (Obj.repr (action_execve, path, argv, env)) } | ||
|
||
external action_chdir : unit -> fork_fn = "eio_unix_fork_chdir" | ||
let action_chdir = action_chdir () | ||
let chdir path = { run = fun k -> k (Obj.repr (action_chdir, path)) } | ||
|
||
external action_fchdir : unit -> fork_fn = "eio_unix_fork_fchdir" | ||
let action_fchdir = action_fchdir () | ||
let fchdir fd = { run = fun k -> k (Obj.repr (action_fchdir, fd)) } |
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,40 @@ | ||
(** Actions to perform after forking a child process. | ||
|
||
To spawn a child executable on Unix, the parent forks a copy of itself, | ||
then has the child copy set up the environment for the new program and | ||
execute it. | ||
|
||
However, we cannot run any OCaml code in the forked child process. This is | ||
because `fork` only duplicates its own domain. To the child, it appears | ||
that all other domains have stopped responding and if it tries to e.g. | ||
perform a GC then the child process will hang. | ||
|
||
Therefore, the fork call and all child actions need to be written in C. | ||
This module provides some support code for doing that. | ||
Individual backends will wrap these actions with higher-level APIs and | ||
can also add their own platform-specific actions *) | ||
|
||
type fork_fn | ||
(** A C function, as defined in "include/fork_action.h". *) | ||
|
||
type c_action = Obj.t | ||
(** An action to be performed in a child process after forking. | ||
This must be a tuple whose first field is a [fork_fn]. *) | ||
|
||
type t = { run : 'a. ((c_action -> 'a) -> 'a) } [@@unboxed] | ||
(** An action that calls [run k] in the parent process to create the C action. | ||
[run] passes the action to [k], which forks the child and runs it. When [k] | ||
returns, [run] can free any resources used. *) | ||
|
||
val with_actions : t list -> (c_action list -> 'a) -> 'a | ||
|
||
(** {2 Actions} *) | ||
|
||
val execve : string -> argv:string array -> env:string array -> t | ||
(** See [execve(2)]. *) | ||
|
||
val chdir : string -> t | ||
(** [chdir path] changes directory to [path]. *) | ||
|
||
val fchdir : Unix.file_descr -> t | ||
(** [fchdir fd] changes directory to [fd]. *) |
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,23 @@ | ||
#include <caml/mlvalues.h> | ||
#include <caml/alloc.h> | ||
|
||
/* A function that runs in the forked child process. It must not run any OCaml code or invoke the GC. | ||
* If the action succeeds then the function returns 0. | ||
* Otherwise, it writes an error message to the FD [errors] and returns a non-zero result. | ||
* v_args is the c_action tuple (where field 0 is the function itself). | ||
*/ | ||
typedef int fork_fn(int errors, value v_args); | ||
|
||
#define Val_fork_fn(fn) (caml_copy_nativeint((intnat) fn)) | ||
|
||
/* Run each C action in the list [v_actions]. | ||
* If one returns a non-zero value then it stops and calls | ||
* _exit with that result. If the all succeed, it calls _exit(1). | ||
* Sets [errors] to be blocking. Never returns. | ||
*/ | ||
void eio_unix_run_fork_actions(int errors, value v_actions); | ||
|
||
/* Write "$fn: $msg" to fd. | ||
* fd must be blocking. | ||
* Ignores failure. */ | ||
void eio_unix_fork_error(int fd, char *fn, char *msg); |
Original file line number | Diff line number | Diff line change |
---|---|---|
|
@@ -22,3 +22,5 @@ val run : (stdenv -> 'a) -> 'a | |
|
||
module Low_level = Low_level | ||
(** Low-level API for making POSIX calls directly. *) | ||
|
||
module Process = Process | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Should There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Yes, this was a bit of a hack because Process depends on Low_level. I've moved it now, by making Children a separate file instead. |
Original file line number | Diff line number | Diff line change | ||||
---|---|---|---|---|---|---|
|
@@ -17,6 +17,8 @@ | |||||
#include <caml/unixsupport.h> | ||||||
#include <caml/bigarray.h> | ||||||
|
||||||
#include "fork_action.h" | ||||||
|
||||||
#ifdef ARCH_SIXTYFOUR | ||||||
#define Int63_val(v) Long_val(v) | ||||||
#else | ||||||
|
@@ -185,3 +187,17 @@ CAMLprim value caml_eio_posix_renameat(value v_old_fd, value v_old_path, value v | |||||
if (ret == -1) uerror("renameat", v_old_path); | ||||||
CAMLreturn(Val_unit); | ||||||
} | ||||||
|
||||||
CAMLprim value caml_eio_posix_spawn(value v_errors, value v_actions) { | ||||||
CAMLparam1(v_actions); | ||||||
pid_t child_pid; | ||||||
|
||||||
child_pid = fork(); | ||||||
if (child_pid == 0) { | ||||||
eio_unix_run_fork_actions(Int_val(v_errors), v_actions); | ||||||
} else if (child_pid < 0) { | ||||||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more.
Suggested change
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Why? PIDs can't be negative, so if it returns e.g.
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Exactly, PIDs can't be negative and fork cannot return anything below -1. There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. If it never returns anything below -1 then this code change makes no difference. And if it does, then the original version was safer. There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. it was just more "precise" 😄 |
||||||
uerror("fork", Nothing); | ||||||
} | ||||||
|
||||||
CAMLreturn(Val_long(child_pid)); | ||||||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. I'm surprised this holds, since a pid_t might not fit on an int. The standard library does the same though. There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more.
That could indeed be too big for an OCaml int. However, https://unix.stackexchange.com/questions/16883/what-is-the-maximum-value-of-the-process-id seems to indicate that the limit is usually quite small. There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Interesting, I remember Stevens mentioning that the correct practice whas to for example cast a pid_t to (long long) in order to print it safely, since it was impossible to know its size. |
||||||
} |
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
I think
Fork_action
is a sensible name, but I wonder if people will get confused withFiber.fork
?There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
It could be
Child_action
I suppose. But if you're using the low-level API to get precise control over forking, you probably know whatProcess.Fork_action
means.