diff --git a/lib_eio_linux/dune b/lib_eio_linux/dune index 2378f2bc3..86614e0aa 100644 --- a/lib_eio_linux/dune +++ b/lib_eio_linux/dune @@ -9,5 +9,6 @@ (foreign_stubs (language c) (flags :standard -D_LARGEFILE64_SOURCE) + (include_dirs ../lib_eio/unix/include) (names eio_stubs)) (libraries eio eio.utils eio.unix uring logs fmt)) diff --git a/lib_eio_linux/eio_linux.mli b/lib_eio_linux/eio_linux.mli index 8eacc61dc..dcfbd95cd 100644 --- a/lib_eio_linux/eio_linux.mli +++ b/lib_eio_linux/eio_linux.mli @@ -248,4 +248,46 @@ module Low_level : sig (** [getaddrinfo host] returns a list of IP addresses for [host]. [host] is either a domain name or an ipaddress. *) + (** {1 Processes} *) + + module Process : sig + type t + (** A child process. *) + + (** Setup actions to perform in the child process. *) + module Fork_action : sig + type t = Eio_unix.Private.Fork_action.t + + val execve : string -> argv:string array -> env:string array -> t + (** See execve(2). + This replaces the current executable, + so it only makes sense as the last action to be performed. *) + + val chdir : string -> t + (** [chdir path] changes directory to [path]. *) + + val fchdir : FD.t -> t + (** [fchdir dir] changes directory to [dir]. *) + end + + val spawn : sw:Switch.t -> Fork_action.t list -> t + (** [spawn ~sw actions] forks a child process, which executes [actions]. + The last action should be {!Fork_action.execve}. + + You will typically want to do [Promise.await (exit_status child)] after this. + + @param sw The child will be sent {!Sys.sigkill} if [sw] finishes. *) + + val signal : t -> int -> unit + (** [signal t x] sends signal [x] to [t]. + + This is similar to doing [Unix.kill t.pid x], + except that it ensures no signal is sent after [t] has been reaped. *) + + val pid : t -> int + + val exit_status : t -> Unix.process_status Promise.t + (** [exit_status t] is a promise for the process's exit status. *) + end + end diff --git a/lib_eio_linux/eio_stubs.c b/lib_eio_linux/eio_stubs.c index 4d04e4875..a1102607d 100644 --- a/lib_eio_linux/eio_stubs.c +++ b/lib_eio_linux/eio_stubs.c @@ -1,3 +1,6 @@ +#define _GNU_SOURCE +#include + #include #include #include @@ -7,8 +10,11 @@ #include #include #include +#include #include +// We need caml_convert_signal_number +#define CAML_INTERNALS #include #include @@ -17,6 +23,29 @@ #include #include +#include "fork_action.h" + +#ifndef SYS_pidfd_send_signal +# define SYS_pidfd_send_signal 424 +#endif +#ifndef SYS_clone3 +# define SYS_clone3 435 +# define CLONE_PIDFD 0x00001000 +struct clone_args { + uint64_t flags; + uint64_t pidfd; + uint64_t child_tid; + uint64_t parent_tid; + uint64_t exit_signal; + uint64_t stack; + uint64_t stack_size; + uint64_t tls; + uint64_t set_tid; + uint64_t set_tid_size; + uint64_t cgroup; +}; +#endif + // Make sure we have enough space for at least one entry. #define DIRENT_BUF_SIZE (PATH_MAX + sizeof(struct dirent64)) @@ -99,3 +128,43 @@ CAMLprim value caml_eio_getdents(value v_fd) { CAMLreturn(result); } + +static int pidfd_send_signal(int pidfd, int sig, siginfo_t *info, unsigned int flags) { + return syscall(SYS_pidfd_send_signal, pidfd, sig, info, flags); +} + +CAMLprim value caml_eio_pidfd_send_signal(value v_pidfd, value v_signal) { + CAMLparam0(); + int res; + + res = pidfd_send_signal(Int_val(v_pidfd), caml_convert_signal_number(Int_val(v_signal)), NULL, 0); + if (res == -1) uerror("pidfd_send_signal", Nothing); + CAMLreturn(Val_unit); +} + +CAMLprim value caml_eio_clone3(value v_errors, value v_actions) { + CAMLparam1(v_actions); + CAMLlocal1(v_result); + pid_t child_pid; + int pidfd = -1; /* Is automatically close-on-exec */ + struct clone_args cl_args = { + .flags = CLONE_PIDFD, + .pidfd = (uint64_t) &pidfd, + .exit_signal = SIGCHLD, /* Needed for wait4 to work if we exit before exec */ + .stack = (uint64_t) NULL, /* Use copy-on-write parent stack */ + .stack_size = 0, + }; + + child_pid = syscall(SYS_clone3, &cl_args, sizeof(struct clone_args)); + if (child_pid == 0) { + eio_unix_run_fork_actions(Int_val(v_errors), v_actions); + } else if (child_pid < 0) { + uerror("clone3", Nothing); + } + + v_result = caml_alloc_tuple(2); + Store_field(v_result, 0, Val_long(child_pid)); + Store_field(v_result, 1, Val_int(pidfd)); + + CAMLreturn(v_result); +} diff --git a/lib_eio_linux/fd.ml b/lib_eio_linux/fd.ml index 8c37820c3..075d23765 100644 --- a/lib_eio_linux/fd.ml +++ b/lib_eio_linux/fd.ml @@ -10,6 +10,8 @@ type t = { mutable release_hook : Eio.Switch.hook; (* Use this on close to remove switch's [on_release] hook. *) } +let to_rcfd t = t.fd + let err_closed op = Invalid_argument (op ^ ": file descriptor used after calling close!") let use t f ~if_closed = Rcfd.use t.fd f ~if_closed diff --git a/lib_eio_linux/low_level.ml b/lib_eio_linux/low_level.ml index 98e6295f0..11a241f73 100644 --- a/lib_eio_linux/low_level.ml +++ b/lib_eio_linux/low_level.ml @@ -441,3 +441,84 @@ let pipe ~sw = Unix.set_nonblock unix_r; Unix.set_nonblock unix_w; (r, w) + +let with_pipe fn = + Switch.run @@ fun sw -> + let r, w = pipe ~sw in + fn r w + +module Process = struct + module Rcfd = Eio_unix.Private.Rcfd + + external eio_spawn : + Unix.file_descr -> + Eio_unix.Private.Fork_action.c_action list -> + int * Unix.file_descr = "caml_eio_clone3" + + external pidfd_send_signal : Unix.file_descr -> int -> unit = "caml_eio_pidfd_send_signal" + + type t = { + pid : int; + pid_fd : Fd.t; + exit_status : Unix.process_status Promise.t; + } + + let exit_status t = t.exit_status + let pid t = t.pid + + module Fork_action = struct + type t = Eio_unix.Private.Fork_action.t + + let fchdir fd = Eio_unix.Private.Fork_action.fchdir (Fd.to_rcfd fd) + let chdir = Eio_unix.Private.Fork_action.chdir + let execve = Eio_unix.Private.Fork_action.execve + end + + (* Read a (typically short) error message from a child process. *) + let rec read_response fd = + let buf = Cstruct.create 256 in + match readv fd [buf] with + | len -> Cstruct.to_string buf ~len ^ read_response fd + | exception End_of_file -> "" + + let signal t signum = + Fd.use t.pid_fd ~if_closed:Fun.id @@ fun pid_fd -> + pidfd_send_signal pid_fd signum + + let rec waitpid pid = + match Unix.waitpid [] pid with + | p, status -> assert (p = pid); status + | exception Unix.Unix_error (EINTR, _, _) -> waitpid pid + + let spawn ~sw actions = + with_pipe @@ fun errors_r errors_w -> + Eio_unix.Private.Fork_action.with_actions actions @@ fun c_actions -> + Switch.check sw; + let exit_status, set_exit_status = Promise.create () in + let t = + Fd.use_exn "errors-w" errors_w @@ fun errors_w -> + let pid, pid_fd = eio_spawn errors_w c_actions in + let pid_fd = Fd.of_unix ~sw ~seekable:false ~close_unix:true pid_fd in + { pid; pid_fd; exit_status } + in + Fd.close errors_w; + Fiber.fork_daemon ~sw (fun () -> + let cleanup () = + Fd.close t.pid_fd; + Promise.resolve set_exit_status (waitpid t.pid); + `Stop_daemon + in + match await_readable t.pid_fd with + | () -> Eio.Cancel.protect cleanup + | exception Eio.Cancel.Cancelled _ -> + Eio.Cancel.protect (fun () -> + signal t Sys.sigkill; + await_readable t.pid_fd; + cleanup () + ) + ); + (* Check for errors starting the process. *) + match read_response errors_r with + | "" -> t (* Success! Execing the child closed [errors_w] and we got EOF. *) + | err -> failwith err +end diff --git a/lib_eio_linux/tests/spawn.md b/lib_eio_linux/tests/spawn.md new file mode 100644 index 000000000..8d4521142 --- /dev/null +++ b/lib_eio_linux/tests/spawn.md @@ -0,0 +1,138 @@ +```ocaml +# #require "eio_linux";; +``` + +```ocaml +open Eio.Std + +module Process = Eio_linux.Low_level.Process +``` + +## Spawning processes + +Setting environment variables: + +```ocaml +# Eio_linux.run @@ fun _env -> + Switch.run @@ fun sw -> + let child = Process.spawn ~sw Process.Fork_action.[ + execve "/usr/bin/env" + ~argv:[| "env" |] + ~env:[| "FOO=bar" |]; + ] in + Promise.await (Process.exit_status child);; +FOO=bar +- : Unix.process_status = Unix.WEXITED 0 +``` + +Changing directory: + +```ocaml +# Eio_linux.run @@ fun _env -> + Switch.run @@ fun sw -> + let child = Process.spawn ~sw Process.Fork_action.[ + chdir "/"; + execve "/usr/bin/env" + ~argv:[| "env"; "pwd" |] + ~env:(Unix.environment ()) + ] in + Promise.await (Process.exit_status child);; +/ +- : Unix.process_status = Unix.WEXITED 0 +``` + +Changing directory using a file descriptor: + +```ocaml +# Eio_linux.run @@ fun _env -> + Switch.run @@ fun sw -> + let root = + Eio_linux.Low_level.openat2 ~sw "/" + ~seekable:false + ~access:`R + ~perm:0 + ~resolve:Uring.Resolve.empty + ~flags:Uring.Open_flags.(cloexec + path + directory) + in + let child = Process.spawn ~sw Process.Fork_action.[ + fchdir root; + execve "/usr/bin/env" + ~argv:[| "env"; "pwd" |] + ~env:(Unix.environment ()) + ] in + Promise.await (Process.exit_status child);; +/ +- : Unix.process_status = Unix.WEXITED 0 +``` + +Exit status: + +```ocaml +# Eio_linux.run @@ fun _env -> + Switch.run @@ fun sw -> + let child = Process.spawn ~sw Process.Fork_action.[ + execve "/usr/bin/env" + ~argv:[| "env"; "false" |] + ~env:(Unix.environment ()) + ] in + Promise.await (Process.exit_status child);; +- : Unix.process_status = Unix.WEXITED 1 +``` + +Failure starting child: + +```ocaml +# Eio_linux.run @@ fun _env -> + Switch.run @@ fun sw -> + try + let _child = + Process.spawn ~sw Process.Fork_action.[ + chdir "/idontexist"; + execve "/usr/bin/env" + ~argv:[| "env"; "pwd" |] + ~env:(Unix.environment ()) + ] + in + assert false + with Failure ex -> + String.sub ex 0 7 +- : string = "chdir: " +``` + +Signalling a running child: + +```ocaml +# Eio_linux.run @@ fun _env -> + Switch.run @@ fun sw -> + let child = + Process.spawn ~sw Process.Fork_action.[ + execve "/usr/bin/env" + ~argv:[| "env"; "sleep"; "1000" |] + ~env:(Unix.environment ()) + ] + in + Process.signal child Sys.sigkill; + match Promise.await (Process.exit_status child) with + | Unix.WSIGNALED x when x = Sys.sigkill -> traceln "Child got SIGKILL" + | _ -> assert false;; ++Child got SIGKILL +- : unit = () +``` + +Signalling an exited child does nothing: + +```ocaml +# Eio_linux.run @@ fun _env -> + Switch.run @@ fun sw -> + let child = + Process.spawn ~sw Process.Fork_action.[ + execve "/usr/bin/env" + ~argv:[| "env" |] + ~env:[| "FOO=bar" |]; + ] + in + ignore (Promise.await (Process.exit_status child) : Unix.process_status); + Process.signal child Sys.sigkill;; +FOO=bar +- : unit = () +```