diff --git a/DESCRIPTION b/DESCRIPTION index e470fb01..06cb498d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: processx Title: Execute and Control System Processes -Version: 3.8.0.9000 +Version: 3.8.0.9002 Authors@R: c( person("Gábor", "Csárdi", , "csardi.gabor@gmail.com", role = c("aut", "cre", "cph"), comment = c(ORCID = "0000-0001-7098-9676")), @@ -24,18 +24,21 @@ Imports: R6, utils Suggests: - callr (>= 3.7.0), + callr (>= 3.7.3), cli (>= 3.3.0), codetools, covr, curl, debugme, parallel, + pkgload, rlang (>= 1.0.2), testthat (>= 3.0.0), withr +Remotes: + r-lib/callr@fix-client-so-name Encoding: UTF-8 -RoxygenNote: 7.2.0 +RoxygenNote: 7.2.3 Roxygen: list(markdown = TRUE) Config/testthat/edition: 3 Config/Needs/website: tidyverse/tidytemplate diff --git a/NEWS.md b/NEWS.md index e52ae0f9..b34db916 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,14 @@ # processx (development version) +* The `kill()` and `kill_tree()` methods gain a `signal` argument. + This is useful to gracefully terminate processes, e.g. with + `SIGTERM`. + +* On Unixes, R processes created by callr now feature a `SIGTERM` + cleanup handler that cleans up the temporary directory before + shutting down. To disable it, set the + `PROCESSX_NO_R_SIGTERM_CLEANUP` envvar to a non-empty value. + # processx 3.8.0 * processx error stacks are better now. They have ANSI hyperlinks for diff --git a/R/assertions.R b/R/assertions.R index c1f3d078..639945c6 100644 --- a/R/assertions.R +++ b/R/assertions.R @@ -27,12 +27,20 @@ on_failure(is_flag) <- function(call, env) { paste0(deparse(call$x), " is not a flag (length 1 logical)") } +is_integer_scalar <- function(x) { + is.integer(x) && length(x) == 1 && !is.na(x) && round(x) == x +} + +on_failure(is_integer_scalar) <- function(call, env) { + paste0(deparse(call$x), " is not a length 1 integer") +} + is_integerish_scalar <- function(x) { is.numeric(x) && length(x) == 1 && !is.na(x) && round(x) == x } on_failure(is_integerish_scalar) <- function(call, env) { - paste0(deparse(call$x), " is not a length 1 integer") + paste0(deparse(call$x), " is not a length 1 round number") } is_pid <- function(x) { diff --git a/R/initialize.R b/R/initialize.R index 3d7b6d4a..199bae0b 100644 --- a/R/initialize.R +++ b/R/initialize.R @@ -25,10 +25,10 @@ process_initialize <- function(self, private, command, args, stdin, stdout, stderr, pty, pty_options, connections, poll_connection, env, cleanup, - cleanup_tree, wd, echo_cmd, supervise, - windows_verbatim_args, windows_hide_window, - windows_detached_process, encoding, - post_process) { + cleanup_tree, cleanup_signal, wd, echo_cmd, + supervise, windows_verbatim_args, + windows_hide_window, windows_detached_process, + encoding, post_process) { "!DEBUG process_initialize `command`" @@ -45,6 +45,7 @@ process_initialize <- function(self, private, command, args, is.null(env) || is_env_vector(env), is_flag(cleanup), is_flag(cleanup_tree), + is_integer_scalar(cleanup_signal), is_string_or_null(wd), is_flag(echo_cmd), is_flag(windows_verbatim_args), @@ -99,6 +100,7 @@ process_initialize <- function(self, private, command, args, private$args <- args private$cleanup <- cleanup private$cleanup_tree <- cleanup_tree + private$cleanup_signal <- cleanup_signal private$wd <- wd private$pstdin <- stdin private$pstdout <- stdout @@ -139,8 +141,8 @@ process_initialize <- function(self, private, command, args, c_processx_exec, command, c(command, args), pty, pty_options, connections, env, windows_verbatim_args, windows_hide_window, - windows_detached_process, private, cleanup, wd, encoding, - paste0("PROCESSX_", private$tree_id, "=YES") + windows_detached_process, private, cleanup, cleanup_signal, + wd, encoding, paste0("PROCESSX_", private$tree_id, "=YES") ) ## We try the query the start time according to the OS, because we can diff --git a/R/process.R b/R/process.R index f0b2b421..2b356522 100644 --- a/R/process.R +++ b/R/process.R @@ -184,6 +184,9 @@ process <- R6::R6Class( #' object is garbage collected. #' @param cleanup_tree Whether to kill the process and its child #' process tree when the `process` object is garbage collected. + #' @param cleanup_signal Which signal to use in case of cleanup. + #' Defaults to `SIGKILL` but can be set to `tools::SIGTERM`. + #' Has no effect on Windows. #' @param wd Working directory of the process. It must exist. #' If `NULL`, then the current working directory is used. #' @param echo_cmd Whether to print the command to the screen before @@ -210,19 +213,20 @@ process <- R6::R6Class( #' It is only run once. initialize = function(command = NULL, args = character(), - stdin = NULL, stdout = NULL, stderr = NULL, pty = FALSE, - pty_options = list(), connections = list(), poll_connection = NULL, - env = NULL, cleanup = TRUE, cleanup_tree = FALSE, wd = NULL, - echo_cmd = FALSE, supervise = FALSE, windows_verbatim_args = FALSE, - windows_hide_window = FALSE, windows_detached_process = !cleanup, - encoding = "", post_process = NULL) + stdin = NULL, stdout = NULL, stderr = NULL, pty = FALSE, + pty_options = list(), connections = list(), poll_connection = NULL, + env = NULL, cleanup = TRUE, cleanup_tree = FALSE, + cleanup_signal = ps::signals()$SIGKILL, wd = NULL, + echo_cmd = FALSE, supervise = FALSE, windows_verbatim_args = FALSE, + windows_hide_window = FALSE, windows_detached_process = !cleanup, + encoding = "", post_process = NULL) process_initialize(self, private, command, args, stdin, - stdout, stderr, pty, pty_options, connections, - poll_connection, env, cleanup, cleanup_tree, wd, - echo_cmd, supervise, windows_verbatim_args, - windows_hide_window, windows_detached_process, - encoding, post_process), + stdout, stderr, pty, pty_options, connections, + poll_connection, env, cleanup, cleanup_tree, + cleanup_signal, wd, echo_cmd, supervise, + windows_verbatim_args, windows_hide_window, + windows_detached_process, encoding, post_process), #' @description #' Cleanup method that is called when the `process` object is garbage @@ -231,7 +235,7 @@ process <- R6::R6Class( finalize = function() { if (!is.null(private$tree_id) && private$cleanup_tree && - ps::ps_is_supported()) self$kill_tree() + ps::ps_is_supported()) self$kill_tree(signal = private$cleanup_signal) }, #' @description @@ -240,9 +244,11 @@ process <- R6::R6Class( #' or job object (on Windows). It returns `TRUE` if the process #' was terminated, and `FALSE` if it was not (because it was #' already finished/dead when `processx` tried to terminate it). + #' @param signal An integer scalar, the id of the signal to send to + #' the process. See [tools::pskill()] for the list of signals. - kill = function(grace = 0.1, close_connections = TRUE) - process_kill(self, private, grace, close_connections), + kill = function(grace = 0.1, close_connections = TRUE, signal = ps::signals()$SIGKILL) + process_kill(self, private, grace, close_connections, signal), #' @description #' Process tree cleanup. It terminates the process @@ -256,9 +262,11 @@ process <- R6::R6Class( #' `$kill_tree()` returns a named integer vector of the process ids that #' were killed, the names are the names of the processes (e.g. `"sleep"`, #' `"notepad.exe"`, `"Rterm.exe"`, etc.). + #' @param signal An integer scalar, the id of the signal to send to + #' the process. See [tools::pskill()] for the list of signals. - kill_tree = function(grace = 0.1, close_connections = TRUE) - process_kill_tree(self, private, grace, close_connections), + kill_tree = function(grace = 0.1, close_connections = TRUE, signal = ps::signals()$SIGKILL) + process_kill_tree(self, private, grace, close_connections, signal), #' @description #' Send a signal to the process. On Windows only the @@ -650,6 +658,7 @@ process <- R6::R6Class( args = NULL, # Save 'args' argument here cleanup = NULL, # cleanup argument cleanup_tree = NULL, # cleanup_tree argument + cleanup_signal = NULL,# cleanup_signal argument stdin = NULL, # stdin argument or stream stdout = NULL, # stdout argument or stream stderr = NULL, # stderr argument or stream @@ -735,22 +744,25 @@ process_interrupt <- function(self, private) { } } -process_kill <- function(self, private, grace, close_connections) { +process_kill <- function(self, private, grace, close_connections, signal) { "!DEBUG process_kill '`private$get_short_name()`', pid `self$get_pid()`" - ret <- chain_call(c_processx_kill, private$status, as.numeric(grace), - private$get_short_name()) + assert_that(is_integer_scalar(signal)) + + ret <- chain_clean_call(c_processx_kill, private$status, as.numeric(grace), + private$get_short_name(), signal) if (close_connections) private$close_connections() ret } -process_kill_tree <- function(self, private, grace, close_connections) { - "!DEBUG process_kill_tree '`private$get_short_name()`', pid `self$get_pid()`" +process_kill_tree <- function(self, private, grace, close_connections, signal) { + "!DEBUG process_kill_tree '`private$get_short_name()`', pid `self$get_pid()`, signal `signal`" if (!ps::ps_is_supported()) { throw(new_not_implemented_error( "kill_tree is not supported on this platform")) } + assert_that(is_integer_scalar(signal)) - ret <- get("ps_kill_tree", asNamespace("ps"))(private$tree_id) + ret <- get("ps_kill_tree", asNamespace("ps"))(private$tree_id, sig = signal) if (close_connections) private$close_connections() ret } diff --git a/R/run.R b/R/run.R index 52eaf096..8b6b9cf4 100644 --- a/R/run.R +++ b/R/run.R @@ -123,6 +123,9 @@ #' both streams in UTF-8 currently. #' @param cleanup_tree Whether to clean up the child process tree after #' the process has finished. +#' @param cleanup_signal Signal to cleanup the process (and its +#' children if `cleanup_tree` is `TRUE`). Defaults to `SIGKILL`. On +#' Windows, only `SIGTERM` and `SIGKILL` are supported. #' @param ... Extra arguments are passed to `process$new()`, see #' [process]. Note that you cannot pass `stout` or `stderr` here, #' because they are used internally by `run()`. You can use the @@ -162,7 +165,8 @@ run <- function( stderr_line_callback = NULL, stderr_callback = NULL, stderr_to_stdout = FALSE, env = NULL, windows_verbatim_args = FALSE, windows_hide_window = FALSE, - encoding = "", cleanup_tree = FALSE, ...) { + encoding = "", cleanup_tree = FALSE, + cleanup_signal = ps::signals()$SIGKILL, ...) { assert_that(is_flag(error_on_status)) assert_that(is_time_interval(timeout)) @@ -176,6 +180,7 @@ run <- function( assert_that(is.null(stdout_callback) || is.function(stdout_callback)) assert_that(is.null(stderr_callback) || is.function(stderr_callback)) assert_that(is_flag(cleanup_tree)) + assert_that(is_integer_scalar(cleanup_signal)) assert_that(is_flag(stderr_to_stdout)) ## The rest is checked by process$new() "!DEBUG run() Checked arguments" @@ -195,9 +200,9 @@ run <- function( ## We make sure that the process is eliminated if (cleanup_tree) { - on.exit(pr$kill_tree(), add = TRUE) + defer(pr$kill_tree(signal = cleanup_signal)) } else { - on.exit(pr$kill(), add = TRUE) + defer(pr$kill(signal = cleanup_signal)) } ## If echo, then we need to create our own callbacks. diff --git a/R/utils.R b/R/utils.R index 10da64eb..f3c95711 100644 --- a/R/utils.R +++ b/R/utils.R @@ -295,3 +295,29 @@ ends_with <- function(x, post) { l <- nchar(post) substr(x, nchar(x) - l + 1, nchar(x)) == post } + +defer <- function(expr, frame = parent.frame(), after = FALSE) { + thunk <- as.call(list(function() expr)) + do.call(on.exit, list(thunk, add = TRUE, after = after), envir = frame) +} + +rimraf <- function(...) { + x <- file.path(...) + if ("~" %in% x) stop("Cowardly refusing to delete `~`") + unlink(x, recursive = TRUE, force = TRUE) +} + +get_test_lib <- function(lib) { + if (pkgload::is_dev_package("processx")) { + path <- "src" + } else { + path <- paste0('libs', .Platform$r_arch) + } + + system.file( + package = "processx", + path, + "test", + paste0(lib, .Platform$dynlib.ext) + ) +} diff --git a/man/process.Rd b/man/process.Rd index a6330438..cf3a4d52 100644 --- a/man/process.Rd +++ b/man/process.Rd @@ -161,6 +161,7 @@ Start a new process in the background, and then return immediately. env = NULL, cleanup = TRUE, cleanup_tree = FALSE, + cleanup_signal = ps::signals()$SIGKILL, wd = NULL, echo_cmd = FALSE, supervise = FALSE, @@ -275,6 +276,10 @@ object is garbage collected.} \item{\code{cleanup_tree}}{Whether to kill the process and its child process tree when the \code{process} object is garbage collected.} +\item{\code{cleanup_signal}}{Which signal to use in case of cleanup. +Defaults to \code{SIGKILL} but can be set to \code{tools::SIGTERM}. +Has no effect on Windows.} + \item{\code{wd}}{Working directory of the process. It must exist. If \code{NULL}, then the current working directory is used.} @@ -335,7 +340,11 @@ or job object (on Windows). It returns \code{TRUE} if the process was terminated, and \code{FALSE} if it was not (because it was already finished/dead when \code{processx} tried to terminate it). \subsection{Usage}{ -\if{html}{\out{
}}\preformatted{process$kill(grace = 0.1, close_connections = TRUE)}\if{html}{\out{
}} +\if{html}{\out{
}}\preformatted{process$kill( + grace = 0.1, + close_connections = TRUE, + signal = ps::signals()$SIGKILL +)}\if{html}{\out{
}} } \subsection{Arguments}{ @@ -346,6 +355,9 @@ already finished/dead when \code{processx} tried to terminate it). \item{\code{close_connections}}{Whether to close standard input, standard output, standard error connections and the poll connection, after killing the process.} + +\item{\code{signal}}{An integer scalar, the id of the signal to send to +the process. See \code{\link[tools:pskill]{tools::pskill()}} for the list of signals.} } \if{html}{\out{}} } @@ -366,7 +378,11 @@ to the root of the tree cleanup in the process tree any more. were killed, the names are the names of the processes (e.g. \code{"sleep"}, \code{"notepad.exe"}, \code{"Rterm.exe"}, etc.). \subsection{Usage}{ -\if{html}{\out{
}}\preformatted{process$kill_tree(grace = 0.1, close_connections = TRUE)}\if{html}{\out{
}} +\if{html}{\out{
}}\preformatted{process$kill_tree( + grace = 0.1, + close_connections = TRUE, + signal = ps::signals()$SIGKILL +)}\if{html}{\out{
}} } \subsection{Arguments}{ @@ -377,6 +393,9 @@ were killed, the names are the names of the processes (e.g. \code{"sleep"}, \item{\code{close_connections}}{Whether to close standard input, standard output, standard error connections and the poll connection, after killing the process.} + +\item{\code{signal}}{An integer scalar, the id of the signal to send to +the process. See \code{\link[tools:pskill]{tools::pskill()}} for the list of signals.} } \if{html}{\out{}} } diff --git a/man/process_initialize.Rd b/man/process_initialize.Rd index e4dbbafb..a263b4b4 100644 --- a/man/process_initialize.Rd +++ b/man/process_initialize.Rd @@ -19,6 +19,7 @@ process_initialize( env, cleanup, cleanup_tree, + cleanup_signal, wd, echo_cmd, supervise, diff --git a/man/run.Rd b/man/run.Rd index 4b6c407c..b8c8a890 100644 --- a/man/run.Rd +++ b/man/run.Rd @@ -25,6 +25,7 @@ run( windows_hide_window = FALSE, encoding = "", cleanup_tree = FALSE, + cleanup_signal = ps::signals()$SIGKILL, ... ) } @@ -128,6 +129,10 @@ both streams in UTF-8 currently.} \item{cleanup_tree}{Whether to clean up the child process tree after the process has finished.} +\item{cleanup_signal}{Signal to cleanup the process (and its +children if \code{cleanup_tree} is \code{TRUE}). Defaults to \code{SIGKILL}. On +Windows, only \code{SIGTERM} and \code{SIGKILL} are supported.} + \item{...}{Extra arguments are passed to \code{process$new()}, see \link{process}. Note that you cannot pass \code{stout} or \code{stderr} here, because they are used internally by \code{run()}. You can use the diff --git a/src/Makevars b/src/Makevars index 2464737d..0138c5d9 100644 --- a/src/Makevars +++ b/src/Makevars @@ -8,7 +8,8 @@ OBJECTS = init.o poll.o errors.o processx-connection.o \ .PHONY: all clean -all: tools/px tools/sock supervisor/supervisor client$(SHLIB_EXT) $(SHLIB) +all: tools/px tools/sock supervisor/supervisor client$(SHLIB_EXT) $(SHLIB) \ + test/sigtermignore$(SHLIB_EXT) tools/px: tools/px.c $(CC) $(CFLAGS) $(LDFLAGS) -Wall tools/px.c -o tools/px @@ -30,6 +31,9 @@ client$(SHLIB_EXT): $(CLIENT_OBJECTS) patchelf --remove-needed libR.so client$(SHLIB_EXT); \ fi +test/sigtermignore$(SHLIB_EXT): test/sigtermignore.o + $(SHLIB_LINK) -o test/sigtermignore$(SHLIB_EXT) test/sigtermignore.o + clean: rm -rf $(SHLIB) $(OBJECTS) $(CLIENT_OBJECTS) \ supervisor/supervisor supervisor/supervisor.dSYM \ diff --git a/src/client.c b/src/client.c index 62f6d184..71f1862d 100644 --- a/src/client.c +++ b/src/client.c @@ -234,6 +234,62 @@ SEXP processx_set_stderr_to_file(SEXP file) { SEXP processx_base64_encode(SEXP array); SEXP processx_base64_decode(SEXP array); + +#ifndef _WIN32 + +#include +#include + +const char* rimraf_tmpdir_cmd = NULL; + +void term_handler(int n) { + R_system(rimraf_tmpdir_cmd); + + // Continue signal + raise(SIGTERM); +} + +void install_term_handler(void) { + if (getenv("PROCESSX_NO_R_SIGTERM_CLEANUP")) { + return; + } + + const char* tmp_dir = getenv("R_SESSION_TMPDIR"); + + // Should not happen but just in case + if (!tmp_dir) { + return; + } + + // Only install the handler if the tempdir doesn't have special + // characters because we clean it through a `rm -rf` call in a + // subprocess to avoid calling async-signal-unsafe functions like + // `R_unlink(). Also it's faster with some filesystems, see notes in + // the `R_CleanTempDir()` implementation. + char *special = "'\\`$\"\n"; + + for (int i = 0; special[i] != '\0'; ++i) { + if (strchr(tmp_dir, special[i])) { + return; + } + } + + // To make the handler as simple as we can we ignore the possibility + // of the temp directory changing during the session, and create the + // command string upfront. It is protected via the symbol table. + SEXP rimraf_tmpdir_sym = R_ParseEvalString("as.symbol(paste0('rm -rf ', tempdir()))", + R_BaseNamespace); + rimraf_tmpdir_cmd = CHAR(PRINTNAME(rimraf_tmpdir_sym)); + + struct sigaction sig = {{ 0 }}; + sig.sa_handler = term_handler; + sig.sa_flags = SA_RESETHAND; + sigaction(SIGTERM, &sig, NULL); +} + +#endif // not _WIN32 + + static const R_CallMethodDef callMethods[] = { { "processx_base64_encode", (DL_FUNC) &processx_base64_encode, 1 }, { "processx_base64_decode", (DL_FUNC) &processx_base64_decode, 1 }, @@ -250,4 +306,8 @@ void R_init_client(DllInfo *dll) { R_registerRoutines(dll, NULL, callMethods, NULL, NULL); R_useDynamicSymbols(dll, FALSE); R_forceSymbols(dll, TRUE); + +#ifndef _WIN32 + install_term_handler(); +#endif } diff --git a/src/init.c b/src/init.c index a784d8a2..56866f5f 100644 --- a/src/init.c +++ b/src/init.c @@ -15,13 +15,13 @@ SEXP processx__set_boot_time(SEXP); static const R_CallMethodDef callMethods[] = { CLEANCALL_METHOD_RECORD, - { "processx_exec", (DL_FUNC) &processx_exec, 14 }, + { "processx_exec", (DL_FUNC) &processx_exec, 15 }, { "processx_wait", (DL_FUNC) &processx_wait, 3 }, { "processx_is_alive", (DL_FUNC) &processx_is_alive, 2 }, { "processx_get_exit_status", (DL_FUNC) &processx_get_exit_status, 2 }, { "processx_signal", (DL_FUNC) &processx_signal, 3 }, { "processx_interrupt", (DL_FUNC) &processx_interrupt, 2 }, - { "processx_kill", (DL_FUNC) &processx_kill, 3 }, + { "processx_kill", (DL_FUNC) &processx_kill, 4 }, { "processx_get_pid", (DL_FUNC) &processx_get_pid, 1 }, { "processx_create_time", (DL_FUNC) &processx_create_time, 1 }, { "processx_poll", (DL_FUNC) &processx_poll, 3 }, diff --git a/src/install.libs.R b/src/install.libs.R index 20be5d58..4a0b0353 100644 --- a/src/install.libs.R +++ b/src/install.libs.R @@ -18,3 +18,8 @@ file.copy(files, dest, overwrite = TRUE) if (file.exists("symbols.rds")) { file.copy("symbols.rds", dest, overwrite = TRUE) } + +test_files <- Sys.glob(paste0("test/*", SHLIB_EXT)) +test_dest <- file.path(dest, "test") +dir.create(test_dest, recursive = TRUE, showWarnings = FALSE) +file.copy(test_files, test_dest, overwrite = TRUE) diff --git a/src/processx.h b/src/processx.h index 9e3d5eee..e6f3e0b3 100644 --- a/src/processx.h +++ b/src/processx.h @@ -45,14 +45,14 @@ extern "C" { SEXP processx_exec(SEXP command, SEXP args, SEXP pty, SEXP pty_options, SEXP connections, SEXP env, SEXP windows_verbatim_args, SEXP windows_hide_window, SEXP windows_detached_process, - SEXP private_, SEXP cleanup, SEXP wd, SEXP encoding, - SEXP tree_id); + SEXP private_, SEXP cleanup, SEXP cleanup_signal, + SEXP wd, SEXP encoding, SEXP tree_id); SEXP processx_wait(SEXP status, SEXP timeout, SEXP name); SEXP processx_is_alive(SEXP status, SEXP name); SEXP processx_get_exit_status(SEXP status, SEXP name); SEXP processx_signal(SEXP status, SEXP signal, SEXP name); SEXP processx_interrupt(SEXP status, SEXP name); -SEXP processx_kill(SEXP status, SEXP grace, SEXP name); +SEXP processx_kill(SEXP status, SEXP grace, SEXP name, SEXP signal); SEXP processx_get_pid(SEXP status); SEXP processx_create_time(SEXP r_pid); diff --git a/src/test/sigtermignore.c b/src/test/sigtermignore.c new file mode 100644 index 00000000..b564fbfd --- /dev/null +++ b/src/test/sigtermignore.c @@ -0,0 +1,11 @@ +#ifndef _WIN32 + +#include +#include +#include + +void R_init_sigtermignore(DllInfo *dll) { + signal(SIGTERM, SIG_IGN); +} + +#endif diff --git a/src/unix/processx-unix.h b/src/unix/processx-unix.h index f9bbe675..96519079 100644 --- a/src/unix/processx-unix.h +++ b/src/unix/processx-unix.h @@ -23,6 +23,7 @@ typedef struct processx_handle_s { int fd2; /* readable */ int waitpipe[2]; /* use it for wait() with timeout */ int cleanup; + int cleanup_signal; double create_time; processx_connection_t *pipes[3]; int ptyfd; @@ -36,7 +37,11 @@ void processx__sigchld_callback(int sig, siginfo_t *info, void *ctx); void processx__setup_sigchld(void); void processx__remove_sigchld(void); void processx__block_sigchld(void); +void processx__block_sigchld_save(sigset_t *old); void processx__unblock_sigchld(void); +void processx__procmask_set(sigset_t *set); + +int c_processx_wait(processx_handle_t *handle, int timeout, const char *name); void processx__finalizer(SEXP status); diff --git a/src/unix/processx.c b/src/unix/processx.c index a188f6ec..f318d4d5 100644 --- a/src/unix/processx.c +++ b/src/unix/processx.c @@ -21,7 +21,7 @@ static void processx__child_init(processx_handle_t *handle, SEXP connections, processx_options_t *options, const char *tree_id); -static SEXP processx__make_handle(SEXP private, int cleanup); +static SEXP processx__make_handle(SEXP private, int cleanup, int cleanup_signal); static void processx__handle_destroy(processx_handle_t *handle); void processx__create_connections(processx_handle_t *handle, SEXP private, const char *encoding); @@ -350,7 +350,7 @@ void processx__finalizer(SEXP status) { /* If it is running, we need to kill it, and wait for the exit status */ if (wp == 0) { - kill(-pid, SIGKILL); + kill(-pid, handle->cleanup_signal); do { wp = waitpid(pid, &wstat, 0); } while (wp == -1 && errno == EINTR); @@ -370,7 +370,7 @@ void processx__finalizer(SEXP status) { processx__unblock_sigchld(); } -static SEXP processx__make_handle(SEXP private, int cleanup) { +static SEXP processx__make_handle(SEXP private, int cleanup, int cleanup_signal) { processx_handle_t * handle; SEXP result; @@ -382,6 +382,7 @@ static SEXP processx__make_handle(SEXP private, int cleanup) { result = PROTECT(R_MakeExternalPtr(handle, private, R_NilValue)); R_RegisterCFinalizerEx(result, processx__finalizer, 1); handle->cleanup = cleanup; + handle->cleanup_signal = cleanup_signal; UNPROTECT(1); return result; @@ -428,13 +429,14 @@ void processx__make_socketpair(int pipe[2], const char *exe) { SEXP processx_exec(SEXP command, SEXP args, SEXP pty, SEXP pty_options, SEXP connections, SEXP env, SEXP windows_verbatim_args, SEXP windows_hide_window, SEXP windows_detached_process, - SEXP private, SEXP cleanup, SEXP wd, SEXP encoding, - SEXP tree_id) { + SEXP private, SEXP cleanup, SEXP cleanup_signal, SEXP wd, + SEXP encoding, SEXP tree_id) { char *ccommand = processx__tmp_string(command, 0); char **cargs = processx__tmp_character(args); char **cenv = isNull(env) ? 0 : processx__tmp_character(env); int ccleanup = INTEGER(cleanup)[0]; + int ccleanup_signal = INTEGER(cleanup_signal)[0]; const int cpty = LOGICAL(pty)[0]; const char *cencoding = CHAR(STRING_ELT(encoding, 0)); @@ -469,7 +471,7 @@ SEXP processx_exec(SEXP command, SEXP args, SEXP pty, SEXP pty_options, processx__setup_sigchld(); - result = PROTECT(processx__make_handle(private, ccleanup)); + result = PROTECT(processx__make_handle(private, ccleanup, ccleanup_signal)); handle = R_ExternalPtrAddr(result); if (cpty) { @@ -674,30 +676,38 @@ static void processx__wait_cleanup(void *ptr) { SEXP processx_wait(SEXP status, SEXP timeout, SEXP name) { processx_handle_t *handle = R_ExternalPtrAddr(status); + int ctimeout = INTEGER(timeout)[0]; const char *cname = isNull(name) ? "???" : CHAR(STRING_ELT(name, 0)); - int ctimeout = INTEGER(timeout)[0], timeleft = ctimeout; + + int ret = c_processx_wait(handle, ctimeout, cname); + return ScalarLogical(ret); +} + +int c_processx_wait(processx_handle_t *handle, int timeout, const char *name) { struct pollfd fd; int ret = 0; pid_t pid; + int timeleft = timeout; int *fds = malloc(sizeof(int) * 2); if (!fds) R_THROW_SYSTEM_ERROR("Allocating memory when waiting"); fds[0] = fds[1] = -1; r_call_on_exit(processx__wait_cleanup, fds); - processx__block_sigchld(); + sigset_t old; + processx__block_sigchld_save(&old); if (!handle) { - processx__unblock_sigchld(); - return ScalarLogical(1); + processx__procmask_set(&old); + return 1; } pid = handle->pid; /* If we already have the status, then return now. */ if (handle->collected) { - processx__unblock_sigchld(); - return ScalarLogical(1); + processx__procmask_set(&old); + return 1; } /* Make sure this is active, in case another package replaced it... */ @@ -706,8 +716,8 @@ SEXP processx_wait(SEXP status, SEXP timeout, SEXP name) { /* Setup the self-pipe that we can poll */ if (pipe(handle->waitpipe)) { - processx__unblock_sigchld(); - R_THROW_SYSTEM_ERROR("processx error when waiting for '%s'", cname); + processx__procmask_set(&old); + R_THROW_SYSTEM_ERROR("processx error when waiting for '%s'", name); } fds[0] = handle->waitpipe[0]; fds[1] = handle->waitpipe[1]; @@ -723,7 +733,7 @@ SEXP processx_wait(SEXP status, SEXP timeout, SEXP name) { - while (ctimeout < 0 || timeleft > PROCESSX_INTERRUPT_INTERVAL) { + while (timeout < 0 || timeleft > PROCESSX_INTERRUPT_INTERVAL) { do { ret = poll(&fd, 1, PROCESSX_INTERRUPT_INTERVAL); } while (ret == -1 && errno == EINTR); @@ -743,7 +753,7 @@ SEXP processx_wait(SEXP status, SEXP timeout, SEXP name) { goto cleanup; } - if (ctimeout >= 0) timeleft -= PROCESSX_INTERRUPT_INTERVAL; + if (timeout >= 0) timeleft -= PROCESSX_INTERRUPT_INTERVAL; } /* Maybe we are not done, and there is a little left from the timeout */ @@ -755,7 +765,7 @@ SEXP processx_wait(SEXP status, SEXP timeout, SEXP name) { if (ret == -1) { R_THROW_SYSTEM_ERROR("processx wait with timeout error while " - "waiting for '%s'", cname); + "waiting for '%s'", name); } cleanup: @@ -763,7 +773,9 @@ SEXP processx_wait(SEXP status, SEXP timeout, SEXP name) { handle->waitpipe[0] = -1; handle->waitpipe[1] = -1; - return ScalarLogical(ret != 0); + processx__procmask_set(&old); + + return ret != 0; } /* This is similar to `processx_wait`, but a bit simpler, because we @@ -962,7 +974,7 @@ SEXP processx_interrupt(SEXP status, SEXP name) { * still alive or not. */ -SEXP processx_kill(SEXP status, SEXP grace, SEXP name) { +SEXP processx_kill(SEXP status, SEXP grace, SEXP name, SEXP signal) { processx_handle_t *handle = R_ExternalPtrAddr(status); const char *cname = isNull(name) ? "???" : CHAR(STRING_ELT(name, 0)); pid_t pid; @@ -997,26 +1009,19 @@ SEXP processx_kill(SEXP status, SEXP grace, SEXP name) { /* If the process is not running, return (FALSE) */ if (wp != 0) { goto cleanup; } - /* It is still running, so a SIGKILL */ - int ret = kill(-pid, SIGKILL); + int sig_num = INTEGER(signal)[0]; + + /* It is still running, so send the signal */ + int ret = kill(-pid, sig_num); if (ret == -1 && (errno == ESRCH || errno == EPERM)) { goto cleanup; } if (ret == -1) { processx__unblock_sigchld(); R_THROW_SYSTEM_ERROR("process_kill for '%s'", cname); } - /* Do a waitpid to collect the status and reap the zombie */ - do { - wp = waitpid(pid, &wstat, 0); - } while (wp == -1 && errno == EINTR); - - /* Collect exit status, and check if it was killed by a SIGKILL - If yes, this was most probably us (although we cannot be sure in - general... - If the status was collected by another SIGCHLD, then the exit - status will be set to NA */ - processx__collect_exit_status(status, wp, wstat); - result = handle->exitcode == - SIGKILL; + if (c_processx_wait(handle, 200, cname)) { + result = handle->exitcode == -sig_num; + } cleanup: processx__unblock_sigchld(); diff --git a/src/unix/sigchld.c b/src/unix/sigchld.c index cad171bb..5b53e66b 100644 --- a/src/unix/sigchld.c +++ b/src/unix/sigchld.c @@ -128,15 +128,26 @@ void processx__remove_sigchld(void) { memset(&old_sig_handler, 0, sizeof(old_sig_handler)); } -void processx__block_sigchld(void) { +void processx__block_sigchld_save(sigset_t *old) { sigset_t blockMask; sigemptyset(&blockMask); sigaddset(&blockMask, SIGCHLD); - if (sigprocmask(SIG_BLOCK, &blockMask, NULL) == -1) { + + if (sigprocmask(SIG_BLOCK, &blockMask, old) == -1) { R_THROW_ERROR("processx error setting up signal handlers"); } } +void processx__procmask_set(sigset_t *set) { + if (sigprocmask(SIG_SETMASK, set, NULL) == -1) { + R_THROW_ERROR("processx error setting up signal handlers"); + } +} + +void processx__block_sigchld(void) { + processx__block_sigchld_save(NULL); +} + void processx__unblock_sigchld(void) { sigset_t unblockMask; sigemptyset(&unblockMask); diff --git a/src/win/processx.c b/src/win/processx.c index 20010e4e..06b5ade0 100644 --- a/src/win/processx.c +++ b/src/win/processx.c @@ -866,10 +866,10 @@ void processx__handle_destroy(processx_handle_t *handle) { } SEXP processx_exec(SEXP command, SEXP args, SEXP pty, SEXP pty_options, - SEXP connections, SEXP env, SEXP windows_verbatim_args, + SEXP connections, SEXP env, SEXP windows_verbatim_args, SEXP windows_hide, SEXP windows_detached_process, - SEXP private, SEXP cleanup, SEXP wd, SEXP encoding, - SEXP tree_id) { + SEXP private, SEXP cleanup, SEXP cleanup_signal, + SEXP wd, SEXP encoding, SEXP tree_id) { const char *ccommand = CHAR(STRING_ELT(command, 0)); const char *cencoding = CHAR(STRING_ELT(encoding, 0)); @@ -1234,8 +1234,8 @@ SEXP processx_interrupt(SEXP status, SEXP name) { return R_NilValue; } -SEXP processx_kill(SEXP status, SEXP grace, SEXP name) { - return processx_signal(status, ScalarInteger(9), name); +SEXP processx_kill(SEXP status, SEXP grace, SEXP name, SEXP signal) { + return processx_signal(status, signal, name); } SEXP processx_get_pid(SEXP status) { diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R index b119c304..28c5da4a 100644 --- a/tests/testthat/helper.R +++ b/tests/testthat/helper.R @@ -151,3 +151,8 @@ scrub_srcref <- function(x) { x <- sub("\033[90m\033[39m", "", x, fixed = TRUE) x } + +load_sigtermignore <- function() { + lib <- asNamespace("processx")$get_test_lib("sigtermignore") + dyn.load(lib) +} diff --git a/tests/testthat/test-assertions.R b/tests/testthat/test-assertions.R index fc4a5349..c5f62fac 100644 --- a/tests/testthat/test-assertions.R +++ b/tests/testthat/test-assertions.R @@ -64,7 +64,7 @@ test_that("is_integerish_scalar", { expect_false(is_integerish_scalar(n)) expect_error( assert_that(is_integerish_scalar(n)), - "is not a length 1 integer" + "is not a length 1 round number" ) } }) diff --git a/tests/testthat/test-process.R b/tests/testthat/test-process.R index e95faa6b..425d6895 100644 --- a/tests/testthat/test-process.R +++ b/tests/testthat/test-process.R @@ -67,3 +67,169 @@ test_that("working directory does not exist", { ## This closes connections in finalizers gc() }) + +test_that("R process is installed with a SIGTERM cleanup handler", { + # 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") + + out <- tempfile() + + fn <- function(file) { + file.create(tempfile()) + writeLines(tempdir(), file) + } + + p <- callr::r_session$new() + p$run(fn, list(file = out)) + + p_temp_dir <- readLines(out) + expect_true(dir.exists(p_temp_dir)) + + p$signal(ps::signals()$SIGTERM) + p$wait() + expect_false(dir.exists(p_temp_dir)) + + # Disabled case + withr::local_envvar(c(PROCESSX_NO_R_SIGTERM_CLEANUP = "true")) + + # Just in case R adds tempdir cleanup on SIGTERM + skip_on_cran() + + p <- callr::r_session$new() + p$run(fn, list(file = out)) + + p_temp_dir <- readLines(out) + expect_true(dir.exists(p_temp_dir)) + + p$signal(ps::signals()$SIGTERM) + p$wait() + + # Was not cleaned up + expect_true(dir.exists(p_temp_dir)) +}) + +test_that("can SIGTERM process", { + # https://github.com/r-lib/callr/pull/250 + skip_if_not_installed("callr", "3.7.3.9001") + + # Write subprocess `tempdir()` to this file + out <- tempfile() + defer(rimraf(out)) + + fn <- function(file, recurse) { + file.create(tempfile()) + cat(paste0(tempdir(), "\n"), file = file, append = TRUE) + } + + p <- callr::r_session$new() + p$run(fn, list(file = out)) + + dir <- readLines(out) + expect_length(dir, 1) + + p$kill(signal = ps::signals()$SIGTERM) + p$wait() + + # Check that SIGTERM was called on subprocess by examining side + # effect of tempdir cleanup + expect_false(dir.exists(dir)) +}) + +test_that("can SIGTERM process tree", { + # https://github.com/r-lib/callr/pull/250 + skip_if_not_installed("callr", "3.7.3.9001") + + # Needs POSIX signals + skip_on_os("windows") + + # Might be a little undeterministic, e.g. need to wait a sufficient + # time before checking processes were sent SIGTERM and cleaned up + skip_on_cran() + + # Write subprocess `tempdir()` to this file + out <- tempfile() + defer(rimraf(out)) + + fn <- function(file, recurse) { + file.create(tempfile()) + cat(paste0(tempdir(), "\n"), file = file, append = TRUE) + + if (recurse) { + p <- callr::r_session$new() + p$run( + sys.function(), + list(file = file, recurse = recurse - 1L) + ) + } + } + + p <- callr::r_session$new() + p$run(fn, list(file = out, recurse = 2)) + + # Check that SIGTERM was called on all subprocesses by examining + # side effects of tempdir cleanup + dirs <- readLines(out) + expect_length(dirs, 3) + + p$kill_tree(signal = ps::signals()$SIGTERM) + Sys.sleep(0.2) + + expect_false(any(vapply(dirs, dir.exists, NA))) +}) + +test_that("can use custom `cleanup_signal`", { + # https://github.com/r-lib/callr/pull/250 + skip_if_not_installed("callr", "3.7.3.9001") + + # Should become the default in callr + opts <- callr::r_process_options(extra = list( + cleanup_signal = ps::signals()$SIGTERM + )) + p <- callr::r_session$new(opts) + + out <- tempfile() + defer(rimraf(out)) + + fn <- function(file) { + file.create(tempfile()) + writeLines(tempdir(), file) + } + p$run(fn, list(file = out)) + dir <- readLines(out) + + # GC `p` to trigger finalizer + rm(p) + gc() + + # Needs POSIX signals + skip_on_os("windows") + + # As usual we verify the delivery of SIGTERM by checking that the + # callr cleanup handler kicked in and deleted the tempdir + expect_false(dir.exists(dir)) +}) + +test_that("can load sigtermignore", { + p <- callr::r_session$new() + defer(p$kill()) + + p$run(load_sigtermignore) + + tools::pskill(p$get_pid(), tools::SIGTERM) + tools::pskill(p$get_pid(), tools::SIGTERM) + + expect_true(p$is_alive()) +}) + +test_that("can kill with SIGTERM when ignored", { + p <- callr::r_session$new() + defer(p$kill()) + + p$run(load_sigtermignore) + + expect_false(p$kill(close_connections = FALSE, signal = tools::SIGTERM)) + expect_true(p$is_alive()) +})