1 2#' Mark a process and its (future) child tree 3#' 4#' `ps_mark_tree()` generates a random environment variable name and sets 5#' it in the current R process. This environment variable will be (by 6#' default) inherited by all child (and grandchild, etc.) processes, and 7#' will help finding these processes, even if and when they are (no longer) 8#' related to the current R process. (I.e. they are not connected in the 9#' process tree.) 10#' 11#' `ps_find_tree()` finds the processes that set the supplied environment 12#' variable and returns them in a list. 13#' 14#' `ps_kill_tree()` finds the processes that set the supplied environment 15#' variable, and kills them (or sends them the specified signal on Unix). 16#' 17#' `with_process_cleanup()` evaluates an R expression, and cleans up all 18#' external processes that were started by the R process while evaluating 19#' the expression. This includes child processes of child processes, etc., 20#' recursively. It returns a list with entries: `result` is the result of 21#' the expression, `visible` is TRUE if the expression should be printed 22#' to the screen, and `process_cleanup` is a named integer vector of the 23#' cleaned pids, names are the process names. 24#' 25#' If `expr` throws an error, then so does `with_process_cleanup()`, the 26#' same error. Nevertheless processes are still cleaned up. 27#' 28#' @section Note: 29#' Note that `with_process_cleanup()` is problematic if the R process is 30#' multi-threaded and the other threads start subprocesses. 31#' `with_process_cleanup()` cleans up those processes as well, which is 32#' probably not what you want. This is an issue for example in RStudio. 33#' Do not use `with_process_cleanup()`, unless you are sure that the 34#' R process is single-threaded, or the other threads do not start 35#' subprocesses. E.g. using it in package test cases is usually fine, 36#' because RStudio runs these in a separate single-threaded process. 37#' 38#' The same holds for manually running `ps_mark_tree()` and then 39#' `ps_find_tree()` or `ps_kill_tree()`. 40#' 41#' A safe way to use process cleanup is to use the processx package to 42#' start subprocesses, and set the `cleanup_tree = TRUE` in 43#' [processx::run()] or the [processx::process] constructor. 44#' 45#' @return `ps_mark_tree()` returns the name of the environment variable, 46#' which can be used as the `marker` in `ps_kill_tree()`. 47#' 48#' `ps_find_tree()` returns a list of `ps_handle` objects. 49#' 50#' `ps_kill_tree()` returns the pids of the killed processes, in a named 51#' integer vector. The names are the file names of the executables, when 52#' available. 53#' 54#' `with_process_cleanup()` returns the value of the evaluated expression. 55#' 56#' @rdname ps_kill_tree 57#' @export 58 59ps_mark_tree <- function() { 60 id <- get_id() 61 do.call(Sys.setenv, structure(list("YES"), names = id)) 62 id 63} 64 65get_id <- function() { 66 paste0( 67 "PS", 68 paste( 69 sample(c(LETTERS, 0:9), 10, replace = TRUE), 70 collapse = "" 71 ), 72 "_", 73 as.integer(Internal(Sys.time())) 74 ) 75} 76 77#' @param expr R expression to evaluate in the new context. 78#' 79#' @rdname ps_kill_tree 80#' @export 81 82with_process_cleanup <- function(expr) { 83 id <- ps_mark_tree() 84 stat <- NULL 85 do <- function() { 86 on.exit(stat <<- ps_kill_tree(id), add = TRUE) 87 withVisible(expr) 88 } 89 90 res <- do() 91 92 ret <- list( 93 result = res$value, 94 visible = res$visible, 95 process_cleanup = stat) 96 class(ret) <- "with_process_cleanup" 97 ret 98} 99 100#' @export 101 102print.with_process_cleanup <- function(x, ...) { 103 if (x$visible) print(x$result) 104 if (length(x$process_cleanup)) { 105 cat("!! Cleaned up the following processes:\n") 106 print(x$process_cleanup) 107 } else { 108 cat("-- No leftover processes to clean up.\n") 109 } 110 invisible(x) 111} 112 113 114#' @rdname ps_kill_tree 115#' @export 116 117ps_find_tree <- function(marker) { 118 assert_string(marker) 119 after <- as.numeric(strsplit(marker, "_", fixed = TRUE)[[1]][2]) 120 121 pids <- setdiff(ps_pids(), Sys.getpid()) 122 123 not_null(lapply(pids, function(p) { 124 tryCatch( 125 .Call(ps__find_if_env, marker, after, p), 126 error = function(e) NULL 127 ) 128 })) 129} 130 131#' @param marker String scalar, the name of the environment variable to 132#' use to find the marked processes. 133#' @param sig The signal to send to the marked processes on Unix. On 134#' Windows this argument is ignored currently. 135#' 136#' @rdname ps_kill_tree 137#' @export 138 139ps_kill_tree <- function(marker, sig = signals()$SIGKILL) { 140 141 assert_string(marker) 142 143 after <- as.numeric(strsplit(marker, "_", fixed = TRUE)[[1]][2]) 144 145 pids <- setdiff(ps_pids(), Sys.getpid()) 146 147 ret <- lapply(pids, function(p) { 148 tryCatch( 149 .Call(ps__kill_if_env, marker, after, p, sig), 150 error = function(e) e 151 ) 152 }) 153 154 gone <- map_lgl(ret, function(x) is.character(x)) 155 structure(pids[gone], names = unlist(ret[gone])) 156} 157