diff --git a/R/utils.R b/R/utils.R index b6c5026f..4b4b215e 100644 --- a/R/utils.R +++ b/R/utils.R @@ -351,3 +351,4 @@ ends_with <- function(x, post) { l <- nchar(post) substr(x, nchar(x) - l + 1, nchar(x)) == post } + diff --git a/src/client.c b/src/client.c index ee57fa80..8eb159d9 100644 --- a/src/client.c +++ b/src/client.c @@ -251,20 +251,35 @@ SEXP processx_base64_decode(SEXP array); #include #include +#include +#include + +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; diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R index 4fb6b0e2..08475344 100644 --- a/tests/testthat/helper.R +++ b/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") +} diff --git a/tests/testthat/test-process.R b/tests/testthat/test-process.R index 5a6e345b..7b2d7ed4 100644 --- a/tests/testthat/test-process.R +++ b/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())