71 lines
2.2 KiB
C
71 lines
2.2 KiB
C
/* Starting a program that dies with the process that started it.
|
|
*
|
|
* `flan run` builds a program, runs it and deletes it. A flan killed by
|
|
* SIGKILL runs nothing on the way out, so without this the program would go on
|
|
* running with nobody waiting for it. On Linux the child asks the kernel for
|
|
* SIGKILL when its parent dies, between the fork and the exec; elsewhere it is
|
|
* an ordinary fork and exec.
|
|
*/
|
|
|
|
#include <caml/mlvalues.h>
|
|
#include <caml/alloc.h>
|
|
#include <caml/memory.h>
|
|
#include <caml/fail.h>
|
|
/* Exported by the runtime, declared only under CAML_INTERNALS. */
|
|
extern int caml_convert_signal_number(int);
|
|
#include <errno.h>
|
|
#include <signal.h>
|
|
#include <stdlib.h>
|
|
#include <string.h>
|
|
#include <unistd.h>
|
|
#ifdef __linux__
|
|
#include <sys/prctl.h>
|
|
#endif
|
|
|
|
value flan_spawn_dying(value path, value argv) {
|
|
CAMLparam2(path, argv);
|
|
mlsize_t n = Wosize_val(argv), i;
|
|
char **args = malloc((n + 1) * sizeof(char *));
|
|
char *file = strdup(String_val(path));
|
|
pid_t parent = getpid(), pid;
|
|
if (args == NULL || file == NULL) caml_failwith("flan_spawn_dying: out of memory");
|
|
for (i = 0; i < n; i++) args[i] = strdup(String_val(Field(argv, i)));
|
|
args[n] = NULL;
|
|
pid = fork();
|
|
if (pid == 0) {
|
|
sigset_t none;
|
|
sigemptyset(&none);
|
|
sigprocmask(SIG_SETMASK, &none, NULL);
|
|
#ifdef __linux__
|
|
prctl(PR_SET_PDEATHSIG, SIGKILL);
|
|
/* The parent may have died before the request was made. */
|
|
if (getppid() != parent) _exit(137);
|
|
#endif
|
|
execv(file, args);
|
|
_exit(127);
|
|
}
|
|
for (i = 0; i < n; i++) free(args[i]);
|
|
free(args);
|
|
free(file);
|
|
if (pid < 0) caml_failwith(strerror(errno));
|
|
CAMLreturn(Val_int(pid));
|
|
}
|
|
|
|
/* OCaml numbers the signals it knows by negative constants; a shell's exit
|
|
* status wants the host's number. */
|
|
value flan_host_signal(value s) {
|
|
return Val_int(caml_convert_signal_number(Int_val(s)));
|
|
}
|
|
|
|
/* The same request made by this process for itself: SIGKILL when whatever is
|
|
* its parent now dies. Only `flan dev` under a test harness asks
|
|
* (FLAN_DEV_HARNESS, lib/dev.ml); the kernel keeps it across the exec into a
|
|
* merged build. */
|
|
value flan_die_with_parent(value unit) {
|
|
(void)unit;
|
|
#ifdef __linux__
|
|
prctl(PR_SET_PDEATHSIG, SIGKILL);
|
|
#endif
|
|
return Val_unit;
|
|
}
|