Safer cleanup on SIGTERM

R/utils.R

@@ -351,3 +351,4 @@ ends_with <- function(x, post) {
   l <- nchar(post)
   substr(x, nchar(x) - l + 1, nchar(x)) == post
 }
+

src/client.c

@@ -251,20 +251,35 @@ SEXP processx_base64_decode(SEXP array);
 
 #include <string.h>
 #include <signal.h>
+#include <unistd.h>
+#include <limits.h>
+
+static char tmpdir_buf[PATH_MAX];
+static char *rm_argv[] = { "/bin/rm", "-rf", tmpdir_buf, NULL };
 
-void term_handler(int n) {
-  // Need the cast and the +1 to ignore compiler warning about unused
-  // return value.
-  (void) (system("rm -rf \"$R_SESSION_TMPDIR\"") + 1);
+static void term_handler(int n) {
+  pid_t pid = fork();
+  if (pid == 0) {
+    execv("/bin/rm", rm_argv);
+    _exit(127);
+  }
   // Continue signal
   raise(SIGTERM);
 }
 
 void install_term_handler(void) {
-  if (! getenv("PROCESSX_R_SIGTERM_CLEANUP")) {
+  if (!getenv("PROCESSX_R_SIGTERM_CLEANUP")) {
     return;
   }
 
+  const char *tmpdir = getenv("R_SESSION_TMPDIR");
+  if (!tmpdir) {
+    return;
+  }
+
+  // Capture the path now so the signal handler needs no getenv()
+  snprintf(tmpdir_buf, sizeof(tmpdir_buf), "%s", tmpdir);
+
   struct sigaction sig = {{ 0 }};
   sig.sa_handler = term_handler;
   sig.sa_flags = SA_RESETHAND;

tests/testthat/helper.R

@@ -233,3 +233,19 @@ get_deadline <- function(secs = 1, asan_secs = secs * 100) {
 }
 
 err$register_testthat_print()
+
+retry_until <- function(fn, interrupt = 0.2, timeout = 5) {
+  time <- Sys.time()
+  timeout <- time + timeout
+
+  while (Sys.time() < timeout) {
+    if (fn()) {
+      expect_true(TRUE)
+      return()
+    }
+    Sys.sleep(interrupt)
+  }
+
+  skip_on_cran()
+  stop("timeout")
+}

tests/testthat/test-process.R

@@ -97,6 +97,7 @@ test_that("R process is installed with a SIGTERM cleanup handler", {
   withr::local_envvar(c(PROCESSX_R_SIGTERM_CLEANUP = "true"))
 
   out <- tempfile()
+  withr::defer(unlink(out, TRUE, TRUE))
 
   fn <- function(file) {
     file.create(tempfile())
@@ -111,7 +112,8 @@ test_that("R process is installed with a SIGTERM cleanup handler", {
 
   p$signal(ps::signals()$SIGTERM)
   p$wait()
-  expect_false(dir.exists(p_temp_dir))
+
+  retry_until(function() !dir.exists(p_temp_dir))
 
   # Disabled case
   withr::local_envvar(c(PROCESSX_R_SIGTERM_CLEANUP = NA_character_))
@@ -132,6 +134,76 @@ test_that("R process is installed with a SIGTERM cleanup handler", {
   expect_true(dir.exists(p_temp_dir))
 })
 
+test_that("can kill process tree with SIGTERM", {
+  # https://github.com/r-lib/callr/pull/250
+  skip_if_not_installed("callr", "3.7.3.9001")
+
+  # Needs POSIX signal handling
+  skip_on_os("windows")
+
+  # fork() in signal handler can deadlock under ASAN; shutdown is too slow
+  # for the poll timeout under UBSAN and valgrind
+  skip_if(is_asan())
+  skip_if(is_ubsan())
+  skip_if(is_valgrind())
+
+  withr::local_envvar(c(PROCESSX_R_SIGTERM_CLEANUP = "true"))
+
+  out <- tempfile()
+  withr::defer(unlink(out, TRUE, TRUE))
+  file.create(out)
+
+  fn <- function(recurse, local, file) {
+    p <- NULL
+
+    if (recurse) {
+      p <- callr::r_session$new()
+      p$call(
+        sys.function(),
+        list(recurse - 1, local = FALSE, file = file)
+      )
+    }
+
+    if (!local) {
+      file.create(tempfile())
+      cat(paste0(tempdir(), "\n"), file = file, append = TRUE)
+
+      # Sleeping prevents the process to receive an EOF in
+      # `R_ReadConsole()` (which causes it to quit normally)
+      Sys.sleep(60)
+    }
+
+    p
+  }
+
+  N <- 5
+  p <- fn(N, local = TRUE, file = out)
+
+  pid <- p$get_pid()
+  id <- p$.__enclos_env__$private$tree_id
+
+  temp_dirs <- NULL
+
+  retry_until(function() {
+    temp_dirs <<- readLines(out)
+    length(temp_dirs) == N
+  })
+
+  ps <- ps::ps_find_tree(id)
+
+  for (p in ps) {
+    tools::pskill(ps::ps_pid(p))
+  }
+  retry_until(function() {
+    !any(sapply(ps, function(p) ps::ps_is_running(p)))
+  })
+
+  # rm -rf runs in a forked child; poll until it finishes
+  retry_until(function() !any(dir.exists(temp_dirs)))
+  expect_false(any(dir.exists(temp_dirs)))
+})
+
+
 test_that("linux_pdeathsig kills child when parent exits", {
   skip_if(!is_linux())
   skip_if(is_valgrind())