Add process_exists() (#62)

* add process_exists
* fix race in signal testing
* update NEWS
* do not check the exit code in signal testing in Windows

Author: lbartnik

NAMESPACE

@@ -32,6 +32,7 @@ export(TIMEOUT_IMMEDIATE)
 export(TIMEOUT_INFINITE)
 export(is_process_handle)
 export(process_close_input)
+export(process_exists)
 export(process_kill)
 export(process_read)
 export(process_return_code)

NEWS.md

@@ -4,6 +4,8 @@
 
 * replace `select()` with `poll()`
 
+* new API: `process_exists()`
+
 # subprocess 0.8.2
 
 * fixes in test cases for `testthat` 2.0

R/subprocess.R

@@ -3,51 +3,51 @@ NULL
 
 
 #' Start a new child process.
-#' 
+#'
 #' @description
 #' In Linux, the usual combination of `fork()` and `exec()`
 #' is used to spawn a new child process. Standard streams are redirected
 #' over regular unnamed `pipe`s.
-#' 
+#'
 #' In Windows a new process is spawned with `CreateProcess()` and
 #' streams are redirected over unnamed pipes obtained with
 #' `CreatePipe()`. However, because non-blocking (*overlapped*
 #' in Windows-speak) read/write is not supported for unnamed pipes,
 #' two reader threads are created for each new child process. These
 #' threads never touch memory allocated by R and thus they will not
 #' interfere with R interpreter's memory management (garbage collection).
-#' 
-#' 
+#'
+#'
 #' @details
 #' `command` is always prepended to `arguments` so that the
 #' child process can correcty recognize the name of its executable
 #' via its `argv` vector. This is done automatically by
 #' `spawn_process`.
-#' 
+#'
 #' `environment` can be passed as a `character` vector whose
 #' elements take the form `"NAME=VALUE"`, a named `character`
 #' vector or a named `list`.
-#' 
+#'
 #' `workdir` is the path to the directory where the new process is
 #' ought to be started. `NULL` and `""` mean that working
 #' directory is inherited from the parent.
-#' 
+#'
 #' @section Termination:
-#' 
+#'
 #' The `termination_mode` specifies what should happen when
 #' `process_terminate()` or `process_kill()` is called on a
 #' subprocess. If it is set to `TERMINATION_GROUP`, then the
 #' termination signal is sent to the parent and all its descendants
 #' (sub-processes). If termination mode is set to
 #' `TERMINATION_CHILD_ONLY`, only the child process spawned
 #' directly from the R session receives the signal.
-#' 
+#'
 #' In Windows this is implemented with the job API, namely
 #' `CreateJobObject()`, `AssignProcessToJobObject()` and
 #' `TerminateJobObject()`. In Linux, the child calls `setsid()`
 #' after `fork()` but before `execve()`, and `kill()` is
 #' called with the negate process id.
-#' 
+#'
 #' @param command Path to the executable.
 #' @param arguments Optional arguments for the program.
 #' @param environment Optional environment.
@@ -58,10 +58,10 @@ NULL
 #' @return `spawn_process()` returns an object of the
 #'         *process handle* class.
 #' @rdname spawn_process
-#' 
+#'
 #' @format `TERMINATION_GROUP` and `TERMINATION_CHILD_ONLY`
 #'         are single `character` values.
-#' 
+#'
 #' @export
 spawn_process <- function (command, arguments = character(), environment = character(),
                            workdir = "", termination_mode = TERMINATION_GROUP)
@@ -76,7 +76,7 @@ spawn_process <- function (command, arguments = character(), environment = chara
     }
     environment <- paste(names(environment), as.character(environment), sep = '=')
   }
-  
+
   if(!(is.null(workdir) || identical(workdir, ""))){
     workdir <- normalizePath(workdir, mustWork = TRUE)
   }
@@ -92,7 +92,7 @@ spawn_process <- function (command, arguments = character(), environment = chara
 
 #' @param x Object to be printed or tested.
 #' @param ... Other parameters passed to the `print` method.
-#' 
+#'
 #' @export
 #' @rdname spawn_process
 print.process_handle <- function (x, ...)
@@ -101,14 +101,14 @@ print.process_handle <- function (x, ...)
   cat('command   : ', x$command, ' ', paste(x$arguments, collapse = ' '), '\n', sep = '')
   cat('system id : ', as.integer(x$c_handle), '\n', sep = '')
   cat('state     : ', process_state(x), '\n', sep = '')
-  
+
   invisible(x)
 }
 
 
 #' @description `is_process_handle()` verifies that an object is a
 #' valid *process handle* as returned by `spawn_process()`.
-#' 
+#'
 #' @export
 #' @rdname spawn_process
 is_process_handle <- function (x)
@@ -118,37 +118,37 @@ is_process_handle <- function (x)
 
 
 #' Terminating a Child Process.
-#' 
+#'
 #' @description
-#' 
+#'
 #' These functions give access to the state of the child process and to
 #' its exit status (return code).
-#' 
+#'
 #' The `timeout` parameter can take one of three values:
 #' \itemize{
 #'   \item `0` which means no timeout
 #'   \item `-1` which means "wait until there is data to read"
 #'   \item a positive integer, which is the actual timeout in milliseconds
 #' }
-#' 
+#'
 #' @details `process_wait()` checks the state of the child process
 #' by invoking the system call `waitpid()` or
 #' `WaitForSingleObject()`.
-#' 
+#'
 #' @param handle Process handle obtained from `spawn_process`.
 #' @param timeout Optional timeout in milliseconds.
-#' 
+#'
 #' @return `process_wait()` returns an `integer` exit code
 #' of the child process or `NA` if the child process has not exited
 #' yet. The same value can be accessed by `process_return_code()`.
-#' 
+#'
 #' @name terminating
 #' @rdname terminating
 #' @export
-#' 
+#'
 #' @seealso [spawn_process()], [process_read()]
 #'          [signals()]
-#' 
+#'
 process_wait <- function (handle, timeout = TIMEOUT_INFINITE)
 {
   stopifnot(is_process_handle(handle))
@@ -160,10 +160,10 @@ process_wait <- function (handle, timeout = TIMEOUT_INFINITE)
 #' `process_wait()` with no timeout and returns one of these
 #' values: `"not-started"`. `"running"`, `"exited"`,
 #' `"terminated"`.
-#' 
+#'
 #' @rdname terminating
 #' @export
-#' 
+#'
 process_state <- function (handle)
 {
   stopifnot(is_process_handle(handle))
@@ -174,17 +174,34 @@ process_state <- function (handle)
 #' @details `process_return_code()` gives access to the value
 #' returned also by `process_wait()`. It does not invoke
 #' `process_wait()` behind the scenes.
-#' 
+#'
 #' @rdname terminating
 #' @export
-#' 
+#'
 process_return_code <- function (handle)
 {
   stopifnot(is_process_handle(handle))
   .Call("C_process_return_code", handle$c_handle)
 }
 
 
+#' Check if process with a given id exists.
+#'
+#' @param x A process handle returned by [spawn_process] or a OS-level process id.
+#' @return `TRUE` if process exists, `FALSE` otherwise.
+#'
+#' @export
+#'
+process_exists <- function (x)
+{
+  if (is_process_handle(x)) {
+    x <- x$c_handle
+  }
+
+  isTRUE(.Call("C_process_exists", as.integer(x)))
+}
+
+
 #' @description `TIMEOUT_INFINITE` denotes an "infinite" timeout
 #' (that is, wait until response is available) when waiting for an
 #' operation to complete.
@@ -197,7 +214,7 @@ TIMEOUT_INFINITE  <- -1L
 #' @description `TIMEOUT_IMMEDIATE` denotes an "immediate" timeout
 #' (in other words, no timeout) when waiting for an operation to
 #' complete.
-#' 
+#'
 #' @rdname terminating
 #' @export
 TIMEOUT_IMMEDIATE <-  0L
@@ -206,7 +223,7 @@ TIMEOUT_IMMEDIATE <-  0L
 #' @description `TERMINATION_GROUP`: `process_terminate(handle)`
 #' and `process_kill(handle)` deliver the signal to the child
 #' process pointed to by `handle` and all of its descendants.
-#' 
+#'
 #' @rdname spawn_process
 #' @export
 TERMINATION_GROUP <- "group"
@@ -216,7 +233,7 @@ TERMINATION_GROUP <- "group"
 #' `process_terminate(handle)` and `process_kill(handle)`
 #' deliver the signal only to the child process pointed to by
 #' `handle` but to none of its descendants.
-#' 
+#'
 #' @rdname spawn_process
 #' @export
 TERMINATION_CHILD_ONLY <- "child_only"

man/process_exists.Rd

@@ -18,7 +18,7 @@
 #ifdef SUBPROCESS_WINDOWS
 #define EXPORT __declspec( dllexport )
 #else
-#define EXPORT 
+#define EXPORT
 #endif
 
 
@@ -55,6 +55,7 @@
 #undef length
 
 typedef HANDLE process_handle_type;
+typedef DWORD  pid_type;
 typedef HANDLE pipe_handle_type;
 
 constexpr pipe_handle_type HANDLE_CLOSED = nullptr;
@@ -63,6 +64,7 @@ constexpr pipe_handle_type HANDLE_CLOSED = nullptr;
 
 #include <unistd.h>
 typedef pid_t process_handle_type;
+typedef pid_t pid_type;
 typedef int pipe_handle_type;
 
 constexpr pipe_handle_type HANDLE_CLOSED = -1;

src/config-os.h

@@ -120,7 +120,7 @@ SEXP C_process_spawn (SEXP _command, SEXP _arguments, SEXP _environment, SEXP _w
 
   char ** arguments   = to_C_array(_arguments);
   char ** environment = to_C_array(_environment);
-  
+
   /* if environment if empty, simply ignore it */
   if (!environment || !*environment) {
     // allocated with Calloc() but Free() is still needed
@@ -222,7 +222,7 @@ SEXP C_process_read (SEXP _handle, SEXP _pipe, SEXP _timeout)
   /* determine which pipe */
   const char * pipe = translateChar(STRING_ELT(_pipe, 0));
   pipe_type which_pipe;
-  
+
   if (!strncmp(pipe, "stdout", 6))
     which_pipe = PIPE_STDOUT;
   else if (!strncmp(pipe, "stderr", 6))
@@ -232,8 +232,8 @@ SEXP C_process_read (SEXP _handle, SEXP _pipe, SEXP _timeout)
   else {
     Rf_error("unrecognized `pipe` value");
   }
-  
-  try_run(&process_handle_t::read, handle, which_pipe, timeout); 
+
+  try_run(&process_handle_t::read, handle, which_pipe, timeout);
 
   /* produce the result - a list of one or two elements */
   SEXP ans, nms;
@@ -259,7 +259,7 @@ SEXP C_process_close_input (SEXP _handle)
 {
   process_handle_t * handle = extract_process_handle(_handle);
   try_run(&process_handle_t::close_input, handle);
-  return allocate_TRUE();  
+  return allocate_TRUE();
 }
 
 
@@ -272,7 +272,7 @@ SEXP C_process_write (SEXP _handle, SEXP _message)
   }
 
   const char * message = translateChar(STRING_ELT(_message, 0));
-  size_t ret = try_run(&process_handle_t::write, handle, message, strlen(message)); 
+  size_t ret = try_run(&process_handle_t::write, handle, message, strlen(message));
 
   return allocate_single_int((int)ret);
 }
@@ -370,6 +370,19 @@ SEXP C_process_send_signal (SEXP _handle, SEXP _signal)
 }
 
 
+SEXP C_process_exists (SEXP _pid)
+{
+  if (!is_single_integer(_pid)) {
+    Rf_error("`pid` must be a single integer value");
+  }
+
+  int pid = INTEGER_DATA(_pid)[0];
+  bool ret = subprocess::process_exists(static_cast<pid_type>(pid));
+
+  return allocate_single_bool(ret);
+}
+
+
 SEXP C_known_signals ()
 {
   SEXP ans;
@@ -415,7 +428,7 @@ SEXP C_known_signals ()
 #endif
 
   setAttrib(ans, R_NamesSymbol, ansnames);
-  
+
   /* ans, ansnames */
   UNPROTECT(2);
   return ans;
@@ -435,16 +448,16 @@ SEXP C_signal (SEXP _signal, SEXP _handler)
   if (!is_nonempty_string(_handler)) {
     error("`handler` needs to be a single character value");
   }
-  
+
   const char * handler = translateChar(STRING_ELT(_handler, 0));
   if (!strncmp(handler, "ignore", 6) && !strncmp(handler, "default", 7)) {
     error("`handler` can be either \"ignore\" or \"default\"");
   }
-  
+
   int sgn = INTEGER_DATA(_signal)[0];
   typedef void (*sighandler_t)(int);
   sighandler_t hnd = (strncmp(handler, "ignore", 6) ? SIG_DFL : SIG_IGN);
-  
+
   if (signal(sgn, hnd) == SIG_ERR) {
     Rf_error("error while calling signal()");
   }

src/rapi.cc

@@ -36,6 +36,8 @@ EXPORT SEXP C_process_kill(SEXP _handle);
 
 EXPORT SEXP C_process_send_signal(SEXP _handle, SEXP _signal);
 
+EXPORT SEXP C_process_exists(SEXP _pid);
+
 EXPORT SEXP C_known_signals();
 
 EXPORT SEXP C_signal (SEXP _signal, SEXP _handler);