/* 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;
}