processx/0000755000176200001440000000000014043056423012121 5ustar liggesusersprocessx/NAMESPACE0000644000176200001440000000245314043037551013345 0ustar liggesusers# Generated by roxygen2: do not edit by hand S3method(close,processx_connection) S3method(close_named_pipe,unix_named_pipe) S3method(close_named_pipe,windows_named_pipe) S3method(conditionMessage,system_command_error) S3method(conn_is_incomplete,processx_connection) S3method(conn_read_chars,processx_connection) S3method(conn_read_lines,processx_connection) S3method(conn_write,processx_connection) S3method(format,system_command_error) S3method(is_pipe_open,unix_named_pipe) S3method(is_pipe_open,windows_named_pipe) S3method(print,system_command_error) S3method(write_lines_named_pipe,unix_named_pipe) S3method(write_lines_named_pipe,windows_named_pipe) export(base64_decode) export(base64_encode) export(conn_create_fd) export(conn_create_file) export(conn_create_pipepair) export(conn_disable_inheritance) export(conn_get_fileno) export(conn_is_incomplete) export(conn_read_chars) export(conn_read_lines) export(conn_set_stderr) export(conn_set_stdout) export(conn_write) export(curl_fds) export(default_pty_options) export(is_valid_fd) export(poll) export(process) export(processx_conn_close) export(processx_conn_is_incomplete) export(processx_conn_read_chars) export(processx_conn_read_lines) export(processx_conn_write) export(run) export(supervisor_kill) useDynLib(processx, .registration = TRUE, .fixes = "c_") processx/LICENSE0000644000176200001440000000011313616314040013116 0ustar liggesusersYEAR: 2016-2019 COPYRIGHT HOLDER: Mango Solutions, RStudio, Gábor Csárdi processx/README.md0000644000176200001440000004404514026373153013412 0ustar liggesusers # processx > Execute and Control System Processes [![lifecycle](https://lifecycle.r-lib.org/articles/figures/lifecycle-stable.svg)](https://lifecycle.r-lib.org/articles/stages.html) [![R build status](https://github.com/r-lib/processx/workflows/R-CMD-check/badge.svg)](https://github.com/r-lib/processx/actions) [![](https://www.r-pkg.org/badges/version/processx)](https://www.r-pkg.org/pkg/processx) [![CRAN RStudio mirror downloads](https://cranlogs.r-pkg.org/badges/processx)](https://www.r-pkg.org/pkg/processx) [![Coverage Status](https://img.shields.io/codecov/c/github/r-lib/processx/master.svg)](https://codecov.io/github/r-lib/processx?branch=master) Tools to run system processes in the background, read their standard output and error and kill them. processx can poll the standard output and error of a single process, or multiple processes, using the operating system’s polling and waiting facilities, with a timeout. ----- - [Features](#features) - [Installation](#installation) - [Usage](#usage) - [Running an external process](#running-an-external-process) - [Errors](#errors) - [Showing output](#showing-output) - [Spinner](#spinner) - [Callbacks for I/O](#callbacks-for-io) - [Managing external processes](#managing-external-processes) - [Starting processes](#starting-processes) - [Killing a process](#killing-a-process) - [Standard output and error](#standard-output-and-error) - [End of output](#end-of-output) - [Polling the standard output and error](#polling-the-standard-output-and-error) - [Polling multiple processes](#polling-multiple-processes) - [Waiting on a process](#waiting-on-a-process) - [Exit statuses](#exit-statuses) - [Mixing processx and the parallel base R package](#mixing-processx-and-the-parallel-base-r-package) - [Errors](#errors-1) - [Related tools](#related-tools) - [Code of Conduct](#code-of-conduct) - [License](#license) ## Features - Start system processes in the background and find their process id. - Read the standard output and error, using non-blocking connections - Poll the standard output and error connections of a single process or multiple processes. - Write to the standard input of background processes. - Check if a background process is running. - Wait on a background process, or multiple processes, with a timeout. - Get the exit status of a background process, if it has already finished. - Kill background processes. - Kill background process, when its associated object is garbage collected. - Kill background processes and all their child processes. - Works on Linux, macOS and Windows. - Lightweight, it only depends on the also lightweight R6 and ps packages. ## Installation Install the stable version from CRAN: ``` r install.packages("processx") ``` ## Usage ``` r library(processx) ``` > Note: the following external commands are usually present in macOS and > Linux systems, but not necessarily on Windows. We will also use the > `px` command line tool (`px.exe` on Windows), that is a very simple > program that can produce output to `stdout` and `stderr`, with the > specified timings. ``` r px <- paste0( system.file(package = "processx", "bin", "px"), system.file(package = "processx", "bin", .Platform$r_arch, "px.exe") ) px ``` #> [1] "/private/var/folders/59/0gkmw1yj2w7bf2dfc3jznv5w0000gn/T/Rtmp7ipFsS/temp_libpathb89a55e5c2f9/processx/bin/px" ### Running an external process The `run()` function runs an external command. It requires a single command, and a character vector of arguments. You don’t need to quote the command or the arguments, as they are passed directly to the operating system, without an intermediate shell. ``` r run("echo", "Hello R!") ``` #> $status #> [1] 0 #> #> $stdout #> [1] "Hello R!\n" #> #> $stderr #> [1] "" #> #> $timeout #> [1] FALSE Short summary of the `px` binary we are using extensively below: ``` r result <- run(px, "--help", echo = TRUE) ``` #> Usage: px [command arg] [command arg] ... #> #> Commands: #> sleep -- sleep for a number os seconds #> out -- print string to stdout #> err -- print string to stderr #> outln -- print string to stdout, add newline #> errln -- print string to stderr, add newline #> errflush -- flush stderr stream #> cat -- print file to stdout #> return -- return with exitcode #> writefile -- write to file #> write -- write to file descriptor #> echo -- echo from fd to another fd #> getenv -- environment variable to stdout > Note: From version 3.0.1, processx does not let you specify a full > shell command line, as this involves starting a grandchild process > from the child process, and it is difficult to clean up the grandchild > process when the child process is killed. The user can still start a > shell (`sh` or `cmd.exe`) directly of course, and then proper cleanup > is the user’s responsibility. #### Errors By default `run()` throws an error if the process exits with a non-zero status code. To avoid this, specify `error_on_status = FALSE`: ``` r run(px, c("out", "oh no!", "return", "2"), error_on_status = FALSE) ``` #> $status #> [1] 2 #> #> $stdout #> [1] "oh no!" #> #> $stderr #> [1] "" #> #> $timeout #> [1] FALSE #### Showing output To show the output of the process on the screen, use the `echo` argument. Note that the order of `stdout` and `stderr` lines may be incorrect, because they are coming from two different connections. ``` r result <- run(px, c("outln", "out", "errln", "err", "outln", "out again"), echo = TRUE) ``` #> out #> out again #> err If you have a terminal that support ANSI colors, then the standard error output is shown in red. The standard output and error are still included in the result of the `run()` call: ``` r result ``` #> $status #> [1] 0 #> #> $stdout #> [1] "out\nout again\n" #> #> $stderr #> [1] "err\n" #> #> $timeout #> [1] FALSE Note that `run()` is different from `system()`, and it always shows the output of the process on R’s proper standard output, instead of writing to the terminal directly. This means for example that you can capture the output with `capture.output()` or use `sink()`, etc.: ``` r out1 <- capture.output(r1 <- system("ls")) out2 <- capture.output(r2 <- run("ls", echo = TRUE)) ``` ``` r out1 ``` #> character(0) ``` r out2 ``` #> [1] "CODE_OF_CONDUCT.md" "DESCRIPTION" "LICENSE" #> [4] "LICENSE.md" "Makefile" "NAMESPACE" #> [7] "NEWS.md" "R" "README.Rmd" #> [10] "README.html" "README.md" "_pkgdown.yml" #> [13] "inst" "man" "processx.Rproj" #> [16] "src" "tests" #### Spinner The `spinner` option of `run()` puts a calming spinner to the terminal while the background program is running. The spinner is always shown in the first character of the last line, so you can make it work nicely with the regular output of the background process if you like. E.g. try this in your R terminal: result <- run(px, c("out", " foo", "sleep", "1", "out", "\r bar", "sleep", "1", "out", "\rX foobar\n"), echo = TRUE, spinner = TRUE) #### Callbacks for I/O `run()` can call an R function for each line of the standard output or error of the process, just supply the `stdout_line_callback` or the `stderr_line_callback` arguments. The callback functions take two arguments, the first one is a character scalar, the output line. The second one is the `process` object that represents the background process. (See more below about `process` objects.) You can manipulate this object in the callback, if you want. For example you can kill it in response to an error or some text on the standard output: ``` r cb <- function(line, proc) { cat("Got:", line, "\n") if (line == "done") proc$kill() } result <- run(px, c("outln", "this", "outln", "that", "outln", "done", "outln", "still here", "sleep", "10", "outln", "dead by now"), stdout_line_callback = cb, error_on_status = FALSE, ) ``` #> Got: this #> Got: that #> Got: done #> Got: still here ``` r result ``` #> $status #> [1] -9 #> #> $stdout #> [1] "this\nthat\ndone\nstill here\n" #> #> $stderr #> [1] "" #> #> $timeout #> [1] FALSE Keep in mind, that while the R callback is running, the background process is not stopped, it is also running. In the previous example, whether `still here` is printed or not depends on the scheduling of the R process and the background process by the OS. Typically, it is printed, because the R callback takes a while to run. In addition to the line-oriented callbacks, the `stdout_callback` and `stderr_callback` arguments can specify callback functions that are called with output chunks instead of single lines. A chunk may contain multiple lines (separated by `\n` or `\r\n`), or even incomplete lines. ### Managing external processes If you need better control over possibly multiple background processes, then you can use the R6 `process` class directly. #### Starting processes To start a new background process, create a new instance of the `process` class. ``` r p <- process$new("sleep", "20") ``` #### Killing a process A process can be killed via the `kill()` method. ``` r p$is_alive() ``` #> [1] TRUE ``` r p$kill() ``` #> [1] TRUE ``` r p$is_alive() ``` #> [1] FALSE Note that processes are finalized (and killed) automatically if the corresponding `process` object goes out of scope, as soon as the object is garbage collected by R: ``` r p <- process$new("sleep", "20") rm(p) gc() ``` #> used (Mb) gc trigger (Mb) limit (Mb) max used (Mb) #> Ncells 493821 26.4 1069461 57.2 NA 682911 36.5 #> Vcells 928674 7.1 8388608 64.0 16384 1883216 14.4 Here, the direct call to the garbage collector kills the `sleep` process as well. See the `cleanup` option if you want to avoid this behavior. #### Standard output and error By default the standard output and error of the processes are ignored. You can set the `stdout` and `stderr` constructor arguments to a file name, and then they are redirected there, or to `"|"`, and then processx creates connections to them. (Note that starting from processx 3.0.0 these connections are not regular R connections, because the public R connection API was retroactively removed from R.) The `read_output_lines()` and `read_error_lines()` methods can be used to read complete lines from the standard output or error connections. They work similarly to the `readLines()` base R function. Note, that the connections have a buffer, which can fill up, if R does not read out the output, and then the process will stop, until R reads the connection and the buffer is freed. > **Always make sure that you read out the standard output and/or > error** **of the pipes, otherwise the background process will stop > running\!** If you don’t need the standard output or error any more, you can also close it, like this: ``` r close(p$get_output_connection()) close(p$get_error_connection()) ``` Note that the connections used for reading the output and error streams are non-blocking, so the read functions will return immediately, even if there is no text to read from them. If you want to make sure that there is data available to read, you need to poll, see below. ``` r p <- process$new(px, c("sleep", "1", "outln", "foo", "errln", "bar", "outln", "foobar"), stdout = "|", stderr = "|") p$read_output_lines() ``` #> character(0) ``` r p$read_error_lines() ``` #> character(0) #### End of output The standard R way to query the end of the stream for a non-blocking connection, is to use the `isIncomplete()` function. *After a read attempt*, this function returns `FALSE` if the connection has surely no more data. (If the read attempt returns no data, but `isIncomplete()` returns `TRUE`, then the connection might deliver more data in the future. The `is_incomplete_output()` and `is_incomplete_error()` functions work similarly for `process` objects. #### Polling the standard output and error The `poll_io()` method waits for data on the standard output and/or error of a process. It will return if any of the following events happen: - data is available on the standard output of the process (assuming there is a connection to the standard output). - data is available on the standard error of the process (assuming the is a connection to the standard error). - The process has finished and the standard output and/or error connections were closed on the other end. - The specified timeout period expired. For example the following code waits about a second for output. ``` r p <- process$new(px, c("sleep", "1", "outln", "kuku"), stdout = "|") ## No output yet p$read_output_lines() ``` #> character(0) ``` r ## Wait at most 5 sec p$poll_io(5000) ``` #> output error process #> "ready" "nopipe" "nopipe" ``` r ## There is output now p$read_output_lines() ``` #> [1] "kuku" #### Polling multiple processes If you need to manage multiple background processes, and need to wait for output from all of them, processx defines a `poll()` function that does just that. It is similar to the `poll_io()` method, but it takes multiple process objects, and returns as soon as one of them have data on standard output or error, or a timeout expires. Here is an example: ``` r p1 <- process$new(px, c("sleep", "1", "outln", "output"), stdout = "|") p2 <- process$new(px, c("sleep", "2", "errln", "error"), stderr = "|") ## After 100ms no output yet poll(list(p1 = p1, p2 = p2), 100) ``` #> $p1 #> output error process #> "timeout" "nopipe" "nopipe" #> #> $p2 #> output error process #> "nopipe" "timeout" "nopipe" ``` r ## But now we surely have something poll(list(p1 = p1, p2 = p2), 1000) ``` #> $p1 #> output error process #> "ready" "nopipe" "nopipe" #> #> $p2 #> output error process #> "nopipe" "silent" "nopipe" ``` r p1$read_output_lines() ``` #> [1] "output" ``` r ## Done with p1 close(p1$get_output_connection()) ``` #> NULL ``` r ## The second process should have data on stderr soonish poll(list(p1 = p1, p2 = p2), 5000) ``` #> $p1 #> output error process #> "closed" "nopipe" "nopipe" #> #> $p2 #> output error process #> "nopipe" "ready" "nopipe" ``` r p2$read_error_lines() ``` #> [1] "error" #### Waiting on a process As seen before, `is_alive()` checks if a process is running. The `wait()` method can be used to wait until it has finished (or a specified timeout expires).. E.g. in the following code `wait()` needs to wait about 2 seconds for the `sleep` `px` command to finish. ``` r p <- process$new(px, c("sleep", "2")) p$is_alive() ``` #> [1] TRUE ``` r Sys.time() ``` #> [1] "2021-03-23 15:08:37 CET" ``` r p$wait() Sys.time() ``` #> [1] "2021-03-23 15:08:39 CET" It is safe to call `wait()` multiple times: ``` r p$wait() # already finished! ``` #### Exit statuses After a process has finished, its exit status can be queried via the `get_exit_status()` method. If the process is still running, then this method returns `NULL`. ``` r p <- process$new(px, c("sleep", "2")) p$get_exit_status() ``` #> NULL ``` r p$wait() p$get_exit_status() ``` #> [1] 0 #### Mixing processx and the parallel base R package In general, mixing processx (via callr or not) and parallel works fine. If you use parallel’s ‘fork’ clusters, e.g. via `parallel::mcparallel()`, then you might see two issues. One is that processx will not be able to determine the exit status of some processx processes. This is because the status is read out by parallel, and processx will set it to `NA`. The other one is that parallel might complain that it could not clean up some subprocesses. This is not an error, and it is harmless, but it does hold up R for about 10 seconds, before parallel gives up. To work around this, you can set the `PROCESSX_NOTIFY_OLD_SIGCHLD` environment variable to a non-empty value, before you load processx. This behavior might be the default in the future. #### Errors Errors are typically signalled via non-zero exits statuses. The processx constructor fails if the external program cannot be started, but it does not deal with errors that happen after the program has successfully started running. ``` r p <- process$new("nonexistant-command-for-sure") ``` #> Error in rethrow_call(c_processx_exec, command, c(command, args), pty, : cannot start processx process 'nonexistant-command-for-sure' (system error 2, No such file or directory) @unix/processx.c:610 (processx_exec) ``` r p2 <- process$new(px, c("sleep", "1", "command-does-not-exist")) p2$wait() p2$get_exit_status() ``` #> [1] 5 ## Related tools - The [`ps` package](https://ps.r-lib.org/) can query, list, manipulate all system processes (not just subprocesses), and processx uses it internally for some of its functionality. You can also convert a `processx::process` object to a `ps::ps_handle` with the `as_ps_handle()` method. - The [`callr` package](https://callr.r-lib.org/) uses processx to start another R process, and run R code in it, in the foreground or background. ## Code of Conduct Please note that this project is released with a [Contributor Code of Conduct](https://processx.r-lib.org/CODE_OF_CONDUCT.html). By participating in this project you agree to abide by its terms. ## License MIT © Mango Solutions, RStudio, Gábor Csárdi processx/man/0000755000176200001440000000000014043036753012700 5ustar liggesusersprocessx/man/processx_connections.Rd0000644000176200001440000001160514026323556017443 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/connections.R \name{conn_create_fd} \alias{conn_create_fd} \alias{conn_create_pipepair} \alias{conn_read_chars} \alias{conn_read_chars.processx_connection} \alias{processx_conn_read_chars} \alias{conn_read_lines} \alias{conn_read_lines.processx_connection} \alias{processx_conn_read_lines} \alias{conn_is_incomplete} \alias{conn_is_incomplete.processx_connection} \alias{processx_conn_is_incomplete} \alias{conn_write} \alias{conn_write.processx_connection} \alias{processx_conn_write} \alias{conn_create_file} \alias{conn_set_stdout} \alias{conn_set_stderr} \alias{conn_get_fileno} \alias{conn_disable_inheritance} \alias{close.processx_connection} \alias{processx_conn_close} \alias{is_valid_fd} \title{Processx connections} \usage{ conn_create_fd(fd, encoding = "", close = TRUE) conn_create_pipepair(encoding = "", nonblocking = c(TRUE, FALSE)) conn_read_chars(con, n = -1) \method{conn_read_chars}{processx_connection}(con, n = -1) processx_conn_read_chars(con, n = -1) conn_read_lines(con, n = -1) \method{conn_read_lines}{processx_connection}(con, n = -1) processx_conn_read_lines(con, n = -1) conn_is_incomplete(con) \method{conn_is_incomplete}{processx_connection}(con) processx_conn_is_incomplete(con) conn_write(con, str, sep = "\\n", encoding = "") \method{conn_write}{processx_connection}(con, str, sep = "\\n", encoding = "") processx_conn_write(con, str, sep = "\\n", encoding = "") conn_create_file(filename, read = NULL, write = NULL) conn_set_stdout(con, drop = TRUE) conn_set_stderr(con, drop = TRUE) conn_get_fileno(con) conn_disable_inheritance() \method{close}{processx_connection}(con, ...) processx_conn_close(con, ...) is_valid_fd(fd) } \arguments{ \item{fd}{Integer scalar, a Unix file descriptor.} \item{encoding}{Encoding of the readable connection when reading.} \item{close}{Whether to close the OS file descriptor when closing the connection. Sometimes you want to leave it open, and use it again in a \code{conn_create_fd} call. Encoding to re-encode \code{str} into when writing.} \item{nonblocking}{Whether the writeable and the readable ends of the pipe should be non-blocking connections.} \item{con}{Processx connection object.} \item{n}{Number of characters or lines to read. -1 means all available characters or lines.} \item{str}{Character or raw vector to write.} \item{sep}{Separator to use if \code{str} is a character vector. Ignored if \code{str} is a raw vector.} \item{filename}{File name.} \item{read}{Whether the connection is readable.} \item{write}{Whethe the connection is writeable.} \item{drop}{Whether to close the original stdout/stderr, or keep it open and return a connection to it.} \item{...}{Extra arguments, for compatibility with the \code{close()} generic, currently ignored by processx.} } \description{ These functions are currently experimental and will change in the future. Note that processx connections are \emph{not} compatible with R's built-in connection system. } \details{ \code{conn_create_fd()} creates a connection from a file descriptor. \code{conn_create_pipepair()} creates a pair of connected connections, the first one is writeable, the second one is readable. \code{conn_read_chars()} reads UTF-8 characters from the connections. If the connection itself is not UTF-8 encoded, it re-encodes it. \code{conn_read_lines()} reads lines from a connection. \code{conn_is_incomplete()} returns \code{FALSE} if the connection surely has no more data. \code{conn_write()} writes a character or raw vector to the connection. It might not be able to write all bytes into the connection, in which case it returns the leftover bytes in a raw vector. Call \code{conn_write()} again with this raw vector. \code{conn_create_file()} creates a connection to a file. \code{conn_set_stdout()} set the standard output of the R process, to the specified connection. \code{conn_set_stderr()} set the standard error of the R process, to the specified connection. \code{conn_get_fileno()} return the integer file desciptor that belongs to the connection. \code{conn_disable_inheritance()} can be called to disable the inheritance of all open handles. Call this function as soon as possible in a new process to avoid inheriting the inherited handles even further. The function is best effort to close the handles, it might still leave some handles open. It should work for \code{stdin}, \code{stdout} and \code{stderr}, at least. \code{is_valid_fd()} returns \code{TRUE} if \code{fd} is a valid open file descriptor. You can use it to check if the R process has standard input, output or error. E.g. R processes running in GUI (like RGui) might not have any of the standard streams available. If a stream is redirected to the null device (e.g. in a callr subprocess), that is is still a valid file descriptor. } \examples{ is_valid_fd(0L) # stdin is_valid_fd(1L) # stdout is_valid_fd(2L) # stderr } processx/man/run.Rd0000644000176200001440000002214114043035123013761 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/run.R \name{run} \alias{run} \title{Run external command, and wait until finishes} \usage{ run( command = NULL, args = character(), error_on_status = TRUE, wd = NULL, echo_cmd = FALSE, echo = FALSE, spinner = FALSE, timeout = Inf, stdout = "|", stderr = "|", stdout_line_callback = NULL, stdout_callback = NULL, 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, ... ) } \arguments{ \item{command}{Character scalar, the command to run. If you are running \code{.bat} or \code{.cmd} files on Windows, make sure you read the 'Batch files' section in the \link{process} manual page.} \item{args}{Character vector, arguments to the command.} \item{error_on_status}{Whether to throw an error if the command returns with a non-zero status, or it is interrupted. The error classes are \code{system_command_status_error} and \code{system_command_timeout_error}, respectively, and both errors have class \code{system_command_error} as well. See also "Error conditions" below.} \item{wd}{Working directory of the process. If \code{NULL}, the current working directory is used.} \item{echo_cmd}{Whether to print the command to run to the screen.} \item{echo}{Whether to print the standard output and error to the screen. Note that the order of the standard output and error lines are not necessarily correct, as standard output is typically buffered. If the standard output and/or error is redirected to a file or they are ignored, then they also not echoed.} \item{spinner}{Whether to show a reassuring spinner while the process is running.} \item{timeout}{Timeout for the process, in seconds, or as a \code{difftime} object. If it is not finished before this, it will be killed.} \item{stdout}{What to do with the standard output. By default it is collected in the result, and you can also use the \code{stdout_line_callback} and \code{stdout_callback} arguments to pass callbacks for output. If it is the empty string (\code{""}), then the child process inherits the standard output stream of the R process. (If the main R process does not have a standard output stream, e.g. in RGui on Windows, then an error is thrown.) If it is \code{NULL}, then standard output is discarded. If it is a string other than \code{"|"} and \code{""}, then it is taken as a file name and the output is redirected to this file.} \item{stderr}{What to do with the standard error. By default it is collected in the result, and you can also use the \code{stderr_line_callback} and \code{stderr_callback} arguments to pass callbacks for output. If it is the empty string (\code{""}), then the child process inherits the standard error stream of the R process. (If the main R process does not have a standard error stream, e.g. in RGui on Windows, then an error is thrown.) If it is \code{NULL}, then standard error is discarded. If it is a string other than \code{"|"} and \code{""}, then it is taken as a file name and the standard error is redirected to this file.} \item{stdout_line_callback}{\code{NULL}, or a function to call for every line of the standard output. See \code{stdout_callback} and also more below.} \item{stdout_callback}{\code{NULL}, or a function to call for every chunk of the standard output. A chunk can be as small as a single character. At most one of \code{stdout_line_callback} and \code{stdout_callback} can be non-\code{NULL}.} \item{stderr_line_callback}{\code{NULL}, or a function to call for every line of the standard error. See \code{stderr_callback} and also more below.} \item{stderr_callback}{\code{NULL}, or a function to call for every chunk of the standard error. A chunk can be as small as a single character. At most one of \code{stderr_line_callback} and \code{stderr_callback} can be non-\code{NULL}.} \item{stderr_to_stdout}{Whether to redirect the standard error to the standard output. Specifying \code{TRUE} here will keep both in the standard output, correctly interleaved. However, it is not possible to deduce where pieces of the output were coming from. If this is \code{TRUE}, the standard error callbacks (if any) are never called.} \item{env}{Environment variables of the child process. If \code{NULL}, the parent's environment is inherited. On Windows, many programs cannot function correctly if some environment variables are not set, so we always set \code{HOMEDRIVE}, \code{HOMEPATH}, \code{LOGONSERVER}, \code{PATH}, \code{SYSTEMDRIVE}, \code{SYSTEMROOT}, \code{TEMP}, \code{USERDOMAIN}, \code{USERNAME}, \code{USERPROFILE} and \code{WINDIR}. To append new environment variables to the ones set in the current process, specify \code{"current"} in \code{env}, without a name, and the appended ones with names. The appended ones can overwrite the current ones.} \item{windows_verbatim_args}{Whether to omit the escaping of the command and the arguments on windows. Ignored on other platforms.} \item{windows_hide_window}{Whether to hide the window of the application on windows. Ignored on other platforms.} \item{encoding}{The encoding to assume for \code{stdout} and \code{stderr}. By default the encoding of the current locale is used. Note that \code{processx} always reencodes the output of both streams in UTF-8 currently.} \item{cleanup_tree}{Whether to clean up the child process tree after the process has finished.} \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 \code{stdout_callback}, \code{stderr_callback}, etc. arguments to manage the standard output and error, or the \link{process} class directly if you need more flexibility.} } \value{ A list with components: \itemize{ \item status The exit status of the process. If this is \code{NA}, then the process was killed and had no exit status. \item stdout The standard output of the command, in a character scalar. \item stderr The standard error of the command, in a character scalar. \item timeout Whether the process was killed because of a timeout. } } \description{ \code{run} provides an interface similar to \code{\link[base:system]{base::system()}} and \code{\link[base:system2]{base::system2()}}, but based on the \link{process} class. This allows some extra features, see below. } \details{ \code{run} supports \itemize{ \item Specifying a timeout for the command. If the specified time has passed, and the process is still running, it will be killed (with all its child processes). \item Calling a callback function for each line or each chunk of the standard output and/or error. A chunk may contain multiple lines, and can be as short as a single character. \item Cleaning up the subprocess, or the whole process tree, before exiting. } } \section{Callbacks}{ Some notes about the callback functions. The first argument of a callback function is a character scalar (length 1 character), a single output or error line. The second argument is always the \link{process} object. You can manipulate this object, for example you can call \verb{$kill()} on it to terminate it, as a response to a message on the standard output or error. } \section{Error conditions}{ \code{run()} throws error condition objects if the process is interrupted, timeouts or fails (if \code{error_on_status} is \code{TRUE}): \itemize{ \item On interrupt, a condition with classes \code{system_command_interrupt}, \code{interrupt}, \code{condition} is signalled. This can be caught with \code{tryCatch(..., interrupt = ...)}. \item On timeout, a condition with classes \code{system_command_timeout_error}, \code{system_command_error}, \code{error}, \code{condition} is thrown. \item On error (if \code{error_on_status} is \code{TRUE}), an error with classes \code{system_command_status_error}, \code{system_command_error}, \code{error}, \code{condition} is thrown. } All of these conditions have the fields: \itemize{ \item \code{message}: the error message, \item \code{stderr}: the standard error of the process, or the standard output of the process if \code{stderr_to_stdout} was \code{TRUE}. \item \code{call}: the captured call to \code{run()}. \item \code{echo}: the value of the \code{echo} argument. \item \code{stderr_to_stdout}: the value of the \code{stderr_to_stdout} argument. \item \code{status}: the exit status for \code{system_command_status_error} errors. } } \examples{ \dontshow{if (.Platform$OS.type == "unix") (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} # This works on Unix systems run("ls") system.time(run("sleep", "10", timeout = 1, error_on_status = FALSE)) system.time( run( "sh", c("-c", "for i in 1 2 3 4 5; do echo $i; sleep 1; done"), timeout = 2, error_on_status = FALSE ) ) \dontshow{\}) # examplesIf} \dontshow{if (FALSE) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} # This works on Windows systems, if the ping command is available run("ping", c("-n", "1", "127.0.0.1")) run("ping", c("-n", "6", "127.0.0.1"), timeout = 1, error_on_status = FALSE) \dontshow{\}) # examplesIf} } processx/man/process_initialize.Rd0000644000176200001440000000261114026372357017072 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/initialize.R \name{process_initialize} \alias{process_initialize} \title{Start a process} \usage{ 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 ) } \arguments{ \item{self}{this} \item{private}{this$private} \item{command}{Command to run, string scalar.} \item{args}{Command arguments, character vector.} \item{stdin}{Standard input, NULL to ignore.} \item{stdout}{Standard output, NULL to ignore, TRUE for temp file.} \item{stderr}{Standard error, NULL to ignore, TRUE for temp file.} \item{pty}{Whether we create a PTY.} \item{connections}{Connections to inherit in the child process.} \item{poll_connection}{Whether to create a connection for polling.} \item{env}{Environment vaiables.} \item{cleanup}{Kill on GC?} \item{cleanup_tree}{Kill process tree on GC?} \item{wd}{working directory (or NULL)} \item{echo_cmd}{Echo command before starting it?} \item{supervise}{Should the process be supervised?} \item{encoding}{Assumed stdout and stderr encoding.} \item{post_process}{Post processing function.} } \description{ Start a process } \keyword{internal} processx/man/supervisor_kill.Rd0000644000176200001440000000126614043037001016413 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/supervisor.R \name{supervisor_kill} \alias{supervisor_kill} \title{Terminate all supervised processes and the supervisor process itself as well} \usage{ supervisor_kill() } \description{ On Unix the supervisor sends a \code{SIGTERM} signal to all supervised processes, and gives them five seconds to quit, before sending a \code{SIGKILL} signal. Then the supervisor itself terminates. } \details{ Windows is similar, but instead of \code{SIGTERM}, a console CTRL+C interrupt is sent first, then a \code{WM_CLOSE} message is sent to the windows of the supervised processes, if they have windows. } \keyword{internal} processx/man/poll.Rd0000644000176200001440000000556613616314454014153 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/poll.R \name{poll} \alias{poll} \title{Poll for process I/O or termination} \usage{ poll(processes, ms) } \arguments{ \item{processes}{A list of connection objects or\code{process} objects to wait on. (They can be mixed as well.) If this is a named list, then the returned list will have the same names. This simplifies the identification of the processes.} \item{ms}{Integer scalar, a timeout for the polling, in milliseconds. Supply -1 for an infitite timeout, and 0 for not waiting at all.} } \value{ A list of character vectors of length one or three. There is one list element for each connection/process, in the same order as in the input list. For connections the result is a single string scalar. For processes the character vectors' elements are named \code{output}, \code{error} and \code{process}. Possible values for each individual result are: \code{nopipe}, \code{ready}, \code{timeout}, \code{closed}, \code{silent}. See details about these below. \code{process} refers to the poll connection, see the \code{poll_connection} argument of the \code{process} initializer. } \description{ Wait until one of the specified connections or processes produce standard output or error, terminates, or a timeout occurs. } \section{Explanation of the return values}{ \itemize{ \item \code{nopipe} means that the stdout or stderr from this process was not captured. \item \code{ready} means that the connection or the stdout or stderr from this process are ready to read from. Note that end-of-file on these outputs also triggers \code{ready}. \item timeout`: the connections or processes are not ready to read from and a timeout happened. \item \code{closed}: the connection was already closed, before the polling started. \item \code{silent}: the connection is not ready to read from, but another connection was. } } \examples{ \dontshow{if (FALSE) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} # Different commands to run for windows and unix cmd1 <- switch( .Platform$OS.type, "unix" = c("sh", "-c", "sleep 1; ls"), c("cmd", "/c", "ping -n 2 127.0.0.1 && dir /b") ) cmd2 <- switch( .Platform$OS.type, "unix" = c("sh", "-c", "sleep 2; ls 1>&2"), c("cmd", "/c", "ping -n 2 127.0.0.1 && dir /b 1>&2") ) ## Run them. p1 writes to stdout, p2 to stderr, after some sleep p1 <- process$new(cmd1[1], cmd1[-1], stdout = "|") p2 <- process$new(cmd2[1], cmd2[-1], stderr = "|") ## Nothing to read initially poll(list(p1 = p1, p2 = p2), 0) ## Wait until p1 finishes. Now p1 has some output p1$wait() poll(list(p1 = p1, p2 = p2), -1) ## Close p1's connection, p2 will have output on stderr, eventually close(p1$get_output_connection()) poll(list(p1 = p1, p2 = p2), -1) ## Close p2's connection as well, no nothing to poll close(p2$get_error_connection()) poll(list(p1 = p1, p2 = p2), 0) \dontshow{\}) # examplesIf} } processx/man/default_pty_options.Rd0000644000176200001440000000113114025102241017240 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/process.R \name{default_pty_options} \alias{default_pty_options} \title{Default options for pseudo terminals (ptys)} \usage{ default_pty_options() } \value{ Named list of default values of pty options. Options and default values: \itemize{ \item \code{echo} whether to keep the echo on the terminal. \code{FALSE} turns echo off. \item \code{rows} the (initial) terminal size, number of rows. \item \code{cols} the (initial) terminal size, number of columns. } } \description{ Default options for pseudo terminals (ptys) } processx/man/process.Rd0000644000176200001440000011636014043035123014642 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/process.R \name{process} \alias{process} \title{External process} \description{ Managing external processes from R is not trivial, and this class aims to help with this deficiency. It is essentially a small wrapper around the \code{system} base R function, to return the process id of the started process, and set its standard output and error streams. The process id is then used to manage the process. } \section{Batch files}{ Running Windows batch files (\code{.bat} or \code{.cmd} files) may be complicated because of the \code{cmd.exe} command line parsing rules. For example you cannot easily have whitespace in both the command (path) and one of the arguments. To work around these limitations you need to start a \code{cmd.exe} shell explicitly and use its \code{call} command. For example:\if{html}{\out{
}}\preformatted{process$new("cmd.exe", c("/c", "call", bat_file, "arg 1", "arg 2")) }\if{html}{\out{
}} This works even if \code{bat_file} contains whitespace characters. } \section{Polling}{ The \code{poll_io()} function polls the standard output and standard error connections of a process, with a timeout. If there is output in either of them, or they are closed (e.g. because the process exits) \code{poll_io()} returns immediately. In addition to polling a single process, the \code{\link[=poll]{poll()}} function can poll the output of several processes, and returns as soon as any of them has generated output (or exited). } \section{Cleaning up background processes}{ processx kills processes that are not referenced any more (if \code{cleanup} is set to \code{TRUE}), or the whole subprocess tree (if \code{cleanup_tree} is also set to \code{TRUE}). The cleanup happens when the references of the processes object are garbage collected. To clean up earlier, you can call the \code{kill()} or \code{kill_tree()} method of the process(es), from an \code{on.exit()} expression, or an error handler:\if{html}{\out{
}}\preformatted{process_manager <- function() \{ on.exit(\{ try(p1$kill(), silent = TRUE) try(p2$kill(), silent = TRUE) \}, add = TRUE) p1 <- process$new("sleep", "3") p2 <- process$new("sleep", "10") p1$wait() p2$wait() \} process_manager() }\if{html}{\out{
}} If you interrupt \code{process_manager()} or an error happens then both \code{p1} and \code{p2} are cleaned up immediately. Their connections will also be closed. The same happens at a regular exit. } \examples{ \dontshow{if (identical(Sys.getenv("IN_PKGDOWN"), "true")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} p <- process$new("sleep", "2") p$is_alive() p p$kill() p$is_alive() p <- process$new("sleep", "1") p$is_alive() Sys.sleep(2) p$is_alive() \dontshow{\}) # examplesIf} } \section{Methods}{ \subsection{Public methods}{ \itemize{ \item \href{#method-new}{\code{process$new()}} \item \href{#method-finalize}{\code{process$finalize()}} \item \href{#method-kill}{\code{process$kill()}} \item \href{#method-kill_tree}{\code{process$kill_tree()}} \item \href{#method-signal}{\code{process$signal()}} \item \href{#method-interrupt}{\code{process$interrupt()}} \item \href{#method-get_pid}{\code{process$get_pid()}} \item \href{#method-is_alive}{\code{process$is_alive()}} \item \href{#method-wait}{\code{process$wait()}} \item \href{#method-get_exit_status}{\code{process$get_exit_status()}} \item \href{#method-format}{\code{process$format()}} \item \href{#method-print}{\code{process$print()}} \item \href{#method-get_start_time}{\code{process$get_start_time()}} \item \href{#method-is_supervised}{\code{process$is_supervised()}} \item \href{#method-supervise}{\code{process$supervise()}} \item \href{#method-read_output}{\code{process$read_output()}} \item \href{#method-read_error}{\code{process$read_error()}} \item \href{#method-read_output_lines}{\code{process$read_output_lines()}} \item \href{#method-read_error_lines}{\code{process$read_error_lines()}} \item \href{#method-is_incomplete_output}{\code{process$is_incomplete_output()}} \item \href{#method-is_incomplete_error}{\code{process$is_incomplete_error()}} \item \href{#method-has_input_connection}{\code{process$has_input_connection()}} \item \href{#method-has_output_connection}{\code{process$has_output_connection()}} \item \href{#method-has_error_connection}{\code{process$has_error_connection()}} \item \href{#method-has_poll_connection}{\code{process$has_poll_connection()}} \item \href{#method-get_input_connection}{\code{process$get_input_connection()}} \item \href{#method-get_output_connection}{\code{process$get_output_connection()}} \item \href{#method-get_error_connection}{\code{process$get_error_connection()}} \item \href{#method-read_all_output}{\code{process$read_all_output()}} \item \href{#method-read_all_error}{\code{process$read_all_error()}} \item \href{#method-read_all_output_lines}{\code{process$read_all_output_lines()}} \item \href{#method-read_all_error_lines}{\code{process$read_all_error_lines()}} \item \href{#method-write_input}{\code{process$write_input()}} \item \href{#method-get_input_file}{\code{process$get_input_file()}} \item \href{#method-get_output_file}{\code{process$get_output_file()}} \item \href{#method-get_error_file}{\code{process$get_error_file()}} \item \href{#method-poll_io}{\code{process$poll_io()}} \item \href{#method-get_poll_connection}{\code{process$get_poll_connection()}} \item \href{#method-get_result}{\code{process$get_result()}} \item \href{#method-as_ps_handle}{\code{process$as_ps_handle()}} \item \href{#method-get_name}{\code{process$get_name()}} \item \href{#method-get_exe}{\code{process$get_exe()}} \item \href{#method-get_cmdline}{\code{process$get_cmdline()}} \item \href{#method-get_status}{\code{process$get_status()}} \item \href{#method-get_username}{\code{process$get_username()}} \item \href{#method-get_wd}{\code{process$get_wd()}} \item \href{#method-get_cpu_times}{\code{process$get_cpu_times()}} \item \href{#method-get_memory_info}{\code{process$get_memory_info()}} \item \href{#method-suspend}{\code{process$suspend()}} \item \href{#method-resume}{\code{process$resume()}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-new}{}}} \subsection{Method \code{new()}}{ Start a new process in the background, and then return immediately. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{process$new( 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 )}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{command}}{Character scalar, the command to run. Note that this argument is not passed to a shell, so no tilde-expansion or variable substitution is performed on it. It should not be quoted with \code{\link[base:shQuote]{base::shQuote()}}. See \code{\link[base:normalizePath]{base::normalizePath()}} for tilde-expansion. If you want to run \code{.bat} or \code{.cmd} files on Windows, make sure you read the 'Batch files' section above.} \item{\code{args}}{Character vector, arguments to the command. They will be passed to the process as is, without a shell transforming them, They don't need to be escaped.} \item{\code{stdin}}{What to do with the standard input. Possible values: \itemize{ \item \code{NULL}: set to the \emph{null device}, i.e. no standard input is provided; \item a file name, use this file as standard input; \item \code{"|"}: create a (writeable) connection for stdin. \item \code{""} (empty string): inherit it from the main R process. If the main R process does not have a standard input stream, e.g. in RGui on Windows, then an error is thrown. }} \item{\code{stdout}}{What to do with the standard output. Possible values: \itemize{ \item \code{NULL}: discard it; \item a string, redirect it to this file; \item \code{"|"}: create a connection for it. \item \code{""} (empty string): inherit it from the main R process. If the main R process does not have a standard output stream, e.g. in RGui on Windows, then an error is thrown. }} \item{\code{stderr}}{What to do with the standard error. Possible values: \itemize{ \item \code{NULL}: discard it; \item a string, redirect it to this file; \item \code{"|"}: create a connection for it; \item \code{"2>&1"}: redirect it to the same connection (i.e. pipe or file) as \code{stdout}. \code{"2>&1"} is a way to keep standard output and error correctly interleaved. \item \code{""} (empty string): inherit it from the main R process. If the main R process does not have a standard error stream, e.g. in RGui on Windows, then an error is thrown. }} \item{\code{pty}}{Whether to create a pseudo terminal (pty) for the background process. This is currently only supported on Unix systems, but not supported on Solaris. If it is \code{TRUE}, then the \code{stdin}, \code{stdout} and \code{stderr} arguments must be \code{NULL}. If a pseudo terminal is created, then processx will create pipes for standard input and standard output. There is no separate pipe for standard error, because there is no way to distinguish between stdout and stderr on a pty. Note that the standard output connection of the pty is \emph{blocking}, so we always poll the standard output connection before reading from it using the \verb{$read_output()} method. Also, because \verb{$read_output_lines()} could still block if no complete line is available, this function always fails if the process has a pty. Use \verb{$read_output()} to read from ptys.} \item{\code{pty_options}}{Unix pseudo terminal options, a named list. see \code{\link[=default_pty_options]{default_pty_options()}} for details and defaults.} \item{\code{connections}}{A list of processx connections to pass to the child process. This is an experimental feature currently.} \item{\code{poll_connection}}{Whether to create an extra connection to the process that allows polling, even if the standard input and standard output are not pipes. If this is \code{NULL} (the default), then this connection will be only created if standard output and standard error are not pipes, and \code{connections} is an empty list. If the poll connection is created, you can query it via \code{p$get_poll_connection()} and it is also included in the response to \code{p$poll_io()} and \code{\link[=poll]{poll()}}. The numeric file descriptor of the poll connection comes right after \code{stderr} (2), and the connections listed in \code{connections}.} \item{\code{env}}{Environment variables of the child process. If \code{NULL}, the parent's environment is inherited. On Windows, many programs cannot function correctly if some environment variables are not set, so we always set \code{HOMEDRIVE}, \code{HOMEPATH}, \code{LOGONSERVER}, \code{PATH}, \code{SYSTEMDRIVE}, \code{SYSTEMROOT}, \code{TEMP}, \code{USERDOMAIN}, \code{USERNAME}, \code{USERPROFILE} and \code{WINDIR}. To append new environment variables to the ones set in the current process, specify \code{"current"} in \code{env}, without a name, and the appended ones with names. The appended ones can overwrite the current ones.} \item{\code{cleanup}}{Whether to kill the process when the \code{process} 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{wd}}{Working directory of the process. It must exist. If \code{NULL}, then the current working directory is used.} \item{\code{echo_cmd}}{Whether to print the command to the screen before running it.} \item{\code{supervise}}{Whether to register the process with a supervisor. If \code{TRUE}, the supervisor will ensure that the process is killed when the R process exits.} \item{\code{windows_verbatim_args}}{Whether to omit quoting the arguments on Windows. It is ignored on other platforms.} \item{\code{windows_hide_window}}{Whether to hide the application's window on Windows. It is ignored on other platforms.} \item{\code{windows_detached_process}}{Whether to use the \code{DETACHED_PROCESS} flag on Windows. If this is \code{TRUE}, then the child process will have no attached console, even if the parent had one.} \item{\code{encoding}}{The encoding to assume for \code{stdin}, \code{stdout} and \code{stderr}. By default the encoding of the current locale is used. Note that \code{processx} always reencodes the output of the \code{stdout} and \code{stderr} streams in UTF-8 currently. If you want to read them without any conversion, on all platforms, specify \code{"UTF-8"} as encoding.} \item{\code{post_process}}{An optional function to run when the process has finished. Currently it only runs if \verb{$get_result()} is called. It is only run once.} } \if{html}{\out{
}} } \subsection{Returns}{ R6 object representing the process. } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-finalize}{}}} \subsection{Method \code{finalize()}}{ Cleanup method that is called when the \code{process} object is garbage collected. If requested so in the process constructor, then it eliminates all processes in the process's subprocess tree. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{process$finalize()}\if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-kill}{}}} \subsection{Method \code{kill()}}{ Terminate the process. It also terminate all of its child processes, except if they have created a new process group (on Unix), 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{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{grace}}{Currently not used.} \item{\code{close_connections}}{Whether to close standard input, standard output, standard error connections and the poll connection, after killing the process.} } \if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-kill_tree}{}}} \subsection{Method \code{kill_tree()}}{ Process tree cleanup. It terminates the process (if still alive), together with any child (or grandchild, etc.) processes. It uses the \emph{ps} package, so that needs to be installed, and \emph{ps} needs to support the current platform as well. Process tree cleanup works by marking the process with an environment variable, which is inherited in all child processes. This allows finding descendents, even if they are orphaned, i.e. they are not connected to the root of the tree cleanup in the process tree any more. \verb{$kill_tree()} returns a named integer vector of the process ids that 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{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{grace}}{Currently not used.} \item{\code{close_connections}}{Whether to close standard input, standard output, standard error connections and the poll connection, after killing the process.} } \if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-signal}{}}} \subsection{Method \code{signal()}}{ Send a signal to the process. On Windows only the \code{SIGINT}, \code{SIGTERM} and \code{SIGKILL} signals are interpreted, and the special 0 signal. The first three all kill the process. The 0 signal returns \code{TRUE} if the process is alive, and \code{FALSE} otherwise. On Unix all signals are supported that the OS supports, and the 0 signal as well. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{process$signal(signal)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \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{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-interrupt}{}}} \subsection{Method \code{interrupt()}}{ Send an interrupt to the process. On Unix this is a \code{SIGINT} signal, and it is usually equivalent to pressing CTRL+C at the terminal prompt. On Windows, it is a CTRL+BREAK keypress. Applications may catch these events. By default they will quit. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{process$interrupt()}\if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-get_pid}{}}} \subsection{Method \code{get_pid()}}{ Query the process id. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{process$get_pid()}\if{html}{\out{
}} } \subsection{Returns}{ Integer scalar, the process id of the process. } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-is_alive}{}}} \subsection{Method \code{is_alive()}}{ Check if the process is alive. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{process$is_alive()}\if{html}{\out{
}} } \subsection{Returns}{ Logical scalar. } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-wait}{}}} \subsection{Method \code{wait()}}{ Wait until the process finishes, or a timeout happens. Note that if the process never finishes, and the timeout is infinite (the default), then R will never regain control. In some rare cases, \verb{$wait()} might take a bit longer than specified to time out. This happens on Unix, when another package overwrites the processx \code{SIGCHLD} signal handler, after the processx process has started. One such package is parallel, if used with fork clusters, e.g. through \code{parallel::mcparallel()}. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{process$wait(timeout = -1)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{timeout}}{Timeout in milliseconds, for the wait or the I/O polling.} } \if{html}{\out{
}} } \subsection{Returns}{ It returns the process itself, invisibly. } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-get_exit_status}{}}} \subsection{Method \code{get_exit_status()}}{ \verb{$get_exit_status} returns the exit code of the process if it has finished and \code{NULL} otherwise. On Unix, in some rare cases, the exit status might be \code{NA}. This happens if another package (or R itself) overwrites the processx \code{SIGCHLD} handler, after the processx process has started. In these cases processx cannot determine the real exit status of the process. One such package is parallel, if used with fork clusters, e.g. through the \code{parallel::mcparallel()} function. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{process$get_exit_status()}\if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-format}{}}} \subsection{Method \code{format()}}{ \code{format(p)} or \code{p$format()} creates a string representation of the process, usually for printing. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{process$format()}\if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-print}{}}} \subsection{Method \code{print()}}{ \code{print(p)} or \code{p$print()} shows some information about the process on the screen, whether it is running and it's process id, etc. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{process$print()}\if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-get_start_time}{}}} \subsection{Method \code{get_start_time()}}{ \verb{$get_start_time()} returns the time when the process was started. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{process$get_start_time()}\if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-is_supervised}{}}} \subsection{Method \code{is_supervised()}}{ \verb{$is_supervised()} returns whether the process is being tracked by supervisor process. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{process$is_supervised()}\if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-supervise}{}}} \subsection{Method \code{supervise()}}{ \verb{$supervise()} if passed \code{TRUE}, tells the supervisor to start tracking the process. If \code{FALSE}, tells the supervisor to stop tracking the process. Note that even if the supervisor is disabled for a process, if it was started with \code{cleanup = TRUE}, the process will still be killed when the object is garbage collected. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{process$supervise(status)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{status}}{Whether to turn on of off the supervisor for this process.} } \if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-read_output}{}}} \subsection{Method \code{read_output()}}{ \verb{$read_output()} reads from the standard output connection of the process. If the standard output connection was not requested, then then it returns an error. It uses a non-blocking text connection. This will work only if \code{stdout="|"} was used. Otherwise, it will throw an error. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{process$read_output(n = -1)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{n}}{Number of characters or lines to read.} } \if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-read_error}{}}} \subsection{Method \code{read_error()}}{ \verb{$read_error()} is similar to \verb{$read_output}, but it reads from the standard error stream. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{process$read_error(n = -1)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{n}}{Number of characters or lines to read.} } \if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-read_output_lines}{}}} \subsection{Method \code{read_output_lines()}}{ \verb{$read_output_lines()} reads lines from standard output connection of the process. If the standard output connection was not requested, then it returns an error. It uses a non-blocking text connection. This will work only if \code{stdout="|"} was used. Otherwise, it will throw an error. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{process$read_output_lines(n = -1)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{n}}{Number of characters or lines to read.} } \if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-read_error_lines}{}}} \subsection{Method \code{read_error_lines()}}{ \verb{$read_error_lines()} is similar to \verb{$read_output_lines}, but it reads from the standard error stream. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{process$read_error_lines(n = -1)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{n}}{Number of characters or lines to read.} } \if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-is_incomplete_output}{}}} \subsection{Method \code{is_incomplete_output()}}{ \verb{$is_incomplete_output()} return \code{FALSE} if the other end of the standard output connection was closed (most probably because the process exited). It return \code{TRUE} otherwise. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{process$is_incomplete_output()}\if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-is_incomplete_error}{}}} \subsection{Method \code{is_incomplete_error()}}{ \verb{$is_incomplete_error()} return \code{FALSE} if the other end of the standard error connection was closed (most probably because the process exited). It return \code{TRUE} otherwise. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{process$is_incomplete_error()}\if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-has_input_connection}{}}} \subsection{Method \code{has_input_connection()}}{ \verb{$has_input_connection()} return \code{TRUE} if there is a connection object for standard input; in other words, if \code{stdout="|"}. It returns \code{FALSE} otherwise. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{process$has_input_connection()}\if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-has_output_connection}{}}} \subsection{Method \code{has_output_connection()}}{ \verb{$has_output_connection()} returns \code{TRUE} if there is a connection object for standard output; in other words, if \code{stdout="|"}. It returns \code{FALSE} otherwise. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{process$has_output_connection()}\if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-has_error_connection}{}}} \subsection{Method \code{has_error_connection()}}{ \verb{$has_error_connection()} returns \code{TRUE} if there is a connection object for standard error; in other words, if \code{stderr="|"}. It returns \code{FALSE} otherwise. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{process$has_error_connection()}\if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-has_poll_connection}{}}} \subsection{Method \code{has_poll_connection()}}{ \verb{$has_poll_connection()} return \code{TRUE} if there is a poll connection, \code{FALSE} otherwise. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{process$has_poll_connection()}\if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-get_input_connection}{}}} \subsection{Method \code{get_input_connection()}}{ \verb{$get_input_connection()} returns a connection object, to the standard input stream of the process. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{process$get_input_connection()}\if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-get_output_connection}{}}} \subsection{Method \code{get_output_connection()}}{ \verb{$get_output_connection()} returns a connection object, to the standard output stream of the process. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{process$get_output_connection()}\if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-get_error_connection}{}}} \subsection{Method \code{get_error_connection()}}{ \verb{$get_error_conneciton()} returns a connection object, to the standard error stream of the process. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{process$get_error_connection()}\if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-read_all_output}{}}} \subsection{Method \code{read_all_output()}}{ \verb{$read_all_output()} waits for all standard output from the process. It does not return until the process has finished. Note that this process involves waiting for the process to finish, polling for I/O and potentially several \code{readLines()} calls. It returns a character scalar. This will return content only if \code{stdout="|"} was used. Otherwise, it will throw an error. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{process$read_all_output()}\if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-read_all_error}{}}} \subsection{Method \code{read_all_error()}}{ \verb{$read_all_error()} waits for all standard error from the process. It does not return until the process has finished. Note that this process involves waiting for the process to finish, polling for I/O and potentially several \code{readLines()} calls. It returns a character scalar. This will return content only if \code{stderr="|"} was used. Otherwise, it will throw an error. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{process$read_all_error()}\if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-read_all_output_lines}{}}} \subsection{Method \code{read_all_output_lines()}}{ \verb{$read_all_output_lines()} waits for all standard output lines from a process. It does not return until the process has finished. Note that this process involves waiting for the process to finish, polling for I/O and potentially several \code{readLines()} calls. It returns a character vector. This will return content only if \code{stdout="|"} was used. Otherwise, it will throw an error. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{process$read_all_output_lines()}\if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-read_all_error_lines}{}}} \subsection{Method \code{read_all_error_lines()}}{ \verb{$read_all_error_lines()} waits for all standard error lines from a process. It does not return until the process has finished. Note that this process involves waiting for the process to finish, polling for I/O and potentially several \code{readLines()} calls. It returns a character vector. This will return content only if \code{stderr="|"} was used. Otherwise, it will throw an error. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{process$read_all_error_lines()}\if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-write_input}{}}} \subsection{Method \code{write_input()}}{ \verb{$write_input()} writes the character vector (separated by \code{sep}) to the standard input of the process. It will be converted to the specified encoding. This operation is non-blocking, and it will return, even if the write fails (because the write buffer is full), or if it suceeds partially (i.e. not the full string is written). It returns with a raw vector, that contains the bytes that were not written. You can supply this raw vector to \verb{$write_input()} again, until it is fully written, and then the return value will be \code{raw(0)} (invisibly). \subsection{Usage}{ \if{html}{\out{
}}\preformatted{process$write_input(str, sep = "\\n")}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{str}}{Character or raw vector to write to the standard input of the process. If a character vector with a marked encoding, it will be converted to \code{encoding}.} \item{\code{sep}}{Separator to add between \code{str} elements if it is a character vector. It is ignored if \code{str} is a raw vector.} } \if{html}{\out{
}} } \subsection{Returns}{ Leftover text (as a raw vector), that was not written. } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-get_input_file}{}}} \subsection{Method \code{get_input_file()}}{ \verb{$get_input_file()} if the \code{stdin} argument was a filename, this returns the absolute path to the file. If \code{stdin} was \code{"|"} or \code{NULL}, this simply returns that value. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{process$get_input_file()}\if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-get_output_file}{}}} \subsection{Method \code{get_output_file()}}{ \verb{$get_output_file()} if the \code{stdout} argument was a filename, this returns the absolute path to the file. If \code{stdout} was \code{"|"} or \code{NULL}, this simply returns that value. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{process$get_output_file()}\if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-get_error_file}{}}} \subsection{Method \code{get_error_file()}}{ \verb{$get_error_file()} if the \code{stderr} argument was a filename, this returns the absolute path to the file. If \code{stderr} was \code{"|"} or \code{NULL}, this simply returns that value. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{process$get_error_file()}\if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-poll_io}{}}} \subsection{Method \code{poll_io()}}{ \verb{$poll_io()} polls the process's connections for I/O. See more in the \emph{Polling} section, and see also the \code{\link[=poll]{poll()}} function to poll on multiple processes. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{process$poll_io(timeout)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{timeout}}{Timeout in milliseconds, for the wait or the I/O polling.} } \if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-get_poll_connection}{}}} \subsection{Method \code{get_poll_connection()}}{ \verb{$get_poll_connetion()} returns the poll connection, if the process has one. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{process$get_poll_connection()}\if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-get_result}{}}} \subsection{Method \code{get_result()}}{ \verb{$get_result()} returns the result of the post processesing function. It can only be called once the process has finished. If the process has no post-processing function, then \code{NULL} is returned. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{process$get_result()}\if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-as_ps_handle}{}}} \subsection{Method \code{as_ps_handle()}}{ \verb{$as_ps_handle()} returns a \link[ps:ps_handle]{ps::ps_handle} object, corresponding to the process. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{process$as_ps_handle()}\if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-get_name}{}}} \subsection{Method \code{get_name()}}{ Calls \code{\link[ps:ps_name]{ps::ps_name()}} to get the process name. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{process$get_name()}\if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-get_exe}{}}} \subsection{Method \code{get_exe()}}{ Calls \code{\link[ps:ps_exe]{ps::ps_exe()}} to get the path of the executable. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{process$get_exe()}\if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-get_cmdline}{}}} \subsection{Method \code{get_cmdline()}}{ Calls \code{\link[ps:ps_cmdline]{ps::ps_cmdline()}} to get the command line. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{process$get_cmdline()}\if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-get_status}{}}} \subsection{Method \code{get_status()}}{ Calls \code{\link[ps:ps_status]{ps::ps_status()}} to get the process status. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{process$get_status()}\if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-get_username}{}}} \subsection{Method \code{get_username()}}{ calls \code{\link[ps:ps_username]{ps::ps_username()}} to get the username. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{process$get_username()}\if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-get_wd}{}}} \subsection{Method \code{get_wd()}}{ Calls \code{\link[ps:ps_cwd]{ps::ps_cwd()}} to get the current working directory. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{process$get_wd()}\if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-get_cpu_times}{}}} \subsection{Method \code{get_cpu_times()}}{ Calls \code{\link[ps:ps_cpu_times]{ps::ps_cpu_times()}} to get CPU usage data. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{process$get_cpu_times()}\if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-get_memory_info}{}}} \subsection{Method \code{get_memory_info()}}{ Calls \code{\link[ps:ps_memory_info]{ps::ps_memory_info()}} to get memory data. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{process$get_memory_info()}\if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-suspend}{}}} \subsection{Method \code{suspend()}}{ Calls \code{\link[ps:ps_suspend]{ps::ps_suspend()}} to suspend the process. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{process$suspend()}\if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-resume}{}}} \subsection{Method \code{resume()}}{ Calls \code{\link[ps:ps_resume]{ps::ps_resume()}} to resume a suspended process. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{process$resume()}\if{html}{\out{
}} } } } processx/man/base64_decode.Rd0000644000176200001440000000060713616314040015552 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/base64.R \name{base64_decode} \alias{base64_decode} \alias{base64_encode} \title{Base64 Encoding and Decoding} \usage{ base64_decode(x) base64_encode(x) } \arguments{ \item{x}{Raw vector to encode / decode.} } \value{ Raw vector, result of the encoding / decoding. } \description{ Base64 Encoding and Decoding } processx/man/curl_fds.Rd0000644000176200001440000000076713703607776015015 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/poll.R \name{curl_fds} \alias{curl_fds} \title{Create a pollable object from a curl multi handle's file descriptors} \usage{ curl_fds(fds) } \arguments{ \item{fds}{A list of file descriptors, as returned by \code{\link[curl:multi]{curl::multi_fdset()}}.} } \value{ Pollable object, that be used with \code{\link[=poll]{poll()}} directly. } \description{ Create a pollable object from a curl multi handle's file descriptors } processx/DESCRIPTION0000644000176200001440000000276614043056423013642 0ustar liggesusersPackage: processx Title: Execute and Control System Processes Version: 3.5.2 Authors@R: c( person("Gábor", "Csárdi", role = c("aut", "cre", "cph"), email = "csardi.gabor@gmail.com", comment = c(ORCID = "0000-0001-7098-9676")), person("Winston", "Chang", role = "aut"), person("RStudio", role = c("cph", "fnd")), person("Mango Solutions", role = c("cph", "fnd"))) Description: Tools to run system processes in the background. It can check if a background process is running; wait on a background process to finish; get the exit status of finished processes; kill background processes. It can read the standard output and error of the processes, using non-blocking connections. 'processx' can poll a process for standard output or error, with a timeout. It can also poll several processes at once. License: MIT + file LICENSE URL: https://processx.r-lib.org, https://github.com/r-lib/processx#readme BugReports: https://github.com/r-lib/processx/issues RoxygenNote: 7.1.1.9001 Imports: ps (>= 1.2.0), R6, utils Suggests: callr (>= 3.2.0), cli, codetools, covr, curl, debugme, parallel, testthat, withr Encoding: UTF-8 NeedsCompilation: yes Packaged: 2021-04-30 18:31:37 UTC; gaborcsardi Author: Gábor Csárdi [aut, cre, cph] (), Winston Chang [aut], RStudio [cph, fnd], Mango Solutions [cph, fnd] Maintainer: Gábor Csárdi Repository: CRAN Date/Publication: 2021-04-30 19:40:03 UTC processx/tests/0000755000176200001440000000000014032344262013262 5ustar liggesusersprocessx/tests/testthat/0000755000176200001440000000000014043056423015123 5ustar liggesusersprocessx/tests/testthat/test-poll-curl.R0000644000176200001440000000614013620512326020134 0ustar liggesusers context("poll-curl") ## To resolve.... online <- curl::has_internet() if (online) httpbin() test_that("curl fds", { skip_on_cran() if (!online) skip("Offline") resp <- list() errm <- character() done <- function(x) resp <<- c(resp, list(x)) fail <- function(x) errm <<- c(errm, x) pool <- curl::new_pool() url1 <- httpbin("/status/200") url2 <- httpbin("/delay/1") curl::multi_add(pool = pool, curl::new_handle(url = url1), done = done, fail = fail) curl::multi_add(pool = pool, curl::new_handle(url = url1), done = done, fail = fail) curl::multi_add(pool = pool, curl::new_handle(url = url2), done = done, fail = fail) curl::multi_add(pool = pool, curl::new_handle(url = url1), done = done, fail = fail) curl::multi_add(pool = pool, curl::new_handle(url = url1), done = done, fail = fail) timeout <- Sys.time() + 5 repeat { state <- curl::multi_run(timeout = 1/10000, pool = pool, poll = TRUE) fds <- curl::multi_fdset(pool = pool) if (length(fds$reads) > 0) break; if (Sys.time() >= timeout) break; } expect_true(Sys.time() < timeout) xfds <- list() xpr <- character() while (state$pending > 0) { fds <- curl::multi_fdset(pool = pool) xfds <- c(xfds, fds["reads"]) pr <- poll(list(curl_fds(fds)), 2000) xpr <- c(xpr, pr[[1]]) state <- curl::multi_run(timeout = 0.1, pool = pool, poll = TRUE) } expect_true(all(vapply(xfds, length, 1L) > 0)) expect_true(all(xpr == "event")) expect_equal(vapply(resp, "[[", "", "url"), c(rep(url1, 4), url2)) }) test_that("curl fds before others", { skip_on_cran() if (!online) skip("Offline") pool <- curl::new_pool() url <- httpbin("/delay/1") curl::multi_add(pool = pool, curl::new_handle(url = url)) timeout <- Sys.time() + 5 repeat { state <- curl::multi_run(timeout = 1/10000, pool = pool, poll = TRUE) fds <- curl::multi_fdset(pool = pool) if (length(fds$reads) > 0) break; if (Sys.time() >= timeout) break; } expect_true(Sys.time() < timeout) px <- get_tool("px") pp <- process$new(get_tool("px"), c("sleep", "10")) on.exit(pp$kill(), add = TRUE) pr <- poll(list(pp, curl_fds(fds)), 10000) expect_equal( pr, list(c(output = "nopipe", error = "nopipe", process = "silent"), "event") ) pp$kill() }) test_that("process fd before curl fd", { skip_on_cran() if (!online) skip("Offline") pool <- curl::new_pool() url <- httpbin("/delay/1") curl::multi_add(pool = pool, curl::new_handle(url = url)) timeout <- Sys.time() + 5 repeat { state <- curl::multi_run(timeout = 1/10000, pool = pool, poll = TRUE) fds <- curl::multi_fdset(pool = pool) if (length(fds$reads) > 0) break; if (Sys.time() >= timeout) break; } expect_true(Sys.time() < timeout) px <- get_tool("px") pp <- process$new(get_tool("px"), c("outln", "done")) on.exit(pp$kill(), add = TRUE) pr <- poll(list(pp, curl_fds(fds)), 10000) expect_equal( pr, list(c(output = "nopipe", error = "nopipe", process = "ready"), "silent") ) pp$kill() }) processx/tests/testthat/test-assertions.R0000644000176200001440000000520714042776437020436 0ustar liggesusers context("assertions") strings <- list("foo", "", "111", "1", "-", "NA") not_strings <- list(1, character(), NA_character_, NA, c("foo", NA), c("1", "2"), NULL) test_that("is_string", { for (p in strings) { expect_true(is_string(p)) expect_silent(assert_that(is_string(p))) } for (n in not_strings) { expect_false(is_string(n)) expect_error(assert_that(is_string(n)), "is not a string") } }) test_that("is_string_or_null", { for (p in strings) { expect_true(is_string_or_null(p)) expect_silent(assert_that(is_string_or_null(p))) } expect_true(is_string_or_null(NULL)) expect_silent(assert_that(is_string_or_null(NULL))) for (n in not_strings) { if (!is.null(n)) { expect_false(is_string_or_null(n)) expect_error( assert_that(is_string_or_null(n)), "must be a string .* NULL" ) } } }) flags <- list(TRUE, FALSE) not_flags <- list(1, character(), NA_character_, NA, c("foo", NA), c("1", "2"), NULL) test_that("is_flag", { for (p in flags) { expect_true(is_flag(p)) expect_silent(assert_that(is_flag(p))) } for (n in not_flags) { expect_false(is_flag(n)) expect_error(assert_that(is_flag(n)), "is not a flag") } }) ints <- list(1, 0, -1, 1L, 0L, -1L, 1.0, 42.0) not_ints <- list(1.2, 0.1, "foo", numeric(), integer(), NULL, NA_integer_, NA_real_) test_that("is_integerish_scalar", { for (p in ints) { expect_true(is_integerish_scalar(p)) expect_silent(assert_that(is_integerish_scalar(p))) } for (n in not_ints) { expect_false(is_integerish_scalar(n)) expect_error( assert_that(is_integerish_scalar(n)), "is not a length 1 integer" ) } }) test_that("is_pid", { for (p in ints) { expect_true(is_pid(p)) expect_silent(assert_that(is_pid(p))) } for (n in not_ints) { expect_false(is_pid(n)) expect_error(assert_that(is_pid(n)), "is not a process id") } }) test_that("is_flag_or_string", { for (p in c(flags, strings)) { expect_true(is_flag_or_string(p)) expect_silent(assert_that(is_flag_or_string(p))) } for (n in intersect(not_flags, not_strings)) { expect_false(is_flag_or_string(n)) expect_error( assert_that(is_flag_or_string(n)), "is not a flag or a string" ) } }) test_that("is_existing_file", { expect_false(is_existing_file(tempfile())) expect_error( assert_that(is_existing_file(tempfile())), "File .* does not exist" ) cat("foo\n", file = tmp <- tempfile()) on.exit(unlink(tmp), add = TRUE) expect_true(is_existing_file(tmp)) expect_silent(assert_that(is_existing_file(tmp))) }) processx/tests/testthat/fixtures/0000755000176200001440000000000013616314040016771 5ustar liggesusersprocessx/tests/testthat/fixtures/simple.txt0000644000176200001440000000002113616314040021014 0ustar liggesuserssimple text file processx/tests/testthat/test-poll-connections.R0000644000176200001440000000331413616314040021507 0ustar liggesusers context("polling connections") test_that("poll a connection", { px <- get_tool("px") p <- process$new(px, c("sleep", ".5", "outln", "foobar"), stdout = "|") on.exit(p$kill()) out <- p$get_output_connection() ## Timeout expect_equal(poll(list(out), 0)[[1]], "timeout") expect_equal(poll(list(out), 2000)[[1]], "ready") p$read_output_lines() expect_equal(poll(list(out), 2000)[[1]], "ready") close(out) expect_equal(poll(list(out), 0)[[1]], "closed") }) test_that("poll a connection and a process", { px <- get_tool("px") p1 <- process$new(px, c("sleep", ".5", "outln", "foobar"), stdout = "|") p2 <- process$new(px, c("sleep", ".5", "outln", "foobar"), stdout = "|") on.exit(p1$kill(), add = TRUE) on.exit(p2$kill(), add = TRUE) out <- p1$get_output_connection() ## Timeout expect_equal( poll(list(out, p2), 0), list( "timeout", c(output = "timeout", error = "nopipe", process = "nopipe")) ) ## At least one of them is ready. Usually both on Unix, but on Windows ## it is different because the IOCP is a queue pr <- poll(list(out, p2), 2000) expect_true(pr[[1]] == "ready" || pr[[2]][["output"]] == "ready") p1$poll_io(2000) p2$poll_io(2000) p1$read_output_lines() p2$read_output_lines() pr <- poll(list(out, p2), 2000) expect_true(pr[[1]] == "ready" || pr[[2]][["output"]] == "ready") p1$kill(close_connections = FALSE) p2$kill(close_connections = FALSE) pr <- poll(list(out, p2), 2000) expect_true(pr[[1]] == "ready" || pr[[2]][["output"]] == "ready") close(out) close(p2$get_output_connection()) expect_equal( poll(list(out, p2), 2000), list("closed", c(output = "closed", error = "nopipe", process = "nopipe")) ) }) processx/tests/testthat/test-utf8.R0000644000176200001440000000466414043000415017111 0ustar liggesusers test_that("UTF-8 executable name", { skip_on_cran() local_temp_dir() name <- "./\u00fa\u00e1\u00f6\u0151\u00e9.exe" px <- get_tool("px") file.copy(px, name) out <- run( name, c("out", "hello", "return", 10), error_on_status = FALSE ) expect_equal(out$stdout, "hello") expect_equal(out$status, 10) }) test_that("UTF-8 directory name", { skip_on_cran() local_temp_dir() name <- "./\u00fa\u00e1\u00f6\u0151\u00e9.exe" # Older dir.create does not handle UTF-8 correctly if (getRversion() < "4.0.0") { dir.create(enc2native(name)) } else { dir.create(name) } px <- get_tool("px") exe <- file.path(name, "px.exe") if (getRversion() < "4.0.0") { file.copy(px, enc2native(exe)) } else { file.copy(px, exe) } out <- run( exe, c("out", "hello", "return", 10), error_on_status = FALSE ) expect_equal(out$stdout, "hello") expect_equal(out$status, 10) }) test_that("UTF-8 argument", { skip_other_platforms("windows") local_temp_dir() unc <- "\u00fa\u00e1\u00f6\u0151\u00e9\u0414\u041e\u0411\u0420\u041e" out <- run(get_tool("pxu"), c("writefile", "of", unc)) outarg <- readBin("of", what = "raw", n = 200) exp <- iconv(unc, from = "UTF-8", to = "UTF-16LE", toRaw = TRUE)[[1]] expect_equal(exp, outarg) }) test_that("native program name is converted to UTF-8", { skip_other_platforms("windows") if (!l10n_info()$`Latin-1`) skip("Needs latin1 locale") local_temp_dir() exe <- enc2native("./\u00fa\u00e1\u00f6.exe") file.copy(get_tool("px"), exe) out <- run(exe, c("return", 10), error_on_status = FALSE) expect_equal(out$status, 10) }) test_that("native args are converted to UTF-8", { skip_other_platforms("windows") if (!l10n_info()$`Latin-1`) skip("Needs latin1 locale") local_temp_dir() name <- enc2native("\u00fa\u00e1\u00f6") out <- run(get_tool("px"), c("writefile", "of", name)) expect_equal( charToRaw(name), readBin("of", what = "raw", n = 100) ) out2 <- run(get_tool("pxu"), c("writefile", "of2", name)) expect_equal( iconv(name, to = "UTF-16LE", toRaw = TRUE)[[1]], readBin("of2", what = "raw", n = 100) ) }) # TODO: more UTF-8 output test_that("UTF-8 in stdout", { out <- run(get_tool("px"), c("out", "\u00fa\u00e1\u00f6")) expect_equal(out$stdout, "\u00fa\u00e1\u00f6") }) test_that("UTF-8 in stderr", { out <- run(get_tool("px"), c("err", "\u00fa\u00e1\u00f6")) expect_equal(out$stderr, "\u00fa\u00e1\u00f6") }) processx/tests/testthat/test-pty.R0000644000176200001440000000344713616314040017044 0ustar liggesusers context("pty") test_that("fails in windows", { skip_other_platforms("windows") expect_error(process$new("R", pty = TRUE), "only implemented on Unix", class = "error") }) test_that("pty works", { skip_other_platforms("unix") skip_on_os("solaris") skip_on_cran() p <- process$new("cat", pty = TRUE) on.exit(p$kill(), add = TRUE) expect_true(p$is_alive()) if (!p$is_alive()) stop("process not running") pr <- p$poll_io(0) expect_equal(pr[["output"]], "timeout") p$write_input("foobar\n") pr <- p$poll_io(300) expect_equal(pr[["output"]], "ready") if (pr[["output"]] != "ready") stop("no output") expect_equal(p$read_output(), "foobar\r\n") }) test_that("pty echo", { skip_other_platforms("unix") skip_on_os("solaris") skip_on_cran() p <- process$new("cat", pty = TRUE, pty_options = list(echo = TRUE)) on.exit(p$kill(), add = TRUE) expect_true(p$is_alive()) if (!p$is_alive()) stop("process not running") pr <- p$poll_io(0) expect_equal(pr[["output"]], "timeout") p$write_input("foo") pr <- p$poll_io(300) expect_equal(pr[["output"]], "ready") if (pr[["output"]] != "ready") stop("no output") expect_equal(p$read_output(), "foo") p$write_input("bar\n") pr <- p$poll_io(300) expect_equal(pr[["output"]], "ready") if (pr[["output"]] != "ready") stop("no output") expect_equal(p$read_output(), "bar\r\nfoobar\r\n") }) test_that("read_output_lines() fails for pty", { skip_other_platforms("unix") skip_on_os("solaris") skip_on_cran() p <- process$new("cat", pty = TRUE) p$write_input("foobar\n") expect_error(p$read_output_lines(), "Cannot read lines from a pty") pr <- p$poll_io(300) expect_equal(pr[["output"]], "ready") if (pr[["output"]] != "ready") stop("no output") expect_equal(p$read_output(), "foobar\r\n") }) processx/tests/testthat/test-process.R0000644000176200001440000000316613616314040017704 0ustar liggesusers context("process") test_that("process works", { px <- get_tool("px") p <- process$new(px, c("sleep", "5")) on.exit(try_silently(p$kill(grace = 0)), add = TRUE) expect_true(p$is_alive()) }) test_that("get_exit_status", { px <- get_tool("px") p <- process$new(px, c("return", "1")) on.exit(p$kill(), add = TRUE) p$wait() expect_identical(p$get_exit_status(), 1L) }) test_that("non existing process", { expect_error(process$new(tempfile())) ## This closes connections in finalizers gc() }) test_that("post processing", { px <- get_tool("px") p <- process$new( px, c("return", "0"), post_process = function() "foobar") p$wait(5000) p$kill() expect_equal(p$get_result(), "foobar") p <- process$new( px, c("sleep", "5"), post_process = function() "yep") expect_error(p$get_result(), "alive") p$kill() expect_equal(p$get_result(), "yep") ## Only runs once xx <- 0 p <- process$new( px, c("return", "0"), post_process = function() xx <<- xx + 1) p$wait(5000) p$kill() p$get_result() expect_equal(xx, 1) p$get_result() expect_equal(xx, 1) }) test_that("working directory", { px <- get_tool("px") dir.create(tmp <- tempfile()) on.exit(unlink(tmp, recursive = TRUE), add = TRUE) cat("foo\nbar\n", file = file.path(tmp, "file")) p <- process$new(px, c("cat", "file"), wd = tmp, stdout = "|") on.exit(p$kill(), add = TRUE) p$wait() expect_equal(p$read_all_output_lines(), c("foo", "bar")) }) test_that("working directory does not exist", { px <- get_tool("px") expect_error(process$new(px, wd = tempfile())) ## This closes connections in finalizers gc() }) processx/tests/testthat/test-sigchld.R0000644000176200001440000001471613616604677017670 0ustar liggesusers context("SIGCHLD handler interference") test_that("is_alive()", { skip_other_platforms("unix") skip_on_cran() opts <- callr::r_session_options( env = c(PROCESSX_NOTIFY_OLD_SIGCHLD = "true") ) rs <- callr::r_session$new(opts) on.exit(rs$close(), add = TRUE) res <- rs$run_with_output(function() { library(parallel) library(processx) px <- process$new("sleep", "0.5") on.exit(try(px$kill(), silent = TRUE), add = TRUE) p <- mcparallel(Sys.sleep(1)) q <- mcparallel(Sys.sleep(1)) res <- mccollect(list(p, q)) list(alive = px$is_alive(), status = px$get_exit_status()) }) expect_false(res$result$alive) expect_true(res$result$status %in% c(0L, NA_integer_)) }) test_that("finalizer", { skip_other_platforms("unix") skip_on_cran() opts <- callr::r_session_options( env = c(PROCESSX_NOTIFY_OLD_SIGCHLD = "true") ) rs <- callr::r_session$new(opts) on.exit(rs$close(), add = TRUE) res <- rs$run_with_output(function() { library(parallel) library(processx) px <- process$new("sleep", "0.5") on.exit(try(px$kill(), silent = TRUE), add = TRUE) p <- mcparallel(Sys.sleep(1)) q <- mcparallel(Sys.sleep(1)) res <- mccollect(list(p, q)) tryCatch({ rm(px); gc(); "OK" }, error = function(x) x) }) expect_identical(res$result, "OK") }) test_that("get_exit_status", { skip_other_platforms("unix") skip_on_cran() opts <- callr::r_session_options( env = c(PROCESSX_NOTIFY_OLD_SIGCHLD = "true") ) rs <- callr::r_session$new(opts) on.exit(rs$close(), add = TRUE) res <- rs$run_with_output(function() { library(parallel) library(processx) px <- process$new("sleep", "0.5") on.exit(try(px$kill(), silent = TRUE), add = TRUE) p <- mcparallel(Sys.sleep(1)) q <- mcparallel(Sys.sleep(1)) res <- mccollect(list(p, q)) px$get_exit_status() }) expect_true(res$result %in% c(0L, NA_integer_)) }) test_that("signal", { skip_other_platforms("unix") skip_on_cran() opts <- callr::r_session_options( env = c(PROCESSX_NOTIFY_OLD_SIGCHLD = "true") ) rs <- callr::r_session$new(opts) on.exit(rs$close(), add = TRUE) res <- rs$run_with_output(function() { library(parallel) library(processx) px <- process$new("sleep", "0.5") on.exit(try(px$kill(), silent = TRUE), add = TRUE) p <- mcparallel(Sys.sleep(1)) q <- mcparallel(Sys.sleep(1)) res <- mccollect(list(p, q)) signal <- px$signal(2) # SIGINT status <- px$get_exit_status() list(signal = signal, status = status) }) # TRUE means that that signal was delivered, but it is different on # various Unix flavours. Some will deliver a SIGINT to a zombie, some # will not, so we don't test for this. expect_true(res$result$status %in% c(0L, NA_integer_)) }) test_that("kill", { skip_other_platforms("unix") skip_on_cran() opts <- callr::r_session_options( env = c(PROCESSX_NOTIFY_OLD_SIGCHLD = "true") ) rs <- callr::r_session$new(opts) on.exit(rs$close(), add = TRUE) res <- rs$run_with_output(function() { library(parallel) library(processx) px <- process$new("sleep", "0.5") on.exit(try(px$kill(), silent = TRUE), add = TRUE) p <- mcparallel(Sys.sleep(1)) q <- mcparallel(Sys.sleep(1)) res <- mccollect(list(p, q)) kill <- px$kill() status <- px$get_exit_status() list(kill = kill, status = status) }) # FALSE means that that signal was not delivered expect_false(res$result$kill) expect_true(res$result$status %in% c(0L, NA_integer_)) }) test_that("SIGCHLD handler", { skip_other_platforms("unix") skip_on_cran() opts <- callr::r_session_options( env = c(PROCESSX_NOTIFY_OLD_SIGCHLD = "true") ) rs <- callr::r_session$new(opts) on.exit(rs$close(), add = TRUE) res <- rs$run_with_output(function() { library(parallel) library(processx) px <- process$new("sleep", "0.5") on.exit(try(px$kill(), silent = TRUE), add = TRUE) p <- mcparallel(Sys.sleep(1)) q <- mcparallel(Sys.sleep(1)) res <- mccollect(list(p, q)) out <- tryCatch({ px2 <- process$new("true") px2$wait(1) "OK" }, error = function(e) e) list(out = out, status = px$get_exit_status()) }) expect_identical(res$result$out, "OK") expect_true(res$result$status %in% c(0L, NA_integer_)) }) test_that("Notify old signal handler", { skip_on_cran() skip_other_platforms("unix") code <- substitute({ # Create cluster, check that it works cl <- parallel::makeForkCluster(2) parallel::mclapply(1:2, function(x) x) # Run a parallel background job job <- parallel::mcparallel(Sys.sleep(.5)) # Start processx process, it will overwrite the signal handler processx::run("true") # Wait for parallel job to finish parallel::mccollect(job) }) script <- tempfile(pattern = "processx-test-", fileext = ".R") on.exit(unlink(script), add = TRUE) cat(deparse(code), sep = "\n", file = script) env <- c(callr::rcmd_safe_env(), PROCESSX_NOTIFY_OLD_SIGCHLD = "true") ret <- callr::rscript( script, env = env, fail_on_status = FALSE, show = FALSE, timeout = 5 ) # parallel sends a message to stderr, complaining about unable to # to terminate some child processes. That should not happen any more. expect_equal(ret$status, 0) expect_equal(ret$stderr, "") }) test_that("it is ok if parallel has no active cluster", { skip_on_cran() skip_other_platforms("unix") code <- substitute({ cl <- parallel::makeForkCluster(2) if (getRversion() < "3.5.0") parallel::setDefaultCluster(cl) parallel::mclapply(1:2, function(x) x) job <- parallel::mcparallel(Sys.sleep(.5)) processx::run("true") parallel::mccollect(job) # stop cluster, verify that we don't have subprocesses parallel::stopCluster(cl) print(ps::ps_children(ps::ps_handle())) # try to run sg, this still calls the old sigchld handler for (i in 1:5) processx::run("true") }) script <- tempfile(pattern = "processx-test-", fileext = ".R") on.exit(unlink(script), add = TRUE) cat(deparse(code), sep = "\n", file = script) env <- c(callr::rcmd_safe_env(), PROCESSX_NOTIFY_OLD_SIGCHLD = "true") ret <- callr::rscript( script, env = env, fail_on_status = FALSE, show = FALSE, timeout = 5 ) expect_equal(ret$status, 0) # R < 3.5.0 does not kill the subprocesses propery, it seems if (getRversion() >= "3.5.0") { expect_match(ret$stdout, "list()") } else { expect_true(TRUE) } }) processx/tests/testthat/test-print.R0000644000176200001440000000045413616314040017357 0ustar liggesusers context("print") test_that("print", { px <- get_tool("px") p <- process$new(px, c("sleep", "5")) on.exit(try_silently(p$kill(grace = 0)), add = TRUE) expect_output( print(p), "PROCESS .* running, pid" ) p$kill() expect_output( print(p), "PROCESS .* finished" ) }) processx/tests/testthat/test-connections.R0000644000176200001440000001130514032344540020543 0ustar liggesusers context("Connections") if (!is.null(packageDescription("stats")[["ExperimentalWindowsRuntime"]])) { if (!identical(Sys.getenv("NOT_CRAN"), "true")) return() } test_that("lot of text", { px <- get_tool("px") txt <- strrep("x", 100000) cat(txt, file = tmp <- tempfile()) p <- process$new(px, c("cat", tmp), stdout = "|") on.exit(p$kill(), add = TRUE) out <- p$read_all_output_lines() expect_equal(txt, out) }) test_that("UTF-8", { px <- get_tool("px") txt <- charToRaw(strrep("\xc2\xa0\xe2\x86\x92\xf0\x90\x84\x82", 20000)) writeBin(txt, con = tmp <- tempfile()) p <- process$new(px, c("cat", tmp), stdout = "|", encoding = "UTF-8") on.exit(p$kill(), add = TRUE) out <- p$read_all_output_lines() expect_equal(txt, charToRaw(out)) }) test_that("UTF-8 multibyte character cut in half", { px <- get_tool("px") rtxt <- charToRaw("a\xc2\xa0a") writeBin(rtxt[1:2], tmp1 <- tempfile()) writeBin(rtxt[3:4], tmp2 <- tempfile()) p1 <- process$new(px, c("cat", tmp1, "cat", tmp2), stdout = "|", encoding = "UTF-8") on.exit(p1$kill(), add = TRUE) out <- p1$read_all_output_lines() expect_equal(rtxt, charToRaw(out)) cmd <- paste("(cat", shQuote(tmp1), ";sleep 1;cat", shQuote(tmp2), ")") p2 <- process$new(px, c("cat", tmp1, "sleep", "1", "cat", tmp2), stdout = "|", stderr = "|", encoding = "UTF-8") on.exit(p2$kill(), add = TRUE) out <- p2$read_all_output_lines() expect_equal(rtxt, charToRaw(out)) }) test_that("UTF-8 multibyte character cut in half at the end of the file", { px <- get_tool("px") rtxt <- charToRaw("a\xc2\xa0a") writeBin(c(rtxt, rtxt[1:2]), tmp1 <- tempfile()) p <- process$new(px, c("cat", tmp1), stdout = "|", encoding = "UTF-8") on.exit(p$kill(), add = TRUE) expect_warning( out <- p$read_all_output_lines(), "Invalid multi-byte character at end of stream ignored" ) expect_equal(charToRaw(out), c(rtxt, rtxt[1])) }) test_that("Invalid UTF-8 characters in the middle of the string", { px <- get_tool("px") half <- charToRaw("\xc2\xa0")[1] rtxt <- sample(rep(c(half, charToRaw("a")), 100)) writeBin(rtxt, tmp1 <- tempfile()) p <- process$new(px, c("cat", tmp1), stdout = "|", encoding = "UTF-8") on.exit(p$kill(), add = TRUE) suppressWarnings(out <- p$read_all_output_lines()) expect_equal(out, strrep("a", 100)) }) test_that("Convert from another encoding to UTF-8", { px <- get_tool("px") latin1 <- "\xe1\xe9\xed"; writeBin(charToRaw(latin1), tmp1 <- tempfile()) p <- process$new(px, c("cat", tmp1), stdout = "|", encoding = "latin1") on.exit(p$kill(), add = TRUE) suppressWarnings(out <- p$read_all_output_lines()) expect_equal(charToRaw(out), charToRaw("\xc3\xa1\xc3\xa9\xc3\xad")) }) test_that("Passing connection to stdout", { # file first tmp <- tempfile() con <- conn_create_file(tmp, write = TRUE) cmd <- c(get_tool("px"), c("outln", "hello", "outln", "world")) p <- process$new(cmd[1], cmd[-1], stdout = con) on.exit(p$kill(), add = TRUE) close(con) p$wait(3000) expect_false(p$is_alive()) out <- readLines(tmp) expect_equal(out, c("hello", "world")) # pass a pipe to write to pipe <- conn_create_pipepair() on.exit(close(pipe[[1]]), add = TRUE) on.exit(close(pipe[[2]]), add = TRUE) p2 <- process$new(cmd[1], cmd[-1], stdout = pipe[[2]]) on.exit(p2$kill(), add = TRUE) close(pipe[[2]]) ready <- poll(list(pipe[[1]]), 3000) expect_equal(ready[[1]], "ready") lines <- conn_read_lines(pipe[[1]]) expect_equal(lines[1], "hello") ready <- poll(list(pipe[[1]]), 3000) expect_equal(ready[[1]], "ready") lines <- c(lines, conn_read_lines(pipe[[1]])) expect_equal(lines, c("hello", "world")) p2$wait(3000) expect_false(p2$is_alive()) }) test_that("Passing connection to stderr", { # file first tmp <- tempfile() con <- conn_create_file(tmp, write = TRUE) cmd <- c(get_tool("px"), c("errln", "hello", "errln", "world")) p <- process$new(cmd[1], cmd[-1], stderr = con) on.exit(p$kill(), add = TRUE) close(con) p$wait(3000) expect_false(p$is_alive()) err <- readLines(tmp) expect_equal(err, c("hello", "world")) # pass a pipe to write to pipe <- conn_create_pipepair() on.exit(close(pipe[[1]]), add = TRUE) on.exit(close(pipe[[2]]), add = TRUE) p2 <- process$new(cmd[1], cmd[-1], stderr = pipe[[2]]) on.exit(p2$kill(), add = TRUE) close(pipe[[2]]) ready <- poll(list(pipe[[1]]), 3000) expect_equal(ready[[1]], "ready") lines <- conn_read_lines(pipe[[1]]) expect_equal(lines[1], "hello") ready <- poll(list(pipe[[1]]), 3000) expect_equal(ready[[1]], "ready") lines <- c(lines, conn_read_lines(pipe[[1]])) expect_equal(lines, c("hello", "world")) p2$wait(3000) expect_false(p2$is_alive()) }) processx/tests/testthat/test-env.R0000644000176200001440000000222714025704163017017 0ustar liggesusers context("environment") test_that("inherit by default", { v <- basename(tempfile()) if (os_type() == "unix") { cmd <- c("bash", "-c", paste0("echo $", v)) } else { cmd <- c("cmd", "/c", paste0("echo %", v, "%")) } skip_if_no_tool(cmd[1]) out <- run(cmd[1], cmd[-1]) expect_true(out$stdout %in% c("\n", paste0("%", v, "%\r\n"))) gc() }) test_that("specify custom env", { v <- c(basename(tempfile()), basename(tempfile())) if (os_type() == "unix") { cmd <- c("bash", "-c", paste0("echo ", paste0("$", v, collapse = " "))) } else { cmd <- c("cmd", "/c", paste0("echo ", paste0("%", v, "%", collapse = " "))) } skip_if_no_tool(cmd[1]) out <- run(cmd[1], cmd[-1], env = structure(c("bar", "baz"), names = v)) expect_true(out$stdout %in% paste0("bar baz", c("\n", "\r\n"))) gc() }) test_that("append to env", { withr::local_envvar(FOO = "fooe", BAR = "bare") px <- get_tool("px") out <- run( px, c("getenv", "FOO", "getenv", "BAR", "getenv", "BAZ"), env = c("current", BAZ = "baze", BAR = "bare2") ) outenv <- strsplit(out$stdout, "\r?\n")[[1]] expect_equal(outenv, c("fooe", "bare2", "baze")) }) processx/tests/testthat/test-poll3.R0000644000176200001440000000334613616314040017257 0ustar liggesusers context("poll connection") test_that("poll connection", { px <- get_tool("px") p <- process$new(px, c("sleep", ".5", "outln", "foobar")) on.exit(p$kill()) ## Timeout expect_equal(p$poll_io(0), c(output = "nopipe", error = "nopipe", process = "timeout")) p$wait() expect_equal(p$poll_io(-1), c(output = "nopipe", error = "nopipe", process = "ready")) p$kill(close_connections = FALSE) expect_equal(p$poll_io(-1), c(output = "nopipe", error = "nopipe", process = "ready")) close(p$get_poll_connection()) expect_equal(p$poll_io(-1), c(output = "nopipe", error = "nopipe", process = "closed")) }) test_that("poll connection + stdout", { px <- get_tool("px") p1 <- process$new(px, c("outln", "foobar"), stdout = "|") on.exit(p1$kill(), add = TRUE) expect_false(p1$has_poll_connection()) p2 <- process$new(px, c("sleep", "0.5", "outln", "foobar"), stdout = "|", poll_connection = TRUE) on.exit(p2$kill(), add = TRUE) expect_equal(p2$poll_io(0), c(output = "timeout", error = "nopipe", process = "timeout")) pr <- p2$poll_io(-1) expect_true("ready" %in% pr) }) test_that("poll connection + stderr", { px <- get_tool("px") p1 <- process$new(px, c("errln", "foobar"), stderr = "|") on.exit(p1$kill(), add = TRUE) expect_false(p1$has_poll_connection()) p2 <- process$new(px, c("sleep", "0.5", "errln", "foobar"), stderr = "|", poll_connection = TRUE) on.exit(p2$kill(), add = TRUE) expect_equal(p2$poll_io(0), c(output = "nopipe", error = "timeout", process = "timeout")) }) processx/tests/testthat/test-ps-methods.R0000644000176200001440000000214213700156402020302 0ustar liggesusers context("ps methods") test_that("ps methods", { skip_if_no_ps() px <- get_tool("px") p <- process$new(px, c("sleep", "100")) on.exit(p$kill(), add = TRUE) ps <- p$as_ps_handle() expect_s3_class(ps, "ps_handle") expect_true(ps::ps_name(ps) %in% c("px", "px.exe")) expect_equal(p$get_name(), ps::ps_name(ps)) expect_equal(p$get_exe(), ps::ps_exe(ps)) expect_equal(p$get_cmdline(), ps::ps_cmdline(ps)) expect_equal(p$get_status(), ps::ps_status(ps)) expect_equal(p$get_username(), ps::ps_username(ps)) expect_equal(p$get_wd(), ps::ps_cwd(ps)) expect_equal(names(p$get_cpu_times()), names(ps::ps_cpu_times(ps))) expect_equal(names(p$get_memory_info()), names(ps::ps_memory_info(ps))) p$suspend() deadline <- Sys.time() + 3 while (p$get_status() != "stopped" && Sys.time() < deadline) Sys.sleep(0.05) expect_true(Sys.time() < deadline) expect_equal(p$get_status(), "stopped") p$resume() deadline <- Sys.time() + 3 while (p$get_status() == "stopped" && Sys.time() < deadline) Sys.sleep(0.05) expect_true(Sys.time() < deadline) expect_true(p$get_status() != "stopped") }) processx/tests/testthat/test-poll.R0000644000176200001440000000543613616314040017176 0ustar liggesusers context("poll") test_that("polling for output available", { px <- get_tool("px") p <- process$new(px, c("sleep", "1", "outln", "foobar"), stdout = "|") ## Timeout expect_equal(p$poll_io(0), c(output = "timeout", error = "nopipe", process = "nopipe")) p$wait() expect_equal(p$poll_io(-1), c(output = "ready", error = "nopipe", process = "nopipe")) p$read_output_lines() expect_equal(p$poll_io(-1), c(output = "ready", error = "nopipe", process = "nopipe")) p$kill(close_connections = FALSE) expect_equal(p$poll_io(-1), c(output = "ready", error = "nopipe", process = "nopipe")) close(p$get_output_connection()) expect_equal(p$poll_io(-1), c(output = "closed", error = "nopipe", process = "nopipe")) }) test_that("polling for stderr", { px <- get_tool("px") p <- process$new(px, c("sleep", "1", "errln", "foobar"), stderr = "|") ## Timeout expect_equal(p$poll_io(0), c(output = "nopipe", error = "timeout", process = "nopipe")) p$wait() expect_equal(p$poll_io(-1), c(output = "nopipe", error = "ready", process = "nopipe")) p$read_error_lines() expect_equal(p$poll_io(-1), c(output = "nopipe", error = "ready", process = "nopipe")) p$kill(close_connections = FALSE) expect_equal(p$poll_io(-1), c(output = "nopipe", error = "ready", process = "nopipe")) close(p$get_error_connection()) expect_equal(p$poll_io(-1), c(output = "nopipe", error = "closed", process = "nopipe")) }) test_that("polling for both stdout and stderr", { px <- get_tool("px") p <- process$new(px, c("sleep", "1", "errln", "foo", "outln", "bar"), stdout = "|", stderr = "|") ## Timeout expect_equal(p$poll_io(0), c(output = "timeout", error = "timeout", process = "nopipe")) p$wait() expect_true("ready" %in% p$poll_io(-1)) p$read_error_lines() expect_true("ready" %in% p$poll_io(-1)) p$kill(close_connections = FALSE) expect_true("ready" %in% p$poll_io(-1)) close(p$get_output_connection()) close(p$get_error_connection()) expect_equal(p$poll_io(-1), c(output = "closed", error = "closed", process = "nopipe")) }) test_that("multiple polls", { px <- get_tool("px") p <- process$new( px, c("sleep", "1", "outln", "foo", "sleep", "1", "outln", "bar"), stdout = "|", stderr = "|") on.exit(p$kill(), add = TRUE) out <- character() while (p$is_alive()) { p$poll_io(2000) out <- c(out, p$read_output_lines()) } expect_identical(out, c("foo", "bar")) }) processx/tests/testthat/test-poll-stress.R0000644000176200001440000000205713616314040020513 0ustar liggesusers context("poll stress test") test_that("many processes", { skip_on_cran() ## Create many processes num <- 100 px <- get_tool("px") on.exit(try(lapply(pp, function(x) x$kill()), silent = TRUE), add = TRUE) pp <- lapply(1:num, function(i) { cmd <- c("sleep", "1", "outln", paste("out", i), "errln", paste("err", i)) process$new(px, cmd, stdout = "|", stderr = "|") }) ## poll them results <- replicate(num, list(character(), character()), simplify = FALSE) while (TRUE) { pr <- poll(pp, -1) lapply(seq_along(pp), function(i) { if (pr[[i]]["output"] == "ready") { results[[i]][[1]] <<- c(results[[i]][[1]], pp[[i]]$read_output_lines()) } if (pr[[i]]["error"] == "ready") { results[[i]][[2]] <<- c(results[[i]][[2]], pp[[i]]$read_error_lines()) } }) inc <- sapply(pp, function(x) x$is_incomplete_output() || x$is_incomplete_error()) if (!any(inc)) break } exp <- lapply(1:num, function(i) list(paste("out", i), paste("err", i))) expect_identical(exp, results) }) processx/tests/testthat/test-poll2.R0000644000176200001440000001216313616314040017253 0ustar liggesusers context("poll multiple processes") test_that("single process", { px <- get_tool("px") p <- process$new(px, c("sleep", "1", "outln", "foo", "outln", "bar"), stdout = "|") on.exit(p$kill(), add = TRUE) ## Timeout expect_equal( poll(list(p), 0), list(c(output = "timeout", error = "nopipe", process = "nopipe")) ) p$wait() expect_equal( poll(list(p), -1), list(c(output = "ready", error = "nopipe", process = "nopipe")) ) p$read_output_lines() expect_equal( poll(list(p), -1), list(c(output = "ready", error = "nopipe", process = "nopipe")) ) p$kill(close_connections = FALSE) expect_equal( poll(list(p), -1), list(c(output = "ready", error = "nopipe", process = "nopipe")) ) close(p$get_output_connection()) expect_equal( poll(list(p), -1), list(c(output = "closed", error = "nopipe", process = "nopipe")) ) }) test_that("multiple processes", { px <- get_tool("px") cmd1 <- c("sleep", "1", "outln", "foo", "outln", "bar") cmd2 <- c("sleep", "2", "errln", "foo", "errln", "bar") p1 <- process$new(px, cmd1, stdout = "|") p2 <- process$new(px, cmd2, stderr = "|") ## Timeout res <- poll(list(p1 = p1, p2 = p2), 0) expect_equal( res, list( p1 = c(output = "timeout", error = "nopipe", process = "nopipe"), p2 = c(output = "nopipe", error = "timeout", process = "nopipe") ) ) p1$wait() res <- poll(list(p1 = p1, p2 = p2), -1) expect_equal(res$p1, c(output = "ready", error = "nopipe", process = "nopipe")) expect_equal(res$p2[["output"]], "nopipe") expect_true(res$p2[["error"]] %in% c("silent", "ready")) close(p1$get_output_connection()) p2$wait() res <- poll(list(p1 = p1, p2 = p2), -1) expect_equal( res, list( p1 = c(output = "closed", error = "nopipe", process = "nopipe"), p2 = c(output = "nopipe", error = "ready", process = "nopipe") ) ) close(p2$get_error_connection()) res <- poll(list(p1 = p1, p2 = p2), 0) expect_equal( res, list( p1 = c(output = "closed", error = "nopipe", process = "nopipe"), p2 = c(output = "nopipe", error = "closed", process = "nopipe") ) ) }) test_that("multiple polls", { px <- get_tool("px") cmd <- c("sleep", "1", "outln", "foo", "sleep", "1", "outln", "bar") p <- process$new(px, cmd, stdout = "|", stderr = "|") on.exit(p$kill(), add = TRUE) out <- character() while (p$is_alive()) { poll(list(p), 2000) out <- c(out, p$read_output_lines()) } expect_identical(out, c("foo", "bar")) }) test_that("polling and buffering", { skip_on_os("windows") px <- get_tool("px") for (i in 1:10) { ## We set up two processes, one produces a output, that we do not ## read out from the cache. The other one does not produce output. p1 <- process$new(px, c(rbind("outln", 1:20), "sleep", "3"), stdout = "|", stderr = "|") p2 <- process$new(px, c("sleep", "3"), stdout = "|", stderr = "|") ## We poll until p1 has output. We read out some of the output, ## and leave the rest in the buffer. tick <- Sys.time() p1$poll_io(-1) expect_true(Sys.time() - tick < as.difftime(1, units = "secs")) expect_equal(p1$read_output_lines(n = 1), "1") ## Now poll should return immediately, because there is output ready ## from p1. The status of p2 should be 'silent' (and not 'timeout') tick <- Sys.time() s <- poll(list(p1, p2), 3000) dt <- Sys.time() - tick expect_true(dt < as.difftime(2, units = "secs")) expect_equal( s, list( c(output = "ready", error = "silent", process = "nopipe"), c(output = "silent", error = "silent", process = "nopipe") ) ) p1$kill() p2$kill() if (s[[2]][1] != "silent") break; } }) test_that("polling and buffering #2", { px <- get_tool("px") ## We run this a bunch of times, because it used to fail ## non-deterministically on the CI for (i in 1:10) { ## Two processes, they both produce output. For the first process, ## we make sure that there is something in the buffer. ## For the second process we need to poll, but data should be ## available immediately. p1 <- process$new(px, rbind("outln", 1:20), stdout = "|") p2 <- process$new(px, rbind("outln", 21:30), stdout = "|") ## We poll until p1 has output. We read out some of the output, ## and leave the rest in the buffer. p1$poll_io(-1) expect_equal(p1$read_output_lines(n = 1), "1") ## We also need to poll p2, to make sure that there is ## output from it. But we don't read anything from it. expect_equal(p1$poll_io(-1)[["output"]], "ready") expect_equal(p2$poll_io(-1)[["output"]], "ready") ## Now poll should return ready for both processes, and it should ## return fast. tick <- Sys.time() s <- poll(list(p1, p2), 3000) expect_equal( s, list( c(output = "ready", error = "nopipe", process = "nopipe"), c(output = "ready", error = "nopipe", process = "nopipe") ) ) p1$kill() p2$kill() ## Check that poll has returned immediately expect_true(Sys.time() - tick < as.difftime(2, units = "secs")) } }) processx/tests/testthat/test-client-lib.R0000644000176200001440000000745214025102241020243 0ustar liggesusers context("client-lib") test_that("client lib is standalone", { lib <- load_client_lib(client) on.exit(try(lib$.finalize()), add = TRUE) objs <- ls(lib, all.names = TRUE) funs <- Filter(function(x) is.function(lib[[x]]), objs) funobjs <- mget(funs, lib) for (f in funobjs) expect_identical(environmentName(topenv(f)), "base") expect_message( mapply(codetools::checkUsage, funobjs, funs, MoreArgs = list(report = message)), NA) }) test_that("base64", { lib <- load_client_lib(client) on.exit(try(lib$.finalize()), add = TRUE) expect_equal(lib$base64_encode(charToRaw("foobar")), "Zm9vYmFy") expect_equal(lib$base64_encode(charToRaw(" ")), "IA==") expect_equal(lib$base64_encode(charToRaw("")), "") x <- charToRaw(paste(sample(letters, 10000, replace = TRUE), collapse = "")) expect_equal(lib$base64_decode(lib$base64_encode(x)), x) for (i in 5:32) { mtcars2 <- unserialize(lib$base64_decode(lib$base64_encode( serialize(mtcars[1:i, ], NULL)))) expect_identical(mtcars[1:i,], mtcars2) } }) test_that("disable_inheritance", { ## TODO expect_true(TRUE) }) test_that("write_fd", { lib <- load_client_lib(client) on.exit(try(lib$.finalize()), add = TRUE) tmp <- tempfile(fileext = ".rds") on.exit(unlink(tmp), add = TRUE) conn <- conn_create_file(tmp, read = FALSE, write = TRUE) fd <- conn_get_fileno(conn) obj <- runif(100000) data <- serialize(obj, connection = NULL) lib$write_fd(fd, data) close(conn) expect_identical(readRDS(tmp), obj) }) test_that("processx_connection_set_stdout", { stdout_to_file <- function(filename) { lib <- asNamespace("processx")$load_client_lib(processx:::client) lib$set_stdout_file(filename) cat("output\n") message("error") 42 } tmp <- tempfile() on.exit(unlink(tmp), add = TRUE) opt <- callr::r_process_options( func = stdout_to_file, args = list(filename = tmp)) on.exit(p$kill(), add = TRUE) p <- callr::r_process$new(opt) p$wait(5000) expect_false(p$kill(close_connections = FALSE)) expect_equal(p$get_result(), 42) expect_equal(p$read_all_error_lines(), "error") expect_equal(p$read_all_output_lines(), character()) expect_equal(readLines(tmp), "output") p$kill() }) test_that("processx_connection_set_stdout", { stderr_to_file <- function(filename) { lib <- asNamespace("processx")$load_client_lib(processx:::client) lib$set_stderr_file(filename) cat("output\n") message("error") 42 } tmp <- tempfile() on.exit(unlink(tmp), add = TRUE) opt <- callr::r_process_options( func = stderr_to_file, args = list(filename = tmp)) on.exit(p$kill(), add = TRUE) p <- callr::r_process$new(opt) p$wait(5000) expect_false(p$kill(close_connections = FALSE)) expect_equal(p$get_result(), 42) expect_equal(p$read_all_output_lines(), "output") expect_equal(p$read_all_error_lines(), character()) expect_equal(readLines(tmp), "error") p$kill() }) test_that("setting stdout multiple times", { stdout_to_file <- function(file1, file2) { lib <- asNamespace("processx")$load_client_lib(processx:::client) lib$set_stdout_file(file1) cat("output\n") message("error") lib$set_stdout_file(file2) cat("output2\n") message("error2") 42 } tmp1 <- tempfile() tmp2 <- tempfile() on.exit(unlink(c(tmp1, tmp2)), add = TRUE) opt <- callr::r_process_options( func = stdout_to_file, args = list(file1 = tmp1, file2 = tmp2)) on.exit(p$kill(), add = TRUE) p <- callr::r_process$new(opt) p$wait(5000) expect_false(p$kill(close_connections = FALSE)) expect_equal(p$get_result(), 42) expect_equal(p$read_all_error_lines(), c("error", "error2")) expect_equal(p$read_all_output_lines(), character()) expect_equal(readLines(tmp1), "output") expect_equal(readLines(tmp2), "output2") p$kill() }) processx/tests/testthat/test-wait.R0000644000176200001440000000375413617233735017211 0ustar liggesusers context("waiting on processes") test_that("no deadlock when no stdout + wait", { skip("failure would freeze") p <- process$new("seq", c("1", "100000")) p$wait() }) test_that("wait with timeout", { px <- get_tool("px") p <- process$new(px, c("sleep", "3")) expect_true(p$is_alive()) t1 <- proc.time() p$wait(timeout = 100) t2 <- proc.time() expect_true(p$is_alive()) expect_true((t2 - t1)["elapsed"] > 50/1000) expect_true((t2 - t1)["elapsed"] < 3000/1000) p$kill() expect_false(p$is_alive()) }) test_that("wait after process already exited", { px <- get_tool("px") pxs <- replicate(20, process$new(px, c("outln", "foo", "outln", "bar"))) rm(pxs) p <- process$new( px, c("outln", "foo", "outln", "bar", "outln", "foobar")) on.exit(p$kill(), add = TRUE) ## Make sure it is done p$wait() ## Now wait() should return immediately, regardless of timeout expect_true(system.time(p$wait())[["elapsed"]] < 1) expect_true(system.time(p$wait(3000))[["elapsed"]] < 1) }) test_that("no fd leak on unix", { skip_on_cran() skip_on_os("solaris") if (is_windows()) return(expect_true(TRUE)) # We run this test in a subprocess, so we can send an interrupt to it # We start a subprocess (within the subprocess) and wait on it. # Then the main process, after waiting a second so that everything is # set up in the subprocess, sends an interrupt. The suprocess catches # this interrupts and copies everything back to the main process. rs <- callr::r_session$new() on.exit(rs$close(), add = TRUE) rs$call(function() { fd1 <- ps::ps_num_fds(ps::ps_handle()) p <- processx::process$new("sleep", "3", poll_connection = FALSE) err <- tryCatch(ret <- p$wait(), interrupt = function(e) e) fd2 <- ps::ps_num_fds(ps::ps_handle()) list(fd1 = fd1, fd2 = fd2, err = err) }) Sys.sleep(1) rs$interrupt() rs$poll_io(1000) res <- rs$read() expect_equal(res$result$fd1, res$result$fd2) expect_s3_class(res$result$err, "interrupt") }) processx/tests/testthat/helper.R0000644000176200001440000000545414043033410016524 0ustar liggesusers skip_other_platforms <- function(platform) { if (os_type() != platform) skip(paste("only run it on", platform)) } skip_if_no_tool <- function(tool) { if (Sys.which(tool) == "") skip(paste0("`", tool, "` is not available")) } skip_extra_tests <- function() { if (Sys.getenv("PROCESSX_EXTRA_TESTS") == "") skip("no extra tests") } skip_if_no_ps <- function() { if (!requireNamespace("ps", quietly = TRUE)) skip("ps package needed") if (!ps::ps_is_supported()) skip("ps does not support this platform") } try_silently <- function(expr) { tryCatch( expr, error = function(x) "error", warning = function(x) "warning", message = function(x) "message" ) } get_pid_by_name <- function(name) { if (os_type() == "windows") { get_pid_by_name_windows(name) } else if (is_linux()) { get_pid_by_name_linux(name) } else { get_pid_by_name_unix(name) } } get_pid_by_name_windows <- function(name) { ## TODO } ## Linux does not exclude the ancestors of the pgrep process ## from the list, so we have to do that manually. We remove every ## process that contains 'pgrep' in its command line, which is ## not the proper solution, but for testing it will do. ## ## Unfortunately Ubuntu 12.04 pgrep does not have a -a switch, ## so we cannot just output the full command line and then filter ## it in R. So we first run pgrep to get all matching process ids ## (without their command lines), and then use ps to list the processes ## again. At this time the first pgrep process is not running any ## more, but another process might have its id, so we filter again the ## result for 'name' get_pid_by_name_linux <- function(name) { ## TODO } skip_in_covr <- function() { if (Sys.getenv("R_COVR", "") == "true") skip("in covr") } httpbin <- local({ cache <- NULL function(url = "") { if (is.null(cache)) cache <<- curl::nslookup("eu.httpbin.org") paste0("http://", cache, url) } }) interrupt_me <- function(expr, after = 1) { tryCatch({ p <- callr::r_bg(function(pid, after) { Sys.sleep(after) ps::ps_interrupt(ps::ps_handle(pid)) }, list(pid = Sys.getpid(), after = after)) expr p$kill() }, interrupt = function(e) e) } expect_error <- function(..., class = "error") { testthat::expect_error(..., class = class) } local_temp_dir <- function(pattern = "file", tmpdir = tempdir(), fileext = "", envir = parent.frame()) { path <- tempfile(pattern = pattern, tmpdir = tmpdir, fileext = fileext) dir.create(path) withr::local_dir(path, .local_envir = envir) withr::defer(unlink(path, recursive = TRUE), envir = envir) invisible(path) } has_locale <- function(l) { has <- TRUE tryCatch( withr::with_locale(c(LC_CTYPE = l), "foobar"), warning = function(w) has <<- FALSE, error = function(e) has <<- FALSE ) has } processx/tests/testthat/test-errors.R0000644000176200001440000000366513616314454017557 0ustar liggesusers context("errors") test_that("run() prints stderr if echo = FALSE", { px <- get_tool("px") err <- tryCatch( run(px, c("outln", "nopppp", "errln", "bad", "errln", "foobar", "return", "2")), error = function(e) e) expect_true(any(grepl("foobar", format(err)))) expect_false(any(grepl("nopppp", conditionMessage(err)))) }) test_that("run() omits stderr if echo = TRUE", { px <- get_tool("px") err <- tryCatch( capture.output( run(px, c("errln", "bad", "errln", "foobar", "return", "2"), echo = TRUE)), error = function(e) e) expect_false(any(grepl("foobar", conditionMessage(err)))) }) test_that("run() handles stderr_to_stdout = TRUE properly", { px <- get_tool("px") err <- tryCatch( run(px, c("outln", "nopppp", "errln", "bad", "errln", "foobar", "return", "2"), stderr_to_stdout = TRUE), error = function(e) e) expect_true(any(grepl("foobar", format(err)))) expect_true(any(grepl("nopppp", format(err)))) }) test_that("run() only prints the last 10 lines of stderr", { px <- get_tool("px") args <- rbind("errln", paste0("foobar", 1:11, "--")) withr::with_options( list(rlib_interactive = TRUE), ferr <- format(tryCatch( run(px, c(args, "return", "2")), error = function(e) e)) ) expect_false(any(grepl("foobar1--", ferr))) expect_true(any(grepl("foobar2--", ferr))) expect_true(any(grepl("foobar11--", ferr))) }) test_that("prints full stderr in non-interactive mode", { script <- tempfile(fileext = ".R") on.exit(unlink(script, recursive = TRUE), add = TRUE) code <- quote({ px <- asNamespace("processx")$get_tool("px") args <- rbind("errln", paste0("foobar", 1:20, "--")) processx::run(px, c(args, "return", "2")) }) cat(deparse(code), file = script, sep = "\n") out <- callr::rscript(script, fail_on_status = FALSE, show = FALSE) expect_match(out$stderr, "foobar1--") expect_match(out$stderr, "foobar20--") }) processx/tests/testthat/test-stdin.R0000644000176200001440000000504213616314040017342 0ustar liggesusers context("stdin") test_that("stdin", { skip_on_cran() skip_if_no_tool("cat") tmp <- tempfile() on.exit(unlink(tmp), add = TRUE) p <- process$new("cat", stdin = "|", stdout = tmp, stderr = "|") expect_true(p$is_alive()) p$write_input("foo\n") p$write_input("bar\n") expect_true(p$is_alive()) close(p$get_input_connection()) p$wait(5000) expect_false(p$is_alive()) p$kill() expect_equal(readLines(tmp), c("foo", "bar")) }) test_that("stdin & stdout", { skip_on_cran() skip_if_no_tool("cat") p <- process$new("cat", stdin = "|", stdout = "|") expect_true(p$is_alive()) p$write_input("foo\n") p$poll_io(1000) expect_equal(p$read_output_lines(), "foo") p$write_input("bar\n") p$poll_io(1000) expect_equal(p$read_output_lines(), "bar") close(p$get_input_connection()) p$wait(10) expect_false(p$is_alive()) p$kill() }) test_that("stdin buffer full", { skip_on_cran() skip_other_platforms("unix") px <- get_tool("px") p <- process$new(px, c("sleep", 100), stdin = "|") on.exit(p$kill(), add = TRUE) for (i in 1:100000) { ret <- p$write_input("foobar") if (length(ret) > 0) break } expect_true(length(ret) > 0) }) test_that("file as stdin", { skip_on_cran() skip_if_no_tool("cat") tmp <- tempfile() tmp2 <- tempfile() on.exit(unlink(c(tmp, tmp2), recursive = TRUE), add = TRUE) txt <- strrep(paste(sample(letters, 10), collapse = ""), 100) cat(txt, file = tmp) p <- process$new("cat", stdin = tmp, stdout = tmp2) on.exit(p$kill(), add = TRUE) p$wait() expect_true(file.exists(tmp2)) expect_equal(readChar(tmp2, nchar(txt)), txt) }) test_that("large file as stdin", { skip_on_cran() skip_if_no_tool("cat") tmp <- tempfile() tmp2 <- tempfile() on.exit(unlink(c(tmp, tmp2), recursive = TRUE), add = TRUE) txt <- strrep(paste(sample(letters, 10), collapse = ""), 10000) cat(txt, file = tmp) p <- process$new("cat", stdin = tmp, stdout = tmp2) on.exit(p$kill(), add = TRUE) p$wait() expect_true(file.exists(tmp2)) expect_equal(file.info(tmp2)$size, nchar(txt)) }) test_that("writing raw", { skip_on_cran() skip_if_no_tool("cat") tmp <- tempfile() on.exit(unlink(tmp), add = TRUE) p <- process$new("cat", stdin = "|", stdout = tmp, stderr = "|") expect_true(p$is_alive()) foo <- charToRaw("foo\n") bar <- charToRaw("bar\n") p$write_input(foo) p$write_input(bar) expect_true(p$is_alive()) close(p$get_input_connection()) p$wait(5000) expect_false(p$is_alive()) p$kill() expect_equal(readLines(tmp), c("foo", "bar")) }) processx/tests/testthat/test-io.R0000644000176200001440000001163313616314040016633 0ustar liggesusers context("io") test_that("Output and error are discarded by default", { px <- get_tool("px") p <- process$new(px, c("outln", "foobar")) on.exit(try_silently(p$kill(grace = 0)), add = TRUE) expect_error(p$read_output_lines(n=1), "not a pipe") expect_error(p$read_all_output_lines(), "not a pipe") expect_error(p$read_all_output(), "not a pipe") expect_error(p$read_error_lines(n=1), "not a pipe") expect_error(p$read_all_error_lines(), "not a pipe") expect_error(p$read_all_error(), "not a pipe") }) test_that("We can get the output", { px <- get_tool("px") p <- process$new(px, c("out", "foo\nbar\nfoobar\n"), stdout = "|", stderr = "|") on.exit(try_silently(p$kill(grace = 0)), add = TRUE) out <- p$read_all_output_lines() expect_identical(out, c("foo", "bar", "foobar")) }) test_that("We can get the error stream", { tmp <- tempfile(fileext = ".bat") on.exit(unlink(tmp), add = TRUE) cat(">&2 echo hello", ">&2 echo world", sep = "\n", file = tmp) Sys.chmod(tmp, "700") p <- process$new(tmp, stderr = "|") on.exit(try_silently(p$kill(grace = 0)), add = TRUE) out <- sort(p$read_all_error_lines()) expect_identical(out, c("hello", "world")) }) test_that("Output & error at the same time", { tmp <- tempfile(fileext = ".bat") on.exit(unlink(tmp), add = TRUE) cat( if (os_type() == "windows") "@echo off", ">&2 echo hello", "echo wow", ">&2 echo world", "echo wooow", sep = "\n", file = tmp ) Sys.chmod(tmp, "700") p <- process$new(tmp, stdout = "|", stderr = "|") on.exit(try_silently(p$kill(grace = 0)), add = TRUE) out <- p$read_all_output_lines() expect_identical(out, c("wow", "wooow")) err <- p$read_all_error_lines() expect_identical(err, c("hello", "world")) }) test_that("Output and error to specific files", { tmp <- tempfile(fileext = ".bat") on.exit(unlink(tmp), add = TRUE) cat( if (os_type() == "windows") "@echo off", ">&2 echo hello", "echo wow", ">&2 echo world", "echo wooow", sep = "\n", file = tmp ) Sys.chmod(tmp, "700") tmpout <- tempfile() tmperr <- tempfile() p <- process$new(tmp, stdout = tmpout, stderr = tmperr) on.exit(try_silently(p$kill(grace = 0)), add = TRUE) p$wait() ## In theory this is a race condition, because the OS might be still ## writing the files. But it is hard to wait until they are done. ## We'll see if this fails in practice, hopefully not. expect_identical(readLines(tmpout), c("wow", "wooow")) expect_identical(readLines(tmperr), c("hello", "world")) }) test_that("is_incomplete", { px <- get_tool("px") p <- process$new(px, c("out", "foo\nbar\nfoobar\n"), stdout = "|") on.exit(p$kill(), add = TRUE) expect_true(p$is_incomplete_output()) p$read_output_lines(n = 1) expect_true(p$is_incomplete_output()) p$read_all_output_lines() expect_false(p$is_incomplete_output()) }) test_that("readChar on IO, unix", { ## Need to skip, because of the different EOL character skip_other_platforms("unix") px <- get_tool("px") p <- process$new(px, c("outln", "hello world!"), stdout = "|") on.exit(p$kill(), add = TRUE) p$wait() p$poll_io(-1) expect_equal(p$read_output(5), "hello") expect_equal(p$read_output(5), " worl") expect_equal(p$read_output(5), "d!\n") }) test_that("readChar on IO, windows", { ## Need to skip, because of the different EOL character skip_other_platforms("windows") px <- get_tool("px") p <- process$new(px, c("outln", "hello world!"), stdout = "|") on.exit(p$kill(), add = TRUE) p$wait() p$poll_io(-1) expect_equal(p$read_output(5), "hello") p$poll_io(-1) expect_equal(p$read_output(5), " worl") p$poll_io(-1) expect_equal(p$read_output(5), "d!\r\n") }) test_that("same pipe", { px <- get_tool("px") cmd <- c("out", "o1", "err", "e1", "out", "o2", "err", "e2") p <- process$new(px, cmd, stdout = "|", stderr = "2>&1") on.exit(p$kill(), add = TRUE) p$wait(2000) expect_equal(p$get_exit_status(), 0L) out <- p$read_all_output() expect_equal(out, "o1e1o2e2") expect_error(p$read_all_error_lines(), "not a pipe") }) test_that("same file", { px <- get_tool("px") cmd <- c("out", "o1", "err", "e1", "out", "o2", "errln", "e2") tmp <- tempfile() on.exit(unlink(tmp, recursive = TRUE), add = TRUE) p <- process$new(px, cmd, stdout = tmp, stderr = "2>&1") p$wait(2000) p$kill() expect_equal(p$get_exit_status(), 0L) expect_equal(readLines(tmp), "o1e1o2e2") expect_error(p$read_all_output_lines(), "not a pipe") expect_error(p$read_all_error_lines(), "not a pipe") }) test_that("same NULL, for completeness", { px <- get_tool("px") cmd <- c("out", "o1", "err", "e1", "out", "o2", "errln", "e2") p <- process$new(px, cmd, stdout = NULL, stderr = "2>&1") p$wait(2000) p$kill() expect_equal(p$get_exit_status(), 0L) expect_error(p$read_all_output_lines(), "not a pipe") expect_error(p$read_all_error_lines(), "not a pipe") }) processx/tests/testthat/test-stress.R0000644000176200001440000000161413616314040017545 0ustar liggesusers context("stress test") test_that("can start 100 processes quickly", { skip_on_cran() px <- get_tool("px") expect_error(for (i in 1:100) run(px), NA) gc() }) test_that("run() a lot of times, with small timeouts", { skip_on_cran() px <- get_tool("px") for (i in 1:100) { tic <- Sys.time() err <- tryCatch( run(px, c("sleep", "5"), timeout = 1/1000), error = identity ) expect_s3_class(err, "system_command_timeout_error") expect_true(Sys.time() - tic < as.difftime(3, units = "secs")) } gc() }) test_that("run() and kill while polling", { skip_on_cran() px <- get_tool("px") for (i in 1:10) { tic <- Sys.time() err <- tryCatch( run(px, c("sleep", "5"), timeout = 1/2), error = identity ) expect_s3_class(err, "system_command_timeout_error") expect_true(Sys.time() - tic < as.difftime(3, units = "secs")) } gc() }) processx/tests/testthat/test-utils.R0000644000176200001440000000746413616314040017373 0ustar liggesuserscontext("utils") test_that("full_path gives correct values", { skip_on_cran() if (is_windows()) { # Will be something like "C:" drive <- substring(getwd(), 1, 2) } else { # Use "" so that file.path("", "a") will return "/a" drive <- "" } expect_identical(full_path("/a/b"), file.path(drive, "a/b")) expect_identical(full_path("/a/b/"), file.path(drive, "a/b")) expect_identical(full_path("/"), file.path(drive, "")) expect_identical(full_path("a"), file.path(getwd(), "a")) expect_identical(full_path("a/b"), file.path(getwd(), "a/b")) expect_identical(full_path("a/../b/c"), file.path(getwd(), "b/c")) expect_identical( full_path( "../../../../../../../../../../../../../../../../../../../../../../../a"), file.path(drive, "a")) expect_identical(full_path("/../.././a"), file.path(drive, "a")) expect_identical(full_path("/a/./b/../c"), file.path(drive, "a/c")) expect_identical(full_path("~nonexistent_user"), file.path(getwd(), "~nonexistent_user")) expect_identical( full_path("~/a/../b"), # On Windows, path.expand() can return a path with backslashes gsub("\\", "/", path.expand("~/b"), fixed = TRUE) ) expect_identical(full_path("a//b"), file.path(getwd(), "a/b")) expect_identical(full_path("/a//b"), file.path(drive, "a/b")) }) test_that("full_path gives correct values, windows", { skip_other_platforms("windows") # Backslash separators expect_identical(full_path("f:\\a/b"), "f:/a/b") expect_identical(full_path("a\\b"), file.path(getwd(), "a/b")) expect_identical(full_path("a\\\\b"), file.path(getwd(), "a/b")) expect_identical(full_path("\\\\a\\b"), "//a/b") expect_identical(full_path("\\\\a/b/..\\c"), "//a/c") # Drives expect_identical(full_path("f:/a/b"), "f:/a/b") expect_identical(full_path("f:/a/b/../../.."), "f:/") expect_identical(full_path("f:/../a"), "f:/a") expect_identical(full_path("f:/"), "f:/") expect_identical(full_path("f:"), "f:/") # Leading double slashes. Server name always has trailing slash ("//server/"), # like drives do ("f:/"). But dirs on the server don't have a trailing slash. expect_identical(full_path("//a"), "//a/") expect_identical(full_path("//a/"), "//a/") expect_identical(full_path("//a/b"), "//a/b") expect_identical(full_path("//a/b/.."), "//a/") # Can't go .. to remove the server name expect_identical(full_path("//a/b/../.."), "//a/") expect_identical(full_path("//a/../b"), "//a/b") expect_error(full_path("//")) expect_error(full_path("///")) expect_error(full_path("///a")) }) test_that("full_path gives correct values, unix", { skip_other_platforms("unix") # Leading double slashes should collapse expect_identical(full_path("//"), "/") expect_identical(full_path("///a/"), "/a") }) test_that("do_echo_cmd", { skip_other_platforms("unix") expect_output( withr::with_options( list(width = 20), do_echo_cmd("command", rep("a r g x", 3)) ), "Running command \\\n 'a r g x' \\\n 'a r g x' \\\n 'a r g x'", fixed = TRUE ) }) test_that("sh_quote_smart", { cases <- list( list(c("foo", "bar")), list(character()), list("foo"), list(""), list("foo/bar123_-"), list("foo bar", shQuote("foo bar")), list(c("foo", "1 2"), c("foo", shQuote("1 2"))) ) for (c in cases) expect_equal(sh_quote_smart(c[[1]]), c[[length(c)]]) }) test_that("base64", { expect_equal(base64_encode(charToRaw("foobar")), "Zm9vYmFy") expect_equal(base64_encode(charToRaw(" ")), "IA==") expect_equal(base64_encode(charToRaw("")), "") x <- charToRaw(paste(sample(letters, 10000, replace = TRUE), collapse = "")) expect_equal(base64_decode(base64_encode(x)), x) for (i in 5:32) { mtcars2 <- unserialize(base64_decode(base64_encode( serialize(mtcars[1:i, ], NULL)))) expect_identical(mtcars[1:i,], mtcars2) } }) processx/tests/testthat/test-set-std.R0000644000176200001440000001166013616314040017607 0ustar liggesusers context("set std streams") test_that("setting stdout to a file", { stdout_to_file <- function(filename) { con <- processx::conn_create_file(filename, write = TRUE) processx::conn_set_stdout(con) cat("output\n") message("error") close(con) 42 } tmp <- tempfile() on.exit(unlink(tmp), add = TRUE) opt <- callr::r_process_options( func = stdout_to_file, args = list(filename = tmp)) on.exit(p$kill(), add = TRUE) p <- callr::r_process$new(opt) p$wait(5000) expect_false(p$kill(close_connections = FALSE)) expect_equal(p$get_result(), 42) expect_equal(p$read_all_error_lines(), "error") expect_equal(p$read_all_output_lines(), character()) expect_equal(readLines(tmp), "output") p$kill() }) test_that("setting stderr to a file", { stderr_to_file <- function(filename) { con <- processx::conn_create_file(filename, write = TRUE) processx::conn_set_stderr(con) cat("output\n") message("error") close(con) 42 } tmp <- tempfile() on.exit(unlink(tmp), add = TRUE) opt <- callr::r_process_options( func = stderr_to_file, args = list(filename = tmp)) on.exit(p$kill(), add = TRUE) p <- callr::r_process$new(opt) p$wait(5000) expect_false(p$kill(close_connections = FALSE)) expect_equal(p$get_result(), 42) expect_equal(p$read_all_output_lines(), "output") expect_equal(p$read_all_error_lines(), character()) expect_equal(readLines(tmp), "error") p$kill() }) test_that("setting stdout multiple times", { stdout_to_file <- function(file1, file2) { con1 <- processx::conn_create_file(file1, write = TRUE) processx::conn_set_stdout(con1) cat("output\n") message("error") close(con1) con2 <- processx::conn_create_file(file2, write = TRUE) processx::conn_set_stdout(con2) cat("output2\n") message("error2") close(con2) 42 } tmp1 <- tempfile() tmp2 <- tempfile() on.exit(unlink(c(tmp1, tmp2)), add = TRUE) opt <- callr::r_process_options( func = stdout_to_file, args = list(file1 = tmp1, file2 = tmp2)) on.exit(p$kill(), add = TRUE) p <- callr::r_process$new(opt) p$wait(5000) expect_false(p$kill(close_connections = FALSE)) expect_equal(p$get_result(), 42) expect_equal(p$read_all_error_lines(), c("error", "error2")) expect_equal(p$read_all_output_lines(), character()) expect_equal(readLines(tmp1), "output") expect_equal(readLines(tmp2), "output2") p$kill() }) test_that("set stdout to a pipe", { rem_fun <- function() { pipe <- processx::conn_create_pipepair() processx::conn_set_stdout(pipe[[2]]) cat("output\n") flush(stdout()) processx::conn_read_lines(pipe[[1]]) } opt <- callr::r_process_options(func = rem_fun) on.exit(p$kill(), add = TRUE) p <- callr::r_process$new(opt) p$wait(5000) expect_false(p$kill()) expect_equal(p$get_result(), "output") }) test_that("set stderr to a pipe", { rem_fun <- function() { pipe <- processx::conn_create_pipepair() processx::conn_set_stderr(pipe[[2]]) message("error") flush(stderr()) processx::conn_read_lines(pipe[[1]]) } opt <- callr::r_process_options(func = rem_fun) on.exit(p$kill(), add = TRUE) p <- callr::r_process$new(opt) p$wait(5000) expect_false(p$kill()) expect_equal(p$get_result(), "error") }) test_that("set stdout and save the old fd", { stdout <- function(file1, file2) { con1 <- processx::conn_create_file(file1, write = TRUE) con2 <- processx::conn_create_file(file2, write = TRUE) processx::conn_set_stdout(con1) cat("output1\n") old <- processx::conn_set_stdout(con2, drop = FALSE) cat("output2\n") processx::conn_set_stdout(old) cat("output1 again\n") 42 } tmp1 <- tempfile() tmp2 <- tempfile() on.exit(unlink(c(tmp1, tmp2)), add = TRUE) opt <- callr::r_process_options( func = stdout, args = list(file1 = tmp1, file2 = tmp2)) on.exit(p$kill(), add = TRUE) p <- callr::r_process$new(opt) p$wait(5000) expect_false(p$kill()) expect_equal(p$get_result(), 42) expect_equal(readLines(tmp1), c("output1", "output1 again")) expect_equal(readLines(tmp2), "output2") }) test_that("set stderr and save the old fd", { stderr <- function(file1, file2) { con1 <- processx::conn_create_file(file1, write = TRUE) con2 <- processx::conn_create_file(file2, write = TRUE) processx::conn_set_stderr(con1) message("output1") old <- processx::conn_set_stderr(con2, drop = FALSE) message("output2") processx::conn_set_stderr(old) message("output1 again") 42 } tmp1 <- tempfile() tmp2 <- tempfile() on.exit(unlink(c(tmp1, tmp2)), add = TRUE) opt <- callr::r_process_options( func = stderr, args = list(file1 = tmp1, file2 = tmp2)) on.exit(p$kill(), add = TRUE) p <- callr::r_process$new(opt) p$wait(5000) expect_false(p$kill()) expect_equal(p$get_result(), 42) expect_equal(readLines(tmp1), c("output1", "output1 again")) expect_equal(readLines(tmp2), "output2") }) processx/tests/testthat/test-kill-tree.R0000644000176200001440000001533413616314454020127 0ustar liggesusers context("kill_tree") test_that("tree ids are inherited", { skip_on_cran() skip_if_no_ps() px <- get_tool("px") p <- process$new(px, c("sleep", "10")) on.exit(p$kill(), add = TRUE) ep <- ps::ps_handle(p$get_pid()) ev <- paste0("PROCESSX_", get_private(p)$tree_id) ## On Windows, if the process hasn't been initialized yet, ## this will return ERROR_PARTIAL_COPY (System error 299). ## Until this is fixed in ps, we just retry a couple of times. env <- "failed" deadline <- Sys.time() + 3 while (TRUE) { if (Sys.time() >= deadline) break tryCatch({ env <- ps::ps_environ(ep)[[ev]] break }, error = function(e) e) Sys.sleep(0.05) } expect_true(Sys.time() < deadline) expect_equal(env, "YES") }) test_that("tree ids are inherited if env is specified", { skip_on_cran() skip_if_no_ps() px <- get_tool("px") p <- process$new(px, c("sleep", "10"), env = c(FOO = "bar")) on.exit(p$kill(), add = TRUE) ep <- ps::ps_handle(p$get_pid()) ev <- paste0("PROCESSX_", get_private(p)$tree_id) ## On Windows, if the process hasn't been initialized yet, ## this will return ERROR_PARTIAL_COPY (System error 299). ## Until this is fixed in ps, we just retry a couple of times. env <- "failed" deadline <- Sys.time() + 3 while (TRUE) { if (Sys.time() >= deadline) break tryCatch({ env <- ps::ps_environ(ep)[[ev]] break }, error = function(e) e) Sys.sleep(0.05) } expect_true(Sys.time() < deadline) expect_equal(ps::ps_environ(ep)[[ev]], "YES") expect_equal(ps::ps_environ(ep)[["FOO"]], "bar") }) test_that("kill_tree", { skip_on_cran() skip_if_no_ps() px <- get_tool("px") p <- process$new(px, c("sleep", "100")) on.exit(p$kill(), add = TRUE) res <- p$kill_tree() expect_true(any(c("px", "px.exe") %in% names(res))) expect_true(p$get_pid() %in% res) deadline <- Sys.time() + 1 while (p$is_alive() && Sys.time() < deadline) Sys.sleep(0.05) expect_true(Sys.time() < deadline) expect_false(p$is_alive()) }) test_that("kill_tree with children", { skip_on_cran() skip_if_no_ps() tmp <- tempfile() on.exit(unlink(tmp), add = TRUE) p <- callr::r_bg( function(px, tmp) { processx::run(px, c("outln", "ok", "sleep", "100"), stdout_callback = function(x, p) cat(x, file = tmp, append = TRUE)) }, args = list(px = get_tool("px"), tmp = tmp) ) deadline <- Sys.time() + 5 while (!file.exists(tmp) && Sys.time() < deadline) Sys.sleep(0.05) expect_true(Sys.time() < deadline) res <- p$kill_tree() expect_true(any(c("px", "px.exe") %in% names(res))) expect_true(any(c("R", "Rterm.exe") %in% names(res))) expect_true(p$get_pid() %in% res) deadline <- Sys.time() + 1 while (p$is_alive() && Sys.time() < deadline) Sys.sleep(0.05) expect_true(Sys.time() < deadline) expect_false(p$is_alive()) }) test_that("kill_tree and orphaned children", { skip_on_cran() skip_if_no_ps() tmp <- tempfile() on.exit(unlink(tmp), add = TRUE) p1 <- callr::r_bg( function(px, tmp) { p <- processx::process$new(px, c("outln", "ok", "sleep", "100"), stdout = tmp, cleanup = FALSE) list(pid = p$get_pid(), create_time = p$get_start_time(), id = p$.__enclos_env__$private$tree_id) }, args = list(px = get_tool("px"), tmp = tmp) ) p1$wait() pres <- p1$get_result() ps <- ps::ps_handle(pres$pid) expect_true(ps::ps_is_running(ps)) deadline <- Sys.time() + 2 while ((!file.exists(tmp) || file_size(tmp) == 0) && Sys.time() < deadline) Sys.sleep(0.05) expect_true(Sys.time() < deadline) res <- p1$kill_tree(pres$id) expect_true(any(c("px", "px.exe") %in% names(res))) deadline <- Sys.time() + 1 while (ps::ps_is_running(ps) && Sys.time() < deadline) Sys.sleep(0.05) expect_true(Sys.time() < deadline) expect_false(ps::ps_is_running(ps)) }) test_that("cleanup_tree option", { skip_on_cran() skip_if_no_ps() px <- get_tool("px") p <- process$new(px, c("sleep", "100"), cleanup_tree = TRUE) on.exit(try(p$kill(), silent = TRUE), add = TRUE) ps <- p$as_ps_handle() rm(p) gc() gc() deadline <- Sys.time() + 1 while (ps::ps_is_running(ps) && Sys.time() < deadline) Sys.sleep(0.05) expect_true(Sys.time() < deadline) expect_false(ps::ps_is_running(ps)) }) test_that("run cleanup", { ## This currently only works on macOS if (Sys.info()[["sysname"]] != "Darwin") { expect_true(TRUE) return() } skip_on_cran() ## This is cumbesome to test... here is what we are doing. ## We run a grandchild process in the background, i.e. it will be ## orphaned. nohup will detach the process from the terminal, we ## need that, otherwise `run()` will wait for the shell to finish. ## We orphaned process writes its pid to a file, so we can read that ## back to see its process id. ## We also need to create a random file and run that, so that we ## can be sure that this process is not runing after the cleanup. ## Otherwise pid reuse might create the same pid, but then this pid ## will have a different command line. tmp <- tempfile() pid <- paste0(tmp, ".pid") btmp <- basename(tmp) bpid <- basename(pid) dtmp <- dirname(tmp) on.exit(unlink(c(tmp, pid)), add = TRUE) ## The sleep at the end gives a better chance for the grandchild ## process to write the pid before it is killed by the GC finalizer ## on the processx process. cat(sprintf("#! /bin/sh\necho $$ >%s\nsleep 10\n", bpid), file = tmp) Sys.chmod(tmp, "0777") run("sh", c("--norc", "-c", paste0("(nohup ", "./", btmp, " /dev/null &); sleep 0.5")), wd = dtmp, cleanup_tree = TRUE) ## We need to wait until the process writes it pid into `pid` deadline <- Sys.time() + 3 while ((!file.exists(pid) || !length(readLines(pid))) && Sys.time() < deadline) Sys.sleep(0.05) expect_true(Sys.time() < deadline) ## Make sure the finalizer is called gc(); gc() ## Now either the pid should not exist, or, in the unlikely event ## when it does because of pid reuse, it should have a different command ## line. tryCatch({ ps <- ps::ps_handle(as.integer(readLines(pid))) cmd <- ps::ps_cmdline(ps) expect_false(any(grepl(btmp, cmd))) }, no_such_process = function(e) expect_true(TRUE) ) }) test_that("cleanup_tree stress test", { skip_on_cran() skip_if_no_ps() do <- function() { px <- get_tool("px") p <- process$new(px, c("sleep", "100"), cleanup_tree = TRUE) on.exit(try(p$kill(), silent = TRUE), add = TRUE) ps <- p$as_ps_handle() rm(p) gc() gc() deadline <- Sys.time() + 1 while (ps::ps_is_running(ps) && Sys.time() < deadline) Sys.sleep(0.05) expect_true(Sys.time() < deadline) expect_false(ps::ps_is_running(ps)) } for (i in 1:50) do() }) processx/tests/testthat/test-cleanup.R0000644000176200001440000000071413616314040017651 0ustar liggesusers context("Cleanup") test_that("process is cleaned up", { px <- get_tool("px") p <- process$new(px, c("sleep", "1"), cleanup = TRUE) pid <- p$get_pid() rm(p) gc() expect_false(process__exists(pid)) }) test_that("process can stay alive", { px <- get_tool("px") on.exit(tools::pskill(pid, 9), add = TRUE) p <- process$new(px, c("sleep", "60"), cleanup = FALSE) pid <- p$get_pid() rm(p) gc() expect_true(process__exists(pid)) }) processx/tests/testthat/test-run.R0000644000176200001440000000717314025102241017025 0ustar liggesusers context("run") test_that("run can run", { px <- get_tool("px") expect_error({ run(px, c("sleep", "0")) }, NA) gc() }) test_that("timeout works", { px <- get_tool("px") tic <- Sys.time() x <- run(px, c("sleep", "5"), timeout = 0.00001, error_on_status = FALSE) toc <- Sys.time() expect_true(toc - tic < as.difftime(3, units = "secs")) expect_true(x$timeout) gc() }) test_that("timeout throws right error", { px <- get_tool("px") e <- tryCatch( run(px, c("sleep", "5"), timeout = 0.00001, error_on_status = TRUE), error = function(e) e ) expect_true("system_command_timeout_error" %in% class(e)) gc() }) test_that("callbacks work", { px <- get_tool("px") ## This typically freezes on Unix, if there is a malloc/free race ## condition in the SIGCHLD handler. for (i in 1:30) { out <- NULL run( px, rbind("outln", 1:20), stdout_line_callback = function(x, ...) out <<- c(out, x) ) expect_equal(out, as.character(1:20)) gc() } for (i in 1:30) { out <- NULL run( px, rbind("errln", 1:20), stderr_line_callback = function(x, ...) out <<- c(out, x), error_on_status = FALSE ) expect_equal(out, as.character(1:20)) gc() } }) test_that("working directory", { px <- get_tool("px") dir.create(tmp <- tempfile()) on.exit(unlink(tmp, recursive = TRUE), add = TRUE) cat("foo\nbar\n", file = file.path(tmp, "file")) x <- run(px, c("cat", "file"), wd = tmp) if (is_windows()) { expect_equal(x$stdout, "foo\r\nbar\r\n") } else { expect_equal(x$stdout, "foo\nbar\n") } gc() }) test_that("working directory does not exist", { px <- get_tool("px") expect_error(run(px, wd = tempfile())) gc() }) test_that("stderr_to_stdout", { px <- get_tool("px") out <- run( px, c("out", "o1", "err", "e1", "out", "o2", "err", "e2", "outln", ""), stderr_to_stdout = TRUE) expect_equal(out$status, 0L) expect_equal( out$stdout, paste0("o1e1o2e2", if (is_windows()) "\r", "\n")) expect_equal(out$stderr, "") expect_false(out$timeout) }) test_that("condition on interrupt", { skip_if_no_ps() skip_on_cran() skip_on_appveyor() # TODO: why does this fail? px <- get_tool("px") cnd <- tryCatch( interrupt_me(run(px, c("errln", "oops", "errflush", "sleep", 3)), 0.5), error = function(c) c, interrupt = function(c) c) expect_s3_class(cnd, "system_command_interrupt") expect_equal(str_trim(cnd$stderr), "oops") }) test_that("stdin", { tmp <- tempfile() on.exit(unlink(tmp), add = TRUE) txt <- "foobar\nthis is the input\n" cat(txt, file = tmp) px <- get_tool("px") res <- run(px, c("cat", ""), stdin = tmp) expect_equal( strsplit(res$stdout, "\r?\n")[[1]], c("foobar", "this is the input")) }) test_that("drop stdout", { px <- get_tool("px") res <- run(px, c("out", "boo", "err", "bah"), stdout = NULL) expect_null(res$stdout) expect_equal(res$stderr, "bah") }) test_that("drop stderr", { px <- get_tool("px") res <- run(px, c("out", "boo", "err", "bah"), stderr = NULL) expect_equal(res$stdout, "boo") expect_null(res$stderr) }) test_that("drop std*", { px <- get_tool("px") res <- run(px, c("out", "boo", "err", "bah"), stdout = NULL, stderr = NULL) expect_null(res$stdout) expect_null(res$stderr) }) test_that("redirect stout", { tmp1 <- tempfile() tmp2 <- tempfile() on.exit(unlink(c(tmp1, tmp2)), add = TRUE) px <- get_tool("px") res <- run(px, c("outln", "boo", "errln", "bah"), stdout = tmp1, stderr = tmp2) expect_null(res$stdout) expect_null(res$stderr) expect_equal(readLines(tmp1), "boo") expect_equal(readLines(tmp2), "bah") }) processx/tests/testthat/test-err.R0000644000176200001440000002575514037274727017045 0ustar liggesusers context("errors.R") test_that("throw() is standalone", { stenv <- environment(throw) objs <- ls(stenv, all.names = TRUE) funs <- Filter(function(x) is.function(stenv[[x]]), objs) funobjs <- mget(funs, stenv) for (f in funobjs) expect_identical(environmentName(topenv(f)), "base") expect_message( mapply(codetools::checkUsage, funobjs, funs, MoreArgs = list(report = message)), NA) }) test_that("new_cond", { c <- new_cond("foo", "bar") expect_identical(class(c), "condition") expect_identical(c$message, "foobar") }) test_that("new_error", { c <- new_error("foo", "bar") expect_identical( class(c), c("rlib_error_2_0", "rlib_error", "error", "condition") ) expect_identical(c$message, "foobar") }) test_that("throw() needs condition objects", { expect_error( throw("foobar"), "can only throw conditions", class = "rlib_error") expect_error( throw(new_error("foobar"), parent = "nope"), "Parent condition must be a condition object", class = "rlib_error") }) test_that("throw() adds the proper call, if requested", { f <- function() throw(new_error("ooops")) err <- tryCatch(f(), error = function(e) e) expect_s3_class(err, "rlib_error") expect_identical(err$call, quote(f())) g <- function() throw(new_error("ooops", call. = FALSE)) err <- tryCatch(g(), error = function(e) e) expect_s3_class(err, "rlib_error") expect_null(err$call) }) test_that("throw() only stops for errors", { f <- function() throw(new_cond("nothing important")) cond <- tryCatch(f(), condition = function(e) e) expect_s3_class(cond, "condition") expect_error(f(), NA) }) test_that("caught conditions have no trace", { f <- function() throw(new_error("nothing important")) cond <- tryCatch(f(), condition = function(e) e) expect_null(cond$trace) }) test_that("un-caught condition has trace", { skip_on_cran() # We need to run this in a separate script, because # testthat catches all conditions. We also cannot run it in callr::r() # or similar, because those catch conditions as well. sf <- tempfile(fileext = ".R") op <- sub("\\.R$", ".rds", sf) so <- paste0(sf, "out") se <- paste0(sf, "err") on.exit(unlink(c(sf, op, so, se), recursive = TRUE), add = TRUE) expr <- substitute({ f <- function() g() g <- function() processx:::throw(processx:::new_error("oooops")) options(rlib_error_handler = function(c) { saveRDS(c, file = `__op__`) }) f() }, list("__op__" = op)) cat(deparse(expr), file = sf, sep = "\n") callr::rscript(sf, stdout = so, stderr = se) cond <- readRDS(op) expect_s3_class(cond, "rlib_error") expect_s3_class(cond$trace, "rlib_trace") }) test_that("catch_rethow", { h <- function() h2() h2 <- function() throw(new_error("oops")) f <- function() g() g <- function() { err$catch_rethrow( h(), error = function(e) throw(new_error("oops2"), parent = e)) } cond <- tryCatch(g(), error = function(e) e) expect_s3_class(cond, "rlib_error") expect_equal(cond$call, quote(g())) expect_s3_class(cond$parent, "rlib_error") expect_equal(cond$parent$call, quote(h2())) expect_true(is.integer(cond$`_nframe`)) expect_true(is.integer(cond$parent$`_nframe`)) expect_true(cond$`_nframe` < cond$parent$`_nframe`) }) test_that("rethrow", { h <- function() h2() h2 <- function() throw(new_error("oops")) f <- function() g() g <- function() rethrow(h(), new_error("oops2")) cond <- tryCatch(g(), error = function(e) e) expect_s3_class(cond, "rlib_error") expect_equal(cond$call, quote(g())) expect_s3_class(cond$parent, "rlib_error") expect_equal(cond$parent$call, quote(h2())) expect_true(is.integer(cond$`_nframe`)) expect_true(is.integer(cond$parent$`_nframe`)) expect_true(cond$`_nframe` < cond$parent$`_nframe`) }) test_that("rethrow without call", { h <- function() h2() h2 <- function() throw(new_error("oops")) f <- function() g() g <- function() rethrow(h(), new_error("oops2"), call = FALSE) cond <- tryCatch(g(), error = function(e) e) expect_s3_class(cond, "rlib_error") expect_null(cond$call) expect_s3_class(cond$parent, "rlib_error") expect_equal(cond$parent$call, quote(h2())) expect_true(is.integer(cond$`_nframe`)) expect_true(is.integer(cond$parent$`_nframe`)) expect_true(cond$`_nframe` < cond$parent$`_nframe`) }) test_that("rethrow_call", { cond <- tryCatch( rethrow_call(c_processx_base64_encode, "foobar"), error = function(e) e) expect_equal(cond$call[[1]], quote(rethrow_call)) expect_s3_class(cond, "c_error") expect_s3_class(cond, "rlib_error") }) test_that("trace when rethrowing", { skip_on_cran() sf <- tempfile(fileext = ".R") op <- sub("\\.R$", ".rds", sf) so <- paste0(sf, "out") se <- paste0(sf, "err") on.exit(unlink(c(sf, op, so, se), recursive = TRUE), add = TRUE) expr <- substitute({ f <- function() g() g <- function() processx:::throw(processx:::new_error("oooops")) h <- function() processx:::rethrow(f(), processx:::new_error("and again")) options(rlib_error_handler = function(c) { saveRDS(c, file = `__op__`) # quit after the first, because the other one is caught here as well q() }) h() }, list("__op__" = op)) cat(deparse(expr), file = sf, sep = "\n") callr::rscript(sf, stdout = so, stderr = se) cond <- readRDS(op) expect_s3_class(cond, "rlib_error") expect_s3_class(cond$parent, "rlib_error") expect_s3_class(cond$trace, "rlib_trace") expect_null(cond$parent$trace) expect_equal(length(cond$trace$nframe), 2) expect_true(cond$trace$nframe[1] < cond$trace$nframe[2]) expect_equal(cond$trace$messages, list("and again", "oooops")) expect_equal(cond$trace$calls[[cond$trace$nframe[1]-1]], "h()") expect_equal(cond$trace$calls[[cond$trace$nframe[2]-1]], "g()") }) test_that("rethrowing non rlib errors", { skip_on_cran() sf <- tempfile(fileext = ".R") op <- sub("\\.R$", ".rds", sf) so <- paste0(sf, "out") se <- paste0(sf, "err") on.exit(unlink(c(sf, op, so, se), recursive = TRUE), add = TRUE) expr <- substitute({ f <- function() g() g <- function() stop("oooopsie") h <- function() processx:::rethrow(f(), processx:::new_error("and again")) options(rlib_error_handler = function(c) { saveRDS(c, file = `__op__`) # quit after the first, because the other one is caught here as well q() }) h() }, list("__op__" = op)) cat(deparse(expr), file = sf, sep = "\n") callr::rscript(sf, stdout = so, stderr = se) cond <- readRDS(op) expect_s3_class(cond, "rlib_error") expect_s3_class(cond$parent, "simpleError") expect_false(inherits(cond$parent, "rlib_error")) expect_s3_class(cond$trace, "rlib_trace") expect_null(cond$parent$trace) expect_equal(length(cond$trace$nframe), 2) expect_true(cond$trace$nframe[1] < cond$trace$nframe[2]) expect_equal(cond$trace$messages, list("and again", "oooopsie")) expect_equal(cond$trace$calls[[cond$trace$nframe[1]-1]], "h()") }) test_that("errors from subprocess", { skip_if_not_installed("callr", minimum_version = "3.2.0.9001") err <- tryCatch( callr::r(function() 1 + "a"), error = function(e) e) expect_s3_class(err, "rlib_error") expect_s3_class(err$parent, "error") expect_false(is.null(err$parent$trace)) }) test_that("error trace from subprocess", { skip_on_cran() skip_if_not_installed("callr", minimum_version = "3.2.0.9001") sf <- tempfile(fileext = ".R") op <- sub("\\.R$", ".rds", sf) so <- paste0(sf, "out") se <- paste0(sf, "err") on.exit(unlink(c(sf, op, so, se), recursive = TRUE), add = TRUE) expr <- substitute({ h <- function() callr::r(function() 1 + "a") options(rlib_error_handler = function(c) { saveRDS(c, file = `__op__`) # quit after the first, because the other one is caught here as well q() }) h() }, list("__op__" = op)) cat(deparse(expr), file = sf, sep = "\n") callr::rscript(sf, stdout = so, stderr = se) cond <- readRDS(op) expect_s3_class(cond, "rlib_error") expect_s3_class(cond$parent, "error") expect_s3_class(cond$trace, "rlib_trace") expect_equal(length(cond$trace$nframe), 2) expect_true(cond$trace$nframe[1] < cond$trace$nframe[2]) expect_match(cond$trace$messages[[1]], "subprocess failed: non-numeric") expect_match(cond$trace$messages[[2]], "non-numeric argument") }) test_that("error trace from throw() in subprocess", { skip_on_cran() skip_if_not_installed("callr", minimum_version = "3.2.0.9001") sf <- tempfile(fileext = ".R") op <- sub("\\.R$", ".rds", sf) so <- paste0(sf, "out") se <- paste0(sf, "err") on.exit(unlink(c(sf, op, so, se), recursive = TRUE), add = TRUE) expr <- substitute({ h <- function() callr::r(function() processx::run("does-not-exist---")) options(rlib_error_handler = function(c) { saveRDS(c, file = `__op__`) # quit after the first, because the other one is caught here as well q() }) h() }, list("__op__" = op)) cat(deparse(expr), file = sf, sep = "\n") callr::rscript(sf, stdout = so, stderr = se) cond <- readRDS(op) expect_s3_class(cond, "rlib_error") expect_s3_class(cond$parent, "rlib_error") expect_s3_class(cond$trace, "rlib_trace") expect_equal(length(cond$trace$nframe), 2) expect_true(cond$trace$nframe[1] < cond$trace$nframe[2]) expect_match(cond$trace$messages[[1]], "subprocess failed: .*processx\\.c") expect_match(cond$trace$messages[[2]], "@.*processx\\.c") }) test_that("trace is not overwritten", { skip_on_cran() withr::local_options(list(rlib_error_always_trace = TRUE)) err <- new_error("foobar") err$trace <- "not really" err2 <- tryCatch(throw(err), error = function(e) e) expect_identical(err2$trace, "not really") }) test_that("error is printed on error", { skip_on_cran() sf <- tempfile(fileext = ".R") op <- sub("\\.R$", ".rds", sf) so <- paste0(sf, "out") se <- paste0(sf, "err") on.exit(unlink(c(sf, op, so, se), recursive = TRUE), add = TRUE) expr <- substitute({ options(rlib_interactive = TRUE) processx::run(basename(tempfile())) }) cat(deparse(expr), file = sf, sep = "\n") callr::rscript( sf, stdout = so, stderr = se, fail_on_status = FALSE, show = FALSE ) selines <- readLines(se) expect_true( any(grepl("No such file or directory", selines)) || any(grepl("Command .* not found", selines)) ) expect_false(any(grepl("Stack trace", selines))) }) test_that("trace is printed on error in non-interactive sessions", { sf <- tempfile(fileext = ".R") op <- sub("\\.R$", ".rds", sf) so <- paste0(sf, "out") se <- paste0(sf, "err") on.exit(unlink(c(sf, op, so, se), recursive = TRUE), add = TRUE) expr <- substitute({ processx::run(basename(tempfile())) }) cat(deparse(expr), file = sf, sep = "\n") callr::rscript( sf, stdout = so, stderr = se, fail_on_status = FALSE, show = FALSE ) selines <- readLines(se) expect_true( any(grepl("No such file or directory", selines)) || any(grepl("Command .* not found", selines)) ) expect_true(any(grepl("Stack trace", selines))) }) processx/tests/testthat/test-extra-connections.R0000644000176200001440000000367513616314040021676 0ustar liggesusers context("extra connections") test_that("writing to extra connection", { skip_on_cran() msg <- "foobar" cmd <- c(get_tool("px"), "echo", "3", "1", nchar(msg)) pipe <- conn_create_pipepair(nonblocking = c(FALSE, FALSE)) expect_silent( p <- process$new(cmd[1], cmd[-1], stdout = "|", stderr = "|", connections = list(pipe[[1]]) ) ) close(pipe[[1]]) on.exit(p$kill(), add = TRUE) conn_write(pipe[[2]], msg) p$poll_io(-1) expect_equal(p$read_all_output_lines(), msg) expect_equal(p$read_all_error_lines(), character()) close(pipe[[2]]) }) test_that("reading from extra connection", { skip_on_cran() cmd <- c( get_tool("px"), "sleep", "0.5", "write", "3", "foobar\r\n", "out", "ok") pipe <- conn_create_pipepair() expect_silent( p <- process$new(cmd[1], cmd[-1], stdout = "|", stderr = "|", connections = list(pipe[[2]]) ) ) close(pipe[[2]]) on.exit(p$kill(), add = TRUE) ## Nothing to read yet expect_equal(conn_read_lines(pipe[[1]]), character()) ## Wait until there is output ready <- poll(list(pipe[[1]]), 5000)[[1]] expect_equal(ready, "ready") expect_equal(conn_read_lines(pipe[[1]]), "foobar") expect_equal(p$read_all_output_lines(), "ok") expect_equal(p$read_all_error_lines(), character()) close(pipe[[1]]) }) test_that("reading and writing to extra connection", { skip_on_cran() msg <- "foobar\n" cmd <- c(get_tool("px"), "echo", "3", "4", nchar(msg), "outln", "ok") pipe1 <- conn_create_pipepair(nonblocking = c(FALSE, FALSE)) pipe2 <- conn_create_pipepair() expect_silent( p <- process$new(cmd[1], cmd[-1], stdout = "|", stderr = "|", connections = list(pipe1[[1]], pipe2[[2]]) ) ) close(pipe1[[1]]) close(pipe2[[2]]) on.exit(p$kill(), add = TRUE) conn_write(pipe1[[2]], msg) p$poll_io(-1) expect_equal(conn_read_chars(pipe2[[1]]), msg) expect_equal(p$read_output_lines(), "ok") close(pipe1[[2]]) close(pipe2[[1]]) }) processx/tests/testthat/test-chr-io.R0000644000176200001440000000201313616314040017375 0ustar liggesusers context("character IO") test_that("Can read last line without trailing newline", { px <- get_tool("px") p <- process$new(px, c("out", "foobar"), stdout = "|") on.exit(p$kill(), add = TRUE) out <- p$read_all_output_lines() expect_equal(out, "foobar") }) test_that("Can read single characters", { px <- get_tool("px") p <- process$new(px, c("out", "123"), stdout = "|") on.exit(p$kill(), add = TRUE) p$wait() p$poll_io(-1) expect_equal(p$read_output(1), "1") expect_equal(p$read_output(1), "2") expect_equal(p$read_output(1), "3") expect_equal(p$read_output(1), "") expect_false(p$is_incomplete_output()) }) test_that("Can read multiple characters", { px <- get_tool("px") p <- process$new(px, c("out", "123456789"), stdout = "|") on.exit(p$kill(), add = TRUE) p$wait() p$poll_io(-1) expect_equal(p$read_output(3), "123") expect_equal(p$read_output(4), "4567") expect_equal(p$read_output(2), "89") expect_equal(p$read_output(1), "") expect_false(p$is_incomplete_output()) }) processx/tests/testthat.R0000644000176200001440000000015613700157102015243 0ustar liggesuserslibrary(testthat) library(processx) Sys.setenv("R_TESTS" = "") test_check("processx", reporter = "summary") processx/src/0000755000176200001440000000000014043046410012703 5ustar liggesusersprocessx/src/cleancall.c0000644000176200001440000001016613703607776015015 0ustar liggesusers#define R_NO_REMAP #include #include "cleancall.h" #if (defined(R_VERSION) && R_VERSION < R_Version(3, 4, 0)) SEXP R_MakeExternalPtrFn(DL_FUNC p, SEXP tag, SEXP prot) { fn_ptr ptr; ptr.fn = p; return R_MakeExternalPtr(ptr.p, tag, prot); } DL_FUNC R_ExternalPtrAddrFn(SEXP s) { fn_ptr ptr; ptr.p = R_ExternalPtrAddr(s); return ptr.fn; } #endif // The R API does not have a setter for function pointers SEXP cleancall_MakeExternalPtrFn(DL_FUNC p, SEXP tag, SEXP prot) { fn_ptr tmp; tmp.fn = p; return R_MakeExternalPtr(tmp.p, tag, prot); } void cleancall_SetExternalPtrAddrFn(SEXP s, DL_FUNC p) { fn_ptr ptr; ptr.fn = p; R_SetExternalPtrAddr(s, ptr.p); } // Initialised at load time with the `.Call` primitive SEXP cleancall_fns_dot_call = NULL; void cleancall_init() { cleancall_fns_dot_call = Rf_findVar(Rf_install(".Call"), R_BaseEnv); } struct eval_args { SEXP call; SEXP env; }; static SEXP eval_wrap(void* data) { struct eval_args* args = (struct eval_args*) data; return Rf_eval(args->call, args->env); } SEXP cleancall_call(SEXP args, SEXP env) { SEXP call = PROTECT(Rf_lcons(cleancall_fns_dot_call, args)); struct eval_args data = { call, env }; SEXP out = r_with_cleanup_context(&eval_wrap, &data); UNPROTECT(1); return out; } static SEXP callbacks = NULL; // Preallocate a callback static void push_callback(SEXP stack) { SEXP top = CDR(stack); SEXP early_handler = PROTECT(Rf_allocVector(LGLSXP, 1)); SEXP fn_extptr = PROTECT(cleancall_MakeExternalPtrFn(NULL, R_NilValue, R_NilValue)); SEXP data_extptr = PROTECT(R_MakeExternalPtr(NULL, early_handler, R_NilValue)); SEXP cb = Rf_cons(Rf_cons(fn_extptr, data_extptr), top); SETCDR(stack, cb); UNPROTECT(3); } struct data_wrapper { SEXP (*fn)(void* data); void *data; SEXP callbacks; int success; }; static void call_exits(void* data) { // Remove protecting node. Don't remove the preallocated callback on // the top as it might contain a handler when something went wrong. SEXP top = CDR(callbacks); // Restore old stack struct data_wrapper* state = data; callbacks = (SEXP) state->callbacks; // Handlers should not jump while (top != R_NilValue) { SEXP cb = CAR(top); top = CDR(top); void (*fn)(void*) = (void (*)(void*)) R_ExternalPtrAddrFn(CAR(cb)); void *data = (void*) R_ExternalPtrAddr(CDR(cb)); int early_handler = LOGICAL(R_ExternalPtrTag(CDR(cb)))[0]; // Check for empty pointer in preallocated callbacks if (fn) { if (!early_handler || !state->success) fn(data); } } } static SEXP with_cleanup_context_wrap(void *data) { struct data_wrapper* cdata = data; SEXP ret = cdata->fn(cdata->data); cdata->success = 1; return ret; } SEXP r_with_cleanup_context(SEXP (*fn)(void* data), void* data) { // Preallocate new stack before changing `callbacks` to avoid // leaving the global variable in a bad state if alloc fails SEXP new = PROTECT(Rf_cons(R_NilValue, R_NilValue)); push_callback(new); if (!callbacks) callbacks = R_NilValue; SEXP old = callbacks; callbacks = new; struct data_wrapper state = { fn, data, old, 0 }; SEXP out = R_ExecWithCleanup(with_cleanup_context_wrap, &state, &call_exits, &state); UNPROTECT(1); return out; } static void call_save_handler(void (*fn)(void *data), void* data, int early) { if (!callbacks) { fn(data); Rf_error("Internal error: Exit handler pushed outside " "of an exit context"); } SEXP cb = CADR(callbacks); // Update pointers cleancall_SetExternalPtrAddrFn(CAR(cb), (DL_FUNC) fn); R_SetExternalPtrAddr(CDR(cb), data); LOGICAL(R_ExternalPtrTag(CDR(cb)))[0] = early; // Preallocate the next callback in case the allocator jumps push_callback(callbacks); } void r_call_on_exit(void (*fn)(void* data), void* data) { call_save_handler(fn, data, /* early = */ 0); } void r_call_on_early_exit(void (*fn)(void* data), void* data) { call_save_handler(fn, data, /* early = */ 1); } processx/src/install.libs.R0000644000176200001440000000122514025102241015417 0ustar liggesusers progs <- if (WINDOWS) { c(file.path("tools", c("px.exe", "pxu.exe", "interrupt.exe")), file.path("supervisor", "supervisor.exe")) } else { c(file.path("tools", "px"), file.path("supervisor", "supervisor")) } dest <- file.path(R_PACKAGE_DIR, paste0("bin", R_ARCH)) dir.create(dest, recursive = TRUE, showWarnings = FALSE) file.copy(progs, dest, overwrite = TRUE) files <- Sys.glob(paste0("*", SHLIB_EXT)) dest <- file.path(R_PACKAGE_DIR, paste0('libs', R_ARCH)) dir.create(dest, recursive = TRUE, showWarnings = FALSE) file.copy(files, dest, overwrite = TRUE) if (file.exists("symbols.rds")) { file.copy("symbols.rds", dest, overwrite = TRUE) } processx/src/win/0000755000176200001440000000000014043002736013503 5ustar liggesusersprocessx/src/win/thread.c0000644000176200001440000001755414031426467015142 0ustar liggesusers #include "../processx.h" HANDLE processx__connection_iocp = NULL; HANDLE processx__get_default_iocp() { if (! processx__connection_iocp) { processx__connection_iocp = CreateIoCompletionPort( /* FileHandle = */ INVALID_HANDLE_VALUE, /* ExistingCompletionPort = */ NULL, /* CompletionKey = */ 0, /* NumberOfConcurrentThreads = */ 0); } return processx__connection_iocp; } HANDLE processx__iocp_thread = NULL; HANDLE processx__thread_start = NULL; HANDLE processx__thread_done = NULL; BOOL processx__thread_success; void *processx__thread_data = NULL; DWORD processx__thread_last_error = 0; int processx__thread_cmd = PROCESSX__THREAD_CMD_INIT; fd_set processx__readfds, processx__writefds, processx__exceptionfds; SOCKET processx__notify_socket[2] = { 0, 0 }; int processx__select = 0; struct processx__thread_readfile_data { processx_connection_t *ccon; LPVOID lpBuffer; DWORD nNumberOfBytesToRead; LPDWORD lpNumberOfBytesRead; } processx__thread_readfile_data; struct processx__thread_getstatus_data { LPDWORD lpNumberOfBytes; PULONG_PTR lpCompletionKey; LPOVERLAPPED *lpOverlapped; DWORD dwMilliseconds; } processx__thread_getstatus_data; ULONG_PTR processx__key_none = 1; DWORD processx_i_thread_readfile() { processx_connection_t *ccon = processx__thread_readfile_data.ccon; if (! ccon->handle.overlapped.hEvent && (ccon->type == PROCESSX_FILE_TYPE_ASYNCFILE || ccon->type == PROCESSX_FILE_TYPE_ASYNCPIPE)) { ccon->handle.overlapped.hEvent = CreateEvent( /* lpEventAttributes = */ NULL, /* bManualReset = */ FALSE, /* bInitialState = */ FALSE, /* lpName = */ NULL); if (ccon->handle.overlapped.hEvent == NULL) return FALSE; HANDLE iocp = processx__get_default_iocp(); if (!iocp) return FALSE; HANDLE res = CreateIoCompletionPort( /* FileHandle = */ ccon->handle.handle, /* ExistingCompletionPort = */ iocp, /* CompletionKey = */ (ULONG_PTR) ccon, /* NumberOfConcurrentThreads = */ 0); if (!res) return FALSE; } /* These need to be set to zero for non-file handles */ if (ccon->type != PROCESSX_FILE_TYPE_ASYNCFILE) { ccon->handle.overlapped.Offset = 0; ccon->handle.overlapped.OffsetHigh = 0; } DWORD res = ReadFile(ccon->handle.handle, processx__thread_readfile_data.lpBuffer, processx__thread_readfile_data.nNumberOfBytesToRead, processx__thread_readfile_data.lpNumberOfBytesRead, &ccon->handle.overlapped); return res; } DWORD processx_i_thread_getstatus() { static const char *ok_buf = "OK"; HANDLE iocp = processx__get_default_iocp(); if (!iocp) return FALSE; DWORD res = GetQueuedCompletionStatus( iocp, processx__thread_getstatus_data.lpNumberOfBytes, processx__thread_getstatus_data.lpCompletionKey, processx__thread_getstatus_data.lpOverlapped, processx__thread_getstatus_data.dwMilliseconds); if (processx__select) { /* TODO: error */ send(processx__notify_socket[1], ok_buf, 2, 0); } return res; } DWORD processx__thread_callback(void *data) { while (1) { WaitForSingleObject(processx__thread_start, INFINITE); processx__thread_success = TRUE; processx__thread_last_error = 0; switch (processx__thread_cmd) { case PROCESSX__THREAD_CMD_INIT: case PROCESSX__THREAD_CMD_IDLE: break; case PROCESSX__THREAD_CMD_READFILE: processx__thread_success = processx_i_thread_readfile(); break; case PROCESSX__THREAD_CMD_GETSTATUS: processx__thread_success = processx_i_thread_getstatus(); break; default: /* ???? */ processx__thread_success = FALSE; break; } if (!processx__thread_success) { processx__thread_last_error = GetLastError(); } processx__thread_cmd = PROCESSX__THREAD_CMD_IDLE; SetEvent(processx__thread_done); } return 0; } int processx__start_thread() { if (processx__iocp_thread != NULL) return 0; DWORD threadid; processx__thread_start = CreateEventA(NULL, FALSE, FALSE, NULL); processx__thread_done = CreateEventA(NULL, FALSE, FALSE, NULL); if (processx__thread_start == NULL || processx__thread_done == NULL) { if (processx__thread_start) CloseHandle(processx__thread_start); if (processx__thread_done ) CloseHandle(processx__thread_done); processx__thread_start = processx__thread_done = NULL; R_THROW_SYSTEM_ERROR("Cannot create I/O events"); } processx__thread_cmd = PROCESSX__THREAD_CMD_INIT; processx__iocp_thread = CreateThread( /* lpThreadAttributes = */ NULL, /* dwStackSize = */ 0, /* lpStartAddress = */ (LPTHREAD_START_ROUTINE) processx__thread_callback, /* lpParameter = */ 0, /* dwCreationFlags = */ 0, /* lpThreadId = */ &threadid); if (processx__iocp_thread == NULL) { CloseHandle(processx__thread_start); CloseHandle(processx__thread_done); processx__thread_start = processx__thread_done = NULL; R_THROW_SYSTEM_ERROR("Cannot start I/O thread"); } /* Wait for thread to be ready */ SetEvent(processx__thread_start); WaitForSingleObject(processx__thread_done, INFINITE); return 0; } /* ReadFile, but in the bg thread */ BOOL processx__thread_readfile(processx_connection_t *ccon, LPVOID lpBuffer, DWORD nNumberOfBytesToRead, LPDWORD lpNumberOfBytesRead) { processx__start_thread(); processx__thread_cmd = PROCESSX__THREAD_CMD_READFILE; processx__thread_readfile_data.ccon = ccon; processx__thread_readfile_data.lpBuffer = lpBuffer; processx__thread_readfile_data.nNumberOfBytesToRead = nNumberOfBytesToRead; processx__thread_readfile_data.lpNumberOfBytesRead = lpNumberOfBytesRead; SetEvent(processx__thread_start); WaitForSingleObject(processx__thread_done, INFINITE); return processx__thread_success; } /* GetQueuedCompletionStatus but in the bg thread */ BOOL processx__thread_getstatus(LPDWORD lpNumberOfBytes, PULONG_PTR lpCompletionKey, LPOVERLAPPED *lpOverlapped, DWORD dwMilliseconds) { processx__start_thread(); processx__thread_cmd = PROCESSX__THREAD_CMD_GETSTATUS; processx__thread_getstatus_data.lpNumberOfBytes = lpNumberOfBytes; processx__thread_getstatus_data.lpCompletionKey = lpCompletionKey; processx__thread_getstatus_data.lpOverlapped = lpOverlapped; processx__thread_getstatus_data.dwMilliseconds = dwMilliseconds; SetEvent(processx__thread_start); WaitForSingleObject(processx__thread_done, INFINITE); return processx__thread_success; } BOOL processx__thread_getstatus_select(LPDWORD lpNumberOfBytes, PULONG_PTR lpCompletionKey, LPOVERLAPPED *lpOverlapped, DWORD dwMilliseconds) { TIMEVAL timeout; char buf[10]; HANDLE iocp = processx__get_default_iocp(); int ret; processx__start_thread(); timeout.tv_sec = dwMilliseconds / 1000; timeout.tv_usec = dwMilliseconds % 1000 * 1000; processx__thread_cmd = PROCESSX__THREAD_CMD_GETSTATUS; processx__select = 1; processx__thread_getstatus_data.lpNumberOfBytes = lpNumberOfBytes; processx__thread_getstatus_data.lpCompletionKey = lpCompletionKey; processx__thread_getstatus_data.lpOverlapped = lpOverlapped; processx__thread_getstatus_data.dwMilliseconds = dwMilliseconds; SetEvent(processx__thread_start); ret = select(/* (ignored) */ 0, &processx__readfds, &processx__writefds, &processx__exceptionfds, &timeout); if (FD_ISSET(processx__notify_socket[0], &processx__readfds)) { /* TODO: error */ recv(processx__notify_socket[0], buf, 10, 0); } else { /* Wake up the IO thread. */ PostQueuedCompletionStatus(iocp, 0, processx__key_none, 0); } /* This waits until the IO thread is done */ WaitForSingleObject(processx__thread_done, INFINITE); return processx__thread_success; } DWORD processx__thread_get_last_error() { return processx__thread_last_error; } processx/src/win/utils.c0000644000176200001440000000056114026323556015020 0ustar liggesusers #include "../processx.h" SEXP processx_disable_crash_dialog() { /* TODO */ return R_NilValue; } SEXP processx__echo_on() { R_THROW_ERROR("Only implemented on Unix"); return R_NilValue; } SEXP processx__echo_off() { R_THROW_ERROR("Only implemented on Unix"); return R_NilValue; } SEXP processx_make_fifo(SEXP name) { /* TODO */ return R_NilValue; } processx/src/win/processx-win.h0000644000176200001440000000235114026323556016325 0ustar liggesusers #ifndef R_PROCESSX_WIN_H #define R_PROCESSX_WIN_H #include typedef struct processx_handle_s { int exitcode; int collected; /* Whether exit code was collected already */ HANDLE hProcess; DWORD dwProcessId; BYTE *child_stdio_buffer; HANDLE waitObject; processx_connection_t *pipes[3]; int cleanup; double create_time; } processx_handle_t; int processx__utf8_to_utf16_alloc(const char* s, WCHAR** ws_ptr); int processx__stdio_create(processx_handle_t *handle, SEXP connections, BYTE** buffer_ptr, SEXP privatex, const char *encoding, const char *cname, int* inherit_std); WORD processx__stdio_size(BYTE* buffer); HANDLE processx__stdio_handle(BYTE* buffer, int fd); void processx__stdio_destroy(BYTE* buffer); int processx__create_pipe(void *id, HANDLE* parent_pipe_ptr, HANDLE* child_pipe_ptr, const char *cname); int processx__create_input_pipe(void *id, HANDLE* parent_pipe_ptr, HANDLE* child_pipe_ptr, const char *cname); void processx__handle_destroy(processx_handle_t *handle); void processx__stdio_noinherit(BYTE* buffer); int processx__stdio_verify(BYTE* buffer, WORD size); double processx__create_time(HANDLE process); extern HANDLE processx__connection_iocp; #endif processx/src/win/stdio.c0000644000176200001440000003234314026323556015005 0ustar liggesusers #include #include "../processx.h" #include "processx-stdio.h" #include #include HANDLE processx__default_iocp = NULL; static int processx__create_nul_handle(HANDLE *handle_ptr, DWORD access) { HANDLE handle; SECURITY_ATTRIBUTES sa; sa.nLength = sizeof(sa); sa.lpSecurityDescriptor = NULL; sa.bInheritHandle = TRUE; handle = CreateFileW( /* lpFilename = */ L"NUL", /* dwDesiredAccess= */ access, /* dwShareMode = */ FILE_SHARE_READ | FILE_SHARE_WRITE, /* lpSecurityAttributes = */ &sa, /* dwCreationDisposition = */ OPEN_EXISTING, /* dwFlagsAndAttributes = */ 0, /* hTemplateFile = */ NULL); if (handle == INVALID_HANDLE_VALUE) { return GetLastError(); } *handle_ptr = handle; return 0; } static int processx__create_input_handle(HANDLE *handle_ptr, const char *file, DWORD access) { HANDLE handle; SECURITY_ATTRIBUTES sa; int err; sa.nLength = sizeof(sa); sa.lpSecurityDescriptor = NULL; sa.bInheritHandle = TRUE; WCHAR *filew; err = processx__utf8_to_utf16_alloc(file, &filew); if (err) return(err); handle = CreateFileW( /* lpFilename = */ filew, /* dwDesiredAccess= */ access, /* dwShareMode = */ FILE_SHARE_READ | FILE_SHARE_WRITE, /* lpSecurityAttributes = */ &sa, /* dwCreationDisposition = */ OPEN_EXISTING, /* dwFlagsAndAttributes = */ 0, /* hTemplateFile = */ NULL); if (handle == INVALID_HANDLE_VALUE) { return GetLastError(); } *handle_ptr = handle; return 0; } static int processx__create_output_handle(HANDLE *handle_ptr, const char *file, DWORD access) { HANDLE handle; SECURITY_ATTRIBUTES sa; int err; sa.nLength = sizeof(sa); sa.lpSecurityDescriptor = NULL; sa.bInheritHandle = TRUE; WCHAR *filew; err = processx__utf8_to_utf16_alloc(file, &filew); if (err) return(err); handle = CreateFileW( /* lpFilename = */ filew, /* dwDesiredAccess= */ access, /* dwShareMode = */ FILE_SHARE_READ | FILE_SHARE_WRITE, /* lpSecurityAttributes = */ &sa, /* dwCreationDisposition = */ CREATE_ALWAYS, /* dwFlagsAndAttributes = */ 0, /* hTemplateFile = */ NULL); if (handle == INVALID_HANDLE_VALUE) { return GetLastError(); } /* We will append, so set pointer to end of file */ SetFilePointer(handle, 0, NULL, FILE_END); *handle_ptr = handle; return 0; } static void processx__unique_pipe_name(char* ptr, char* name, size_t size) { int r; GetRNGstate(); r = (int)(unif_rand() * 65000); snprintf(name, size, "\\\\?\\pipe\\px\\%p-%lu", ptr + r, GetCurrentProcessId()); PutRNGstate(); } int processx__create_pipe(void *id, HANDLE* parent_pipe_ptr, HANDLE* child_pipe_ptr, const char *cname) { char pipe_name[40]; HANDLE hOutputRead = INVALID_HANDLE_VALUE; HANDLE hOutputWrite = INVALID_HANDLE_VALUE; SECURITY_ATTRIBUTES sa; DWORD err; char *errmessage = "error for process '%s'"; sa.nLength = sizeof(sa); sa.lpSecurityDescriptor = NULL; sa.bInheritHandle = TRUE; for (;;) { processx__unique_pipe_name(id, pipe_name, sizeof(pipe_name)); hOutputRead = CreateNamedPipeA( pipe_name, PIPE_ACCESS_OUTBOUND | PIPE_ACCESS_INBOUND | FILE_FLAG_OVERLAPPED | FILE_FLAG_FIRST_PIPE_INSTANCE, PIPE_TYPE_BYTE | PIPE_READMODE_BYTE | PIPE_WAIT, 1, 65536, 65536, 0, NULL); if (hOutputRead != INVALID_HANDLE_VALUE) { break; } err = GetLastError(); if (err != ERROR_PIPE_BUSY && err != ERROR_ACCESS_DENIED) { errmessage = "creating read pipe for '%s'"; goto error; } } hOutputWrite = CreateFileA( pipe_name, GENERIC_WRITE, 0, &sa, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL); if (hOutputWrite == INVALID_HANDLE_VALUE) { err = GetLastError(); errmessage = "creating write pipe for '%s'"; goto error; } *parent_pipe_ptr = hOutputRead; *child_pipe_ptr = hOutputWrite; return 0; error: if (hOutputRead != INVALID_HANDLE_VALUE) CloseHandle(hOutputRead); if (hOutputWrite != INVALID_HANDLE_VALUE) CloseHandle(hOutputWrite); R_THROW_SYSTEM_ERROR_CODE(err, errmessage, cname); return 0; /* never reached */ } int processx__create_input_pipe(void *id, HANDLE* parent_pipe_ptr, HANDLE* child_pipe_ptr, const char *cname) { char pipe_name[40]; HANDLE hOutputRead = INVALID_HANDLE_VALUE; HANDLE hOutputWrite = INVALID_HANDLE_VALUE; SECURITY_ATTRIBUTES sa; DWORD err; char *errmessage = "error for '%s'"; sa.nLength = sizeof(sa); sa.lpSecurityDescriptor = NULL; sa.bInheritHandle = TRUE; for (;;) { processx__unique_pipe_name(id, pipe_name, sizeof(pipe_name)); hOutputRead = CreateNamedPipeA( pipe_name, PIPE_ACCESS_OUTBOUND | PIPE_ACCESS_INBOUND | FILE_FLAG_FIRST_PIPE_INSTANCE, PIPE_TYPE_BYTE | PIPE_READMODE_BYTE | PIPE_WAIT, 1, 65536, 65536, 0, NULL); if (hOutputRead != INVALID_HANDLE_VALUE) { break; } err = GetLastError(); if (err != ERROR_PIPE_BUSY && err != ERROR_ACCESS_DENIED) { errmessage = "creating read pipe for '%s'"; goto error; } } hOutputWrite = CreateFileA( pipe_name, GENERIC_READ, 0, &sa, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL); if (hOutputWrite == INVALID_HANDLE_VALUE) { err = GetLastError(); errmessage = "creating write pipe for '%s'"; goto error; } *parent_pipe_ptr = hOutputRead; *child_pipe_ptr = hOutputWrite; return 0; error: if (hOutputRead != INVALID_HANDLE_VALUE) CloseHandle(hOutputRead); if (hOutputWrite != INVALID_HANDLE_VALUE) CloseHandle(hOutputWrite); R_THROW_SYSTEM_ERROR_CODE(err, errmessage, cname); return 0; /* never reached */ } processx_connection_t * processx__create_connection( HANDLE pipe_handle, const char *membername, SEXP private, const char *encoding, BOOL async) { processx_connection_t *con; SEXP res; con = processx_c_connection_create( pipe_handle, async ? PROCESSX_FILE_TYPE_ASYNCPIPE : PROCESSX_FILE_TYPE_PIPE, encoding, &res); defineVar(install(membername), res, private); return con; } static int processx__duplicate_handle(HANDLE handle, HANDLE* dup) { HANDLE current_process; /* _get_osfhandle will sometimes return -2 in case of an error. This seems */ /* to happen when fd <= 2 and the process' corresponding stdio handle is */ /* set to NULL. Unfortunately DuplicateHandle will happily duplicate */ /* (HANDLE) -2, so this situation goes unnoticed until someone tries to */ /* use the duplicate. Therefore we filter out known-invalid handles here. */ if (handle == INVALID_HANDLE_VALUE || handle == NULL || handle == (HANDLE) -2) { *dup = INVALID_HANDLE_VALUE; return ERROR_INVALID_HANDLE; } current_process = GetCurrentProcess(); if (!DuplicateHandle(current_process, handle, current_process, dup, 0, TRUE, DUPLICATE_SAME_ACCESS)) { *dup = INVALID_HANDLE_VALUE; return GetLastError(); } return 0; } int processx__stdio_create(processx_handle_t *handle, SEXP connections, BYTE** buffer_ptr, SEXP private, const char *encoding, const char *cname, int* inherit_std) { BYTE* buffer; int i; int err; int count = LENGTH(connections); if (count > 255) { R_THROW_ERROR("Too many processx connections to inherit, '%s'", cname); } /* Allocate the child stdio buffer */ buffer = malloc(CHILD_STDIO_SIZE(count)); if (!buffer) { R_THROW_ERROR("Out of memory for process"); } /* Prepopulate the buffer with INVALID_HANDLE_VALUE handles, so we can clean up on failure*/ CHILD_STDIO_COUNT(buffer) = count; for (i = 0; i < count; i++) { CHILD_STDIO_CRT_FLAGS(buffer, i) = 0; CHILD_STDIO_HANDLE(buffer, i) = INVALID_HANDLE_VALUE; } handle->pipes[0] = handle->pipes[1] = handle->pipes[2] = 0; for (i = 0; i < count; i++) { DWORD access = (i == 0) ? FILE_GENERIC_READ | FILE_WRITE_ATTRIBUTES : FILE_GENERIC_WRITE | FILE_READ_ATTRIBUTES; SEXP output = VECTOR_ELT(connections, i); const char *stroutput = Rf_isString(output) ? CHAR(STRING_ELT(output, 0)) : NULL; /* NULL means ignore */ if (isNull(output)) { /* ignored output */ err = processx__create_nul_handle(&CHILD_STDIO_HANDLE(buffer, i), access); if (err) { goto error; } CHILD_STDIO_CRT_FLAGS(buffer, i) = FOPEN | FDEV; } else if (i == 2 && stroutput && ! strcmp("2>&1", stroutput)) { /* This is stderr, sent to stdout */ /* We need to turn off buffering, otherwise the output on the two handles won't be correctly interleaved. We set FDEV on the pipes/files. This tricks windows into turning off the CRT buffering */ CHILD_STDIO_COPY(buffer, 2, 1); CHILD_STDIO_CRT_FLAGS(buffer, 1) = FOPEN | FDEV; CHILD_STDIO_CRT_FLAGS(buffer, 2) = FOPEN | FDEV; } else if (stroutput && ! strcmp("|", stroutput)) { /* piped output */ processx_connection_t *con = 0; HANDLE parent_handle; const char *r_pipe_name = i == 0 ? "stdin_pipe" : (i == 1 ? "stdout_pipe" : "stderr_pipe"); if (i == 0) { err = processx__create_input_pipe(handle, &parent_handle, &CHILD_STDIO_HANDLE(buffer, i), cname); } else { err = processx__create_pipe(handle, &parent_handle, &CHILD_STDIO_HANDLE(buffer, i), cname); } if (err) goto error; CHILD_STDIO_CRT_FLAGS(buffer, i) = FOPEN | FPIPE; con = processx__create_connection(parent_handle, r_pipe_name, private, encoding, i != 0); handle->pipes[i] = con; } else if (stroutput && strcmp("", stroutput)) { /* output to file */ if (i == 0) { err = processx__create_input_handle(&CHILD_STDIO_HANDLE(buffer, i), stroutput, access); } else { err = processx__create_output_handle(&CHILD_STDIO_HANDLE(buffer, i), stroutput, access); } if (err) { goto error; } CHILD_STDIO_CRT_FLAGS(buffer, i) = FOPEN | FDEV; } else { /* inherit connection */ HANDLE child_handle; HANDLE ihnd; /* std connection or extra connection */ if (stroutput) { *inherit_std = 1; DWORD nh = i == 0 ? STD_INPUT_HANDLE : (i == 1 ? STD_OUTPUT_HANDLE : STD_ERROR_HANDLE ); ihnd = GetStdHandle(nh); if (ihnd == INVALID_HANDLE_VALUE || ihnd == NULL || ihnd == (HANDLE) -2) { FILE *sh = i == 0 ? stdin : (i == 1 ? stdout : stderr); int fd = _fileno(sh); REprintf("Opening fd %i\n", fd); ihnd = (HANDLE) _get_osfhandle(fd); } } else { processx_connection_t *ccon = R_ExternalPtrAddr(output); if (!ccon) R_THROW_ERROR("Invalid (closed) connection"); ihnd = (HANDLE*) processx_c_connection_fileno(ccon); } err = processx__duplicate_handle(ihnd, &child_handle); if (err) goto error; switch (GetFileType(child_handle)) { case FILE_TYPE_DISK: CHILD_STDIO_CRT_FLAGS(buffer, i) = FOPEN; break; case FILE_TYPE_PIPE: CHILD_STDIO_CRT_FLAGS(buffer, i) = FOPEN | FDEV; break; case FILE_TYPE_CHAR: case FILE_TYPE_REMOTE: case FILE_TYPE_UNKNOWN: CHILD_STDIO_CRT_FLAGS(buffer, i) = FOPEN | FDEV; break; default: err = -1; goto error; } CHILD_STDIO_HANDLE(buffer, i) = child_handle; } } *buffer_ptr = buffer; return 0; error: processx__stdio_destroy(buffer); for (i = 0; i < 3; i++) { if (handle->pipes[i]) { processx_c_connection_destroy(handle->pipes[i]); } } return err; } void processx__stdio_destroy(BYTE* buffer) { int i, count; count = CHILD_STDIO_COUNT(buffer); for (i = 0; i < count; i++) { HANDLE handle = CHILD_STDIO_HANDLE(buffer, i); if (handle != INVALID_HANDLE_VALUE) { CloseHandle(handle); } } free(buffer); } void processx__stdio_noinherit(BYTE* buffer) { int i, count; count = CHILD_STDIO_COUNT(buffer); for (i = 0; i < count; i++) { HANDLE handle = CHILD_STDIO_HANDLE(buffer, i); if (handle != INVALID_HANDLE_VALUE) { SetHandleInformation(handle, HANDLE_FLAG_INHERIT, 0); } } } int processx__stdio_verify(BYTE* buffer, WORD size) { unsigned int count; /* Check the buffer pointer. */ if (buffer == NULL) return 0; /* Verify that the buffer is at least big enough to hold the count. */ if (size < CHILD_STDIO_SIZE(0)) return 0; /* Verify if the count is within range. */ count = CHILD_STDIO_COUNT(buffer); if (count > 256) return 0; /* Verify that the buffer size is big enough to hold info for N FDs. */ if (size < CHILD_STDIO_SIZE(count)) return 0; return 1; } WORD processx__stdio_size(BYTE* buffer) { return (WORD) CHILD_STDIO_SIZE(CHILD_STDIO_COUNT((buffer))); } HANDLE processx__stdio_handle(BYTE* buffer, int fd) { return CHILD_STDIO_HANDLE(buffer, fd); } processx/src/win/named_pipe.c0000644000176200001440000000750113616314040015752 0ustar liggesusers #ifdef _WIN32 #include #include #include #include #include #include "../errors.h" SEXP processx_is_named_pipe_open(SEXP pipe_ext) { if (pipe_ext == R_NilValue) R_THROW_ERROR("Not a named pipe handle."); // This function currently only tests if the named pipe has been closed // "properly", by processx_close_named_pipe(). It doesn't test if the // other end of the pipe has been closed. if (R_ExternalPtrAddr(pipe_ext) == NULL) return ScalarLogical(0); return ScalarLogical(1); } SEXP processx_close_named_pipe(SEXP pipe_ext) { if (pipe_ext == R_NilValue || R_ExternalPtrAddr(pipe_ext) == NULL) return R_NilValue; HANDLE h = (HANDLE)R_ExternalPtrAddr(pipe_ext); DisconnectNamedPipe(h); CloseHandle(h); R_ClearExternalPtr(pipe_ext); return R_NilValue; } // For the finalizer, we need to wrap the SEXP function with a void function. void named_pipe_finalizer(SEXP pipe_ext) { processx_close_named_pipe(pipe_ext); } SEXP processx_create_named_pipe(SEXP name, SEXP mode) { if (!isString(name) || name == R_NilValue || length(name) != 1) { R_THROW_ERROR("`name` must be a character vector of length 1."); } if (!isString(mode) || mode == R_NilValue || length(mode) != 1) { R_THROW_ERROR("`mode` must be either 'w' or 'r'."); } const char* name_str = CHAR(STRING_ELT(name, 0)); // const char* mode_str = CHAR(STRING_ELT(mode, 0)); if (strncmp("\\\\.\\pipe\\", name_str, sizeof("\\\\.\\pipe\\") - 1) != 0) { R_THROW_ERROR("`name` must start with \"\\\\.\\pipe\\\""); } // int mode_num; // if (strcmp(mode_str, "r") == 0) // mode_num = 0; // else if (strcmp(mode_str, "w") == 0) // mode_num = 1; // else // R_THROW_ERROR("`mode` must be either 'w' or 'r'."); HANDLE hPipe = CreateNamedPipe( name_str, PIPE_ACCESS_DUPLEX, PIPE_TYPE_MESSAGE | // message type pipe PIPE_READMODE_MESSAGE | // message-read mode PIPE_REJECT_REMOTE_CLIENTS | PIPE_NOWAIT, // blocking mode 1, // max. instances 1024, // output buffer size 1024, // input buffer size 0, // client time-out NULL // default security attribute ); if (hPipe == INVALID_HANDLE_VALUE) { R_THROW_SYSTEM_ERROR("Error creating named pipe"); } // Wrap it in an external pointer SEXP pipe_ext = PROTECT(R_MakeExternalPtr(hPipe, R_NilValue, R_NilValue)); R_RegisterCFinalizerEx(pipe_ext, named_pipe_finalizer, TRUE); UNPROTECT(1); return pipe_ext; } SEXP processx_write_named_pipe(SEXP pipe_ext, SEXP text) { if (!isString(text) || text == R_NilValue || length(text) != 1) { R_THROW_ERROR("`text` must be a character vector of length 1."); } if (pipe_ext == R_NilValue) { R_THROW_ERROR("Pipe must not be NULL."); } HANDLE hPipe = (HANDLE) R_ExternalPtrAddr(pipe_ext); if (hPipe == NULL) { R_THROW_ERROR("Pipe handle is NULL."); } const char* text_str = CHAR(STRING_ELT(text, 0)); DWORD n_written; BOOL success = WriteFile( hPipe, text_str, strlen(text_str), &n_written, NULL ); if (!success || strlen(text_str) != n_written) { DWORD last_error = GetLastError(); const char* extra_info = ""; if (last_error == 536) { extra_info = " No process is listening on other end of pipe."; } R_THROW_SYSTEM_ERROR_CODE( last_error, "An error occurred when writing to the named pipe. %s", extra_info); } FlushFileBuffers(hPipe); return text; } #endif processx/src/win/processx-stdio.h0000644000176200001440000000266213616314040016647 0ustar liggesusers #include #include "../processx.h" /* * The `child_stdio_buffer` buffer has the following layout: * int number_of_fds * unsigned char crt_flags[number_of_fds] * HANDLE os_handle[number_of_fds] */ #define CHILD_STDIO_SIZE(count) \ (sizeof(int) + \ sizeof(unsigned char) * (count) + \ sizeof(uintptr_t) * (count)) #define CHILD_STDIO_COUNT(buffer) \ *((unsigned int*) (buffer)) #define CHILD_STDIO_CRT_FLAGS(buffer, fd) \ *((unsigned char*) (buffer) + sizeof(int) + fd) #define CHILD_STDIO_HANDLE(buffer, fd) \ *((HANDLE*) ((unsigned char*) (buffer) + \ sizeof(int) + \ sizeof(unsigned char) * \ CHILD_STDIO_COUNT((buffer)) + \ sizeof(HANDLE) * (fd))) #define CHILD_STDIO_COPY(buffer, dst, src) do { \ DuplicateHandle( \ GetCurrentProcess(), \ CHILD_STDIO_HANDLE(buffer, src), \ GetCurrentProcess(), \ &CHILD_STDIO_HANDLE(buffer, dst), \ 0, TRUE, DUPLICATE_SAME_ACCESS); \ } while (0) /* CRT file descriptor mode flags */ #define FOPEN 0x01 #define FEOFLAG 0x02 #define FCRLF 0x04 #define FPIPE 0x08 #define FNOINHERIT 0x10 #define FAPPEND 0x20 #define FDEV 0x40 #define FTEXT 0x80 processx/src/win/processx.c0000644000176200001440000011065514043002736015525 0ustar liggesusers #include #include #include "../processx.h" #include static HANDLE processx__global_job_handle = NULL; static void processx__init_global_job_handle(void) { /* Create a job object and set it up to kill all contained processes when * it's closed. Since this handle is made non-inheritable and we're not * giving it to anyone, we're the only process holding a reference to it. * That means that if this process exits it is closed and all the * processes it contains are killed. All processes created with processx * that are spawned without the cleanup flag are assigned to this job. * * We're setting the JOB_OBJECT_LIMIT_SILENT_BREAKAWAY_OK flag so only * the processes that we explicitly add are affected, and *their* * subprocesses are not. This ensures that our child processes are not * limited in their ability to use job control on Windows versions that * don't deal with nested jobs (prior to Windows 8 / Server 2012). It * also lets our child processes create detached processes without * explicitly breaking away from job control (which processx_exec * doesn't do, either). */ SECURITY_ATTRIBUTES attr; JOBOBJECT_EXTENDED_LIMIT_INFORMATION info; memset(&attr, 0, sizeof attr); attr.bInheritHandle = FALSE; memset(&info, 0, sizeof info); info.BasicLimitInformation.LimitFlags = JOB_OBJECT_LIMIT_BREAKAWAY_OK | JOB_OBJECT_LIMIT_SILENT_BREAKAWAY_OK | JOB_OBJECT_LIMIT_DIE_ON_UNHANDLED_EXCEPTION | JOB_OBJECT_LIMIT_KILL_ON_JOB_CLOSE; processx__global_job_handle = CreateJobObjectW(&attr, NULL); if (processx__global_job_handle == NULL) { R_THROW_SYSTEM_ERROR("Creating global job object"); } if (!SetInformationJobObject(processx__global_job_handle, JobObjectExtendedLimitInformation, &info, sizeof info)) { R_THROW_SYSTEM_ERROR("Setting up global job object"); } } void R_init_processx_win() { /* Nothing to do currently */ } SEXP processx__unload_cleanup() { if (processx__connection_iocp) CloseHandle(processx__connection_iocp); if (processx__iocp_thread) TerminateThread(processx__iocp_thread, 0); if (processx__thread_start) CloseHandle(processx__thread_start); if (processx__thread_done) CloseHandle(processx__thread_done); processx__connection_iocp = processx__iocp_thread = processx__thread_start = processx__thread_done = NULL; if (processx__global_job_handle) { TerminateJobObject(processx__global_job_handle, 1); CloseHandle(processx__global_job_handle); processx__global_job_handle = NULL; } return R_NilValue; } int processx__utf8_to_utf16_alloc(const char* s, WCHAR** ws_ptr) { int ws_len, r; WCHAR* ws; ws_len = MultiByteToWideChar( /* CodePage = */ CP_UTF8, /* dwFlags = */ 0, /* lpMultiByteStr = */ s, /* cbMultiByte = */ -1, /* lpWideCharStr = */ NULL, /* cchWideChar = */ 0); if (ws_len <= 0) { return GetLastError(); } ws = (WCHAR*) R_alloc(ws_len, sizeof(WCHAR)); if (ws == NULL) { return ERROR_OUTOFMEMORY; } r = MultiByteToWideChar( /* CodePage = */ CP_UTF8, /* dwFlags = */ 0, /* lpMultiByteStr = */ s, /* cbMultiBytes = */ -1, /* lpWideCharStr = */ ws, /* cchWideChar = */ ws_len); if (r != ws_len) { R_THROW_ERROR("processx error interpreting UTF8 command or arguments: '%s'", s); } *ws_ptr = ws; return 0; } WCHAR* processx__quote_cmd_arg(const WCHAR *source, WCHAR *target) { size_t len = wcslen(source); size_t i; int quote_hit; WCHAR* start; if (len == 0) { /* Need double quotation for empty argument */ *(target++) = L'"'; *(target++) = L'"'; return target; } if (NULL == wcspbrk(source, L" \t\"")) { /* No quotation needed */ wcsncpy(target, source, len); target += len; return target; } if (NULL == wcspbrk(source, L"\"\\")) { /* * No embedded double quotes or backlashes, so I can just wrap * quote marks around the whole thing. */ *(target++) = L'"'; wcsncpy(target, source, len); target += len; *(target++) = L'"'; return target; } /* * Expected input/output: * input : hello"world * output: "hello\"world" * input : hello""world * output: "hello\"\"world" * input : hello\world * output: hello\world * input : hello\\world * output: hello\\world * input : hello\"world * output: "hello\\\"world" * input : hello\\"world * output: "hello\\\\\"world" * input : hello world\ * output: "hello world\\" */ *(target++) = L'"'; start = target; quote_hit = 1; for (i = len; i > 0; --i) { *(target++) = source[i - 1]; if (quote_hit && source[i - 1] == L'\\') { *(target++) = L'\\'; } else if(source[i - 1] == L'"') { quote_hit = 1; *(target++) = L'\\'; } else { quote_hit = 0; } } target[0] = L'\0'; wcsrev(start); *(target++) = L'"'; return target; } static int processx__make_program_args(SEXP args, int verbatim_arguments, WCHAR **dst_ptr) { const char* arg; WCHAR* dst = NULL; WCHAR* temp_buffer = NULL; size_t dst_len = 0; size_t temp_buffer_len = 0; WCHAR* pos; int arg_count = LENGTH(args); int err = 0; int i; /* Count the required size. */ for (i = 0; i < arg_count; i++) { DWORD arg_len; arg = CHAR(STRING_ELT(args, i)); arg_len = MultiByteToWideChar( /* CodePage = */ CP_UTF8, /* dwFlags = */ 0, /* lpMultiByteStr = */ arg, /* cbMultiBytes = */ -1, /* lpWideCharStr = */ NULL, /* cchWideChar = */ 0); if (arg_len == 0) { return GetLastError(); } dst_len += arg_len; if (arg_len > temp_buffer_len) { temp_buffer_len = arg_len; } } /* Adjust for potential quotes. Also assume the worst-case scenario */ /* that every character needs escaping, so we need twice as much space. */ dst_len = dst_len * 2 + arg_count * 2; /* Allocate buffer for the final command line. */ dst = (WCHAR*) R_alloc(dst_len, sizeof(WCHAR)); /* Allocate temporary working buffer. */ temp_buffer = (WCHAR*) R_alloc(temp_buffer_len, sizeof(WCHAR)); pos = dst; for (i = 0; i < arg_count; i++) { DWORD arg_len; arg = CHAR(STRING_ELT(args, i)); /* Convert argument to wide char. */ arg_len = MultiByteToWideChar( /* CodePage = */ CP_UTF8, /* dwFlags = */ 0, /* lpMultiByteStr = */ arg, /* cbMultiBytes = */ -1, /* lpWideCharStr = */ temp_buffer, /* cchWideChar = */ (int) (dst + dst_len - pos)); if (arg_len == 0) { err = GetLastError(); goto error; } if (verbatim_arguments) { /* Copy verbatim. */ wcscpy(pos, temp_buffer); pos += arg_len - 1; } else { /* Quote/escape, if needed. */ pos = processx__quote_cmd_arg(temp_buffer, pos); } *pos++ = i < arg_count - 1 ? L' ' : L'\0'; } *dst_ptr = dst; return 0; error: return err; } /* * The way windows takes environment variables is different than what C does; * Windows wants a contiguous block of null-terminated strings, terminated * with an additional null. * * Windows has a few "essential" environment variables. winsock will fail * to initialize if SYSTEMROOT is not defined; some APIs make reference to * TEMP. SYSTEMDRIVE is probably also important. We therefore ensure that * these get defined if the input environment block does not contain any * values for them. * * Also add variables known to Cygwin to be required for correct * subprocess operation in many cases: * https://github.com/Alexpux/Cygwin/blob/b266b04fbbd3a595f02ea149e4306d3ab9b1fe3d/winsup/cygwin/environ.cc#L955 * */ typedef struct env_var { const WCHAR* const wide; const WCHAR* const wide_eq; const size_t len; /* including null or '=' */ } env_var_t; #define E_V(str) { L##str, L##str L"=", sizeof(str) } static const env_var_t required_vars[] = { /* keep me sorted */ E_V("HOMEDRIVE"), E_V("HOMEPATH"), E_V("LOGONSERVER"), E_V("PATH"), E_V("SYSTEMDRIVE"), E_V("SYSTEMROOT"), E_V("TEMP"), E_V("USERDOMAIN"), E_V("USERNAME"), E_V("USERPROFILE"), E_V("WINDIR"), }; static size_t n_required_vars = ARRAY_SIZE(required_vars); int env_strncmp(const wchar_t* a, int na, const wchar_t* b) { wchar_t* a_eq; wchar_t* b_eq; wchar_t* A; wchar_t* B; int nb; int r; if (na < 0) { a_eq = wcschr(a, L'='); na = (int)(long)(a_eq - a); } else { na--; } b_eq = wcschr(b, L'='); nb = b_eq - b; A = alloca((na+1) * sizeof(wchar_t)); B = alloca((nb+1) * sizeof(wchar_t)); r = LCMapStringW(LOCALE_INVARIANT, LCMAP_UPPERCASE, a, na, A, na); if (!r) R_THROW_SYSTEM_ERROR("make environment for process"); A[na] = L'\0'; r = LCMapStringW(LOCALE_INVARIANT, LCMAP_UPPERCASE, b, nb, B, nb); if (!r) R_THROW_SYSTEM_ERROR("make environment for process"); B[nb] = L'\0'; while (1) { wchar_t AA = *A++; wchar_t BB = *B++; if (AA < BB) { return -1; } else if (AA > BB) { return 1; } else if (!AA && !BB) { return 0; } } } static int qsort_wcscmp(const void *a, const void *b) { wchar_t* astr = *(wchar_t* const*)a; wchar_t* bstr = *(wchar_t* const*)b; return env_strncmp(astr, -1, bstr); } static int processx__add_tree_id_env(const char *ctree_id, WCHAR **dst_ptr) { WCHAR *env = GetEnvironmentStringsW(); int len = 0, len2 = 0; WCHAR *ptr = env; WCHAR *id = 0; int err; int idlen; WCHAR *dst_copy; if (!env) return GetLastError(); err = processx__utf8_to_utf16_alloc(ctree_id, &id); if (err) { FreeEnvironmentStringsW(env); return(err); } while (1) { WCHAR *prev = ptr; if (!*ptr) break; while (*ptr) ptr++; ptr++; len += (ptr - prev); } /* Plus the id */ idlen = wcslen(id) + 1; len2 = len + idlen; /* Allocate, copy */ dst_copy = (WCHAR*) R_alloc(len2 + 1, sizeof(WCHAR)); /* +1 for final zero */ memcpy(dst_copy, env, len * sizeof(WCHAR)); memcpy(dst_copy + len, id, idlen * sizeof(WCHAR)); /* Final \0 */ *(dst_copy + len2) = L'\0'; *dst_ptr = dst_copy; FreeEnvironmentStringsW(env); return 0; } static int processx__make_program_env(SEXP env_block, const char *tree_id, WCHAR** dst_ptr, const char *cname) { WCHAR* dst; WCHAR* ptr; size_t env_len = 0; int len; size_t i; DWORD var_size; size_t env_block_count = 1; /* 1 for null-terminator */ WCHAR* dst_copy; WCHAR** ptr_copy; WCHAR** env_copy; DWORD* required_vars_value_len = alloca(n_required_vars * sizeof(DWORD*)); int j, num = LENGTH(env_block); /* first pass: determine size in UTF-16 */ for (j = 0; j < num; j++) { const char *env = CHAR(STRING_ELT(env_block, j)); if (strchr(env, '=')) { len = MultiByteToWideChar(CP_UTF8, 0, env, -1, NULL, 0); if (len <= 0) { return GetLastError(); } env_len += len; env_block_count++; } } /* Plus the tree id */ len = MultiByteToWideChar(CP_UTF8, 0, tree_id, -1, NULL, 0); if (len <= 0) return GetLastError(); env_len += len; env_block_count++; /* second pass: copy to UTF-16 environment block */ dst_copy = (WCHAR*) R_alloc(env_len, sizeof(WCHAR)); env_copy = alloca(env_block_count * sizeof(WCHAR*)); ptr = dst_copy; ptr_copy = env_copy; for (j = 0; j < num; j++) { const char *env = CHAR(STRING_ELT(env_block, j)); if (strchr(env, '=')) { len = MultiByteToWideChar(CP_UTF8, 0, env, -1, ptr, (int) (env_len - (ptr - dst_copy))); if (len <= 0) { DWORD err = GetLastError(); return err; } *ptr_copy++ = ptr; ptr += len; } } /* Plus the tree id */ len = MultiByteToWideChar(CP_UTF8, 0, tree_id, -1, ptr, (int) (env_len - (ptr - dst_copy))); if (len <= 0) return GetLastError(); *ptr_copy++ = ptr; ptr += len; *ptr_copy = NULL; /* sort our (UTF-16) copy */ qsort(env_copy, env_block_count-1, sizeof(wchar_t*), qsort_wcscmp); /* third pass: check for required variables */ for (ptr_copy = env_copy, i = 0; i < n_required_vars; ) { int cmp; if (!*ptr_copy) { cmp = -1; } else { cmp = env_strncmp(required_vars[i].wide_eq, required_vars[i].len, *ptr_copy); } if (cmp < 0) { /* missing required var */ var_size = GetEnvironmentVariableW(required_vars[i].wide, NULL, 0); required_vars_value_len[i] = var_size; if (var_size != 0) { env_len += required_vars[i].len; env_len += var_size; } i++; } else { ptr_copy++; if (cmp == 0) i++; } } /* final pass: copy, in sort order, and inserting required variables */ dst = (WCHAR*) R_alloc(1 + env_len, sizeof(WCHAR)); for (ptr = dst, ptr_copy = env_copy, i = 0; *ptr_copy || i < n_required_vars; ptr += len) { int cmp; if (i >= n_required_vars) { cmp = 1; } else if (!*ptr_copy) { cmp = -1; } else { cmp = env_strncmp(required_vars[i].wide_eq, required_vars[i].len, *ptr_copy); } if (cmp < 0) { /* missing required var */ len = required_vars_value_len[i]; if (len) { wcscpy(ptr, required_vars[i].wide_eq); ptr += required_vars[i].len; var_size = GetEnvironmentVariableW(required_vars[i].wide, ptr, (int) (env_len - (ptr - dst))); if (var_size != len-1) { /* race condition? */ R_THROW_SYSTEM_ERROR("GetEnvironmentVariableW for process '%s'", cname); } } i++; } else { /* copy var from env_block */ len = wcslen(*ptr_copy) + 1; wmemcpy(ptr, *ptr_copy, len); ptr_copy++; if (cmp == 0) i++; } } /* Terminate with an extra NULL. */ *ptr = L'\0'; *dst_ptr = dst; return 0; } static WCHAR* processx__search_path_join_test(const WCHAR* dir, size_t dir_len, const WCHAR* name, size_t name_len, const WCHAR* ext, size_t ext_len, const WCHAR* cwd, size_t cwd_len) { WCHAR *result, *result_pos; DWORD attrs; if (dir_len > 2 && dir[0] == L'\\' && dir[1] == L'\\') { /* It's a UNC path so ignore cwd */ cwd_len = 0; } else if (dir_len >= 1 && (dir[0] == L'/' || dir[0] == L'\\')) { /* It's a full path without drive letter, use cwd's drive letter only */ cwd_len = 2; } else if (dir_len >= 2 && dir[1] == L':' && (dir_len < 3 || (dir[2] != L'/' && dir[2] != L'\\'))) { /* It's a relative path with drive letter (ext.g. D:../some/file) * Replace drive letter in dir by full cwd if it points to the same drive, * otherwise use the dir only. */ if (cwd_len < 2 || _wcsnicmp(cwd, dir, 2) != 0) { cwd_len = 0; } else { dir += 2; dir_len -= 2; } } else if (dir_len > 2 && dir[1] == L':') { /* It's an absolute path with drive letter * Don't use the cwd at all */ cwd_len = 0; } /* Allocate buffer for output */ result = result_pos = (WCHAR*) R_alloc( (cwd_len + 1 + dir_len + 1 + name_len + 1 + ext_len + 1), sizeof(WCHAR)); /* Copy cwd */ wcsncpy(result_pos, cwd, cwd_len); result_pos += cwd_len; /* Add a path separator if cwd didn't end with one */ if (cwd_len && wcsrchr(L"\\/:", result_pos[-1]) == NULL) { result_pos[0] = L'\\'; result_pos++; } /* Copy dir */ wcsncpy(result_pos, dir, dir_len); result_pos += dir_len; /* Add a separator if the dir didn't end with one */ if (dir_len && wcsrchr(L"\\/:", result_pos[-1]) == NULL) { result_pos[0] = L'\\'; result_pos++; } /* Copy filename */ wcsncpy(result_pos, name, name_len); result_pos += name_len; if (ext_len) { /* Add a dot if the filename didn't end with one */ if (name_len && result_pos[-1] != '.') { result_pos[0] = L'.'; result_pos++; } /* Copy extension */ wcsncpy(result_pos, ext, ext_len); result_pos += ext_len; } /* Null terminator */ result_pos[0] = L'\0'; attrs = GetFileAttributesW(result); if (attrs != INVALID_FILE_ATTRIBUTES && !(attrs & FILE_ATTRIBUTE_DIRECTORY)) { return result; } return NULL; } /* * Helper function for search_path */ static WCHAR* processx__path_search_walk_ext(const WCHAR *dir, size_t dir_len, const WCHAR *name, size_t name_len, WCHAR *cwd, size_t cwd_len, int name_has_ext) { WCHAR* result; /* If the name itself has a nonempty extension, try this extension first */ if (name_has_ext) { result = processx__search_path_join_test(dir, dir_len, name, name_len, L"", 0, cwd, cwd_len); if (result != NULL) { return result; } } /* Try .com extension */ result = processx__search_path_join_test(dir, dir_len, name, name_len, L"com", 3, cwd, cwd_len); if (result != NULL) { return result; } /* Try .exe extension */ result = processx__search_path_join_test(dir, dir_len, name, name_len, L"exe", 3, cwd, cwd_len); if (result != NULL) { return result; } return NULL; } /* * search_path searches the system path for an executable filename - * the windows API doesn't provide this as a standalone function nor as an * option to CreateProcess. * * It tries to return an absolute filename. * * Furthermore, it tries to follow the semantics that cmd.exe, with this * exception that PATHEXT environment variable isn't used. Since CreateProcess * can start only .com and .exe files, only those extensions are tried. This * behavior equals that of msvcrt's spawn functions. * * - Do not search the path if the filename already contains a path (either * relative or absolute). * * - If there's really only a filename, check the current directory for file, * then search all path directories. * * - If filename specified has *any* extension, search for the file with the * specified extension first. * * - If the literal filename is not found in a directory, try *appending* * (not replacing) .com first and then .exe. * * - The path variable may contain relative paths; relative paths are relative * to the cwd. * * - Directories in path may or may not end with a trailing backslash. * * - CMD does not trim leading/trailing whitespace from path/pathex entries * nor from the environment variables as a whole. * * - When cmd.exe cannot read a directory, it will just skip it and go on * searching. However, unlike posix-y systems, it will happily try to run a * file that is not readable/executable; if the spawn fails it will not * continue searching. * * UNC path support: we are dealing with UNC paths in both the path and the * filename. This is a deviation from what cmd.exe does (it does not let you * start a program by specifying an UNC path on the command line) but this is * really a pointless restriction. * */ static WCHAR* processx__search_path(const WCHAR *file, WCHAR *cwd, const WCHAR *path) { int file_has_dir; WCHAR* result = NULL; WCHAR *file_name_start; WCHAR *dot; const WCHAR *dir_start, *dir_end, *dir_path; size_t dir_len; int name_has_ext; size_t file_len = wcslen(file); size_t cwd_len = wcslen(cwd); /* If the caller supplies an empty filename, * we're not gonna return c:\windows\.exe -- GFY! */ if (file_len == 0 || (file_len == 1 && file[0] == L'.')) { return NULL; } /* Find the start of the filename so we can split the directory from the */ /* name. */ for (file_name_start = (WCHAR*)file + file_len; file_name_start > file && file_name_start[-1] != L'\\' && file_name_start[-1] != L'/' && file_name_start[-1] != L':'; file_name_start--); file_has_dir = file_name_start != file; /* Check if the filename includes an extension */ dot = wcschr(file_name_start, L'.'); name_has_ext = (dot != NULL && dot[1] != L'\0'); if (file_has_dir) { /* The file has a path inside, don't use path */ result = processx__path_search_walk_ext( file, file_name_start - file, file_name_start, file_len - (file_name_start - file), cwd, cwd_len, name_has_ext); } else { dir_end = path; /* The file is really only a name; look in cwd first, then scan path */ result = processx__path_search_walk_ext(L"", 0, file, file_len, cwd, cwd_len, name_has_ext); while (result == NULL) { if (*dir_end == L'\0') { break; } /* Skip the separator that dir_end now points to */ if (dir_end != path || *path == L';') { dir_end++; } /* Next slice starts just after where the previous one ended */ dir_start = dir_end; /* Slice until the next ; or \0 is found */ dir_end = wcschr(dir_start, L';'); if (dir_end == NULL) { dir_end = wcschr(dir_start, L'\0'); } /* If the slice is zero-length, don't bother */ if (dir_end - dir_start == 0) { continue; } dir_path = dir_start; dir_len = dir_end - dir_start; /* Adjust if the path is quoted. */ if (dir_path[0] == '"' || dir_path[0] == '\'') { ++dir_path; --dir_len; } if (dir_path[dir_len - 1] == '"' || dir_path[dir_len - 1] == '\'') { --dir_len; } result = processx__path_search_walk_ext(dir_path, dir_len, file, file_len, cwd, cwd_len, name_has_ext); } } return result; } void processx__collect_exit_status(SEXP status, DWORD exitcode); DWORD processx__terminate(processx_handle_t *handle, SEXP status) { DWORD err; err = TerminateProcess(handle->hProcess, 2); if (err) processx__collect_exit_status(status, 2); WaitForSingleObject(handle->hProcess, INFINITE); CloseHandle(handle->hProcess); handle->hProcess = 0; return err; } void processx__finalizer(SEXP status) { processx_handle_t *handle = (processx_handle_t*) R_ExternalPtrAddr(status); if (!handle) return; if (handle->cleanup && !handle->collected) { /* Just in case it is running */ processx__terminate(handle, status); } if (handle->hProcess) CloseHandle(handle->hProcess); handle->hProcess = NULL; R_ClearExternalPtr(status); processx__handle_destroy(handle); } SEXP processx__make_handle(SEXP private, int cleanup) { processx_handle_t * handle; SEXP result; handle = (processx_handle_t*) malloc(sizeof(processx_handle_t)); if (!handle) { R_THROW_ERROR("Out of memory when creating subprocess"); } memset(handle, 0, sizeof(processx_handle_t)); result = PROTECT(R_MakeExternalPtr(handle, private, R_NilValue)); R_RegisterCFinalizerEx(result, processx__finalizer, 1); handle->cleanup = cleanup; UNPROTECT(1); return result; } void processx__handle_destroy(processx_handle_t *handle) { if (!handle) return; if (handle->child_stdio_buffer) free(handle->child_stdio_buffer); free(handle); } SEXP processx_exec(SEXP command, SEXP args, SEXP pty, SEXP pty_options, 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) { const char *ccommand = CHAR(STRING_ELT(command, 0)); const char *cencoding = CHAR(STRING_ELT(encoding, 0)); const char *ccwd = isNull(wd) ? 0 : CHAR(STRING_ELT(wd, 0)); const char *ctree_id = CHAR(STRING_ELT(tree_id, 0)); int err = 0; WCHAR *path; WCHAR *application_path = NULL, *application = NULL, *arguments = NULL, *cenv = NULL, *cwd = NULL; processx_options_t options; STARTUPINFOW startup = { 0 }; PROCESS_INFORMATION info = { 0 }; DWORD process_flags; processx_handle_t *handle; int ccleanup = INTEGER(cleanup)[0]; SEXP result; DWORD dwerr; options.windows_verbatim_args = LOGICAL(windows_verbatim_args)[0]; options.windows_hide = LOGICAL(windows_hide)[0]; err = processx__utf8_to_utf16_alloc(CHAR(STRING_ELT(command, 0)), &application); if (err) { R_THROW_SYSTEM_ERROR_CODE(err, "utf8 -> utf16 conversion '%s'", ccommand); } err = processx__make_program_args( args, options.windows_verbatim_args, &arguments); if (err) { R_THROW_SYSTEM_ERROR_CODE(err, "making program args '%s'", ccommand); } if (isNull(env)) { err = processx__add_tree_id_env(ctree_id, &cenv); } else { err = processx__make_program_env(env, ctree_id, &cenv, ccommand); } if (err) R_THROW_SYSTEM_ERROR_CODE(err, "making environment '%s'", ccommand); if (ccwd) { /* Explicit cwd */ err = processx__utf8_to_utf16_alloc(ccwd, &cwd); if (err) { R_THROW_SYSTEM_ERROR("convert current directory encoding '%s'", ccommand); } } else { /* Inherit cwd */ DWORD cwd_len, r; cwd_len = GetCurrentDirectoryW(0, NULL); if (!cwd_len) { R_THROW_SYSTEM_ERROR("get current directory length '%s'", ccommand); } cwd = (WCHAR*) R_alloc(cwd_len, sizeof(WCHAR)); r = GetCurrentDirectoryW(cwd_len, cwd); if (r == 0 || r >= cwd_len) { R_THROW_SYSTEM_ERROR("get current directory '%s'", ccommand); } } /* Get PATH environment variable */ { DWORD path_len, r; path_len = GetEnvironmentVariableW(L"PATH", NULL, 0); if (!path_len) { R_THROW_SYSTEM_ERROR("get env var length '%s'", ccommand); } path = (WCHAR*) R_alloc(path_len, sizeof(WCHAR)); r = GetEnvironmentVariableW(L"PATH", path, path_len); if (r == 0 || r >= path_len) { R_THROW_SYSTEM_ERROR("get PATH env var for '%s'", ccommand); } } result = PROTECT(processx__make_handle(private, ccleanup)); handle = R_ExternalPtrAddr(result); int inherit_std = 0; err = processx__stdio_create(handle, connections, &handle->child_stdio_buffer, private, cencoding, ccommand, &inherit_std); if (err) { R_THROW_SYSTEM_ERROR_CODE(err, "setup stdio for '%s'", ccommand); } application_path = processx__search_path(application, cwd, path); /* If a UNC Path, then we try to flip the forward slashes, if any. * It is apparently enough to flip the first two slashes, the rest * are not important. */ if (! application_path && wcslen(path) >= 2 && application[0] == L'/' && application[1] == L'/') { application[0] = L'\\'; application[1] = L'\\'; application_path = processx__search_path(application, cwd, path); } if (!application_path) { R_ClearExternalPtr(result); processx__stdio_destroy(handle->child_stdio_buffer); free(handle); R_THROW_ERROR("Command '%s' not found", ccommand); } startup.cb = sizeof(startup); startup.lpReserved = NULL; startup.lpDesktop = NULL; startup.lpTitle = NULL; startup.dwFlags = STARTF_USESTDHANDLES | STARTF_USESHOWWINDOW; startup.cbReserved2 = processx__stdio_size(handle->child_stdio_buffer); startup.lpReserved2 = (BYTE*) handle->child_stdio_buffer; startup.hStdInput = processx__stdio_handle(handle->child_stdio_buffer, 0); startup.hStdOutput = processx__stdio_handle(handle->child_stdio_buffer, 1); startup.hStdError = processx__stdio_handle(handle->child_stdio_buffer, 2); startup.wShowWindow = options.windows_hide ? SW_HIDE : SW_SHOWDEFAULT; process_flags = CREATE_UNICODE_ENVIRONMENT | CREATE_SUSPENDED; /* We only use CREATE_NO_WINDOW if none of stdin, stdout and stderr * are inherited, because if there is no window, then inherited * handles do not work. Other inherited handles should be fine, * I think. See https://github.com/gaborcsardi/win32-console-docs * for more about CREATE_NO_WINDOW. */ if (! inherit_std) process_flags |= CREATE_NO_WINDOW; if (!ccleanup) { /* Note that we're not setting the CREATE_BREAKAWAY_FROM_JOB flag. That * means that processx might not let you create a fully deamonized * process when run under job control. However the type of job control * that processx itself creates doesn't trickle down to subprocesses * so they can still daemonize. * * A reason to not do this is that CREATE_BREAKAWAY_FROM_JOB makes the * CreateProcess call fail if we're under job control that doesn't * allow breakaway. */ process_flags |= CREATE_NEW_PROCESS_GROUP; } if (LOGICAL(windows_detached_process)[0]) { process_flags |= DETACHED_PROCESS; } err = CreateProcessW( /* lpApplicationName = */ application_path, /* lpCommandLine = */ arguments, /* lpProcessAttributes = */ NULL, /* lpThreadAttributes = */ NULL, /* bInheritHandles = */ 1, /* dwCreationFlags = */ process_flags, /* lpEnvironment = */ cenv, /* lpCurrentDirectory = */ cwd, /* lpStartupInfo = */ &startup, /* lpProcessInformation = */ &info); if (!err) { R_THROW_SYSTEM_ERROR("create process '%s'", ccommand); } handle->hProcess = info.hProcess; handle->dwProcessId = info.dwProcessId; /* Query official creation time. On Windows this is not used as an id, since the pid itself is valid until the process handle is released. */ handle->create_time = processx__create_time(handle->hProcess); /* If the process isn't spawned as detached, assign to the global job */ /* object so windows will kill it when the parent process dies. */ if (ccleanup) { if (! processx__global_job_handle) processx__init_global_job_handle(); if (!AssignProcessToJobObject(processx__global_job_handle, info.hProcess)) { /* AssignProcessToJobObject might fail if this process is under job * control and the job doesn't have the * JOB_OBJECT_LIMIT_SILENT_BREAKAWAY_OK flag set, on a Windows * version that doesn't support nested jobs. * * When that happens we just swallow the error and continue without * establishing a kill-child-on-parent-exit relationship, otherwise * there would be no way for R/processx applications run under job * control to spawn processes at all. */ DWORD err = GetLastError(); if (err != ERROR_ACCESS_DENIED) { R_THROW_SYSTEM_ERROR_CODE(err, "Assign to job object '%s'", ccommand); } } } dwerr = ResumeThread(info.hThread); if (dwerr == (DWORD) -1) { R_THROW_SYSTEM_ERROR("resume thread for '%s'", ccommand); } CloseHandle(info.hThread); processx__stdio_destroy(handle->child_stdio_buffer); handle->child_stdio_buffer = NULL; UNPROTECT(1); return result; } void processx__collect_exit_status(SEXP status, DWORD exitcode) { processx_handle_t *handle = R_ExternalPtrAddr(status); handle->exitcode = exitcode; handle->collected = 1; } SEXP processx_wait(SEXP status, SEXP timeout, SEXP name) { int ctimeout = INTEGER(timeout)[0], timeleft = ctimeout; const char *cname = isNull(name) ? "???" : CHAR(STRING_ELT(name, 0)); processx_handle_t *handle = R_ExternalPtrAddr(status); DWORD err, err2, exitcode; if (!handle) return ScalarLogical(1); if (handle->collected) return ScalarLogical(1); err2 = WAIT_TIMEOUT; while (ctimeout < 0 || timeleft > PROCESSX_INTERRUPT_INTERVAL) { err2 = WaitForSingleObject(handle->hProcess, PROCESSX_INTERRUPT_INTERVAL); if (err2 != WAIT_TIMEOUT) break; R_CheckUserInterrupt(); timeleft -= PROCESSX_INTERRUPT_INTERVAL; } /* Maybe there is some time left from the timeout */ if (err2 == WAIT_TIMEOUT && timeleft >= 0) { err2 = WaitForSingleObject(handle->hProcess, timeleft); } if (err2 == WAIT_FAILED) { R_THROW_SYSTEM_ERROR("failed to wait on process '%s'", cname); } else if (err2 == WAIT_TIMEOUT) { return ScalarLogical(FALSE); } /* Collect */ err = GetExitCodeProcess(handle->hProcess, &exitcode); if (!err) { R_THROW_SYSTEM_ERROR("cannot get exit code after wait for '%s'", cname); } processx__collect_exit_status(status, exitcode); return ScalarLogical(TRUE); } SEXP processx_is_alive(SEXP status, SEXP name) { processx_handle_t *handle = R_ExternalPtrAddr(status); const char *cname = isNull(name) ? "???" : CHAR(STRING_ELT(name, 0)); DWORD err, exitcode; /* This might happen if it was finalized at the end of the session, even though there are some references to the R object. */ if (!handle) return ScalarLogical(0); if (handle->collected) return ScalarLogical(0); /* Otherwise try to get exit code */ err = GetExitCodeProcess(handle->hProcess, &exitcode); if (!err) { R_THROW_SYSTEM_ERROR("failed to get exit code to check if ", "'%s' is alive", cname); } if (exitcode == STILL_ACTIVE) { return ScalarLogical(1); } else { processx__collect_exit_status(status, exitcode); return ScalarLogical(0); } } SEXP processx_get_exit_status(SEXP status, SEXP name) { processx_handle_t *handle = R_ExternalPtrAddr(status); const char *cname = isNull(name) ? "???" : CHAR(STRING_ELT(name, 0)); DWORD err, exitcode; /* This might happen if it was finalized at the end of the session, even though there are some references to the R object. */ if (!handle) return R_NilValue; if (handle->collected) return ScalarInteger(handle->exitcode); /* Otherwise try to get exit code */ err = GetExitCodeProcess(handle->hProcess, &exitcode); if (!err) {R_THROW_SYSTEM_ERROR("get exit status failed for '%s'", cname); } if (exitcode == STILL_ACTIVE) { return R_NilValue; } else { processx__collect_exit_status(status, exitcode); return ScalarInteger(handle->exitcode); } } SEXP processx_signal(SEXP status, SEXP signal, SEXP name) { processx_handle_t *handle = R_ExternalPtrAddr(status); const char *cname = isNull(name) ? "???" : CHAR(STRING_ELT(name, 0)); DWORD err, exitcode = STILL_ACTIVE; if (!handle) return ScalarLogical(0); if (handle->collected) return ScalarLogical(0); switch (INTEGER(signal)[0]) { case 15: /* SIGTERM */ case 9: /* SIGKILL */ case 2: { /* SIGINT */ /* Call GetExitCodeProcess to see if it is done */ /* TODO: there is a race condition here, might finish right before we are terminating it... */ err = GetExitCodeProcess(handle->hProcess, &exitcode); if (!err) { R_THROW_SYSTEM_ERROR("get exit code after signal for '%s'", cname); } if (exitcode == STILL_ACTIVE) { err = processx__terminate(handle, status); return ScalarLogical(err != 0); } else { processx__collect_exit_status(status, exitcode); return ScalarLogical(0); } } case 0: { /* Health check: is the process still alive? */ err = GetExitCodeProcess(handle->hProcess, &exitcode); if (!err) { R_THROW_SYSTEM_ERROR("get exit code for signal 0 for '%s'", cname); } if (exitcode == STILL_ACTIVE) { return ScalarLogical(1); } else { return ScalarLogical(0); } } default: R_THROW_ERROR("Unsupported signal on this platform for '%s'", cname); return R_NilValue; } } SEXP processx_interrupt(SEXP status, SEXP name) { R_THROW_ERROR("Internal processx error, `processx_interrupt()` should not be called"); return R_NilValue; } SEXP processx_kill(SEXP status, SEXP grace, SEXP name) { return processx_signal(status, ScalarInteger(9), name); } SEXP processx_get_pid(SEXP status) { processx_handle_t *handle = R_ExternalPtrAddr(status); /* This might happen if it was finalized at the end of the session, even though there are some references to the R object. */ if (!handle) return ScalarInteger(NA_INTEGER); return ScalarInteger(handle->dwProcessId); } SEXP processx__process_exists(SEXP pid) { DWORD cpid = INTEGER(pid)[0]; HANDLE proc = OpenProcess(PROCESS_QUERY_INFORMATION, FALSE, cpid); if (proc == NULL) { DWORD err = GetLastError(); if (err == ERROR_INVALID_PARAMETER) return ScalarLogical(0); R_THROW_SYSTEM_ERROR_CODE(err, "open process '%d' to check if it exists", cpid); return R_NilValue; } else { /* Maybe just finished, and in that case we still have a valid handle. Let's see if this is the case. */ DWORD exitcode; DWORD err = GetExitCodeProcess(proc, &exitcode); CloseHandle(proc); if (!err) { R_THROW_SYSTEM_ERROR("get exit code to check if process '%d' exists", cpid); } return ScalarLogical(exitcode == STILL_ACTIVE); } } processx/src/unix/0000755000176200001440000000000014043046410013666 5ustar liggesusersprocessx/src/unix/childlist.c0000644000176200001440000000621313616314040016015 0ustar liggesusers #include "../processx.h" processx__child_list_t child_list_head = { 0, 0, 0 }; processx__child_list_t *child_list = &child_list_head; processx__child_list_t child_free_list_head = { 0, 0, 0 }; processx__child_list_t *child_free_list = &child_free_list_head; void processx__freelist_add(processx__child_list_t *ptr) { ptr->next = child_free_list->next; child_free_list->next = ptr; } /* This is not a race condition with the SIGCHLD handler, because this function is only called with the handler blocked, from processx.c */ void processx__freelist_free() { processx__child_list_t *ptr = child_free_list->next; while (ptr) { processx__child_list_t *next = ptr->next; R_ReleaseObject(ptr->weak_status); free(ptr); ptr = next; } child_free_list->next = 0; } void processx__child_finalizer(SEXP x) { /* Nothing to do here, there is a finalizer on the xPTR */ } int processx__child_add(pid_t pid, SEXP status) { processx__child_list_t *child = calloc(1, sizeof(processx__child_list_t)); SEXP weak_ref; if (!child) return 1; weak_ref = R_MakeWeakRefC(status, R_NilValue, processx__child_finalizer, 1); child->pid = pid; R_PreserveObject(weak_ref); child->weak_status = weak_ref; child->next = child_list->next; child_list->next = child; return 0; } /* This is actually not used currently. But it should work fine. */ /* LCOV_EXCL_START */ void processx__child_remove(pid_t pid) { processx__child_list_t *prev = child_list, *ptr = child_list->next; while (ptr) { if (ptr->pid == pid) { prev->next = ptr->next; /* Defer freeing the memory, because malloc/free are typically not reentrant, and if we free in the SIGCHLD handler, that can cause crashes. The test case in test-run.R (see comments there) typically brings this out. */ processx__freelist_add(ptr); return; } prev = ptr; ptr = ptr->next; } } /* This is actually not used currently. But it should work fine. */ processx__child_list_t *processx__child_find(pid_t pid) { processx__child_list_t *ptr = child_list->next; while (ptr) { if (ptr->pid == pid) return ptr; ptr = ptr->next; } return 0; } /* LCOV_EXCL_STOP */ SEXP processx__unload_cleanup() { processx__child_list_t *ptr = child_list->next; int killed = 0; processx__remove_sigchld(); while (ptr) { processx__child_list_t *next = ptr->next; SEXP status = R_WeakRefKey(ptr->weak_status); processx_handle_t *handle = isNull(status) ? 0 : (processx_handle_t*) R_ExternalPtrAddr(status); int wp, wstat; if (handle && handle->cleanup) { int ret = kill(ptr->pid, SIGKILL); do { wp = waitpid(ptr->pid, &wstat, 0); } while (wp == -1 && errno == EINTR); if (ret == 0) killed++; } /* waitpid errors are ignored here... */ if (!isNull(status)) R_ClearExternalPtr(status); /* The handle will be freed in the finalizer, otherwise there is a race condition here. */ free(ptr); ptr = next; } child_list->next = 0; processx__freelist_free(); if (killed > 0) { REprintf("Unloading processx shared library, killed %d processes\n", killed); } return R_NilValue; } processx/src/unix/connection.c0000644000176200001440000000260613616314040016177 0ustar liggesusers #include "../processx.h" #include #include #include processx_connection_t* processx__create_connection( int fd, const char *membername, SEXP private, const char *encoding) { processx_connection_t *con; SEXP res; con = processx_c_connection_create(fd, PROCESSX_FILE_TYPE_ASYNCPIPE, encoding, &res); defineVar(install(membername), res, private); return con; } void processx__create_connections(processx_handle_t *handle, SEXP private, const char *encoding) { handle->pipes[0] = handle->pipes[1] = handle->pipes[2] = 0; if (handle->fd0 >= 0) { handle->pipes[0] = processx__create_connection( handle->fd0, "stdin_pipe", private, encoding); } if (handle->fd1 >= 0) { handle->pipes[1] = processx__create_connection( handle->fd1, "stdout_pipe", private, encoding); } if (handle->fd2 >= 0) { handle->pipes[2] = processx__create_connection( handle->fd2, "stderr_pipe", private, encoding); } if (handle->ptyfd >= 0) { handle->fd0 = handle->ptyfd; handle->pipes[0] = processx__create_connection( handle->ptyfd, "stdin_pipe", private, encoding); handle->fd1 = handle->ptyfd; handle->pipes[1] = processx__create_connection( handle->ptyfd, "stdout_pipe", private, encoding); } } processx/src/unix/sigchld.c0000644000176200001440000000747613617127012015471 0ustar liggesusers #include "../processx.h" extern processx__child_list_t *child_list; static struct sigaction old_sig_handler = {{ 0 }}; int processx__notify_old_sigchld_handler = 0; void processx__sigchld_callback(int sig, siginfo_t *info, void *ctx) { if (sig != SIGCHLD) return; /* While we get a pid in info, this is basically useless, as (on some platforms at least) a single signal might be delivered for multiple children exiting around the same time. So we need to iterate over all children to see which one has exited. */ processx__child_list_t *ptr = child_list->next; processx__child_list_t *prev = child_list; while (ptr) { processx__child_list_t *next = ptr->next; int wp, wstat; /* Check if this child has exited */ do { wp = waitpid(ptr->pid, &wstat, WNOHANG); } while (wp == -1 && errno == EINTR); if (wp == 0 || (wp < 0 && errno != ECHILD)) { /* If it is still running (or an error, other than ECHILD happened), we do nothing */ prev = ptr; ptr = next; } else { /* Remove the child from the list */ /* We deliberately do not call the finalizer here, because that moves the exit code and pid to R, and we might have just checked that these are not in R, before calling C. So finalizing here would be a race condition. OTOH, we need to check if the handle is null, because a finalizer might actually run before the SIGCHLD handler. Or the finalizer might even trigger the SIGCHLD handler... */ SEXP status = R_WeakRefKey(ptr->weak_status); processx_handle_t *handle = isNull(status) ? 0 : R_ExternalPtrAddr(status); /* If waitpid errored with ECHILD, then the exit status is set to NA */ if (handle) processx__collect_exit_status(status, wp, wstat); /* Defer freeing the memory, because malloc/free are typically not reentrant, and if we free in the SIGCHLD handler, that can cause crashes. The test case in test-run.R (see comments there) typically brings this out. */ processx__freelist_add(ptr); /* If there is an active wait() with a timeout, then stop it */ if (handle && handle->waitpipe[1] >= 0) { close(handle->waitpipe[1]); handle->waitpipe[1] = -1; } /* If we remove the current list node, then prev stays the same, we only need to update ptr. */ prev->next = next; ptr = next; } } if (processx__notify_old_sigchld_handler) { if (old_sig_handler.sa_handler != SIG_DFL && old_sig_handler.sa_handler != SIG_IGN && old_sig_handler.sa_handler != NULL) { if (old_sig_handler.sa_flags | SA_SIGINFO) { old_sig_handler.sa_sigaction(sig, info, NULL); } else { old_sig_handler.sa_handler(sig); } } } } void processx__setup_sigchld() { struct sigaction action; struct sigaction old; memset(&action, 0, sizeof(action)); action.sa_sigaction = processx__sigchld_callback; action.sa_flags = SA_SIGINFO | SA_RESTART | SA_NOCLDSTOP; sigaction(SIGCHLD, &action, &old); if (old.sa_sigaction != processx__sigchld_callback) { memcpy(&old_sig_handler, &old, sizeof(old)); } } void processx__remove_sigchld() { struct sigaction action; memset(&action, 0, sizeof(action)); action.sa_handler = SIG_DFL; sigaction(SIGCHLD, &action, &old_sig_handler); memset(&old_sig_handler, 0, sizeof(old_sig_handler)); } void processx__block_sigchld() { sigset_t blockMask; sigemptyset(&blockMask); sigaddset(&blockMask, SIGCHLD); if (sigprocmask(SIG_BLOCK, &blockMask, NULL) == -1) { R_THROW_ERROR("processx error setting up signal handlers"); } } void processx__unblock_sigchld() { sigset_t unblockMask; sigemptyset(&unblockMask); sigaddset(&unblockMask, SIGCHLD); if (sigprocmask(SIG_UNBLOCK, &unblockMask, NULL) == -1) { R_THROW_ERROR("processx error setting up signal handlers"); } } processx/src/unix/utils.c0000644000176200001440000000450014025644634015205 0ustar liggesusers #include "../processx.h" #include #include char *processx__tmp_string(SEXP str, int i) { const char *ptr = CHAR(STRING_ELT(str, i)); char *cstr = R_alloc(1, (int) strlen(ptr) + 1); strcpy(cstr, ptr); return cstr; } char **processx__tmp_character(SEXP chr) { size_t i, n = LENGTH(chr); char **cchr = (void*) R_alloc(n + 1, sizeof(char*)); for (i = 0; i < n; i++) { cchr[i] = processx__tmp_string(chr, (int) i); } cchr[n] = 0; return cchr; } int processx__nonblock_fcntl(int fd, int set) { int flags; int r; do { r = fcntl(fd, F_GETFL); } while (r == -1 && errno == EINTR); if (r == -1) { return -errno; } /* Bail out now if already set/clear. */ if (!!(r & O_NONBLOCK) == !!set) { return 0; } if (set) { flags = r | O_NONBLOCK; } else { flags = r & ~O_NONBLOCK; } do { r = fcntl(fd, F_SETFL, flags); } while (r == -1 && errno == EINTR); if (r) { return -errno; } return 0; } int processx__cloexec_fcntl(int fd, int set) { int flags; int r; do { r = fcntl(fd, F_GETFD); } while (r == -1 && errno == EINTR); if (r == -1) { return -errno; } /* Bail out now if already set/clear. */ if (!!(r & FD_CLOEXEC) == !!set) { return 0; } if (set) { flags = r | FD_CLOEXEC; } else { flags = r & ~FD_CLOEXEC; } do { r = fcntl(fd, F_SETFD, flags); } while (r == -1 && errno == EINTR); if (r) { return -errno; } return 0; } SEXP processx_disable_crash_dialog() { struct sigaction action; memset(&action, 0, sizeof(action)); action.sa_handler = SIG_DFL; sigaction(SIGSEGV, &action, /* oldact= */ NULL); sigaction(SIGILL, &action, /* oldact= */ NULL); #ifdef SIGBUS sigaction(SIGBUS, &action, /* oldact= */ NULL); #endif return R_NilValue; } SEXP processx__echo_on() { struct termios tp; if (tcgetattr(STDOUT_FILENO, &tp) == -1) { R_THROW_ERROR("Cannot turn terminal echo on"); } tp.c_lflag |= ECHO; if (tcsetattr(STDOUT_FILENO, TCSAFLUSH, &tp) == -1) { R_THROW_ERROR("Cannot turn terminal echo on"); } return R_NilValue; } SEXP processx__echo_off() { struct termios tp; if (tcgetattr(STDOUT_FILENO, &tp) == -1) { R_THROW_ERROR("Cannot turn terminal echo off"); } tp.c_lflag &= ~ECHO; if (tcsetattr(STDOUT_FILENO, TCSAFLUSH, &tp) == -1) { R_THROW_ERROR("Cannot turn terminal echo off"); } return R_NilValue; } processx/src/unix/named_pipe.c0000644000176200001440000000146213616314040016140 0ustar liggesusers// On non-windows platforms, we still need the C interfaces, but they simply // give errors. #ifndef _WIN32 #ifndef _GNU_SOURCE #define _GNU_SOURCE 1 #endif #include #include "../errors.h" SEXP processx_is_named_pipe_open(SEXP pipe_ext) { R_THROW_ERROR("processx_is_named_pipe_open only valid on Windows."); return R_NilValue; } SEXP processx_close_named_pipe(SEXP pipe_ext) { R_THROW_ERROR("processx_close_named_pipe only valid on Windows."); return R_NilValue; } SEXP processx_create_named_pipe(SEXP name, SEXP mode) { R_THROW_ERROR("processx_create_named_pipe only valid on Windows."); return R_NilValue; } SEXP processx_write_named_pipe(SEXP pipe_ext, SEXP text) { R_THROW_ERROR("processx_write_named_pipe only valid on Windows."); return R_NilValue; } #endif processx/src/unix/processx-unix.h0000644000176200001440000000376713616314454016716 0ustar liggesusers#ifndef R_PROCESSX_UNIX_H #define R_PROCESSX_UNIX_H #include #include #include # ifndef O_CLOEXEC # define O_CLOEXEC 02000000 # endif # ifndef SOCK_CLOEXEC # define SOCK_CLOEXEC O_CLOEXEC # endif typedef struct processx_handle_s { int exitcode; int collected; /* Whether exit code was collected already */ pid_t pid; int fd0; /* writeable */ int fd1; /* readable */ int fd2; /* readable */ int waitpipe[2]; /* use it for wait() with timeout */ int cleanup; double create_time; processx_connection_t *pipes[3]; int ptyfd; } processx_handle_t; char *processx__tmp_string(SEXP str, int i); char **processx__tmp_character(SEXP chr); void processx__sigchld_callback(int sig, siginfo_t *info, void *ctx); void processx__setup_sigchld(); void processx__remove_sigchld(); void processx__block_sigchld(); void processx__unblock_sigchld(); void processx__finalizer(SEXP status); /* Child list and its functions */ typedef struct processx__child_list_s { pid_t pid; SEXP weak_status; struct processx__child_list_s *next; } processx__child_list_t; int processx__child_add(pid_t pid, SEXP status); void processx__child_remove(pid_t pid); processx__child_list_t *processx__child_find(pid_t pid); void processx__freelist_add(processx__child_list_t *ptr); void processx__freelist_free(); void processx__collect_exit_status(SEXP status, int retval, int wstat); int processx__nonblock_fcntl(int fd, int set); int processx__cloexec_fcntl(int fd, int set); /* Control connections*/ void processx__create_control_read(processx_handle_t *handle, int fd, const char *membername, SEXP privatex); void processx__create_control_write(processx_handle_t *handle, int fd, const char *membername, SEXP privatex); /* Interruptible system calls */ int processx__interruptible_poll(struct pollfd fds[], nfds_t nfds, int timeout); void processx__make_socketpair(int pipe[2], const char *name); double processx__create_time(long pid); #endif processx/src/unix/processx.c0000644000176200001440000007365114043002736015717 0ustar liggesusers #ifndef _WIN32 #ifndef _GNU_SOURCE #define _GNU_SOURCE 1 #endif #include #include #include #include "../processx.h" #include "../cleancall.h" /* Internals */ static void processx__child_init(processx_handle_t *handle, SEXP connections, int (*pipes)[2], int stdio_count, char *command, char **args, int error_fd, const char *pty_name, char **env, processx_options_t *options, const char *tree_id); static SEXP processx__make_handle(SEXP private, int cleanup); static void processx__handle_destroy(processx_handle_t *handle); void processx__create_connections(processx_handle_t *handle, SEXP private, const char *encoding); /* Define BSWAP_32 on Big Endian systems */ #ifdef WORDS_BIGENDIAN #if (defined(__sun) && defined(__SVR4)) #include #elif (defined(__APPLE__) && defined(__ppc__) || defined(__ppc64__)) #include #define BSWAP_32 OSSwapInt32 #elif (defined(__OpenBSD__)) #define BSWAP_32(x) swap32(x) #elif (defined(__GLIBC__)) #include #define BSWAP_32(x) bswap_32(x) #endif #endif #if defined(__APPLE__) # include # define environ (*_NSGetEnviron()) #else extern char **environ; #endif #include #include extern processx__child_list_t child_list_head; extern processx__child_list_t *child_list; extern processx__child_list_t child_free_list_head; extern processx__child_list_t *child_free_list; extern int processx__notify_old_sigchld_handler; /* We are trying to make sure that the variables in the library are properly set to their initial values after a library (re)load. This function is called from `R_init_processx`. */ void R_init_processx_unix() { child_list_head.pid = 0; child_list_head.weak_status = R_NilValue; child_list_head.next = 0; child_list = &child_list_head; child_free_list_head.pid = 0; child_free_list_head.weak_status = R_NilValue; child_free_list_head.next = 0; child_free_list = &child_free_list_head; if (getenv("PROCESSX_NOTIFY_OLD_SIGCHLD")) { processx__notify_old_sigchld_handler = 1; } } int processx__pty_master_open(char *sub_name, size_t sn_len) { int master_fd, saved_errno; char *p; master_fd = posix_openpt(O_RDWR | O_NOCTTY); if (master_fd == -1) return -1; if (grantpt(master_fd) == -1) { saved_errno = errno; close(master_fd); errno = saved_errno; return -1; } if (unlockpt(master_fd) == -1) { saved_errno = errno; close(master_fd); errno = saved_errno; return -1; } p = ptsname(master_fd); if (p == NULL) { saved_errno = errno; close(master_fd); errno = saved_errno; return -1; } if (strlen(p) < sn_len) { strncpy(sub_name, p, sn_len); } else { close(master_fd); errno = EOVERFLOW; return -1; } return master_fd; } /* These run in the child process, so no coverage here. */ /* LCOV_EXCL_START */ void processx__write_int(int fd, int err) { ssize_t dummy = write(fd, &err, sizeof(int)); (void) dummy; } static void processx__child_init(processx_handle_t *handle, SEXP connections, int (*pipes)[2], int stdio_count, char *command, char **args, int error_fd, const char *pty_name, char **env, processx_options_t *options, const char *tree_id) { int close_fd, use_fd, fd, i; int min_fd = 0; setsid(); /* Do we need a pty? */ if (pty_name) { /* Do not mess with stdin/stdout/stderr, all handled by the pty */ min_fd = 3; int sub_fd = open(pty_name, O_RDWR); if (sub_fd == -1) { processx__write_int(error_fd, -errno); raise(SIGKILL); } #ifdef TIOCSCTTY if (ioctl(sub_fd, TIOCSCTTY, 0) == -1) { processx__write_int(error_fd, -errno); raise(SIGKILL); } #endif #ifdef TIOCSWINSZ struct winsize w; w.ws_row = options->pty_rows; w.ws_col = options->pty_cols; if (ioctl(sub_fd, TIOCSWINSZ, &w) == -1) { processx__write_int(error_fd, -errno); raise(SIGKILL); } #endif struct termios tp; if (tcgetattr(sub_fd, &tp) == -1) { processx__write_int(error_fd, -errno); raise(SIGKILL); } if (options->pty_echo) { tp.c_lflag |= ECHO; } else { tp.c_lflag &= ~ECHO; } if (tcsetattr(sub_fd, TCSAFLUSH, &tp) == -1) { processx__write_int(error_fd, -errno); raise(SIGKILL); } /* TODO: set other terminal attributes and size */ /* Duplicate pty sub to be child's stdin, stdout, and stderr */ if (dup2(sub_fd, STDIN_FILENO) != STDIN_FILENO) { processx__write_int(error_fd, -errno); raise(SIGKILL); } if (dup2(sub_fd, STDOUT_FILENO) != STDOUT_FILENO) { processx__write_int(error_fd, -errno); raise(SIGKILL); } if (dup2(sub_fd, STDERR_FILENO) != STDERR_FILENO) { processx__write_int(error_fd, -errno); raise(SIGKILL); } if (sub_fd > STDERR_FILENO) close(sub_fd); } /* We want to prevent use_fd < fd, because we will dup2() use_fd into fd later. If use_fd >= fd, then this is always possible, without mixing up stdin, stdout and stderr. Without this, we could have a case when we dup2() 2 into 1, and then 1 is lost. */ for (fd = min_fd; fd < stdio_count; fd++) { use_fd = pipes[fd][1]; /* If use_fd < 0 then there is no pipe for fd. */ if (use_fd < 0 || use_fd >= fd) continue; /* If use_fd < fd, then we create a brand new fd for it, starting at stdio_count, which is bigger then fd, surely. */ pipes[fd][1] = fcntl(use_fd, F_DUPFD, stdio_count); if (pipes[fd][1] == -1) { processx__write_int(error_fd, -errno); raise(SIGKILL); } } /* This loop initializes the stdin, stdout, stderr fds of the child process properly. */ for (fd = min_fd; fd < stdio_count; fd++) { SEXP output = VECTOR_ELT(connections, fd); const char *stroutput = Rf_isString(output) ? CHAR(STRING_ELT(output, 0)) : NULL; /* close_fd is an fd that must be closed. Initially this is the parent's end of a pipe. (-1 if no pipe for this fd.) */ close_fd = pipes[fd][0]; /* use_fd is the fd that the child must use for stdin/out/err. */ use_fd = pipes[fd][1]; /* If no pipe, then we see if this is the 2>&1 case. */ if (fd == 2 && use_fd < 0 && stroutput && ! strcmp(stroutput, "2>&1")) { use_fd = 1; } else if (use_fd < 0) { /* Otherwise we open a file. If the stdin/out/err is not requested, then we open a file to /dev/null */ /* For fd >= 3, the fd is just passed, and we just use it, no need to open any file */ if (fd >= 3) continue; if (stroutput) { /* A file was requested, open it */ if (fd == 0) { use_fd = open(stroutput, O_RDONLY); } else { use_fd = open(stroutput, O_CREAT | O_TRUNC| O_RDWR, 0644); } } else { /* NULL, so stdin/out/err is ignored, using /dev/null */ use_fd = open("/dev/null", fd == 0 ? O_RDONLY : O_RDWR); } /* In the output file case, we might need to close use_fd, after we dup2()-d it into fd. */ close_fd = use_fd; if (use_fd == -1) { processx__write_int(error_fd, -errno); raise(SIGKILL); } } /* We will use use_fd for fd. If they happen to be equal, make sure that fd is _not_ closed on exec. Otherwise dup2() use_fd into fd. dup2() clears the CLOEXEC flag, so no need for a fcntl call in this case. */ if (fd == use_fd) { processx__cloexec_fcntl(use_fd, 0); } else { fd = dup2(use_fd, fd); } if (fd == -1) { processx__write_int(error_fd, -errno); raise(SIGKILL); } if (fd <= 2) processx__nonblock_fcntl(fd, 0); /* If we have an extra fd, that we already dup2()-d into fd, we can close it now. */ if (close_fd >= stdio_count) close(close_fd); } for (fd = min_fd; fd < stdio_count; fd++) { use_fd = pipes[fd][1]; if (use_fd >= stdio_count) close(use_fd); } for (i = stdio_count; i < error_fd; i++) { close(i); } for (i = error_fd + 1; ; i++) { if (-1 == close(i) && i > 200) break; } if (options->wd != NULL && chdir(options->wd)) { processx__write_int(error_fd, - errno); raise(SIGKILL); } if (env) environ = env; if (putenv(strdup(tree_id))) { processx__write_int(error_fd, - errno); raise(SIGKILL); } execvp(command, args); processx__write_int(error_fd, - errno); raise(SIGKILL); } /* LCOV_EXCL_STOP */ void processx__finalizer(SEXP status) { processx_handle_t *handle = (processx_handle_t*) R_ExternalPtrAddr(status); pid_t pid; int wp, wstat; processx__block_sigchld(); /* Free child list nodes that are not needed any more. */ processx__freelist_free(); /* Already freed? */ if (!handle) goto cleanup; pid = handle->pid; if (handle->cleanup) { /* Do a non-blocking waitpid() to see if it is running */ do { wp = waitpid(pid, &wstat, WNOHANG); } while (wp == -1 && errno == EINTR); /* Maybe just waited on it? Then collect status */ if (wp == pid) processx__collect_exit_status(status, wp, wstat); /* If it is running, we need to kill it, and wait for the exit status */ if (wp == 0) { kill(-pid, SIGKILL); do { wp = waitpid(pid, &wstat, 0); } while (wp == -1 && errno == EINTR); processx__collect_exit_status(status, wp, wstat); } } /* Note: if no cleanup is requested, then we still have a sigchld handler, to read out the exit code via waitpid, but no handle any more. */ /* Deallocate memory */ R_ClearExternalPtr(status); processx__handle_destroy(handle); cleanup: processx__unblock_sigchld(); } static SEXP processx__make_handle(SEXP private, int cleanup) { processx_handle_t * handle; SEXP result; handle = (processx_handle_t*) malloc(sizeof(processx_handle_t)); if (!handle) { R_THROW_ERROR("Cannot make processx handle, out of memory"); } memset(handle, 0, sizeof(processx_handle_t)); handle->waitpipe[0] = handle->waitpipe[1] = -1; result = PROTECT(R_MakeExternalPtr(handle, private, R_NilValue)); R_RegisterCFinalizerEx(result, processx__finalizer, 1); handle->cleanup = cleanup; UNPROTECT(1); return result; } static void processx__handle_destroy(processx_handle_t *handle) { if (!handle) return; free(handle); } void processx__make_socketpair(int pipe[2], const char *exe) { #if defined(__linux__) static int no_cloexec; if (no_cloexec) goto skip; if (socketpair(AF_UNIX, SOCK_STREAM | SOCK_CLOEXEC, 0, pipe) == 0) return; /* Retry on EINVAL, it means SOCK_CLOEXEC is not supported. * Anything else is a genuine error. */ if (errno != EINVAL) { R_THROW_SYSTEM_ERROR("processx socketpair"); } no_cloexec = 1; skip: #endif if (socketpair(AF_UNIX, SOCK_STREAM, 0, pipe)) { if (exe) { R_THROW_SYSTEM_ERROR("cannot make processx socketpair while " "running '%s'", exe); } else { R_THROW_SYSTEM_ERROR("cannot make processx socketpair"); } } processx__cloexec_fcntl(pipe[0], 1); processx__cloexec_fcntl(pipe[1], 1); } 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) { 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]; const int cpty = LOGICAL(pty)[0]; const char *cencoding = CHAR(STRING_ELT(encoding, 0)); const char *ctree_id = CHAR(STRING_ELT(tree_id, 0)); processx_options_t options = { 0 }; int num_connections = LENGTH(connections); pid_t pid; int err, exec_errorno = 0, status; ssize_t r; int signal_pipe[2] = { -1, -1 }; int (*pipes)[2]; int i; int pty_master_fd; #define R_PROCESSX_PTY_NAME_LEN 2014 char pty_namex[R_PROCESSX_PTY_NAME_LEN]; char *pty_name = cpty ? pty_namex : 0; processx_handle_t *handle = NULL; SEXP result; pipes = (int(*)[2]) R_alloc(num_connections, sizeof(int) * 2); for (i = 0; i < num_connections; i++) pipes[i][0] = pipes[i][1] = -1; options.wd = isNull(wd) ? 0 : CHAR(STRING_ELT(wd, 0)); if (pipe(signal_pipe)) { R_THROW_SYSTEM_ERROR("Cannot create pipe when running '%s'", ccommand); } processx__cloexec_fcntl(signal_pipe[0], 1); processx__cloexec_fcntl(signal_pipe[1], 1); processx__setup_sigchld(); result = PROTECT(processx__make_handle(private, ccleanup)); handle = R_ExternalPtrAddr(result); if (cpty) { pty_master_fd = processx__pty_master_open(pty_name, R_PROCESSX_PTY_NAME_LEN); if (pty_master_fd == -1) { R_THROW_SYSTEM_ERROR("Cannot open pty when running '%s'", ccommand); } options.pty_echo = LOGICAL(VECTOR_ELT(pty_options, 0))[0]; options.pty_rows = INTEGER(VECTOR_ELT(pty_options, 1))[0]; options.pty_cols = INTEGER(VECTOR_ELT(pty_options, 2))[0]; } handle->fd0 = handle->fd1 = handle->fd2 = -1; for (i = 0; i < num_connections; i++) { SEXP output = VECTOR_ELT(connections, i); const char *stroutput = Rf_isString(output) ? CHAR(STRING_ELT(output, 0)) : NULL; if (isNull(output)) { /* Ignored output, nothing to do, handled in the child */ } else if (stroutput && ! strcmp("|", stroutput)) { /* pipe, need to create */ processx__make_socketpair(pipes[i], ccommand); if (i == 0) handle->fd0 = pipes[i][0]; if (i == 1) handle->fd1 = pipes[i][0]; if (i == 2) handle->fd2 = pipes[i][0]; processx__nonblock_fcntl(pipes[i][0], 1); } else if (i == 2 && stroutput && ! strcmp("2>&1", stroutput)) { /* redirected stderr, handled in child */ } else if (stroutput && ! strcmp("", stroutput)) { /* inherited std stream, assume usual numbers */ pipes[i][1] = i; } else if (stroutput) { /* redirect to file, nothing to do the child will open it */ } else { /* inherited processx connection, need to duplicate */ processx_connection_t *ccon = R_ExternalPtrAddr(VECTOR_ELT(connections, i)); int fd = processx_c_connection_fileno(ccon); pipes[i][1] = fd; } } processx__block_sigchld(); pid = fork(); /* TODO: how could we test a failure? */ if (pid == -1) { /* ERROR */ err = -errno; if (signal_pipe[0] >= 0) close(signal_pipe[0]); if (signal_pipe[1] >= 0) close(signal_pipe[1]); if (cpty) close(pty_master_fd); processx__unblock_sigchld(); R_THROW_SYSTEM_ERROR_CODE(err, "Cannot fork when running '%s'", ccommand); } /* CHILD */ if (pid == 0) { /* LCOV_EXCL_START */ if (cpty) close(pty_master_fd); processx__unblock_sigchld(); processx__child_init(handle, connections, pipes, num_connections, ccommand, cargs, signal_pipe[1], pty_name, cenv, &options, ctree_id); R_THROW_SYSTEM_ERROR("Cannot start child process when running '%s'", ccommand); /* LCOV_EXCL_STOP */ } /* Query creation time ASAP. We'll use (pid, create_time) as an ID, to avoid race conditions when sending signals */ handle->create_time = processx__create_time(pid); handle->ptyfd = -1; if (cpty) handle->ptyfd = pty_master_fd; /* We need to know the processx children */ if (processx__child_add(pid, result)) { err = -errno; if (signal_pipe[0] >= 0) close(signal_pipe[0]); if (signal_pipe[1] >= 0) close(signal_pipe[1]); processx__unblock_sigchld(); R_THROW_ERROR("Cannot create child process '%s', out of memory", ccommand); } /* SIGCHLD can arrive now */ processx__unblock_sigchld(); if (signal_pipe[1] >= 0) close(signal_pipe[1]); do { r = read(signal_pipe[0], &exec_errorno, sizeof(exec_errorno)); } while (r == -1 && errno == EINTR); if (r == 0) { ; /* okay, EOF */ } else if (r == sizeof(exec_errorno)) { do { err = waitpid(pid, &status, 0); /* okay, read errorno */ } while (err == -1 && errno == EINTR); } else if (r == -1 && errno == EPIPE) { do { err = waitpid(pid, &status, 0); /* okay, got EPIPE */ } while (err == -1 && errno == EINTR); } else { R_THROW_SYSTEM_ERROR_CODE(-exec_errorno, "Child process '%s' failed to start", ccommand); } if (signal_pipe[0] >= 0) close(signal_pipe[0]); /* Closed unused ends of std pipes. If there is no parent end, then this is an inherited std{in,out,err} fd, so we should not close it. */ for (i = 0; i < 3; i++) { if (pipes[i][1] >= 0 && pipes[i][0] >= 0) close(pipes[i][1]); } /* Create proper connections */ processx__create_connections(handle, private, cencoding); if (exec_errorno == 0) { handle->pid = pid; UNPROTECT(1); /* result */ return result; } R_THROW_SYSTEM_ERROR_CODE(-exec_errorno, "cannot start processx process '%s'", ccommand); return R_NilValue; } void processx__collect_exit_status(SEXP status, int retval, int wstat) { processx_handle_t *handle = R_ExternalPtrAddr(status); /* This must be called from a function that blocks SIGCHLD. So we are not blocking it here. */ if (!handle) { R_THROW_ERROR("Invalid handle, already finalized"); } if (handle->collected) { return; } /* If waitpid returned -1, then an error happened, e.g. ECHILD, because another SIGCHLD handler collected the exit status already. */ if (retval == -1) { handle->exitcode = NA_INTEGER; } else if (WIFEXITED(wstat)) { handle->exitcode = WEXITSTATUS(wstat); } else { handle->exitcode = - WTERMSIG(wstat); } handle->collected = 1; } static void processx__wait_cleanup(void *ptr) { int *fds = (int*) ptr; if (!fds) return; if (fds[0] >= 0) close(fds[0]); if (fds[1] >= 0) close(fds[1]); free(fds); } /* In general we need to worry about three asynchronous processes here: * 1. The main code, i.e. the code in this function. * 2. The finalizer, that can be triggered by any R function. * A good strategy is to avoid calling R functions here completely. * Functions that return immediately, like `R_CheckUserInterrupt`, or * a `ScalarLogical` that we return, are fine. * 3. The SIGCHLD handler that we just block at the beginning, but it can * still be called between the R function doing the `.Call` to us, and * the signal blocking call. * * Keeping these in mind, we do this: * * 1. If the exit status was copied over to R already, we return * immediately from R. Otherwise this C function is called. * 2. We block SIGCHLD. * 3. If we already collected the exit status, then this process has * finished, so we don't need to wait. * 4. We set up a self-pipe that we can poll. The pipe will be closed in * the SIGCHLD signal handler, and that triggers the poll event. * 5. We unblock the SIGCHLD handler, so that it can trigger the pipe event. * 6. We start polling. We poll in small time chunks, to keep the wait still * interruptible. * 7. We keep polling until the timeout expires or the process finishes. */ SEXP processx_wait(SEXP status, SEXP timeout, SEXP name) { processx_handle_t *handle = R_ExternalPtrAddr(status); const char *cname = isNull(name) ? "???" : CHAR(STRING_ELT(name, 0)); int ctimeout = INTEGER(timeout)[0], timeleft = ctimeout; struct pollfd fd; int ret = 0; pid_t pid; 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(); if (!handle) { processx__unblock_sigchld(); return ScalarLogical(1); } pid = handle->pid; /* If we already have the status, then return now. */ if (handle->collected) { processx__unblock_sigchld(); return ScalarLogical(1); } /* Make sure this is active, in case another package replaced it... */ processx__setup_sigchld(); processx__block_sigchld(); /* 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); } fds[0] = handle->waitpipe[0]; fds[1] = handle->waitpipe[1]; processx__nonblock_fcntl(handle->waitpipe[0], 1); processx__nonblock_fcntl(handle->waitpipe[1], 1); /* Poll on the pipe, need to unblock sigchld before */ fd.fd = handle->waitpipe[0]; fd.events = POLLIN; fd.revents = 0; processx__unblock_sigchld(); while (ctimeout < 0 || timeleft > PROCESSX_INTERRUPT_INTERVAL) { do { ret = poll(&fd, 1, PROCESSX_INTERRUPT_INTERVAL); } while (ret == -1 && errno == EINTR); /* If not a timeout, then we are done */ if (ret != 0) break; R_CheckUserInterrupt(); /* We also check if the process is alive, because the SIGCHLD is not delivered in valgrind :( This also works around the issue of SIGCHLD handler interference, i.e. if another package (like parallel) removes our signal handler. */ ret = kill(pid, 0); if (ret != 0) { ret = 1; goto cleanup; } if (ctimeout >= 0) timeleft -= PROCESSX_INTERRUPT_INTERVAL; } /* Maybe we are not done, and there is a little left from the timeout */ if (ret == 0 && timeleft >= 0) { do { ret = poll(&fd, 1, timeleft); } while (ret == -1 && errno == EINTR); } if (ret == -1) { R_THROW_SYSTEM_ERROR("processx wait with timeout error while " "waiting for '%s'", cname); } cleanup: /* pipe is closed in the on_exit handler */ handle->waitpipe[0] = -1; handle->waitpipe[1] = -1; return ScalarLogical(ret != 0); } /* This is similar to `processx_wait`, but a bit simpler, because we * don't need to wait and poll. The same restrictions listed there, also * apply here. * * 1. If the exit status was copied over to R already, we return * immediately from R. Otherwise this C function is called. * 2. We block SIGCHLD. * 3. If we already collected the exit status, then this process has * finished, and we return FALSE. * 4. Otherwise we do a non-blocking `waitpid`, because the process might * have finished, we just haven't collected its exit status yet. * 5. If the process is still running, `waitpid` returns 0. We return TRUE. * 6. Otherwise we collect the exit status, and return FALSE. */ SEXP processx_is_alive(SEXP status, SEXP name) { processx_handle_t *handle = R_ExternalPtrAddr(status); const char *cname = isNull(name) ? "???" : CHAR(STRING_ELT(name, 0)); pid_t pid; int wstat, wp; int ret = 0; processx__block_sigchld(); if (!handle) goto cleanup; if (handle->collected) goto cleanup; /* Otherwise a non-blocking waitpid to collect zombies */ pid = handle->pid; do { wp = waitpid(pid, &wstat, WNOHANG); } while (wp == -1 && errno == EINTR); /* Maybe another SIGCHLD handler collected the exit status? Then we just set it to NA (in the collect_exit_status call) */ if (wp == -1 && errno == ECHILD) { processx__collect_exit_status(status, wp, wstat); goto cleanup; } /* Some other error? */ if (wp == -1) { processx__unblock_sigchld(); R_THROW_SYSTEM_ERROR("processx_is_alive, process '%s'", cname); } /* If running, return TRUE, otherwise collect exit status, return FALSE */ if (wp == 0) { ret = 1; } else { processx__collect_exit_status(status, wp, wstat); } cleanup: processx__unblock_sigchld(); return ScalarLogical(ret); } /* This is essentially the same as `processx_is_alive`, but we return an * exit status if the process has already finished. See above. */ SEXP processx_get_exit_status(SEXP status, SEXP name) { processx_handle_t *handle = R_ExternalPtrAddr(status); const char *cname = isNull(name) ? "???" : CHAR(STRING_ELT(name, 0)); pid_t pid; int wstat, wp; SEXP result; processx__block_sigchld(); if (!handle) { result = PROTECT(ScalarInteger(NA_INTEGER)); goto cleanup; } /* If we already have the status, then just return */ if (handle->collected) { result = PROTECT(ScalarInteger(handle->exitcode)); goto cleanup; } /* Otherwise do a non-blocking waitpid to collect zombies */ pid = handle->pid; do { wp = waitpid(pid, &wstat, WNOHANG); } while (wp == -1 && errno == EINTR); /* Another SIGCHLD handler already collected the exit code? Then we set it to NA (in the collect_exit_status call). */ if (wp == -1 && errno == ECHILD) { processx__collect_exit_status(status, wp, wstat); result = PROTECT(ScalarInteger(handle->exitcode)); goto cleanup; } /* Some other error? */ if (wp == -1) { processx__unblock_sigchld(); R_THROW_SYSTEM_ERROR("processx_get_exit_status error for '%s'", cname); } /* If running, do nothing otherwise collect */ if (wp == 0) { result = PROTECT(R_NilValue); } else { processx__collect_exit_status(status, wp, wstat); result = PROTECT(ScalarInteger(handle->exitcode)); } cleanup: processx__unblock_sigchld(); UNPROTECT(1); return result; } /* See `processx_wait` above for the description of async processes and * possible race conditions. * * This is mostly along the lines of `processx_is_alive`. After we * successfully sent the signal, we try a `waitpid` just in case the * processx has aborted on it. This is a harmless race condition, because * the process might not have been cleaned up yet, when we call `waitpid`, * but that's OK, then its exit status will be collected later, e.g. in * the SIGCHLD handler. */ SEXP processx_signal(SEXP status, SEXP signal, SEXP name) { processx_handle_t *handle = R_ExternalPtrAddr(status); const char *cname = isNull(name) ? "???" : CHAR(STRING_ELT(name, 0)); pid_t pid; int wstat, wp, ret, result; processx__block_sigchld(); if (!handle) { result = 0; goto cleanup; } /* If we already have the status, then return `FALSE` */ if (handle->collected) { result = 0; goto cleanup; } /* Otherwise try to send signal */ pid = handle->pid; ret = kill(pid, INTEGER(signal)[0]); if (ret == 0) { result = 1; } else if (ret == -1 && errno == ESRCH) { result = 0; } else { processx__unblock_sigchld(); R_THROW_SYSTEM_ERROR("processx_signal for '%s'", cname); return R_NilValue; } /* Possibly dead now, collect status */ do { wp = waitpid(pid, &wstat, WNOHANG); } while (wp == -1 && errno == EINTR); /* Maybe another SIGCHLD handler collected it already? */ if (wp == -1 && errno == ECHILD) { processx__collect_exit_status(status, wp, wstat); goto cleanup; } if (wp == -1) { processx__unblock_sigchld(); R_THROW_SYSTEM_ERROR("processx_signal for '%s'", cname); } cleanup: processx__unblock_sigchld(); return ScalarLogical(result); } SEXP processx_interrupt(SEXP status, SEXP name) { return processx_signal(status, ScalarInteger(2), name); } /* This is a special case of `processx_signal`, and we implement it almost * the same way. We make an effort to return a TRUE/FALSE value to indicate * if the process died as a response to our KILL signal. This is not 100% * accurate because of the unavoidable race conditions. (E.g. it might have * been killed by another process's KILL signal.) * * To do a better job for the return value, we call a `waitpid` before * delivering the signal, as a final check to see if the child process is * still alive or not. */ SEXP processx_kill(SEXP status, SEXP grace, SEXP name) { processx_handle_t *handle = R_ExternalPtrAddr(status); const char *cname = isNull(name) ? "???" : CHAR(STRING_ELT(name, 0)); pid_t pid; int wstat, wp, result = 0; processx__block_sigchld(); if (!handle) { goto cleanup; } /* Check if we have an exit status, it yes, just return (FALSE) */ if (handle->collected) { goto cleanup; } /* Do a non-blocking waitpid to collect zombies */ pid = handle->pid; do { wp = waitpid(pid, &wstat, WNOHANG); } while (wp == -1 && errno == EINTR); /* The child does not exist any more, set exit status to NA & return FALSE. */ if (wp == -1 && errno == ECHILD) { processx__collect_exit_status(status, wp, wstat); goto cleanup; } /* Some other error? */ if (wp == -1) { processx__unblock_sigchld(); R_THROW_SYSTEM_ERROR("processx_kill for '%s'", cname); } /* 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); 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; cleanup: processx__unblock_sigchld(); return ScalarLogical(result); } SEXP processx_get_pid(SEXP status) { processx_handle_t *handle = R_ExternalPtrAddr(status); /* This might happen if it was finalized at the end of the session, even though there are some references to the R object. */ if (!handle) return ScalarInteger(NA_INTEGER); return ScalarInteger(handle->pid); } /* We send a 0 signal to check if the process is alive. Note that a process * that is in a zombie state also counts as 'alive' with this method. */ SEXP processx__process_exists(SEXP pid) { pid_t cpid = INTEGER(pid)[0]; int res = kill(cpid, 0); if (res == 0) { return ScalarLogical(1); } else if (errno == ESRCH) { return ScalarLogical(0); } else { R_THROW_SYSTEM_ERROR("kill syscall error for pid '%d'", cpid); return R_NilValue; } } #endif processx/src/base64.c0000644000176200001440000001067213616314040014143 0ustar liggesusers #ifndef _GNU_SOURCE #define _GNU_SOURCE 1 #endif #include #include #define BASE64_ENCODE_OUT_SIZE(s) ((unsigned int)((((s) + 2) / 3) * 4)) #define BASE64_DECODE_OUT_SIZE(s) ((unsigned int)(((s) / 4) * 3)) #define BASE64_PAD '=' /* BASE 64 encode table */ static const char base64en[] = { 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z', 'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', 'y', 'z', '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', '+', '/', }; /* ASCII order for BASE 64 decode, 255 in unused character */ static const unsigned char base64de[] = { /* nul, soh, stx, etx, eot, enq, ack, bel, */ 255, 255, 255, 255, 255, 255, 255, 255, /* bs, ht, nl, vt, np, cr, so, si, */ 255, 255, 255, 255, 255, 255, 255, 255, /* dle, dc1, dc2, dc3, dc4, nak, syn, etb, */ 255, 255, 255, 255, 255, 255, 255, 255, /* can, em, sub, esc, fs, gs, rs, us, */ 255, 255, 255, 255, 255, 255, 255, 255, /* sp, '!', '"', '#', '$', '%', '&', ''', */ 255, 255, 255, 255, 255, 255, 255, 255, /* '(', ')', '*', '+', ',', '-', '.', '/', */ 255, 255, 255, 62, 255, 255, 255, 63, /* '0', '1', '2', '3', '4', '5', '6', '7', */ 52, 53, 54, 55, 56, 57, 58, 59, /* '8', '9', ':', ';', '<', '=', '>', '?', */ 60, 61, 255, 255, 255, 255, 255, 255, /* '@', 'A', 'B', 'C', 'D', 'E', 'F', 'G', */ 255, 0, 1, 2, 3, 4, 5, 6, /* 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', */ 7, 8, 9, 10, 11, 12, 13, 14, /* 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', */ 15, 16, 17, 18, 19, 20, 21, 22, /* 'X', 'Y', 'Z', '[', '\', ']', '^', '_', */ 23, 24, 25, 255, 255, 255, 255, 255, /* '`', 'a', 'b', 'c', 'd', 'e', 'f', 'g', */ 255, 26, 27, 28, 29, 30, 31, 32, /* 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o', */ 33, 34, 35, 36, 37, 38, 39, 40, /* 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', */ 41, 42, 43, 44, 45, 46, 47, 48, /* 'x', 'y', 'z', '{', '|', '}', '~', del, */ 49, 50, 51, 255, 255, 255, 255, 255 }; SEXP processx_base64_encode(SEXP array) { const unsigned char *in = RAW(array); unsigned int inlen = LENGTH(array); unsigned int outlen = BASE64_ENCODE_OUT_SIZE(inlen); SEXP rout = PROTECT(allocVector(RAWSXP, outlen)); unsigned char *out = (unsigned char*) RAW(rout); int s; unsigned int i; unsigned int j; unsigned char c; unsigned char l; s = 0; l = 0; for (i = j = 0; i < inlen; i++) { c = in[i]; switch (s) { case 0: s = 1; out[j++] = base64en[(c >> 2) & 0x3F]; break; case 1: s = 2; out[j++] = base64en[((l & 0x3) << 4) | ((c >> 4) & 0xF)]; break; case 2: s = 0; out[j++] = base64en[((l & 0xF) << 2) | ((c >> 6) & 0x3)]; out[j++] = base64en[c & 0x3F]; break; } l = c; } switch (s) { case 1: out[j++] = base64en[(l & 0x3) << 4]; out[j++] = BASE64_PAD; out[j++] = BASE64_PAD; break; case 2: out[j++] = base64en[(l & 0xF) << 2]; out[j++] = BASE64_PAD; break; } UNPROTECT(1); return rout; } SEXP processx_base64_decode(SEXP array) { const unsigned char *in = (const unsigned char*) RAW(array); unsigned int inlen = LENGTH(array); unsigned int outlen = BASE64_DECODE_OUT_SIZE(inlen); SEXP rout = PROTECT(allocVector(RAWSXP, outlen)); unsigned char *out = RAW(rout); unsigned int i; unsigned int j; unsigned char c; if (inlen & 0x3) { UNPROTECT(1); return rout; } for (i = j = 0; i < inlen; i++) { if (in[i] == BASE64_PAD) { break; } if (in[i] < 0) { UNPROTECT(1); return rout; } c = base64de[in[i]]; if (c == 255) { UNPROTECT(1); return rout; } switch (i & 0x3) { case 0: out[j] = (c << 2) & 0xFF; break; case 1: out[j++] |= (c >> 4) & 0x3; out[j] = (unsigned char)((c & 0xF) << 4); break; case 2: out[j++] |= (c >> 2) & 0xF; out[j] = (unsigned char)((c & 0x3) << 6); break; case 3: out[j++] |= c; break; } } /* We might have allocated to much space, because of the padding... */ if (j + 1 < outlen) { SEXP rout2 = PROTECT(allocVector(RAWSXP, j)); memcpy(RAW(rout2), RAW(rout), j); UNPROTECT(2); return rout2; } else { UNPROTECT(1); return rout; } } processx/src/create-time.c0000644000176200001440000001403013703607776015270 0ustar liggesusers #ifndef _GNU_SOURCE #define _GNU_SOURCE 1 #endif #include #include "processx.h" #ifdef _WIN32 #include /* FILETIME origin is January 1, 1601 (UTC). See https://msdn.microsoft.com/en-us/9baf8a0e-59e3-4fbd-9616-2ec9161520d1 Unix origin is January 1, 1970. The difference is 11644473600 seconds. FILETIME is in 100ns units, so we need to multiple this by 10^7. */ double processx__create_time(HANDLE process) { long long ll, secs, nsecs; FILETIME ftCreate, ftExit, ftKernel, ftUser; if (! GetProcessTimes(process, &ftCreate, &ftExit, &ftKernel, &ftUser)) { if (GetLastError() == ERROR_ACCESS_DENIED) { // usually means the process has died return 0.0; } else { return 0.0; } } ll = ((LONGLONG) ftCreate.dwHighDateTime) << 32; ll += ftCreate.dwLowDateTime - 116444736000000000LL; secs = ll / 10000000; nsecs = ll % 10000000; return (double) secs + ((double) nsecs) / 10000000; } #endif /* This is defined on all OSes, but only really needed (and used) * on Linux. */ static double processx__linux_boot_time = 0.0; SEXP processx__set_boot_time(SEXP bt) { processx__linux_boot_time = REAL(bt)[0]; return R_NilValue; } #ifdef __linux__ #include #include int processx__read_file(const char *path, char **buffer, size_t buffer_size) { int fd = -1; ssize_t ret; char *ptr; size_t rem_size = buffer_size; *buffer = 0; fd = open(path, O_RDONLY); if (fd == -1) goto error; ptr = *buffer = R_alloc(buffer_size, 1); if (!*buffer) goto error; do { if (rem_size == 0) { *buffer = S_realloc(*buffer, buffer_size * 2, buffer_size, 1); if (!*buffer) goto error; ptr = *buffer + buffer_size; rem_size = buffer_size; buffer_size *= 2; } ret = read(fd, ptr, rem_size); if (ret == -1) goto error; ptr += ret; rem_size -= ret; } while (ret > 0); close(fd); return buffer_size - rem_size; error: if (fd >= 0) close(fd); if (*buffer) free(*buffer); *buffer = 0; return -1; } double processx__create_time_since_boot(long pid) { char path[512]; int ret; char *buf; char *l, *r; char state[2] = { 0, 0 }; int ppid, pgrp, session, tty_nr, tpgid; unsigned int flags; unsigned long minflt, cminflt, majflt, cmajflt, utime, stime; long int cutime, cstime, priority, nice, num_threads, itrealvalue; unsigned long long starttime; ret = snprintf(path, sizeof(path), "/proc/%d/stat", (int) pid); if (ret >= sizeof(path)) { warning("Cannot parse stat file, buffer too small: %s", strerror(errno)); return 0.0; } else if (ret < 0) { warning("Cannot parse stat file, buffer error: %s", strerror(errno)); return 0.0; } ret = processx__read_file(path, &buf, /* buffer= */ 2048); if (ret == -1) { warning("Cannot parse stat file, cannot read file: %s", strerror(errno)); return 0.0; } /* This removed the last character, but that's a \n anyway. At least we have a zero terminated string... */ *(buf + ret - 1) = '\0'; /* Find the first '(' and last ')', that's the end of the command */ l = strchr(buf, '('); r = strrchr(buf, ')'); if (!l || !r) { return 0.0; } *r = '\0'; ret = sscanf(r+2, "%c %d %d %d %d %d %u %lu %lu %lu %lu %lu %lu %ld %ld %ld %ld %ld %ld %llu", state, &ppid, &pgrp, &session, &tty_nr, &tpgid, &flags, &minflt, &cminflt, &majflt, &cmajflt, &utime, &stime, &cutime, &cstime, &priority, &nice, &num_threads, &itrealvalue, &starttime); if (ret == -1) { warning("Cannot parse stat file, parse error: %s", strerror(errno)); return 0.0; } else if (ret != 20) { warning("Cannot parse stat file, unknown parse error.", strerror(errno)); return 0.0; } return starttime; } void *processx__memmem(const void *haystack, size_t n1, const void *needle, size_t n2) { const unsigned char *p1 = haystack; const unsigned char *p2 = needle; const unsigned char *p3 = p1 + n1 - n2 + 1; const unsigned char *p; if (n2 == 0) return (void*)p1; if (n2 > n1) return NULL; for (p = p1; (p = memchr(p, *p2, p3 - p)) != NULL; p++) { if (!memcmp(p, p2, n2)) return (void*)p; } return NULL; } double processx__boot_time() { return processx__linux_boot_time; } static double processx__linux_clock_period = 0.0; double processx__create_time(long pid) { double ct; double bt; double clock; ct = processx__create_time_since_boot(pid); if (ct == 0) return 0.0; bt = processx__boot_time(); if (bt == 0) return 0.0; /* Query if not yet queried */ if (processx__linux_clock_period == 0) { clock = sysconf(_SC_CLK_TCK); if (clock == -1) return 0.0; processx__linux_clock_period = 1.0 / clock; } return bt + ct * processx__linux_clock_period; } #endif #ifdef __APPLE__ #include #include #include #define PROCESSX__TV2DOUBLE(t) ((t).tv_sec + (t).tv_usec / 1000000.0) double processx__create_time(long pid) { struct kinfo_proc kp; int mib[4]; size_t len; mib[0] = CTL_KERN; mib[1] = KERN_PROC; mib[2] = KERN_PROC_PID; mib[3] = (pid_t) pid; len = sizeof(struct kinfo_proc); if (sysctl(mib, 4, &kp, &len, NULL, 0) == -1) return 0.0; /* Happens if process is gone already */ if (len == 0) return 0.0; return PROCESSX__TV2DOUBLE(kp.kp_proc.p_starttime); } #endif #ifndef _WIN32 #ifndef __linux__ #ifndef __APPLE__ double processx__create_time(long pid) { return 0; } #endif #endif #endif SEXP processx_create_time(SEXP r_pid) { long pid = INTEGER(r_pid)[0]; #ifdef _WIN32 DWORD dwDesiredAccess = PROCESS_QUERY_INFORMATION | PROCESS_VM_READ; HANDLE process = OpenProcess(dwDesiredAccess, FALSE, pid); double ct = processx__create_time(process); CloseHandle(process); return ScalarReal(ct); #else return ScalarReal(processx__create_time(pid)); #endif } SEXP processx__proc_start_time(SEXP status) { processx_handle_t *handle = R_ExternalPtrAddr(status); if (!handle) { R_THROW_ERROR("Internal processx error, handle already removed"); } return ScalarReal(handle->create_time); } processx/src/client.c0000644000176200001440000001413014026373706014340 0ustar liggesusers #ifndef _GNU_SOURCE #define _GNU_SOURCE 1 #endif #ifdef _WIN32 #include #include "win/processx-stdio.h" #include #include #include #include #include #include "errors.h" int processx__stdio_verify(BYTE* buffer, WORD size) { unsigned int count; /* Check the buffer pointer. */ if (buffer == NULL) return 0; /* Verify that the buffer is at least big enough to hold the count. */ if (size < CHILD_STDIO_SIZE(0)) return 0; /* Verify if the count is within range. */ count = CHILD_STDIO_COUNT(buffer); if (count > 256) return 0; /* Verify that the buffer size is big enough to hold info for N FDs. */ if (size < CHILD_STDIO_SIZE(count)) return 0; return 1; } void processx__stdio_noinherit(BYTE* buffer) { int i, count; count = CHILD_STDIO_COUNT(buffer); for (i = 0; i < count; i++) { HANDLE handle = CHILD_STDIO_HANDLE(buffer, i); if (handle != INVALID_HANDLE_VALUE) { SetHandleInformation(handle, HANDLE_FLAG_INHERIT, 0); } } } /* * Clear the HANDLE_FLAG_INHERIT flag from all HANDLEs that were inherited * the parent process. Don't check for errors - the stdio handles may not be * valid, or may be closed already. There is no guarantee that this function * does a perfect job. */ SEXP processx_disable_inheritance() { HANDLE handle; STARTUPINFOW si; /* Make the windows stdio handles non-inheritable. */ handle = GetStdHandle(STD_INPUT_HANDLE); if (handle != NULL && handle != INVALID_HANDLE_VALUE) { SetHandleInformation(handle, HANDLE_FLAG_INHERIT, 0); } handle = GetStdHandle(STD_OUTPUT_HANDLE); if (handle != NULL && handle != INVALID_HANDLE_VALUE) { SetHandleInformation(handle, HANDLE_FLAG_INHERIT, 0); } handle = GetStdHandle(STD_ERROR_HANDLE); if (handle != NULL && handle != INVALID_HANDLE_VALUE) { SetHandleInformation(handle, HANDLE_FLAG_INHERIT, 0); } /* Make inherited CRT FDs non-inheritable. */ GetStartupInfoW(&si); if (processx__stdio_verify(si.lpReserved2, si.cbReserved2)) { processx__stdio_noinherit(si.lpReserved2); } return R_NilValue; } SEXP processx_write(SEXP fd, SEXP data) { int cfd = INTEGER(fd)[0]; HANDLE h = (HANDLE) _get_osfhandle(cfd); DWORD written; BOOL ret = WriteFile(h, RAW(data), LENGTH(data), &written, NULL); if (!ret) R_THROW_SYSTEM_ERROR("Cannot write to fd"); return ScalarInteger(written); } #else #include #include #include #include #include #include "errors.h" static int processx__cloexec_fcntl(int fd, int set) { int flags; int r; do { r = fcntl(fd, F_GETFD); } while (r == -1 && errno == EINTR); if (r == -1) { return -errno; } /* Bail out now if already set/clear. */ if (!!(r & FD_CLOEXEC) == !!set) { return 0; } if (set) { flags = r | FD_CLOEXEC; } else { flags = r & ~FD_CLOEXEC; } do { r = fcntl(fd, F_SETFD, flags); } while (r == -1 && errno == EINTR); if (r) { return -errno; } return 0; } SEXP processx_disable_inheritance() { int fd; /* Set the CLOEXEC flag on all open descriptors. Unconditionally try the * first 16 file descriptors. After that, bail out after the first error. */ for (fd = 0; ; fd++) { if (processx__cloexec_fcntl(fd, 1) && fd > 15) break; } return R_NilValue; } SEXP processx_write(SEXP fd, SEXP data) { int cfd = INTEGER(fd)[0]; ssize_t ret = write(cfd, RAW(data), LENGTH(data)); if (ret == -1) { if (errno == EAGAIN || errno == EWOULDBLOCK) { ret = 0; } else { R_THROW_SYSTEM_ERROR("Cannot write to fd"); } } return ScalarInteger(ret); } #endif static SEXP processx_set_std(int which, int fd, int drop) { int orig = -1; int ret; const char *what[] = { "stdin", "stdout", "stderr" }; if (!drop) { #ifdef _WIN32 orig = _dup(which); #else orig = dup(which); #endif if (orig == -1) { R_THROW_SYSTEM_ERROR("Cannot reroute %s", what[which]); } } #ifdef _WIN32 ret = _dup2(fd, which); #else ret = dup2(fd, which); #endif if (ret == -1) { R_THROW_SYSTEM_ERROR("Cannot reroute %s", what[which]); } close(fd); if (!drop) { return ScalarInteger(orig); } else { return R_NilValue; } } SEXP processx_set_stdout(SEXP fd, SEXP drop) { return processx_set_std(1, INTEGER(fd)[0], LOGICAL(drop)[0]); } SEXP processx_set_stderr(SEXP fd, SEXP drop) { return processx_set_std(2, INTEGER(fd)[0], LOGICAL(drop)[0]); } SEXP processx_set_stdout_to_file(SEXP file) { const char *c_file = CHAR(STRING_ELT(file, 0)); #ifdef _WIN32 int fd = open(c_file, _O_WRONLY | _O_CREAT | _O_TRUNC, 0644); #else int fd = open(c_file, O_WRONLY | O_CREAT | O_TRUNC, 0644); #endif if (fd == -1) { R_THROW_SYSTEM_ERROR("Cannot open new stdout file `%s`", c_file); } SEXP ret = processx_set_std(1, fd, 0); close(fd); return ret; } SEXP processx_set_stderr_to_file(SEXP file) { const char *c_file = CHAR(STRING_ELT(file, 0)); #ifdef _WIN32 int fd = open(c_file, _O_WRONLY | _O_CREAT | _O_TRUNC, 0644); #else int fd = open(c_file, O_WRONLY | O_CREAT | O_TRUNC, 0644); #endif if (fd == -1) { R_THROW_SYSTEM_ERROR("Cannot open new stderr file `%s`", c_file); } SEXP ret = processx_set_std(2, fd, 0); close(fd); return ret; } SEXP processx_base64_encode(SEXP array); SEXP processx_base64_decode(SEXP array); static const R_CallMethodDef callMethods[] = { { "processx_base64_encode", (DL_FUNC) &processx_base64_encode, 1 }, { "processx_base64_decode", (DL_FUNC) &processx_base64_decode, 1 }, { "processx_disable_inheritance", (DL_FUNC) &processx_disable_inheritance, 0 }, { "processx_write", (DL_FUNC) &processx_write, 2 }, { "processx_set_stdout", (DL_FUNC) &processx_set_stdout, 2 }, { "processx_set_stderr", (DL_FUNC) &processx_set_stderr, 2 }, { "processx_set_stdout_to_file", (DL_FUNC) &processx_set_stdout_to_file, 1 }, { "processx_set_stderr_to_file", (DL_FUNC) &processx_set_stderr_to_file, 1 }, { NULL, NULL, 0 } }; void R_init_client(DllInfo *dll) { R_registerRoutines(dll, NULL, callMethods, NULL, NULL); R_useDynamicSymbols(dll, FALSE); R_forceSymbols(dll, TRUE); } processx/src/tools/0000755000176200001440000000000014043046411014044 5ustar liggesusersprocessx/src/tools/interrupt.c0000644000176200001440000000152313616314040016246 0ustar liggesusers #include #include #include int main(int argc, const char **argv) { int ctrlbreak = 1; int pid; int ret; BOOL bret; if (argc == 1) return 1; ret = sscanf(argv[1], "%d", &pid); if (ret != 1) return 1; printf("Pid: %d\n", pid); if (argc == 3 && !strcmp(argv[2], "c")) ctrlbreak = 0; printf("Event: %s\n", ctrlbreak ? "ctrl+break" : "ctrl+c"); printf("Free console\n"); bret = FreeConsole(); if (!bret) return GetLastError(); printf("Attach console\n"); bret = AttachConsole(pid); if (!bret) return GetLastError(); printf("Set console ctrl handler\n"); SetConsoleCtrlHandler(NULL, TRUE); printf("Send event\n"); bret = GenerateConsoleCtrlEvent( ctrlbreak ? CTRL_BREAK_EVENT : CTRL_C_EVENT, 0); if (!bret) return GetLastError(); printf("Done\n"); return 0; } processx/src/tools/pxu.c0000644000176200001440000001350314025102241015020 0ustar liggesusers #ifndef _GNU_SOURCE #define _GNU_SOURCE 1 #endif #include #include #include #include #include #include #include #include #include void usage() { fwprintf(stderr, L"Usage: px [command arg] [command arg] ...\n\n"); fwprintf(stderr, L"Commands:\n"); fwprintf(stderr, L" sleep -- " L"sleep for a number os seconds\n"); fwprintf(stderr, L" out -- " L"print string to stdout\n"); fwprintf(stderr, L" err -- " L"print string to stderr\n"); fwprintf(stderr, L" outln -- " L"print string to stdout, add newline\n"); fwprintf(stderr, L" errln -- " L"print string to stderr, add newline\n"); fwprintf(stderr, L" errflush -- " L"flush stderr stream\n"); fwprintf(stderr, L" cat -- " L"print file to stdout\n"); fwprintf(stderr, L" return -- " L"return with exitcode\n"); fwprintf(stderr, L" writefile -- " L"write to file\n"); fwprintf(stderr, L" write -- " L"write to file descriptor\n"); fwprintf(stderr, L" echo -- " L"echo from fd to another fd\n"); fwprintf(stderr, L" getenv -- " L"environment variable to stdout\n"); } void cat2(int f, const wchar_t *s) { char buf[8192]; long n; while ((n = read(f, buf, (long) sizeof buf)) > 0) { if (write(1, buf, n) != n){ fwprintf(stderr, L"write error copying %ls", s); exit(6); } } if (n < 0) fwprintf(stderr, L"error reading %ls", s); } void cat(const wchar_t* filename) { int f; if (!wcscmp(L"", filename)) { f = STDIN_FILENO; } else { f = _wopen(filename, O_RDONLY); } if (f < 0) { fwprintf(stderr, L"can't open %ls", filename); exit(6); } cat2(f, filename); close(f); } int write_to_fd(int fd, const wchar_t *s) { size_t len = wcslen(s); ssize_t ret = write(fd, s, len * sizeof(wchar_t)); if (ret != len * sizeof(wchar_t)) { fwprintf(stderr, L"Cannot write to fd '%d'\n", fd); return 1; } return 0; } int write_to_fd_simple(int fd, const char *s) { size_t len = strlen(s); ssize_t ret = write(fd, s, len); if (ret != len) { fwprintf(stderr, L"Cannot write to fd '%d'\n", fd); return 1; } return 0; } int echo_from_fd(int fd1, int fd2, int nbytes) { char buffer[nbytes + 1]; ssize_t ret; buffer[nbytes] = '\0'; ret = read(fd1, buffer, nbytes); if (ret == -1) { fwprintf(stderr, L"Cannot read from fd '%d', %s\n", fd1, strerror(errno)); return 1; } if (ret != nbytes) { fwprintf(stderr, L"Cannot read from fd '%d' (%d bytes)\n", fd1, (int) ret); return 1; } if (write_to_fd_simple(fd2, buffer)) return 1; fflush(stdout); fflush(stderr); return 0; } int wmain(int argc, const wchar_t **argv) { int num, idx, ret, fd, fd2, nbytes; double fnum; _setmode(_fileno(stdout), _O_U16TEXT); if (argc == 2 && !wcscmp(L"--help", argv[1])) { usage(); return 0; } for (idx = 1; idx < argc; idx++) { const wchar_t *cmd = argv[idx]; if (idx + 1 == argc) { fwprintf(stderr, L"Missing argument for '%ls'\n", argv[idx]); return 5; } if (!wcscmp(L"sleep", cmd)) { ret = swscanf(argv[++idx], L"%lf", &fnum); if (ret != 1) { fwprintf(stderr, L"Invalid seconds for px sleep: '%ls'\n", argv[idx]); return 3; } num = (int) fnum; sleep(num); fnum = fnum - num; if (fnum > 0) usleep((useconds_t) (fnum * 1000.0 * 1000.0)); } else if (!wcscmp(L"out", cmd)) { wprintf(L"%ls", argv[++idx]); fflush(stdout); } else if (!wcscmp(L"err", cmd)) { fwprintf(stderr, L"%ls", argv[++idx]); } else if (!wcscmp(L"outln", cmd)) { wprintf(L"%ls\n", argv[++idx]); fflush(stdout); } else if (!wcscmp(L"errln", cmd)) { fwprintf(stderr, L"%ls\n", argv[++idx]); } else if (!wcscmp(L"errflush", cmd)) { fflush(stderr); } else if (!wcscmp(L"cat", cmd)) { cat(argv[++idx]); } else if (!wcscmp(L"return", cmd)) { ret = swscanf(argv[++idx], L"%d", &num); if (ret != 1) { fwprintf(stderr, L"Invalid exit code for px return: '%ls'\n", argv[idx]); return 4; } return num; } else if (!wcscmp(L"writefile", cmd)) { if (idx + 2 >= argc) { fwprintf(stderr, L"Missing argument(s) for 'writefile'\n"); return 5; } int fd = _wopen(argv[++idx], _O_WRONLY | _O_CREAT | _O_BINARY); if (fd == -1) return 5; if (write_to_fd(fd, argv[++idx])) { close(fd); return 5; } close(fd); } else if (!wcscmp(L"write", cmd)) { if (idx + 2 >= argc) { fwprintf(stderr, L"Missing argument(s) for 'write'\n"); return 6; } ret = swscanf(argv[++idx], L"%d", &fd); if (ret != 1) { fwprintf(stderr, L"Invalid fd for write: '%ls'\n", argv[idx]); return 7; } if (write_to_fd(fd, argv[++idx])) return 7; } else if (!wcscmp(L"echo", cmd)) { if (idx + 3 >= argc) { fwprintf(stderr, L"Missing argument(s) for 'read'\n"); return 8; } ret = swscanf(argv[++idx], L"%d", &fd); ret = ret + swscanf(argv[++idx], L"%d", &fd2); ret = ret + swscanf(argv[++idx], L"%d", &nbytes); if (ret != 3) { fwprintf(stderr, L"Invalid fd1, fd2 or nbytes for read: '%ls', '%ls', '%ls'\n", argv[idx-2], argv[idx-1], argv[idx]); return 9; } if (echo_from_fd(fd, fd2, nbytes)) return 10; } else if (!wcscmp(L"getenv", cmd)) { wprintf(L"%ls\n", _wgetenv(argv[++idx])); fflush(stdout); } else { fwprintf(stderr, L"Unknown px command: '%ls'\n", cmd); return 2; } } return 0; } processx/src/tools/px.c0000644000176200001440000001270014025102241014631 0ustar liggesusers #ifndef _GNU_SOURCE #define _GNU_SOURCE 1 #endif #if defined __INTEL_COMPILER #define _BSD_SOURCE 1 #define _POSIX_C_SOURCE 200809L #endif #include #include #include #include #include #include #include void usage() { fprintf(stderr, "Usage: px [command arg] [command arg] ...\n\n"); fprintf(stderr, "Commands:\n"); fprintf(stderr, " sleep -- " "sleep for a number os seconds\n"); fprintf(stderr, " out -- " "print string to stdout\n"); fprintf(stderr, " err -- " "print string to stderr\n"); fprintf(stderr, " outln -- " "print string to stdout, add newline\n"); fprintf(stderr, " errln -- " "print string to stderr, add newline\n"); fprintf(stderr, " errflush -- " "flush stderr stream\n"); fprintf(stderr, " cat -- " "print file to stdout\n"); fprintf(stderr, " return -- " "return with exitcode\n"); fprintf(stderr, " writefile -- " "write to file\n"); fprintf(stderr, " write -- " "write to file descriptor\n"); fprintf(stderr, " echo -- " "echo from fd to another fd\n"); fprintf(stderr, " getenv -- " "environment variable to stdout\n"); } void cat2(int f, const char *s) { char buf[8192]; long n; while ((n = read(f, buf, (long) sizeof buf)) > 0) { if (write(1, buf, n) != n){ fprintf(stderr, "write error copying %s", s); exit(6); } } if (n < 0) fprintf(stderr, "error reading %s", s); } void cat(const char* filename) { int f; if (!strcmp("", filename)) { f = STDIN_FILENO; } else { f = open(filename, O_RDONLY); } if (f < 0) { fprintf(stderr, "can't open %s", filename); exit(6); } cat2(f, filename); close(f); } int write_to_fd(int fd, const char *s) { size_t len = strlen(s); ssize_t ret = write(fd, s, len); if (ret != len) { fprintf(stderr, "Cannot write to fd '%d'\n", fd); return 1; } return 0; } int echo_from_fd(int fd1, int fd2, int nbytes) { char buffer[nbytes + 1]; ssize_t ret; buffer[nbytes] = '\0'; ret = read(fd1, buffer, nbytes); if (ret == -1) { fprintf(stderr, "Cannot read from fd '%d', %s\n", fd1, strerror(errno)); return 1; } if (ret != nbytes) { fprintf(stderr, "Cannot read from fd '%d' (%d bytes)\n", fd1, (int) ret); return 1; } if (write_to_fd(fd2, buffer)) return 1; fflush(stdout); fflush(stderr); return 0; } int main(int argc, const char **argv) { int num, idx, ret, fd, fd2, nbytes; double fnum; if (argc == 2 && !strcmp("--help", argv[1])) { usage(); return 0; } for (idx = 1; idx < argc; idx++) { const char *cmd = argv[idx]; if (idx + 1 == argc) { fprintf(stderr, "Missing argument for '%s'\n", argv[idx]); return 5; } if (!strcmp("sleep", cmd)) { ret = sscanf(argv[++idx], "%lf", &fnum); if (ret != 1) { fprintf(stderr, "Invalid seconds for px sleep: '%s'\n", argv[idx]); return 3; } num = (int) fnum; sleep(num); fnum = fnum - num; if (fnum > 0) usleep((useconds_t) (fnum * 1000.0 * 1000.0)); } else if (!strcmp("out", cmd)) { printf("%s", argv[++idx]); fflush(stdout); } else if (!strcmp("err", cmd)) { fprintf(stderr, "%s", argv[++idx]); } else if (!strcmp("outln", cmd)) { printf("%s\n", argv[++idx]); fflush(stdout); } else if (!strcmp("errln", cmd)) { fprintf(stderr, "%s\n", argv[++idx]); } else if (!strcmp("errflush", cmd)) { fflush(stderr); } else if (!strcmp("cat", cmd)) { cat(argv[++idx]); } else if (!strcmp("return", cmd)) { ret = sscanf(argv[++idx], "%d", &num); if (ret != 1) { fprintf(stderr, "Invalid exit code for px return: '%s'\n", argv[idx]); return 4; } return num; } else if (!strcmp("writefile", cmd)) { if (idx + 2 >= argc) { fprintf(stderr, "Missing argument(s) for 'writefile'\n"); return 5; } #ifdef WIN32 int fd = open(argv[++idx], _O_WRONLY | _O_CREAT | _O_BINARY); #else int fd = open(argv[++idx], O_WRONLY | O_CREAT, 0644); #endif if (fd == -1) return 11; if (write_to_fd(fd, argv[++idx])) { close(fd); return 12; } close(fd); } else if (!strcmp("write", cmd)) { if (idx + 2 >= argc) { fprintf(stderr, "Missing argument(s) for 'write'\n"); return 6; } ret = sscanf(argv[++idx], "%d", &fd); if (ret != 1) { fprintf(stderr, "Invalid fd for write: '%s'\n", argv[idx]); return 7; } if (write_to_fd(fd, argv[++idx])) return 7; } else if (!strcmp("echo", cmd)) { if (idx + 3 >= argc) { fprintf(stderr, "Missing argument(s) for 'read'\n"); return 8; } ret = sscanf(argv[++idx], "%d", &fd); ret = ret + sscanf(argv[++idx], "%d", &fd2); ret = ret + sscanf(argv[++idx], "%d", &nbytes); if (ret != 3) { fprintf(stderr, "Invalid fd1, fd2 or nbytes for read: '%s', '%s', '%s'\n", argv[idx-2], argv[idx-1], argv[idx]); return 9; } if (echo_from_fd(fd, fd2, nbytes)) return 10; } else if (!strcmp("getenv", cmd)) { printf("%s\n", getenv(argv[++idx])); fflush(stdout); } else { fprintf(stderr, "Unknown px command: '%s'\n", cmd); return 2; } } return 0; } processx/src/supervisor/0000755000176200001440000000000014043046410015124 5ustar liggesusersprocessx/src/supervisor/windows.c0000644000176200001440000001675413616314040017001 0ustar liggesusers #ifdef __INTEL_COMPILER #define _BSD_SOURCE 1 #define _POSIX_C_SOURCE 200809L #endif #include #include #include "windows.h" #include "utils.h" #define MIN(a,b) ((ab)?a:b) int getppid() { int pid = GetCurrentProcessId(); HANDLE hProcessSnap = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); PROCESSENTRY32 pe; // Set the size of the structure before using it. pe.dwSize = sizeof(PROCESSENTRY32); // Get info about first process. if(!Process32First(hProcessSnap, &pe)) { printf("Unable to get parent pid"); exit(1); } // Walk the snapshot of processes to find the parent. do { if (pe.th32ProcessID == pid) { return pe.th32ParentProcessID; } } while(Process32Next(hProcessSnap, &pe)); CloseHandle(hProcessSnap); printf("Unable to get parent pid"); exit(1); } HANDLE open_stdin() { HANDLE h_input = GetStdHandle(STD_INPUT_HANDLE); if (h_input == INVALID_HANDLE_VALUE) { printf("Unable to get stdin handle."); exit(1); } return h_input; } HANDLE open_named_pipe(const char* pipe_name) { HANDLE h_input = CreateFile(pipe_name, GENERIC_READ, 0, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL ); if (h_input == INVALID_HANDLE_VALUE) { printf("CreateFile failed with error %u\n", (unsigned)GetLastError()); exit(1); } return h_input; } void configure_input_handle(HANDLE h_input) { DWORD handle_type = GetFileType(h_input); if (handle_type == FILE_TYPE_CHAR) { DWORD lpmode; GetConsoleMode(h_input, &lpmode); // Disable line input lpmode = lpmode & ~ENABLE_LINE_INPUT & ~ENABLE_ECHO_INPUT; // Only listen for character input events if (!SetConsoleMode(h_input, lpmode)) { printf("Unable to set console mode. %d", (int)GetLastError()); exit(1); } } else if (handle_type == FILE_TYPE_PIPE) { // No need to do anything } else if (handle_type == FILE_TYPE_DISK) { printf("Don't know how to handle FILE_TYPE_DISK."); exit(1); } else { printf("Unknown input type."); exit(1); } } // If there's a complete line of text, put that line in buffer, and return the // number of characters. Otherwise, return NULL. char* get_line_nonblock(char* buf, int max_chars, HANDLE h_input) { // Check what type of thing we're reading from DWORD input_type = GetFileType(h_input); // Debugging info char* input_type_name; switch(input_type) { case FILE_TYPE_CHAR: input_type_name = "FILE_TYPE_CHAR (console)"; break; case FILE_TYPE_DISK: input_type_name = "FILE_TYPE_DISK"; break; case FILE_TYPE_PIPE: input_type_name = "FILE_TYPE_PIPE"; break; default: input_type_name = "Unknown"; } if (input_type == FILE_TYPE_CHAR) { // Attempt to read enough to fill the buffer DWORD num_peeked; INPUT_RECORD in_record_buf[WIN_INPUT_BUF_LEN]; char input_char_buf[WIN_INPUT_BUF_LEN]; int input_char_buf_n = 0; // First use PeekConsoleInput to make sure some char is available, // because ReadConsoleInput will block if there's no input. if (!PeekConsoleInput(h_input, in_record_buf, WIN_INPUT_BUF_LEN, &num_peeked)) { printf("Error peeking at console input.\n"); return NULL; }; if (num_peeked == 0) { return NULL; } bool found_newline = false; int i; for (i=0; i #include #include #include "utils.h" bool verbose_mode = false; void verbose_printf(const char *format, ...) { va_list args; va_start(args, format); if (verbose_mode) { vprintf(format, args); fflush(stdout); } va_end(args); } // Remove an element from an array by replacing it with the last element. Note // that this can alter the order of elements in the array. Returns new length // of array. int remove_element(int* ar, int len, int idx) { ar[idx] = ar[len-1]; return len-1; } bool array_contains(int* ar, int len, int value) { for (int i=0; i #include #include // Constants ------------------------------------------------------------------ #define WIN_INPUT_BUF_LEN 1024 // Functions ------------------------------------------------------------------ int getppid(); HANDLE open_stdin(); HANDLE open_named_pipe(const char* pipe_name); void configure_input_handle(HANDLE h_input); char* get_line_nonblock(char* buf, int max_chars, HANDLE h_input); void sendCtrlC(int pid); BOOL CALLBACK enumCloseWindowProc(_In_ HWND hwnd, LPARAM lParam); void sendWmClose(int pid); BOOL kill_pid(DWORD dwProcessId); #endif processx/src/supervisor/utils.h0000644000176200001440000000043213616314040016436 0ustar liggesusers #ifndef R_PROCESSX_SUPERVISOR_UTILS_H #define R_PROCESSX_SUPERVISOR_UTILS_H #include extern bool verbose_mode; void verbose_printf(const char *format, ...); int remove_element(int* ar, int len, int idx) ; bool array_contains(int* ar, int len, int value); #endif processx/src/supervisor/supervisor.c0000644000176200001440000003115113703607776017536 0ustar liggesusers// This supervisor program keeps track of a process (normally the parent // process) and receives process IDs (called children) on standard input. If // the supervisor process receives a SIGINT (Ctrl-C) or SIGTERM, or if it // detects that the parent process has died, it will kill all the child // processes. // // Every 0.2 seconds, it does the following: // * Checks for any new process IDs on standard input, and adds them to the list // of child processes to track. If the PID is negative, as in "-1234", then // that value will be negated and removed from the list of processes to track. // * Checks if any child processes have died. If so, remove them from the list // of child processes to track. // * Checks if the parent process has died. If so, kill all children and exit. // // To test it out in verbose mode, run: // gcc supervisor.c -o supervisor // ./supervisor -v -p [parent_pid] // // The [parent_pid] is optional. If not supplied, the supervisor will auto- // detect the parent process. // // After it is started, you can enter pids for child processes. Then you can // do any of the following to test it out: // * Press Ctrl-C. // * Send a SIGTERM to the supervisor with `killall supervisor`. // * Kill the parent processes. // * Kill a child process. #ifdef __INTEL_COMPILER #define _BSD_SOURCE 1 #define _POSIX_C_SOURCE 200809L #endif #include #include #include #include #include #include #include #include #include #include #include #include #ifdef WIN32 #include "windows.h" #endif #include "utils.h" // Constants ------------------------------------------------------------------ // Size of stdin input buffer #define INPUT_BUF_LEN 1024 // Maximum number of children to keep track of #define MAX_CHILDREN 1024 // Milliseconds to sleep in polling loop #define POLL_MS 200 // Globals -------------------------------------------------------------------- // Child processes to track int children[MAX_CHILDREN]; int n_children = 0; int sigint_received = false; int sigterm_received = false; // Utility functions ---------------------------------------------------------- // Cross-platform sleep function #ifdef WIN32 #include #elif _POSIX_C_SOURCE >= 199309L #include // for nanosleep #else #include // for usleep #endif void sleep_ms(int milliseconds) { #ifdef WIN32 Sleep(milliseconds); #elif _POSIX_C_SOURCE >= 199309L struct timespec ts; ts.tv_sec = milliseconds / 1000; ts.tv_nsec = (milliseconds % 1000) * 1000000; nanosleep(&ts, NULL); #else usleep(milliseconds * 1000); #endif } // Given a string of format "102", return 102. If conversion fails because it // is out of range, or because the string can't be parsed, return 0. int extract_pid(char* buf, int len) { long pid = strtol(buf, NULL, 10); // Out of range: errno is ERANGE if it's out of range for a long. We're // going to cast to int, so we also need to make sure that it's within // range for int. if (errno == ERANGE || pid > INT_MAX || pid < INT_MIN) { return 0; } return (int)pid; } // Check if a process is running. Returns 1 if yes, 0 if no. bool pid_is_running(pid_t pid) { #ifdef WIN32 HANDLE h_process = OpenProcess(PROCESS_QUERY_INFORMATION, false, pid); if (h_process == NULL) { printf("Unable to check if process %d is running.\n", (int)pid); return false; } DWORD exit_code; if (!GetExitCodeProcess(h_process, &exit_code)) { printf("Unable to check if process %d is running.\n", (int)pid); return false; } if (exit_code == STILL_ACTIVE) { return true; } else { return false; } #else int res = kill(pid, 0); if (res == -1 && errno == ESRCH) { return false; } return true; #endif } // Send a soft kill signal to all children, wait 5 seconds, then hard kill any // remaining processes. void kill_children() { if (n_children == 0) return; verbose_printf("Sending close signal to children: "); for (int i=0; i= 2) { for (int i=1; i= argc) { printf("-p must be followed with a process ID."); exit(1); } parent_pid_arg = extract_pid(argv[i], (int) strlen(argv[i])); if (parent_pid_arg == 0) { printf("Invalid parent process ID: %s\n", argv[i]); exit(1); } } else if (strcmp(argv[i], "-i") == 0) { i++; if (i >= argc) { printf("-i must be followed with the name of a pipe."); exit(1); } input_pipe_name = argv[i]; } else { printf("Unknown argument: %s\n", argv[i]); exit(1); } } } printf("PID: %d\n", getpid()); fflush(stdout); parent_pid_detected = getppid(); verbose_printf("Parent PID (detected): %d\n", parent_pid_detected); if (parent_pid_arg != 0) { verbose_printf("Parent PID (argument): %d\n", parent_pid_arg); parent_pid = parent_pid_arg; // This check is really only useful for testing. if (parent_pid_arg != parent_pid_detected) { verbose_printf("Note: detected parent PID differs from argument parent PID.\n"); verbose_printf("Using parent PID from argument (%d).\n", parent_pid_arg); } } else { parent_pid = parent_pid_detected; } if (input_pipe_name != NULL) { verbose_printf("Reading input from %s.\n", input_pipe_name); } // Open and configure input source ---------------------------------------- // Input buffer for messages from the R process char readbuf[INPUT_BUF_LEN]; #ifdef WIN32 HANDLE h_input; if (input_pipe_name == NULL) { h_input = open_stdin(); } else { h_input = open_named_pipe(input_pipe_name); } configure_input_handle(h_input); #else FILE* fp_input; if (input_pipe_name == NULL) { fp_input = stdin; } else { printf("fopen.\n"); fp_input = fopen(input_pipe_name, "r"); printf("fopened.\n"); if (fp_input == NULL) { printf("Unable to open %s for reading.\n", input_pipe_name); exit(1); } } if (fcntl(fileno(fp_input), F_SETFL, O_NONBLOCK) == -1) { printf("Error setting input to non-blocking mode.\n"); exit(1); } #endif printf("Ready\n"); fflush(stdout); // Register signal handler ------------------------------------------------ #ifdef WIN32 signal(SIGINT, sig_handler); signal(SIGTERM, sig_handler); #else struct sigaction sa; memset(&sa, 0, sizeof(sa)); sa.sa_handler = sig_handler; sigemptyset(&sa.sa_mask); if (sigaction(SIGINT, &sa, NULL) == -1 || sigaction(SIGTERM, &sa, NULL) == -1) { printf("Error setting up signal handler.\n"); exit(1); } #endif // Poll ------------------------------------------------------------------- while(1) { // Check if a sigint or sigterm has been received. If so, then kill // the child processes and quit. Do the work here instead of in the // signal handler, because the signal handler can itself be // interrupted by another call to the same handler if another signal // is received, and that could result in some unsafe operations. if (sigint_received || sigterm_received) { kill_children(); verbose_printf("\nExiting.\n"); exit(0); } // Look for any new processes IDs from the input char* res = NULL; // Read in the input buffer. There could be multiple lines so we'll // keep reading lines until there's no more content. while(1) { #ifdef WIN32 res = get_line_nonblock(readbuf, INPUT_BUF_LEN, h_input); #else res = fgets(readbuf, INPUT_BUF_LEN, fp_input); #endif if (res == NULL) break; if (strncmp(readbuf, "kill", 4) == 0) { verbose_printf("\'kill' command received.\n"); kill_children(); verbose_printf("\nExiting.\n"); return 0; } int pid = extract_pid(readbuf, INPUT_BUF_LEN); if (pid > 0) { if (n_children == MAX_CHILDREN) { printf( "Number of child processes to watch has exceeded limit of %d.", MAX_CHILDREN ); } else if (array_contains(children, n_children, pid)) { verbose_printf("Not adding (already present):%d\n", pid); } else { verbose_printf("Adding:%d\n", pid); children[n_children] = pid; n_children++; } } else if (pid < 0) { // Remove pids that start with '-' pid = -pid; for (int i=0; i #include #define ERRORBUF_SIZE 4096 static char errorbuf[ERRORBUF_SIZE]; SEXP r_throw_error(const char *func, const char *filename, int line, const char *msg, ...) { va_list args; errorbuf[0] = '\0'; va_start(args, msg); vsnprintf(errorbuf, ERRORBUF_SIZE, msg, args); va_end (args); error("%s @%s:%d (%s)", errorbuf, filename, line, func); return R_NilValue; } #ifdef _WIN32 SEXP r_throw_system_error(const char *func, const char *filename, int line, DWORD errorcode, const char *sysmsg, const char *msg, ...) { va_list args; LPVOID lpMsgBuf; char *realsysmsg = sysmsg ? (char*) sysmsg : NULL; char *failmsg = "Formatting the system message failed :("; if (errorcode == -1) errorcode = GetLastError(); if (!realsysmsg) { DWORD ret = FormatMessage( FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS, NULL, errorcode, MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (LPTSTR) &lpMsgBuf, 0, NULL); if (ret == 0) { realsysmsg = failmsg; } else { realsysmsg = R_alloc(1, strlen(lpMsgBuf) + 1); strcpy(realsysmsg, lpMsgBuf); LocalFree(lpMsgBuf); } } errorbuf[0] = '\0'; va_start(args, msg); vsnprintf(errorbuf, ERRORBUF_SIZE, msg, args); va_end(args); error("%s (system error %d, %s) @%s:%d (%s)", errorbuf, errorcode, realsysmsg, filename, line, func); return R_NilValue; } #endif #ifdef _WIN32 SEXP r_throw_posix_error( #else SEXP r_throw_system_error( #endif const char *func, const char *filename, int line, int errorcode, const char *sysmsg, const char *msg, ...) { va_list args; if (!sysmsg) sysmsg = strerror(errorcode); errorbuf[0] = '\0'; va_start(args, msg); vsnprintf(errorbuf, ERRORBUF_SIZE, msg, args); va_end(args); error("%s (system error %d, %s) @%s:%d (%s)", errorbuf, errorcode, sysmsg, filename, line, func); return R_NilValue; } processx/src/processx-connection.h0000644000176200001440000002033314026323556017072 0ustar liggesusers #ifndef PROCESSX_CONNECTION_H #define PROCESSX_CONNECTION_H #ifndef _GNU_SOURCE #define _GNU_SOURCE 1 #endif #ifdef __INTEL_COMPILER #define _BSD_SOURCE 1 #define _POSIX_C_SOURCE 200809L #endif #ifdef _WIN32 #ifndef FD_SETSIZE #define FD_SETSIZE 32767 #endif #include #include #else #include #endif #include "errors.h" #include #include /* --------------------------------------------------------------------- */ /* Data types */ /* --------------------------------------------------------------------- */ #define ARRAY_SIZE(a) (sizeof(a) / sizeof((a)[0])) #ifdef _WIN32 typedef HANDLE processx_file_handle_t; typedef struct { HANDLE handle; OVERLAPPED overlapped; BOOLEAN async; BOOLEAN read_pending; BOOLEAN freelist; } processx_i_connection_t; #else typedef int processx_file_handle_t; typedef int processx_i_connection_t; #endif typedef enum { PROCESSX_FILE_TYPE_FILE = 1, /* regular file, blocking IO */ PROCESSX_FILE_TYPE_ASYNCFILE, /* regular file, async IO (well, win only) */ PROCESSX_FILE_TYPE_PIPE, /* pipe, blocking IO */ PROCESSX_FILE_TYPE_ASYNCPIPE /* pipe, async IO */ } processx_file_type_t; typedef struct processx_connection_s { processx_file_type_t type; int is_closed_; int is_eof_; /* the UTF8 buffer */ int is_eof_raw_; /* the raw file */ int close_on_destroy; char *encoding; void *iconv_ctx; processx_i_connection_t handle; char* buffer; size_t buffer_allocated_size; size_t buffer_data_size; char *utf8; size_t utf8_allocated_size; size_t utf8_data_size; int poll_idx; } processx_connection_t; struct processx_pollable_s; /* Generic poll method * * @param object The thing to poll. * @param handle A handle can be returned here, to `poll` or wait on. * If this is not needed, set it to NULL. * @param timeout A timeout value can be returned here, for the next * poll. If this is not needed, set it to NULL. * @return The result of the pre-polling. PXCLOSED, PXREADY or PXSILENT. * PXREADY: data is readily available, at least one character. * (But maybe not a full line.) * PXSILENT: we don't know if data is available, we need to check the * operating system via `poll` or `WaitForStatus`. * PXHANDLE * PXPOLLFD */ typedef int (*processx_connection_pre_poll_func_t)( struct processx_pollable_s *pollable); /* Data structure for a pollable object * * @member pre_poll_func The function to call on the object, before * the poll/wait system call. The pollable object might have data * available without immediately, without poll/wait. If not, it * will return the file descriptor or HANDLE to poll. * @member object The object to pass to `poll_func`. * @member free Whether to call `free()` on `object` when finalizing * `processx_pollable_t` objects. * @member event The result of the polling is stored here. Possible values: * `PXSILENT` (no data), `PXREADY` (data), `PXTIMEOUT` (timeout). * @member fd If the pollable is an fd, then it is stored here instead of * in `object`, for simplicity. */ typedef struct processx_pollable_s { processx_connection_pre_poll_func_t pre_poll_func; void *object; int free; int event; processx_file_handle_t handle; SEXP fds; } processx_pollable_t; /* --------------------------------------------------------------------- */ /* API from R */ /* --------------------------------------------------------------------- */ /* Create connection from fd / HANDLE */ SEXP processx_connection_create(SEXP handle, SEXP encoding); /* Create from fd, this is only different on Windows */ SEXP processx_connection_create_fd(SEXP handle, SEXP encoding, SEXP close); /* Create file connection */ SEXP processx_connection_create_file(SEXP filename, SEXP read, SEXP write); /* Read characters in a given encoding from the connection. */ SEXP processx_connection_read_chars(SEXP con, SEXP nchars); /* Read lines of characters from the connection. */ SEXP processx_connection_read_lines(SEXP con, SEXP nlines); /* Write characters */ SEXP processx_connection_write_bytes(SEXP con, SEXP chars); /* Check if the connection has ended. */ SEXP processx_connection_is_eof(SEXP con); /* Close the connection. */ SEXP processx_connection_close(SEXP con); SEXP processx_is_closed(SEXP con); /* Poll connections and other pollable handles */ SEXP processx_connection_poll(SEXP pollables, SEXP timeout); /* Functions for connection inheritance */ SEXP processx_connection_create_pipepair(); SEXP processx_connection_set_stdout(SEXP con, SEXP drop); SEXP processx_connection_set_stderr(SEXP con, SEXP drop); SEXP processx_connection_get_fileno(SEXP con); SEXP processx_connection_disable_inheritance(); SEXP processx_is_valid_fd(SEXP fd); /* --------------------------------------------------------------------- */ /* API from C */ /* --------------------------------------------------------------------- */ /* Create connection object */ processx_connection_t *processx_c_connection_create( processx_file_handle_t os_handle, processx_file_type_t type, const char *encoding, SEXP *r_connection); /* Destroy connection object. We need this for the C API */ void processx_c_connection_destroy(processx_connection_t *ccon); /* Read characters */ ssize_t processx_c_connection_read_chars( processx_connection_t *con, void *buffer, size_t nbyte); /* Read lines of characters */ ssize_t processx_c_connection_read_line( processx_connection_t *ccon, char **linep, size_t *linecapp); /* Write characters */ ssize_t processx_c_connection_write_bytes( processx_connection_t *con, const void *buffer, size_t nbytes); /* Check if the connection has ended */ int processx_c_connection_is_eof( processx_connection_t *con); /* Close */ void processx_c_connection_close( processx_connection_t *con); int processx_c_connection_is_closed( processx_connection_t *con); /* Poll connections and other pollable handles */ int processx_c_connection_poll( processx_pollable_t pollables[], size_t npollables, int timeout); /* Helper function to create pollable handles*/ int processx_c_pollable_from_connection( processx_pollable_t *pollable, processx_connection_t *ccon); int processx_c_pollable_from_curl( processx_pollable_t *pollable, SEXP fds); processx_file_handle_t processx_c_connection_fileno( const processx_connection_t *con); /* --------------------------------------------------------------------- */ /* Internals */ /* --------------------------------------------------------------------- */ #ifndef _WIN32 typedef unsigned long DWORD; #endif /* Threading in Windows */ #ifdef _WIN32 int processx__start_thread(); extern HANDLE processx__iocp_thread; extern HANDLE processx__thread_start; extern HANDLE processx__thread_done; extern fd_set processx__readfds, processx__writefds, processx__exceptionfds; extern SOCKET processx__notify_socket[2]; extern int processx__select; extern ULONG_PTR processx__key_none; extern int processx__thread_cmd; #define PROCESSX__THREAD_CMD_INIT 0 #define PROCESSX__THREAD_CMD_IDLE 1 #define PROCESSX__THREAD_CMD_READFILE 2 #define PROCESSX__THREAD_CMD_GETSTATUS 3 BOOL processx__thread_readfile(processx_connection_t *ccon, LPVOID lpBuffer, DWORD nNumberOfBytesToRead, LPDWORD lpNumberOfBytesRead); BOOL processx__thread_getstatus(LPDWORD lpNumberOfBytes, PULONG_PTR lpCompletionKey, LPOVERLAPPED *lpOverlapped, DWORD dwMilliseconds); BOOL processx__thread_getstatus_select(LPDWORD lpNumberOfBytes, PULONG_PTR lpCompletionKey, LPOVERLAPPED *lpOverlapped, DWORD dwMilliseconds); DWORD processx__thread_get_last_error(); #endif /* Free-list of connection in Windows */ typedef struct processx__connection_freelist_s { processx_connection_t *ccon; struct processx__connection_freelist_s *next; } processx__connection_freelist_t; int processx__connection_freelist_add(processx_connection_t *con); void processx__connection_freelist_remove(processx_connection_t *con); int processx__connection_schedule_destroy(processx_connection_t *con); #endif processx/src/init.c0000644000176200001440000000737614026372357014044 0ustar liggesusers #include "processx.h" #include "cleancall.h" #include #include void R_init_processx_win(); void R_init_processx_unix(); SEXP processx__unload_cleanup(); SEXP run_testthat_tests(); SEXP processx__echo_on(); SEXP processx__echo_off(); SEXP processx__set_boot_time(SEXP); static const R_CallMethodDef callMethods[] = { CLEANCALL_METHOD_RECORD, { "processx_exec", (DL_FUNC) &processx_exec, 14 }, { "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_get_pid", (DL_FUNC) &processx_get_pid, 1 }, { "processx_create_time", (DL_FUNC) &processx_create_time, 1 }, { "processx_poll", (DL_FUNC) &processx_poll, 3 }, { "processx__process_exists", (DL_FUNC) &processx__process_exists, 1 }, { "processx__unload_cleanup", (DL_FUNC) &processx__unload_cleanup, 0 }, { "processx_is_named_pipe_open", (DL_FUNC) &processx_is_named_pipe_open, 1 }, { "processx_close_named_pipe", (DL_FUNC) &processx_close_named_pipe, 1 }, { "processx_create_named_pipe", (DL_FUNC) &processx_create_named_pipe, 2 }, { "processx_write_named_pipe", (DL_FUNC) &processx_write_named_pipe, 2 }, { "processx__proc_start_time", (DL_FUNC) &processx__proc_start_time, 1 }, { "processx__set_boot_time", (DL_FUNC) &processx__set_boot_time, 1 }, { "processx_connection_create", (DL_FUNC) &processx_connection_create, 2 }, { "processx_connection_read_chars", (DL_FUNC) &processx_connection_read_chars, 2 }, { "processx_connection_read_lines", (DL_FUNC) &processx_connection_read_lines, 2 }, { "processx_connection_write_bytes",(DL_FUNC) &processx_connection_write_bytes,2 }, { "processx_connection_is_eof", (DL_FUNC) &processx_connection_is_eof, 1 }, { "processx_connection_close", (DL_FUNC) &processx_connection_close, 1 }, { "processx_connection_poll", (DL_FUNC) &processx_connection_poll, 2 }, { "processx_connection_create_pipepair", (DL_FUNC) processx_connection_create_pipepair, 2 }, { "processx_connection_create_fd", (DL_FUNC) &processx_connection_create_fd, 3 }, { "processx_connection_create_file", (DL_FUNC) &processx_connection_create_file, 3 }, { "processx_connection_set_stdout", (DL_FUNC) &processx_connection_set_stdout, 2 }, { "processx_connection_set_stderr", (DL_FUNC) &processx_connection_set_stderr, 2 }, { "processx_connection_get_fileno", (DL_FUNC) &processx_connection_get_fileno, 1 }, { "processx_connection_disable_inheritance", (DL_FUNC) &processx_connection_disable_inheritance, 0 }, { "processx_is_valid_fd", (DL_FUNC) &processx_is_valid_fd, 1 }, { "processx_disable_crash_dialog", (DL_FUNC) &processx_disable_crash_dialog, 0 }, { "processx_base64_encode", (DL_FUNC) &processx_base64_encode, 1 }, { "processx_base64_decode", (DL_FUNC) &processx_base64_decode, 1 }, { "processx__echo_on", (DL_FUNC) &processx__echo_on, 0 }, { "processx__echo_off", (DL_FUNC) &processx__echo_off, 0 }, { NULL, NULL, 0 } }; void R_init_processx(DllInfo *dll) { R_registerRoutines(dll, NULL, callMethods, NULL, NULL); R_useDynamicSymbols(dll, FALSE); R_forceSymbols(dll, TRUE); cleancall_fns_dot_call = Rf_findVar(Rf_install(".Call"), R_BaseEnv); #ifdef _WIN32 R_init_processx_win(); #else R_init_processx_unix(); #endif } processx/src/processx-connection.c0000644000176200001440000013064214026323556017072 0ustar liggesusers #include "processx-connection.h" #include #include #include #include #include #ifndef _WIN32 #include #include #else #include #endif #include "processx.h" #ifdef _WIN32 #include "win/processx-win.h" #else #include "unix/processx-unix.h" #endif /* Internal functions in this file */ static void processx__connection_find_chars(processx_connection_t *ccon, ssize_t maxchars, ssize_t maxbytes, size_t *chars, size_t *bytes); static void processx__connection_find_lines(processx_connection_t *ccon, ssize_t maxlines, size_t *lines, int *eof); static void processx__connection_alloc(processx_connection_t *ccon); static void processx__connection_realloc(processx_connection_t *ccon); static ssize_t processx__connection_read(processx_connection_t *ccon); static ssize_t processx__find_newline(processx_connection_t *ccon, size_t start); static ssize_t processx__connection_read_until_newline(processx_connection_t *ccon); static void processx__connection_xfinalizer(SEXP con); static ssize_t processx__connection_to_utf8(processx_connection_t *ccon); static void processx__connection_find_utf8_chars(processx_connection_t *ccon, ssize_t maxchars, ssize_t maxbytes, size_t *chars, size_t *bytes); #ifdef _WIN32 #define PROCESSX_CHECK_VALID_CONN(x) do { \ if (!x) R_THROW_ERROR("Invalid connection object"); \ if (!(x)->handle.handle) { \ R_THROW_ERROR("Invalid (uninitialized or closed?) connection object"); \ } \ } while (0) #else #define PROCESSX_CHECK_VALID_CONN(x) do { \ if (!x) R_THROW_ERROR("Invalid connection object"); \ if ((x)->handle < 0) { \ R_THROW_ERROR("Invalid (uninitialized or closed?) connection object"); \ } \ } while (0) #endif /* --------------------------------------------------------------------- */ /* API from R */ /* --------------------------------------------------------------------- */ SEXP processx_connection_create(SEXP handle, SEXP encoding) { processx_file_handle_t *os_handle = R_ExternalPtrAddr(handle); const char *c_encoding = CHAR(STRING_ELT(encoding, 0)); SEXP result = R_NilValue; if (!os_handle) R_THROW_ERROR("Cannot create connection, invalid handle"); processx_c_connection_create(*os_handle, PROCESSX_FILE_TYPE_ASYNCPIPE, c_encoding, &result); return result; } SEXP processx_connection_create_fd(SEXP handle, SEXP encoding, SEXP close) { int fd = INTEGER(handle)[0]; const char *c_encoding = CHAR(STRING_ELT(encoding, 0)); processx_file_handle_t os_handle; processx_connection_t *con; SEXP result = R_NilValue; #ifdef _WIN32 os_handle = (HANDLE) _get_osfhandle(fd); #else os_handle = fd; #endif con = processx_c_connection_create(os_handle, PROCESSX_FILE_TYPE_ASYNCPIPE, c_encoding, &result); if (! LOGICAL(close)[0]) con->close_on_destroy = 0; return result; } SEXP processx_connection_create_file(SEXP filename, SEXP read, SEXP write) { const char *c_filename = CHAR(STRING_ELT(filename, 0)); int c_read = LOGICAL(read)[0]; int c_write = LOGICAL(write)[0]; SEXP result = R_NilValue; processx_file_handle_t os_handle; #ifdef _WIN32 DWORD access = 0, create = 0; if (c_read) access |= GENERIC_READ; if (c_write) access |= GENERIC_WRITE; if (c_read) create |= OPEN_EXISTING; if (c_write) create |= CREATE_ALWAYS; os_handle = CreateFile( /* lpFilename = */ c_filename, /* dwDesiredAccess = */ access, /* dwShareMode = */ 0, /* lpSecurityAttributes = */ NULL, /* dwCreationDisposition = */ create, /* dwFlagsAndAttributes = */ FILE_ATTRIBUTE_NORMAL, /* hTemplateFile = */ NULL); if (os_handle == INVALID_HANDLE_VALUE) { R_THROW_SYSTEM_ERROR("Cannot open file `%s`", c_filename); } #else int flags = 0; if ( c_read && !c_write) flags |= O_RDONLY; if (!c_read && c_write) flags |= O_WRONLY | O_CREAT | O_TRUNC; if ( c_read && c_write) flags |= O_RDWR; os_handle = open(c_filename, flags, 0644); if (os_handle == -1) { R_THROW_SYSTEM_ERROR("Cannot open file `%s`", c_filename); } #endif processx_c_connection_create(os_handle, PROCESSX_FILE_TYPE_FILE, "", &result); return result; } SEXP processx_connection_read_chars(SEXP con, SEXP nchars) { processx_connection_t *ccon = R_ExternalPtrAddr(con); SEXP result; int cnchars = asInteger(nchars); size_t utf8_chars, utf8_bytes; processx__connection_find_chars(ccon, cnchars, -1, &utf8_chars, &utf8_bytes); result = PROTECT(ScalarString(mkCharLenCE(ccon->utf8, (int) utf8_bytes, CE_UTF8))); ccon->utf8_data_size -= utf8_bytes; memmove(ccon->utf8, ccon->utf8 + utf8_bytes, ccon->utf8_data_size); UNPROTECT(1); return result; } SEXP processx_connection_read_lines(SEXP con, SEXP nlines) { processx_connection_t *ccon = R_ExternalPtrAddr(con); SEXP result; int cn = asInteger(nlines); ssize_t newline, eol = -1; size_t lines_read = 0, l; int eof = 0; int slashr; processx__connection_find_lines(ccon, cn, &lines_read, &eof); result = PROTECT(allocVector(STRSXP, lines_read + eof)); for (l = 0, newline = -1; l < lines_read; l++) { eol = processx__find_newline(ccon, newline + 1); slashr = eol > 0 && ccon->utf8[eol - 1] == '\r'; SET_STRING_ELT( result, l, mkCharLenCE(ccon->utf8 + newline + 1, (int) (eol - newline - 1 - slashr), CE_UTF8)); newline = eol; } if (eof) { eol = ccon->utf8_data_size - 1; SET_STRING_ELT( result, l, mkCharLenCE(ccon->utf8 + newline + 1, (int) (eol - newline), CE_UTF8)); } if (eol >= 0) { ccon->utf8_data_size -= eol + 1; memmove(ccon->utf8, ccon->utf8 + eol + 1, ccon->utf8_data_size); } UNPROTECT(1); return result; } SEXP processx_connection_write_bytes(SEXP con, SEXP bytes) { processx_connection_t *ccon = R_ExternalPtrAddr(con); Rbyte *cbytes = RAW(bytes); size_t nbytes = LENGTH(bytes); SEXP result; ssize_t written = processx_c_connection_write_bytes(ccon, cbytes, nbytes); size_t left = nbytes - written; PROTECT(result = allocVector(RAWSXP, left)); if (left > 0) memcpy(RAW(result), cbytes + written, left); UNPROTECT(1); return result; } SEXP processx_connection_is_eof(SEXP con) { processx_connection_t *ccon = R_ExternalPtrAddr(con); if (!ccon) R_THROW_ERROR("Invalid connection object"); return ScalarLogical(ccon->is_eof_); } SEXP processx_connection_close(SEXP con) { processx_connection_t *ccon = R_ExternalPtrAddr(con); if (!ccon) R_THROW_ERROR("Invalid connection object"); processx_c_connection_close(ccon); return R_NilValue; } SEXP processx_connection_is_closed(SEXP con) { processx_connection_t *ccon = R_ExternalPtrAddr(con); if (!ccon) R_THROW_ERROR("Invalid connection object"); return ScalarLogical(processx_c_connection_is_closed(ccon)); } /* Poll connections and other pollable handles */ SEXP processx_connection_poll(SEXP pollables, SEXP timeout) { /* TODO: this is not used currently */ R_THROW_ERROR("Not implemented"); return R_NilValue; } SEXP processx_connection_create_pipepair(SEXP encoding, SEXP nonblocking) { const char *c_encoding = CHAR(STRING_ELT(encoding, 0)); int *c_nonblocking = LOGICAL(nonblocking); SEXP result, con1, con2; #ifdef _WIN32 HANDLE h1, h2; processx__create_pipe(0, &h1, &h2, "???"); #else int pipe[2], h1, h2; processx__make_socketpair(pipe, NULL); processx__nonblock_fcntl(pipe[0], c_nonblocking[0]); processx__nonblock_fcntl(pipe[1], c_nonblocking[1]); h1 = pipe[0]; h2 = pipe[1]; #endif processx_c_connection_create(h1, c_nonblocking[0] ? PROCESSX_FILE_TYPE_ASYNCPIPE : PROCESSX_FILE_TYPE_PIPE, c_encoding, &con1); PROTECT(con1); processx_c_connection_create(h2, c_nonblocking[1] ? PROCESSX_FILE_TYPE_ASYNCPIPE : PROCESSX_FILE_TYPE_PIPE, c_encoding, &con2); PROTECT(con2); result = PROTECT(allocVector(VECSXP, 2)); SET_VECTOR_ELT(result, 0, con1); SET_VECTOR_ELT(result, 1, con2); UNPROTECT(3); return result; } SEXP processx__connection_set_std(SEXP con, int which, int drop) { processx_connection_t *ccon = R_ExternalPtrAddr(con); if (!ccon) R_THROW_ERROR("Invalid connection object"); SEXP result = R_NilValue; #ifdef _WIN32 int fd, ret; if (!drop) { int saved = _dup(which); processx_file_handle_t os_handle; if (saved == -1) { R_THROW_POSIX_ERROR("Cannot save stdout/stderr for rerouting"); } os_handle = (HANDLE) _get_osfhandle(saved) ; processx_c_connection_create(os_handle, PROCESSX_FILE_TYPE_PIPE, "", &result); } fd = _open_osfhandle((intptr_t) ccon->handle.handle, 0); ret = _dup2(fd, which); if (ret) R_THROW_POSIX_ERROR("Cannot reroute stdout/stderr"); #else const char *what[] = { "stdin", "stdout", "stderr" }; int ret; if (!drop) { processx_file_handle_t os_handle = dup(which); if (os_handle == -1) { R_THROW_SYSTEM_ERROR("Cannot save %s for rerouting", what[which]); } processx_c_connection_create(os_handle, PROCESSX_FILE_TYPE_PIPE, "", &result); } ret = dup2(ccon->handle, which); if (ret == -1) { R_THROW_SYSTEM_ERROR("Cannot reroute %s", what[which]); } #endif return result; } SEXP processx_connection_set_stdout(SEXP con, SEXP drop) { return processx__connection_set_std(con, 1, LOGICAL(drop)[0]); } SEXP processx_connection_set_stderr(SEXP con, SEXP drop) { return processx__connection_set_std(con, 2, LOGICAL(drop)[0]); } SEXP processx_connection_get_fileno(SEXP con) { processx_connection_t *ccon = R_ExternalPtrAddr(con); if (!ccon) R_THROW_ERROR("Invalid connection object"); int fd; #ifdef _WIN32 fd = _open_osfhandle((intptr_t) ccon->handle.handle, 0); #else fd = ccon->handle; #endif return ScalarInteger(fd); } #ifdef _WIN32 /* * Clear the HANDLE_FLAG_INHERIT flag from all HANDLEs that were inherited * the parent process. Don't check for errors - the stdio handles may not be * valid, or may be closed already. There is no guarantee that this function * does a perfect job. */ SEXP processx_connection_disable_inheritance() { HANDLE handle; STARTUPINFOW si; /* Make the windows stdio handles non-inheritable. */ handle = GetStdHandle(STD_INPUT_HANDLE); if (handle != NULL && handle != INVALID_HANDLE_VALUE) { SetHandleInformation(handle, HANDLE_FLAG_INHERIT, 0); } handle = GetStdHandle(STD_OUTPUT_HANDLE); if (handle != NULL && handle != INVALID_HANDLE_VALUE) { SetHandleInformation(handle, HANDLE_FLAG_INHERIT, 0); } handle = GetStdHandle(STD_ERROR_HANDLE); if (handle != NULL && handle != INVALID_HANDLE_VALUE) { SetHandleInformation(handle, HANDLE_FLAG_INHERIT, 0); } /* Make inherited CRT FDs non-inheritable. */ GetStartupInfoW(&si); if (processx__stdio_verify(si.lpReserved2, si.cbReserved2)) { processx__stdio_noinherit(si.lpReserved2); } return R_NilValue; } #else SEXP processx_connection_disable_inheritance() { int fd; /* Set the CLOEXEC flag on all open descriptors. Unconditionally try the * first 16 file descriptors. After that, bail out after the first error. */ for (fd = 0; ; fd++) { if (processx__cloexec_fcntl(fd, 1) && fd > 15) break; } return R_NilValue; } #endif /* Api from C -----------------------------------------------------------*/ processx_connection_t *processx_c_connection_create( processx_file_handle_t os_handle, processx_file_type_t type, const char *encoding, SEXP *r_connection) { processx_connection_t *con; SEXP result, class; con = malloc(sizeof(processx_connection_t)); if (!con) R_THROW_ERROR("cannot create connection, out of memory"); con->type = type; con->is_closed_ = 0; con->is_eof_ = 0; con->is_eof_raw_ = 0; con->close_on_destroy = 1; con->iconv_ctx = 0; con->buffer = 0; con->buffer_allocated_size = 0; con->buffer_data_size = 0; con->utf8 = 0; con->utf8_allocated_size = 0; con->utf8_data_size = 0; con->encoding = 0; if (encoding && encoding[0]) { con->encoding = strdup(encoding); if (!con->encoding) { free(con); R_THROW_ERROR("cannot create connection, out of memory"); return 0; /* never reached */ } } #ifdef _WIN32 con->handle.handle = os_handle; memset(&con->handle.overlapped, 0, sizeof(OVERLAPPED)); con->handle.read_pending = FALSE; con->handle.freelist = FALSE; #else con->handle = os_handle; #endif if (r_connection) { result = PROTECT(R_MakeExternalPtr(con, R_NilValue, R_NilValue)); R_RegisterCFinalizerEx(result, processx__connection_xfinalizer, 0); class = PROTECT(ScalarString(mkChar("processx_connection"))); setAttrib(result, R_ClassSymbol, class); *r_connection = result; UNPROTECT(2); } return con; } /* Destroy */ void processx_c_connection_destroy(processx_connection_t *ccon) { if (!ccon) return; if (ccon->close_on_destroy) processx_c_connection_close(ccon); /* Even if not close_on_destroy, for us the connection is closed. */ ccon->is_closed_ = 1; #ifdef _WIN32 /* Check if we can free the connection. If there is a pending read, then we cannot. In this case schedule_destroy will add it to a free list and return 1. */ if (processx__connection_schedule_destroy(ccon)) return; #endif if (ccon->iconv_ctx) { Riconv_close(ccon->iconv_ctx); ccon->iconv_ctx = NULL; } if (ccon->buffer) { free(ccon->buffer); ccon->buffer = NULL; } if (ccon->utf8) { free(ccon->utf8); ccon->utf8 = NULL; } if (ccon->encoding) { free(ccon->encoding); ccon->encoding = NULL; } #ifdef _WIN32 if (ccon->handle.overlapped.hEvent) { CloseHandle(ccon->handle.overlapped.hEvent); } ccon->handle.overlapped.hEvent = 0; #endif free(ccon); } /* Read characters */ ssize_t processx_c_connection_read_chars(processx_connection_t *ccon, void *buffer, size_t nbyte) { size_t utf8_chars, utf8_bytes; if (nbyte < 4) { R_THROW_ERROR("Buffer size must be at least 4 bytes, to allow multibyte " "characters"); } processx__connection_find_chars(ccon, -1, nbyte, &utf8_chars, &utf8_bytes); memcpy(buffer, ccon->utf8, utf8_bytes); ccon->utf8_data_size -= utf8_bytes; memmove(ccon->utf8, ccon->utf8 + utf8_bytes, ccon->utf8_data_size); return utf8_bytes; } /** * Read a single line, ending with \n * * The trailing \n character is not copied to the buffer. * * @param ccon Connection. * @param linep Must point to a buffer pointer. If must not be NULL. If * the buffer pointer is NULL, it will be allocated. If it is not NULL, * it might be reallocated using `realloc`, as needed. * @param linecapp Initial size of the buffer. It will be updated if the * buffer is newly allocated or reallocated. * @return Number of characters read, not including the \n character. * It returns -1 on EOF. If the connection is not at EOF yet, but there * is nothing to read currently, it returns 0. If 0 is returned, `linep` * and `linecapp` are not touched. * */ ssize_t processx_c_connection_read_line(processx_connection_t *ccon, char **linep, size_t *linecapp) { int eof = 0; ssize_t newline; if (!linep) { R_THROW_ERROR("cannot read line, linep cannot be a null pointer"); } if (!linecapp) { R_THROW_ERROR("cannot read line, linecapp cannot be a null pointer"); } if (ccon->is_eof_) return -1; /* Read until a newline character shows up, or there is nothing more to read (at least for now). */ newline = processx__connection_read_until_newline(ccon); /* If there is no newline at the end of the file, we still add the last line. */ if (ccon->is_eof_raw_ && ccon->utf8_data_size != 0 && ccon->buffer_data_size == 0 && ccon->utf8[ccon->utf8_data_size - 1] != '\n') { eof = 1; } /* We cannot serve a line currently. Maybe later. */ if (newline == -1 && ! eof) return 0; /* Newline will contain the end of the line now, even if EOF */ if (newline == -1) newline = ccon->utf8_data_size; if (ccon->utf8[newline - 1] == '\r') newline--; if (! *linep) { *linep = malloc(newline + 1); *linecapp = newline + 1; } else if (*linecapp < newline + 1) { char *tmp = realloc(*linep, newline + 1); if (!tmp) R_THROW_ERROR("cannot read line, out of memory"); *linep = tmp; *linecapp = newline + 1; } memcpy(*linep, ccon->utf8, newline); (*linep)[newline] = '\0'; if (!eof) { ccon->utf8_data_size -= (newline + 1); memmove(ccon->utf8, ccon->utf8 + newline + 1, ccon->utf8_data_size); } else { ccon->utf8_data_size = 0; } return newline; } /* Write bytes */ ssize_t processx_c_connection_write_bytes( processx_connection_t *ccon, const void *buffer, size_t nbytes) { PROCESSX_CHECK_VALID_CONN(ccon); #ifdef _WIN32 DWORD written; BOOL ret = WriteFile( /* hFile = */ ccon->handle.handle, /* lpBuffer = */ buffer, /* nNumberOfBytesToWrite = */ nbytes, /* lpNumberOfBytesWritten = */ &written, /* lpOverlapped = */ NULL); if (!ret) R_THROW_SYSTEM_ERROR("Cannot write connection"); return (ssize_t) written; #else /* Need to ignore SIGPIPE here, otherwise R might crash */ struct sigaction old_handler, new_handler; memset(&new_handler, 0, sizeof(new_handler)); sigemptyset(&new_handler.sa_mask); new_handler.sa_handler = SIG_IGN; sigaction(SIGPIPE, &new_handler, &old_handler ); ssize_t ret = write(ccon->handle, buffer, nbytes); sigaction(SIGPIPE, &old_handler, NULL ); if (ret == -1) { if (errno == EAGAIN || errno == EWOULDBLOCK) { return 0; } else { R_THROW_SYSTEM_ERROR("Cannot write connection"); } } return ret; #endif } /* Check if the connection has ended */ int processx_c_connection_is_eof(processx_connection_t *ccon) { return ccon->is_eof_; } /* Close */ void processx_c_connection_close(processx_connection_t *ccon) { #ifdef _WIN32 if (ccon->handle.handle) { CloseHandle(ccon->handle.handle); } ccon->handle.handle = 0; #else if (ccon->handle >= 0) close(ccon->handle); ccon->handle = -1; #endif ccon->is_closed_ = 1; } int processx_c_connection_is_closed(processx_connection_t *ccon) { return ccon->is_closed_; } #ifdef _WIN32 /* TODO: errors */ int processx__socket_pair(SOCKET fds[2]) { struct sockaddr_in inaddr; struct sockaddr addr; SOCKET lst = socket(AF_INET, SOCK_STREAM, IPPROTO_TCP); memset(&inaddr, 0, sizeof(inaddr)); memset(&addr, 0, sizeof(addr)); inaddr.sin_family = AF_INET; inaddr.sin_addr.s_addr = htonl(INADDR_LOOPBACK); inaddr.sin_port = 0; int yes = 1; setsockopt(lst, SOL_SOCKET, SO_REUSEADDR, (char*)&yes, sizeof(yes)); bind(lst, (struct sockaddr *)&inaddr, sizeof(inaddr)); listen(lst, 1); int len = sizeof(inaddr); getsockname(lst, &addr,&len); fds[0] = socket(AF_INET, SOCK_STREAM, 0); connect(fds[0], &addr, len); fds[1] = accept(lst,0,0); closesocket(lst); return 0; } int processx_c_connection_poll(processx_pollable_t pollables[], size_t npollables, int timeout) { int hasdata = 0; size_t i, j = 0, selj = 0; int *ptr; int timeleft = timeout; DWORD bytes; OVERLAPPED *overlapped = 0; ULONG_PTR key; int *events; FD_ZERO(&processx__readfds); FD_ZERO(&processx__writefds); FD_ZERO(&processx__exceptionfds); events = (int*) R_alloc(npollables, sizeof(int)); /* First iteration, we call the pre-poll method, and collect the handles for the IOCP, and the fds for select(). */ for (i = 0; i < npollables; i++) { processx_pollable_t *el = pollables + i; events[i] = PXSILENT; if (el->pre_poll_func) events[i] = el->pre_poll_func(el); switch (events[i]) { case PXHANDLE: j++; break; default: break; } } /* j contains the number of IOCP handles to poll */ ptr = (int*) R_alloc(j, sizeof(int)); for (i = 0, j = 0; i < npollables; i++) { processx_pollable_t *el = pollables + i; switch (events[i]) { case PXNOPIPE: case PXCLOSED: case PXSILENT: el->event = events[i]; break; case PXREADY: hasdata++; el->event = events[i]; break; case PXHANDLE: el->event = PXSILENT; ptr[j] = i; j++; break; case PXSELECT: { SEXP elem; el->event = PXSILENT; int k, n; elem = VECTOR_ELT(el->fds, 0); n = LENGTH(elem); selj += n; for (k = 0; k < n; k++) FD_SET(INTEGER(elem)[k], &processx__readfds); elem = VECTOR_ELT(el->fds, 1); n = LENGTH(elem); selj += n; for (k = 0; k < n; k++) FD_SET(INTEGER(elem)[k], &processx__writefds); elem = VECTOR_ELT(el->fds, 2); n = LENGTH(elem); selj += n; for (k = 0; k < n; k++) FD_SET(INTEGER(elem)[k], &processx__exceptionfds); } } } if (j == 0 && selj == 0) return hasdata; if (hasdata) timeout = timeleft = 0; if (selj != 0) { processx__socket_pair(processx__notify_socket); FD_SET(processx__notify_socket[0], &processx__readfds); processx__select = 1; } else { processx__select = 0; } while (timeout < 0 || timeleft >= 0) { int poll_timeout; if (timeout < 0 || timeleft > PROCESSX_INTERRUPT_INTERVAL) { poll_timeout = PROCESSX_INTERRUPT_INTERVAL; } else { poll_timeout = timeleft; } BOOL sres; if (selj == 0) { sres = processx__thread_getstatus(&bytes, &key, &overlapped, poll_timeout); } else { sres = processx__thread_getstatus_select(&bytes, &key, &overlapped, poll_timeout); } DWORD err = sres ? ERROR_SUCCESS : processx__thread_get_last_error(); /* See if there was any data from the curl sockets */ if (processx__select) { for (i = 0; i < npollables; i++) { if (events[i] == PXSELECT) { processx_pollable_t *el = pollables + i; SEXP elem; int k, n; int has = 0; elem = VECTOR_ELT(el->fds, 0); n = LENGTH(elem); for (k = 0; k < n; k++) { if (FD_ISSET(INTEGER(elem)[k], &processx__readfds)) has = 1; FD_SET(INTEGER(elem)[k], &processx__readfds); } elem = VECTOR_ELT(el->fds, 1); n = LENGTH(elem); for (k = 0; k < n; k++) { if (FD_ISSET(INTEGER(elem)[k], &processx__writefds)) has = 1; FD_SET(INTEGER(elem)[k], &processx__writefds); } elem = VECTOR_ELT(el->fds, 2); n = LENGTH(elem); for (k = 0; k < n; k++) { if (FD_ISSET(INTEGER(elem)[k], &processx__exceptionfds)) has = 1; FD_SET(INTEGER(elem)[k], &processx__exceptionfds); } if (has) { el->event = PXEVENT; hasdata++; } } } } /* See if there was any data from the IOCP */ if (overlapped) { /* data */ processx_connection_t *con = (processx_connection_t*) key; int poll_idx = con->poll_idx; con->handle.read_pending = FALSE; con->buffer_data_size += bytes; if (con->buffer_data_size > 0) processx__connection_to_utf8(con); if (con->type == PROCESSX_FILE_TYPE_ASYNCFILE) { /* TODO: larger files */ con->handle.overlapped.Offset += bytes; } if (!bytes) { con->is_eof_raw_ = 1; if (con->utf8_data_size == 0 && con->buffer_data_size == 0) { con->is_eof_ = 1; } } if (con->handle.freelist) processx__connection_freelist_remove(con); if (poll_idx < npollables && pollables[poll_idx].object == con) { pollables[poll_idx].event = PXREADY; hasdata++; } } else if (err != WAIT_TIMEOUT && err != ERROR_SUCCESS) { R_THROW_SYSTEM_ERROR_CODE(err, "Cannot poll"); } if (hasdata) break; R_CheckUserInterrupt(); timeleft -= PROCESSX_INTERRUPT_INTERVAL; } if (hasdata == 0) { for (i = 0; i < j; i++) pollables[ptr[i]].event = PXTIMEOUT; } closesocket(processx__notify_socket[0]); closesocket(processx__notify_socket[1]); return hasdata; } #else static int processx__poll_decode(short code) { if (code & POLLNVAL) return PXCLOSED; if (code & POLLIN || code & POLLHUP || code & POLLOUT) return PXREADY; return PXSILENT; } /* Poll connections and other pollable handles */ int processx_c_connection_poll(processx_pollable_t pollables[], size_t npollables, int timeout) { int hasdata = 0; size_t i, j = 0; struct pollfd *fds; int *ptr; int ret; int *events; if (npollables == 0) return 0; /* Need to allocate this, because we need to put in the fds, maybe */ events = (int*) R_alloc(npollables, sizeof(int)); /* First iteration, we call the pre-poll method, and collect the fds to poll. */ for (i = 0; i < npollables; i++) { processx_pollable_t *el = pollables + i; events[i] = PXSILENT; if (el->pre_poll_func) events[i] = el->pre_poll_func(el); switch (events[i]) { case PXHANDLE: j++; break; case PXSELECT: { /* This is three vectors of fds to poll, in an R list */ int w; for (w = 0; w < 3; w++) { j += LENGTH(VECTOR_ELT(el->fds, w)); } } default: break; } } /* j contains the number of fds to poll now */ fds = (struct pollfd*) R_alloc(j, sizeof(struct pollfd)); ptr = (int*) R_alloc(j, sizeof(int)); /* Need to go over them again, collect the ones that we need to poll */ for (i = 0, j = 0; i < npollables; i++) { processx_pollable_t *el = pollables + i; switch (events[i]) { case PXNOPIPE: case PXCLOSED: case PXSILENT: el->event = events[i]; break; case PXREADY: hasdata++; el->event = events[i]; break; case PXHANDLE: el->event = PXSILENT; fds[j].fd = el->handle; fds[j].events = POLLIN; fds[j].revents = 0; ptr[j] = (int) i; j++; break; case PXSELECT: { int pollevs[3] = { POLLIN, POLLOUT, POLLIN | POLLOUT }; int w; el->event = PXSILENT; for (w = 0; w < 3; w++) { SEXP elem = VECTOR_ELT(el->fds, w); int k, n = LENGTH(elem); for (k = 0; k < n; k++) { fds[j].fd = INTEGER(elem)[k]; fds[j].events = pollevs[w]; fds[j].revents = 0; ptr[j] = (int) i; j++; } } break; } } } /* Nothing to poll */ if (j == 0) return hasdata; /* If we already have some data, then we don't wait any more, just check if other connections are ready */ ret = processx__interruptible_poll(fds, (nfds_t) j, hasdata > 0 ? 0 : timeout); if (ret == -1) { R_THROW_SYSTEM_ERROR("Processx poll error"); } else if (ret == 0) { if (hasdata == 0) { for (i = 0; i < j; i++) pollables[ptr[i]].event = PXTIMEOUT; } } else { for (i = 0; i < j; i++) { if (events[ptr[i]] == PXSELECT) { if (pollables[ptr[i]].event == PXSILENT) { int ev = fds[i].revents; if (ev & (POLLNVAL | POLLIN | POLLHUP | POLLOUT)) { pollables[ptr[i]].event = PXEVENT; } } } else { pollables[ptr[i]].event = processx__poll_decode(fds[i].revents); hasdata += (pollables[ptr[i]].event == PXREADY); } } } return hasdata; } #endif #ifdef _WIN32 void processx__connection_start_read(processx_connection_t *ccon) { DWORD bytes_read; BOOLEAN res; size_t todo; if (! ccon->handle.handle) return; if (ccon->handle.read_pending) return; if (!ccon->buffer) processx__connection_alloc(ccon); todo = ccon->buffer_allocated_size - ccon->buffer_data_size; res = processx__thread_readfile( ccon, ccon->buffer + ccon->buffer_data_size, todo, &bytes_read); if (!res) { DWORD err = processx__thread_get_last_error(); if (err == ERROR_BROKEN_PIPE || err == ERROR_HANDLE_EOF) { ccon->is_eof_raw_ = 1; if (ccon->utf8_data_size == 0 && ccon->buffer_data_size == 0) { ccon->is_eof_ = 1; } if (ccon->buffer_data_size) processx__connection_to_utf8(ccon); } else if (err == ERROR_IO_PENDING) { ccon->handle.read_pending = TRUE; } else { ccon->handle.read_pending = FALSE; R_THROW_SYSTEM_ERROR_CODE(err, "reading from connection"); } } else { /* Returned synchronously, but the event will be still signalled, so we just drop the sync data for now. */ ccon->handle.read_pending = TRUE; } } #endif /* Poll a connection * * Checks if there is anything in the buffer. If yes, it returns * PXREADY. Otherwise it returns the handle. * * We can read immediately (without an actual device read), potentially: * 1. if the connection is already closed, we return PXCLOSED * 2. if the connection is already EOF, we return PXREADY * 3. if there is data in the UTF8 buffer, we return PXREADY * 4. if there is data in the raw buffer, and the raw file was EOF, we * return PXREADY, because we can surely return something, even if the * raw buffer has incomplete UTF8 characters. * 5. otherwise, if there is something in the raw buffer, we try * to convert it to UTF8. */ #define PROCESSX__I_PRE_POLL_FUNC_CONNECTION_READY do { \ if (!ccon) return PXNOPIPE; \ if (ccon->is_closed_) return PXCLOSED; \ if (ccon->is_eof_) return PXREADY; \ if (ccon->utf8_data_size > 0) return PXREADY; \ if (ccon->buffer_data_size > 0 && ccon->is_eof_raw_) return PXREADY; \ if (ccon->buffer_data_size > 0) { \ processx__connection_to_utf8(ccon); \ if (ccon->utf8_data_size > 0) return PXREADY; \ } } while (0) int processx_i_pre_poll_func_connection(processx_pollable_t *pollable) { processx_connection_t *ccon = pollable->object; PROCESSX__I_PRE_POLL_FUNC_CONNECTION_READY; #ifdef _WIN32 processx__connection_start_read(ccon); /* Starting to read may actually get some data, or an EOF, so check again */ PROCESSX__I_PRE_POLL_FUNC_CONNECTION_READY; pollable->handle = ccon->handle.overlapped.hEvent; #else pollable->handle = ccon->handle; #endif return PXHANDLE; } int processx_c_pollable_from_connection( processx_pollable_t *pollable, processx_connection_t *ccon) { pollable->pre_poll_func = processx_i_pre_poll_func_connection; pollable->object = ccon; pollable->free = 0; pollable->fds = R_NilValue; return 0; } int processx_i_pre_poll_func_curl(processx_pollable_t *pollable) { return PXSELECT; } int processx_c_pollable_from_curl( processx_pollable_t *pollable, SEXP fds) { pollable->pre_poll_func = processx_i_pre_poll_func_curl; pollable->object = NULL; pollable->free = 0; pollable->fds = fds; return 0; } processx_file_handle_t processx_c_connection_fileno( const processx_connection_t *con) { #ifdef _WIN32 return con->handle.handle; #else return con->handle; #endif } /* --------------------------------------------------------------------- */ /* Internals */ /* --------------------------------------------------------------------- */ /** * Work out how many UTF-8 characters we can read * * It might try to read more data, but it does not modify the buffer * otherwise. * * @param ccon Connection. * @param maxchars Maximum number of characters to find. * @param maxbytes Maximum number of bytes to check while searching. * @param chars Number of characters found is stored here. * @param bytes Number of bytes the `chars` characters span. * */ static void processx__connection_find_chars(processx_connection_t *ccon, ssize_t maxchars, ssize_t maxbytes, size_t *chars, size_t *bytes) { int should_read_more; PROCESSX_CHECK_VALID_CONN(ccon); should_read_more = ! ccon->is_eof_ && ccon->utf8_data_size == 0; if (should_read_more) processx__connection_read(ccon); if (ccon->utf8_data_size == 0 || maxchars == 0) { *bytes = 0; return; } /* At at most cnchars characters from the UTF8 buffer */ processx__connection_find_utf8_chars(ccon, maxchars, maxbytes, chars, bytes); } /** * Find one or more lines in the buffer * * Since the buffer is UTF-8 encoded, `\n` is assumed as end-of-line * character. * * @param ccon Connection. * @param maxlines Maximum number of lines to find. * @param lines Number of lines found is stored here. * @param eof If the end of the file is reached, and there is no `\n` * at the end of the file, this is set to 1. * */ static void processx__connection_find_lines(processx_connection_t *ccon, ssize_t maxlines, size_t *lines, int *eof ) { ssize_t newline; *eof = 0; if (maxlines < 0) maxlines = 1000; PROCESSX_CHECK_VALID_CONN(ccon); /* Read until a newline character shows up, or there is nothing more to read (at least for now). */ newline = processx__connection_read_until_newline(ccon); /* Count the number of lines we got. */ while (newline != -1 && *lines < maxlines) { (*lines) ++; newline = processx__find_newline(ccon, /* start = */ newline + 1); } /* If there is no newline at the end of the file, we still add the last line. */ if (ccon->is_eof_raw_ && ccon->utf8_data_size != 0 && ccon->buffer_data_size == 0 && ccon->utf8[ccon->utf8_data_size - 1] != '\n') { *eof = 1; } } static void processx__connection_xfinalizer(SEXP con) { processx_connection_t *ccon = R_ExternalPtrAddr(con); processx_c_connection_destroy(ccon); } static ssize_t processx__find_newline(processx_connection_t *ccon, size_t start) { if (ccon->utf8_data_size == 0) return -1; const char *ret = ccon->utf8 + start; const char *end = ccon->utf8 + ccon->utf8_data_size; while (ret < end && *ret != '\n') ret++; if (ret < end) return ret - ccon->utf8; else return -1; } static ssize_t processx__connection_read_until_newline (processx_connection_t *ccon) { char *ptr, *end; /* Make sure we try to have something, unless EOF */ if (ccon->utf8_data_size == 0) processx__connection_read(ccon); if (ccon->utf8_data_size == 0) return -1; /* We have sg in the utf8 at this point */ ptr = ccon->utf8; end = ccon->utf8 + ccon->utf8_data_size; while (1) { ssize_t new_bytes; while (ptr < end && *ptr != '\n') ptr++; /* Have we found a newline? */ if (ptr < end) return ptr - ccon->utf8; /* No newline, but EOF? */ if (ccon->is_eof_) return -1; /* Maybe we can read more, but might need a bigger utf8. * The 8 bytes is definitely more than what we need for a UTF8 * character, and this makes sure that we don't stop just because * no more UTF8 characters fit in the UTF8 buffer. */ if (ccon->utf8_data_size >= ccon->utf8_allocated_size - 8) { size_t ptrnum = ptr - ccon->utf8; size_t endnum = end - ccon->utf8; processx__connection_realloc(ccon); ptr = ccon->utf8 + ptrnum; end = ccon->utf8 + endnum; } new_bytes = processx__connection_read(ccon); /* If we cannot read now, then we give up */ if (new_bytes == 0) return -1; } } /* Allocate buffer for reading */ static void processx__connection_alloc(processx_connection_t *ccon) { ccon->buffer = malloc(64 * 1024); if (!ccon->buffer) R_THROW_ERROR("Cannot allocate memory for processx buffer"); ccon->buffer_allocated_size = 64 * 1024; ccon->buffer_data_size = 0; ccon->utf8 = malloc(64 * 1024); if (!ccon->utf8) { free(ccon->buffer); R_THROW_ERROR("Cannot allocate memory for processx buffer"); } ccon->utf8_allocated_size = 64 * 1024; ccon->utf8_data_size = 0; } /* We only really need to re-alloc the UTF8 buffer, because the other buffer is transient, even if there are no newline characters. */ static void processx__connection_realloc(processx_connection_t *ccon) { size_t new_size = (size_t) (ccon->utf8_allocated_size * 1.2); void *nb; if (new_size == ccon->utf8_allocated_size) new_size = 2 * new_size; nb = realloc(ccon->utf8, new_size); if (!nb) R_THROW_ERROR("Cannot allocate memory for processx line"); ccon->utf8 = nb; ccon->utf8_allocated_size = new_size; } /* Read as much as we can. This is the only function that explicitly works with the raw buffer. It is also the only function that actually reads from the data source. When this is called, the UTF8 buffer is probably empty, but the raw buffer might not be. */ #ifdef _WIN32 ssize_t processx__connection_read(processx_connection_t *ccon) { DWORD todo, bytes_read = 0; /* Nothing to read, nothing to convert to UTF8 */ if (ccon->is_eof_raw_ && ccon->buffer_data_size == 0) { if (ccon->utf8_data_size == 0) ccon->is_eof_ = 1; return 0; } if (!ccon->buffer) processx__connection_alloc(ccon); /* If cannot read anything more, then try to convert to UTF8 */ todo = ccon->buffer_allocated_size - ccon->buffer_data_size; if (todo == 0) return processx__connection_to_utf8(ccon); /* Otherwise we read. If there is no read pending, we start one. */ processx__connection_start_read(ccon); /* A read might be pending at this point. See if it has finished. */ if (ccon->handle.read_pending) { ULONG_PTR key; DWORD bytes; OVERLAPPED *overlapped = 0; while (1) { BOOL sres = processx__thread_getstatus(&bytes, &key, &overlapped, 0); DWORD err = sres ? ERROR_SUCCESS : processx__thread_get_last_error(); if (overlapped) { processx_connection_t *con = (processx_connection_t *) key; con->handle.read_pending = FALSE; con->buffer_data_size += bytes; if (con->buffer && con->buffer_data_size > 0) { bytes = processx__connection_to_utf8(con); } if (con->type == PROCESSX_FILE_TYPE_ASYNCFILE) { /* TODO: large files */ con->handle.overlapped.Offset += bytes; } if (!bytes) { con->is_eof_raw_ = 1; if (con->utf8_data_size == 0 && con->buffer_data_size == 0) { con->is_eof_ = 1; } } if (con->handle.freelist) processx__connection_freelist_remove(con); if (con == ccon) { bytes_read = bytes; break; } } else if (err != WAIT_TIMEOUT) { R_THROW_SYSTEM_ERROR_CODE(err, "Read error"); } else { break; } } } return bytes_read; } #else static ssize_t processx__connection_read(processx_connection_t *ccon) { ssize_t todo, bytes_read; /* Nothing to read, nothing to convert to UTF8 */ if (ccon->is_eof_raw_ && ccon->buffer_data_size == 0) { if (ccon->utf8_data_size == 0) ccon->is_eof_ = 1; return 0; } if (!ccon->buffer) processx__connection_alloc(ccon); /* If cannot read anything more, then try to convert to UTF8 */ todo = ccon->buffer_allocated_size - ccon->buffer_data_size; if (todo == 0) return processx__connection_to_utf8(ccon); /* Otherwise we read */ bytes_read = read(ccon->handle, ccon->buffer + ccon->buffer_data_size, todo); if (bytes_read == 0) { /* EOF */ ccon->is_eof_raw_ = 1; if (ccon->utf8_data_size == 0 && ccon->buffer_data_size == 0) { ccon->is_eof_ = 1; } } else if (bytes_read == -1 && errno == EAGAIN) { /* There is still data to read, potentially */ bytes_read = 0; } else if (bytes_read == -1) { /* Proper error */ R_THROW_SYSTEM_ERROR("Cannot read from processx connection"); } ccon->buffer_data_size += bytes_read; /* If there is anything to convert to UTF8, try converting */ if (ccon->buffer_data_size > 0) { bytes_read = processx__connection_to_utf8(ccon); } else { bytes_read = 0; } return bytes_read; } #endif static ssize_t processx__connection_to_utf8(processx_connection_t *ccon) { const char *inbuf, *inbufold; char *outbuf, *outbufold; size_t inbytesleft = ccon->buffer_data_size; size_t outbytesleft = ccon->utf8_allocated_size - ccon->utf8_data_size; size_t r, indone = 0, outdone = 0; int moved = 0; const char *emptystr = ""; const char *encoding = ccon->encoding ? ccon->encoding : emptystr; inbuf = inbufold = ccon->buffer; outbuf = outbufold = ccon->utf8 + ccon->utf8_data_size; /* If we this is the first time we are here. */ if (! ccon->iconv_ctx) ccon->iconv_ctx = Riconv_open("UTF-8", encoding); /* If nothing to do, or no space to do more, just return */ if (inbytesleft == 0 || outbytesleft == 0) return 0; while (!moved) { r = Riconv(ccon->iconv_ctx, &inbuf, &inbytesleft, &outbuf, &outbytesleft); moved = 1; if (r == (size_t) -1) { /* Error */ if (errno == E2BIG) { /* Output buffer is full, that's fine, we'll try later. Just use what we have done so far. */ } else if (errno == EILSEQ) { /* Invalid characters in encoding, *inbuf points to the beginning of the invalid sequence. We can just try to remove this, and convert again? */ inbuf++; inbytesleft--; if (inbytesleft > 0) moved = 0; } else if (errno == EINVAL) { /* Does not end with a complete multi-byte character */ /* This is fine, we'll handle it later, unless we are at the end */ if (ccon->is_eof_raw_) { warning("Invalid multi-byte character at end of stream ignored"); inbuf += inbytesleft; inbytesleft = 0; } } } } /* We converted 'r' bytes, update the buffer structure accordingly */ indone = inbuf - inbufold; outdone = outbuf - outbufold; if (outdone > 0 || indone > 0) { ccon->buffer_data_size -= indone; memmove(ccon->buffer, ccon->buffer + indone, ccon->buffer_data_size); ccon->utf8_data_size += outdone; } return outdone; } /* Try to get at max 'max' UTF8 characters from the buffer. Return the * number of characters found, and also the corresponding number of * bytes. */ /* Number of additional bytes */ static const unsigned char processx__utf8_length[] = { 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, 3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3, 4,4,4,4,4,4,4,4,5,5,5,5,6,6,6,6 }; static void processx__connection_find_utf8_chars(processx_connection_t *ccon, ssize_t maxchars, ssize_t maxbytes, size_t *chars, size_t *bytes) { char *ptr = ccon->utf8; char *end = ccon->utf8 + ccon->utf8_data_size; size_t length = ccon->utf8_data_size; *chars = *bytes = 0; while (maxchars != 0 && maxbytes != 0 && ptr < end) { int clen, c = (unsigned char) *ptr; /* ASCII byte */ if (c < 128) { (*chars) ++; (*bytes) ++; ptr++; length--; if (maxchars > 0) maxchars--; if (maxbytes > 0) maxbytes--; continue; } /* Catch some errors */ if (c < 0xc0) goto invalid; if (c >= 0xfe) goto invalid; clen = processx__utf8_length[c & 0x3f]; if (length < clen) goto invalid; if (maxbytes > 0 && clen > maxbytes) break; (*chars) ++; (*bytes) += clen; ptr += clen; length -= clen; if (maxchars > 0) maxchars--; if (maxbytes > 0) maxbytes -= clen; } return; invalid: R_THROW_ERROR("Invalid UTF-8 string, internal error"); } #ifndef _WIN32 int processx__interruptible_poll(struct pollfd fds[], nfds_t nfds, int timeout) { int ret = 0; int timeleft = timeout; while (timeout < 0 || timeleft > PROCESSX_INTERRUPT_INTERVAL) { do { ret = poll(fds, nfds, PROCESSX_INTERRUPT_INTERVAL); } while (ret == -1 && errno == EINTR); /* If not a timeout, then return */ if (ret != 0) return ret; R_CheckUserInterrupt(); timeleft -= PROCESSX_INTERRUPT_INTERVAL; } /* Maybe we are not done, and there is a little left from the timeout */ if (timeleft >= 0) { do { ret = poll(fds, nfds, timeleft); } while (ret == -1 && errno == EINTR); } return ret; } #endif #ifdef _WIN32 processx__connection_freelist_t freelist_head = { 0, 0 }; processx__connection_freelist_t *freelist = &freelist_head; int processx__connection_freelist_add(processx_connection_t *ccon) { if (ccon->handle.freelist) return 0; processx__connection_freelist_t *node = calloc(1, sizeof(processx__connection_freelist_t)); if (!node) R_THROW_ERROR("Cannot add to connection freelist, this is a leak"); node->ccon = ccon; node->next = freelist->next; freelist->next = node; ccon->handle.freelist = TRUE; return 0; } void processx__connection_freelist_remove(processx_connection_t *ccon) { processx__connection_freelist_t *prev = freelist, *ptr = freelist->next; while (ptr) { if (ptr->ccon == ccon) { prev->next = ptr->next; free(ptr); return; } prev = ptr; ptr = ptr->next; } } int processx__connection_schedule_destroy(processx_connection_t *ccon) { /* The connection is already closed here, but reads might still be pending... if this is the case, then we add the connection to the free list. */ if (ccon->handle.read_pending) { processx__connection_freelist_add(ccon); return 1; } else { return 0; } } #endif #ifdef _WIN32 SEXP processx_is_valid_fd(SEXP fd) { int cfd = INTEGER(fd)[0]; HANDLE hnd = (HANDLE) _get_osfhandle(cfd); int valid = hnd != INVALID_HANDLE_VALUE && hnd != NULL && hnd != (HANDLE) (-2); return ScalarLogical(valid); } #else SEXP processx_is_valid_fd(SEXP fd) { int cfd = INTEGER(fd)[0]; errno = 0; int valid = fcntl(cfd, F_GETFD) != -1 || errno != EBADF; return ScalarLogical(valid); } #endif #undef PROCESSX_CHECK_VALID_CONN processx/src/processx-vector.c0000644000176200001440000000566313616314454016242 0ustar liggesusers #ifndef _GNU_SOURCE #define _GNU_SOURCE 1 #endif #include #include "processx-types.h" #include "errors.h" void processx_vector_init(processx_vector_t *v, size_t size, size_t alloc_size) { if (alloc_size < size) alloc_size = size; if (alloc_size == 0) alloc_size = 1; v->stor_begin = (pid_t*) R_alloc(alloc_size, sizeof(pid_t)); if (v->stor_begin == 0) { R_THROW_ERROR("cannot allocate processx vector, out of memory"); } v->stor_end = v->stor_begin + alloc_size; v->end = v->stor_begin + size; } size_t processx_vector_size(const processx_vector_t *v) { return v->end - v->stor_begin; } void processx_vector_reserve(processx_vector_t *v, size_t size) { size_t actual_size = processx_vector_size(v); size_t alloc_size = v->stor_end - v->stor_begin; pid_t *tmp; if (size <= actual_size) return; tmp = (pid_t*) S_realloc( (char*) v->stor_begin, size, alloc_size, sizeof(pid_t)); v->stor_begin = tmp; v->stor_end = v->stor_begin + size; v->end = v->stor_begin + actual_size; } void processx_vector_clear(processx_vector_t *v) { v->end = v->stor_begin; } void processx_vector_push_back(processx_vector_t *v, pid_t e) { /* full, allocate more storage */ if (v->stor_end == v->end) { long int new_size = processx_vector_size(v) * 2; if (new_size == 0) { new_size = 1; } processx_vector_reserve(v, new_size); } *(v->end) = e; v->end += 1; } /** * Find an element in a vector * * @param v The vector. * @param e The element to find. * @param from Start the search from this position. * @param idx If not a NULL pointer, then it is set to the index of the first occurence of `e`, if found. Otherwise not touched. * @return Non-zero if `e` is found, zero otherwise. */ int processx_vector_find(const processx_vector_t *v, pid_t e, size_t from, size_t *idx) { size_t size = processx_vector_size(v); while (from < size) { if (VECTOR(*v)[from] == e) { if (idx) *idx = from; return 1; } from++; } return 0; } /** * Find a rooted tree within forest * * @param root The id of the root node. * @param nodes The ids of all nodes. * @param parents The ids of the parent nodes for each node. The length must * match `nodes`. * @param result The result is stored here. `root` is included here as well, as the first * (zeroth) element. */ void processx_vector_rooted_tree(pid_t root, const processx_vector_t *nodes, const processx_vector_t *parents, processx_vector_t *result) { size_t len = processx_vector_size(nodes); size_t done = 0, next_done = 1; processx_vector_clear(result); processx_vector_push_back(result, root); while (done < next_done) { size_t i; for (i = 0; i < len; i++) { pid_t parent = VECTOR(*parents)[i]; if (processx_vector_find(result, parent, done, 0)) { processx_vector_push_back(result, VECTOR(*nodes)[i]); } } done = next_done; next_done = processx_vector_size(result); } } processx/src/Makevars0000644000176200001440000000171214042765517014417 0ustar liggesusers# -*- makefile -*- OBJECTS = init.o poll.o errors.o processx-connection.o \ processx-vector.o create-time.o base64.o \ unix/childlist.o unix/connection.o \ unix/processx.o unix/sigchld.o unix/utils.o \ unix/named_pipe.o cleancall.o .PHONY: all clean all: tools/px supervisor/supervisor client$(SHLIB_EXT) $(SHLIB) tools/px: tools/px.c $(CC) $(CFLAGS) $(LDFLAGS) -Wall tools/px.c -o tools/px supervisor/supervisor: supervisor/supervisor.c supervisor/utils.c $(CC) $(CFLAGS) $(LDFLAGS) supervisor/supervisor.c \ supervisor/utils.c -o supervisor/supervisor CLIENT_OBJECTS = base64.o client.o errors.o client$(SHLIB_EXT): $(CLIENT_OBJECTS) $(SHLIB_LINK) -o client$(SHLIB_EXT) $(CLIENT_OBJECTS) $(PKG_LIBS) \ $(SHLIB_LIBADD) $(LIBR) clean: rm -rf $(SHLIB) $(OBJECTS) $(CLIENT_OBJECTS) \ supervisor/supervisor supervisor/supervisor.dSYM \ supervisor/supervisor.exe \ client$(SHLIB_EXT) processx/src/Makevars.win0000644000176200001440000000226114025102241015167 0ustar liggesusers# -*- makefile -*- OBJECTS = init.o poll.o errors.o processx-connection.o \ processx-vector.o create-time.o base64.o \ win/processx.o win/stdio.o win/named_pipe.o \ win/utils.o win/thread.o cleancall.o .PHONY: all clean PKG_CFLAGS = -DSTRICT_R_HEADERS PKG_LIBS = -lws2_32 all: tools/px.exe tools/pxu.exe tools/interrupt.exe \ supervisor/supervisor.exe $(SHLIB) client$(SHLIB_EXT) tools/px.exe: tools/px.c $(CC) $(CFLAGS) -Wall $< -o $@ tools/pxu.exe: tools/pxu.c $(CC) $(CFLAGS) -Wall -municode $< -o $@ tools/interrupt.exe: tools/interrupt.c $(CC) $(CFLAGS) -Wall $< -o $@ supervisor/supervisor.exe: supervisor/supervisor.c supervisor/utils.c \ supervisor/windows.c $(CC) $(CFLAGS) $^ -o supervisor/supervisor.exe CLIENT_OBJECTS = base64.o client.o errors.o client$(SHLIB_EXT): $(CLIENT_OBJECTS) $(SHLIB_LD) -shared $(DLLFLAGS) -o client$(SHLIB_EXT) \ $(CLIENT_OBJECTS) $(PKG_LIBS) $(SHLIB_LIBADD) $(LIBR) clean: rm -rf $(SHLIB) $(OBJECTS) $(CLIENT_OBJECTS) \ supervisor/supervisor supervisor/supervisor.dSYM \ supervisor/supervisor.exe tools/px.exe tools/interrupt.exe \ client$(SHLIB_EXT) processx/src/processx.h0000644000176200001440000000634114026372357014743 0ustar liggesusers #ifndef PROCESSX_H #define PROCESSX_H #ifdef __cplusplus extern "C" { #endif #ifndef _GNU_SOURCE #define _GNU_SOURCE 1 #endif #ifdef __INTEL_COMPILER #define _BSD_SOURCE 1 #define _POSIX_C_SOURCE 200809L #endif #include "processx-connection.h" #include "errors.h" #ifdef _WIN32 #include #else #include #include #include #include #include #include #include #include #include #endif #include #ifdef _WIN32 #include "win/processx-win.h" #else #include "unix/processx-unix.h" #endif /* API from R */ 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 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_get_pid(SEXP status); SEXP processx_create_time(SEXP r_pid); SEXP processx_poll(SEXP statuses, SEXP conn, SEXP ms); SEXP processx__process_exists(SEXP pid); SEXP processx__proc_start_time(SEXP status); SEXP processx__unload_cleanup(); SEXP processx_is_named_pipe_open(SEXP pipe_ext); SEXP processx_close_named_pipe(SEXP pipe_ext); SEXP processx_create_named_pipe(SEXP name, SEXP mode); SEXP processx_write_named_pipe(SEXP pipe_ext, SEXP text); SEXP processx_disable_crash_dialog(); SEXP processx_base64_encode(SEXP array); SEXP processx_base64_decode(SEXP array); /* Common declarations */ /* Interruption interval in ms */ #define PROCESSX_INTERRUPT_INTERVAL 200 /* Various OSes and OS versions return various poll codes when the child's end of the pipe is closed, so we cannot provide a more elaborate API. See e.g. http://www.greenend.org.uk/rjk/tech/poll.html In particular, (recent) macOS return both POLLIN and POLLHUP, Cygwin return POLLHUP, and most others return just POLLIN, so there is not way to distinguish. Essentially, if a read would not block, and the fd is still open, then we return with PXREADY. So for us, we just have: */ #define PXNOPIPE 1 /* we never captured this output */ #define PXREADY 2 /* one fd is ready, or got EOF */ #define PXTIMEOUT 3 /* no fd is ready before the timeout */ #define PXCLOSED 4 /* fd was already closed when started polling */ #define PXSILENT 5 /* still open, but no data or EOF for now. No timeout, either */ /* but there were events on other fds */ #define PXEVENT 6 /* some event, this is used for curl fds */ /* These statuses can be only returned by the pre-poll functions */ #define PXHANDLE 7 /* need to poll the set handle */ #define PXSELECT 8 /* need to poll/select the set fd */ typedef struct { int windows_verbatim_args; int windows_hide; const char *wd; int pty_echo; int pty_rows; int pty_cols; } processx_options_t; #ifdef __cplusplus } #endif #endif processx/src/poll.c0000644000176200001440000000445413616314040014026 0ustar liggesusers #include "processx.h" SEXP processx_poll(SEXP statuses, SEXP types, SEXP ms) { int cms = INTEGER(ms)[0]; int i, j, num_total = LENGTH(statuses); processx_pollable_t *pollables; SEXP result; int num_proc = 0, num_poll; for (i = 0; i < num_total; i++) if (INTEGER(types)[i] == 1) num_proc++; num_poll = num_total + num_proc * 2; pollables = (processx_pollable_t*) R_alloc(num_poll, sizeof(processx_pollable_t)); result = PROTECT(allocVector(VECSXP, num_total)); for (i = 0, j = 0; i < num_total; i++) { SEXP status = VECTOR_ELT(statuses, i); if (INTEGER(types)[i] == 1) { SEXP process = VECTOR_ELT(status, 0); SEXP pollconn = VECTOR_ELT(status, 1); processx_handle_t *handle = R_ExternalPtrAddr(process); processx_connection_t *cpollconn = isNull(pollconn) ? 0 : R_ExternalPtrAddr(pollconn); processx_c_pollable_from_connection(&pollables[j], handle->pipes[1]); if (handle->pipes[1]) handle->pipes[1]->poll_idx = j; j++; processx_c_pollable_from_connection(&pollables[j], handle->pipes[2]); if (handle->pipes[2]) handle->pipes[2]->poll_idx = j; j++; processx_c_pollable_from_connection(&pollables[j], cpollconn); if (cpollconn) cpollconn->poll_idx = j; j++; SET_VECTOR_ELT(result, i, allocVector(INTSXP, 3)); } else if (INTEGER(types)[i] == 2) { processx_connection_t *handle = R_ExternalPtrAddr(status); processx_c_pollable_from_connection(&pollables[j], handle); if (handle) handle->poll_idx = j; j++; SET_VECTOR_ELT(result, i, allocVector(INTSXP, 1)); } else if (INTEGER(types)[i] == 3) { processx_c_pollable_from_curl(&pollables[j], status); j++; SET_VECTOR_ELT(result, i, allocVector(INTSXP, 1)); } } processx_c_connection_poll(pollables, num_poll, cms); for (i = 0, j = 0; i < num_total; i++) { if (INTEGER(types)[i] == 1) { INTEGER(VECTOR_ELT(result, i))[0] = pollables[j++].event; INTEGER(VECTOR_ELT(result, i))[1] = pollables[j++].event; INTEGER(VECTOR_ELT(result, i))[2] = pollables[j++].event; } else if (INTEGER(types)[i] == 2) { INTEGER(VECTOR_ELT(result, i))[0] = pollables[j++].event; } else { INTEGER(VECTOR_ELT(result, i))[0] = pollables[j++].event; } } UNPROTECT(1); return result; } processx/src/cleancall.h0000644000176200001440000000254113617233735015012 0ustar liggesusers#ifndef CLEANCALL_H #define CLEANCALL_H #include #include // -------------------------------------------------------------------- // Internals // -------------------------------------------------------------------- typedef union {void* p; DL_FUNC fn;} fn_ptr; #if (defined(R_VERSION) && R_VERSION < R_Version(3, 4, 0)) SEXP R_MakeExternalPtrFn(DL_FUNC p, SEXP tag, SEXP prot); DL_FUNC R_ExternalPtrAddrFn(SEXP s); #endif // -------------------------------------------------------------------- // API for packages that embed cleancall // -------------------------------------------------------------------- // The R API does not have a setter for external function pointers SEXP cleancall_MakeExternalPtrFn(DL_FUNC p, SEXP tag, SEXP prot); void cleancall_SetExternalPtrAddrFn(SEXP s, DL_FUNC p); #define CLEANCALL_METHOD_RECORD \ {"cleancall_call", (DL_FUNC) &cleancall_call, 2} SEXP cleancall_call(SEXP args, SEXP env); extern SEXP cleancall_fns_dot_call; void cleancall_init(); // -------------------------------------------------------------------- // Public API // -------------------------------------------------------------------- SEXP r_with_cleanup_context(SEXP (*fn)(void* data), void* data); void r_call_on_exit(void (*fn)(void* data), void* data); void r_call_on_early_exit(void (*fn)(void* data), void* data); #endif processx/src/errors.h0000644000176200001440000001301114034020323014357 0ustar liggesusers /* Informative error messages from C in R packages. * * Features: * - templating * - include the function name * - include the file name and line number of the error * - look up (localized) system error messages from errno on Unix, or for * POSIX functions on Windows. * - look up (localized) system error messages from GetLastError() * on Windows * * See the API below. */ #ifndef R_THROW_ERROR_H #define R_THROW_ERROR_H #ifndef _GNU_SOURCE #define _GNU_SOURCE 1 #endif #ifdef _WIN32 #include #else #include #endif #include /* Throw a generic (non-system) error. * * ARGUMENTS * ... Error message template, and values to be substituted into the * template. They are passed to `vsnprintf()`. * * EXAMPLES * If `fun` is a character string, then * * R_THROW_ERROR("`%s` must be a function", fun); * * will produce an error message like this: * * Error in set_mock(...): `old_fun` must be a function * @reassign.c:9 (reassign_function) */ #define R_THROW_ERROR(...) \ r_throw_error(__func__, __FILE__, __LINE__, __VA_ARGS__) SEXP r_throw_error(const char *func, const char *filename, int line, const char *msg, ...); #ifdef _WIN32 /* Throw a system error on Windows. * * DESCRIPTION * `R_THROW_SYSTEM_ERROR()` queries the error code via `GetLastError()`, * and constructs an error message that includes both the error code and * the (localized) error message. * * `R_THROW_SYSTEM_ERROR_CODE()` is similar, but you can specify the * error code explicitly. Use this if you already had to query the * error code before deciding to throw an error. * * ARGUMENTS * errorcode The Windows error code. Sometimes you need to query this * explicitly, because some `GetLastError()` codes are not errors. * ... Error message template, and values to be substituted into the * template. They are passed to `vsnprintf()`. * * EXAMPLES * This is a way to handle a `CreateFileW()` failure on Windows. * (Some details omitted for brevity.) * * HANDLE hnd = CreateFileW(filename, ...); * if (hnd == INVALID_HANDLE_VALUE) { * R_THROW_SYSTEM_ERROR("cannot open file `%ls`", filename); * } * * which will create an error message like this: * * Error in read_file(...): cannot open file `input.txt` * (system error 5, Access is denied.) @read.c:234 (read_file) */ #define R_THROW_SYSTEM_ERROR(...) \ r_throw_system_error(__func__, __FILE__, __LINE__, (-1), NULL, __VA_ARGS__) #define R_THROW_SYSTEM_ERROR_CODE(errorcode, ...) \ r_throw_system_error(__func__, __FILE__, __LINE__, (errorcode), NULL, __VA_ARGS__) SEXP r_throw_system_error(const char *func, const char *filename, int line, DWORD errorcode, const char *sysmsg, const char *msg, ...); /* Throw an error for a POSIX system call failure on Windows or in * portable code that is shared between Unix and Windows. * * DESCRIPTION * `R_THROW_POSIX_ERROR()` queries the error code from `errno`, and * constructs and error message and includes both the error code and * the localized error message. * * `R_THROW_POSIX_ERROR_CODE()` is similar, but you can pass in the * POSIX error code directly. * * Use these functions for POSIX system call failures in Windows. * You can also use them for code that is shared between Unix and * Windows. * * ARGUMENTS * errorcode The POSIX error code. * ... Error message template, and values to be substituted into the * template. They are passed to `vsnprintf()`. * * EXAMPLES * Here is a way to handle a `fopen()` failure on Windows or in * portable code: * * FILE infile = fopen(filename, "r"); * if (infile == NULL) { * R_THROW_POSIX_ERROR("cannot open `%s`", filename); * } * * which will create an error message like this: * * Error in read_file(...): cannot open file `input.txt` * (system error 13, Permission denied) @read.c:234 (read_file) */ #define R_THROW_POSIX_ERROR(...) \ r_throw_posix_error(__func__, __FILE__, __LINE__, errno, NULL, __VA_ARGS__) #define R_THROW_POSIX_ERROR_CODE(errorcode, ...) \ r_throw_posix_error(__func__, __FILE__, __LINE__, errorcode, NULL, __VA_ARGS__) SEXP r_throw_posix_error(const char *func, const char *filename, int line, int errorcode, const char *sysmsg, const char *msg, ...); #else /* See R_THROW_SYSTEM_ERROR(...) above. On Unix `R_THROW_SYSTEM_ERROR()` * is the same as `R_THROW_POSIX_ERROR()`, and `R_THROW_SYSTEM_ERROR_CODE()` * is the same as `R_THROW_POSIX_ERROR_CODE(). */ #define R_THROW_SYSTEM_ERROR(...) \ r_throw_system_error(__func__, __FILE__, __LINE__, errno, NULL, __VA_ARGS__) #define R_THROW_SYSTEM_ERROR_CODE(errorcode, ...) \ r_throw_system_error(__func__, __FILE__, __LINE__, errorcode, NULL, __VA_ARGS__) #define R_THROW_POSIX_ERROR(...) \ r_throw_system_error(__func__, __FILE__, __LINE__, errno, NULL, __VA_ARGS__) #define R_THROW_POSIX_ERROR_CODE(errorcode, ...) \ r_throw_system_error(__func__, __FILE__, __LINE__, errorcode, NULL, __VA_ARGS__) SEXP r_throw_system_error(const char *func, const char *filename, int line, int errorcode, const char *sysmsg, const char *msg, ...); #endif #endif processx/src/processx-types.h0000644000176200001440000000155413616314040016073 0ustar liggesusers #ifndef PROCESSX_TYPES_H #define PROCESSX_TYPES_H #ifdef _WIN32 #include typedef DWORD pid_t; #else #include #include #include #endif typedef struct { pid_t *stor_begin; pid_t *stor_end; pid_t *end; } processx_vector_t; #define VECTOR(v) ((v).stor_begin) void processx_vector_init(processx_vector_t *v, size_t size, size_t alloc_size); size_t processx_vector_size(const processx_vector_t *v); void processx_vector_reserve(processx_vector_t *v, size_t size); void processx_vector_clear(processx_vector_t *v); void processx_vector_push_back(processx_vector_t *v, pid_t e); int processx_vector_find(const processx_vector_t *v, pid_t e, size_t from, size_t *idx); void processx_vector_rooted_tree(pid_t root, const processx_vector_t *nodes, const processx_vector_t *parents, processx_vector_t *result); #endif processx/R/0000755000176200001440000000000014043036776012333 5ustar liggesusersprocessx/R/supervisor.R0000644000176200001440000001066514043036776014707 0ustar liggesusers# Stores information about the supervisor process supervisor_info <- new.env() reg.finalizer(supervisor_info, function(s) { # Pass s to `supervisor_kill`, in case the GC event happens _after_ a new # `processx:::supervisor_info` has been created and the name # `supervisor_info` is bound to the new object. This could happen if the # package is unloaded and reloaded. supervisor_kill2(s) }, onexit = TRUE) #' Terminate all supervised processes and the supervisor process itself as #' well #' #' On Unix the supervisor sends a `SIGTERM` signal to all supervised #' processes, and gives them five seconds to quit, before sending a #' `SIGKILL` signal. Then the supervisor itself terminates. #' #' Windows is similar, but instead of `SIGTERM`, a console CTRL+C interrupt #' is sent first, then a `WM_CLOSE` message is sent to the windows of the #' supervised processes, if they have windows. #' #' @keywords internal #' @export supervisor_kill <- function() { supervisor_kill2() } # This takes an object s, because a new `supervisor_info` object could have been # created. supervisor_kill2 <- function(s = supervisor_info) { if (is.null(s$pid)) return() if (!is.null(s$stdin) && is_pipe_open(s$stdin)) { write_lines_named_pipe(s$stdin, "kill") } if (!is.null(s$stdin) && is_pipe_open(s$stdin)) { close_named_pipe(s$stdin) } if (!is.null(s$stdout) && is_pipe_open(s$stdout)) { close_named_pipe(s$stdout) } s$pid <- NULL } supervisor_reset <- function() { if (supervisor_running()) { supervisor_kill() } supervisor_info$pid <- NULL supervisor_info$stdin <- NULL supervisor_info$stdout <- NULL supervisor_info$stdin_file <- NULL supervisor_info$stdout_file <- NULL } supervisor_ensure_running <- function() { if (!supervisor_running()) supervisor_start() } supervisor_running <- function() { if (is.null(supervisor_info$pid)) { FALSE } else { TRUE } } # Tell the supervisor to watch a PID supervisor_watch_pid <- function(pid) { supervisor_ensure_running() write_lines_named_pipe(supervisor_info$stdin, as.character(pid)) } # Tell the supervisor to un-watch a PID supervisor_unwatch_pid <- function(pid) { write_lines_named_pipe(supervisor_info$stdin, as.character(-pid)) } # Start the supervisor process. Information about the process will be stored in # supervisor_info. If startup fails, this function will throw an error. supervisor_start <- function() { supervisor_info$stdin_file <- named_pipe_tempfile("supervisor_stdin") supervisor_info$stdout_file <- named_pipe_tempfile("supervisor_stdout") supervisor_info$stdin <- create_named_pipe(supervisor_info$stdin_file) supervisor_info$stdout <- create_named_pipe(supervisor_info$stdout_file) # Start the supervisor, passing the R process's PID to it. # Note: for debugging, you can add "-v" to args and use stdout="log.txt". p <- process$new( supervisor_path(), args = c("-p", Sys.getpid(), "-i", supervisor_info$stdin_file), stdout = "|", cleanup = FALSE ) # Wait for supervisor to emit the line "Ready", which indicates it is ready # to receive information. ready <- FALSE cur_time <- Sys.time() end_time <- cur_time + 5 while (cur_time < end_time) { p$poll_io(round(as.numeric(end_time - cur_time, units = "secs") * 1000)) if (!p$is_alive()) break if (any(p$read_output_lines() == "Ready")) { ready <- TRUE break } cur_time <- Sys.time() } if (p$is_alive()) close(p$get_output_connection()) # Two ways of reaching this: if process has died, or if it hasn't emitted # "Ready" after 5 seconds. if (!ready) throw(new_error("processx supervisor was not ready after 5 seconds.")) supervisor_info$pid <- p$get_pid() } # Returns full path to the supervisor binary. Works when package is loaded the # normal way, and when loaded with devtools::load_all(). supervisor_path <- function() { supervisor_name <- "supervisor" if (is_windows()) supervisor_name <- paste0(supervisor_name, ".exe") # Detect if package was loaded via devtools::load_all() dev_meta <- parent.env(environment())$.__DEVTOOLS__ devtools_loaded <- !is.null(dev_meta) if (devtools_loaded) { subdir <- file.path("src", "supervisor") } else { subdir <- "bin" # Add arch (it may be ""; on Windows it may be "/X64") subdir <- paste0(subdir, Sys.getenv("R_ARCH")) } system.file(subdir, supervisor_name, package = "processx", mustWork = TRUE) } processx/R/cleancall.R0000644000176200001440000000015313617233735014373 0ustar liggesusers call_with_cleanup <- function(ptr, ...) { .Call(c_cleancall_call, pairlist(ptr, ...), parent.frame()) } processx/R/print.R0000644000176200001440000000073613616314040013604 0ustar liggesusers process_format <- function(self, private) { state <- if (self$is_alive()) { pid <- self$get_pid() paste0("running, pid ", paste(pid, collapse = ", "), ".") } else { "finished." } paste0( "PROCESS ", "'", private$get_short_name(), "', ", state, "\n" ) } process_print <- function(self, private) { cat(process_format(self, private)) invisible(self) } process_get_short_name <- function(self, private) { basename(private$command) } processx/R/process-helpers.R0000644000176200001440000000012613616314040015557 0ustar liggesusers process__exists <- function(pid) { rethrow_call(c_processx__process_exists, pid) } processx/R/initialize.R0000644000176200001440000001347014043033410014602 0ustar liggesusers #' Start a process #' #' @param self this #' @param private this$private #' @param command Command to run, string scalar. #' @param args Command arguments, character vector. #' @param stdin Standard input, NULL to ignore. #' @param stdout Standard output, NULL to ignore, TRUE for temp file. #' @param stderr Standard error, NULL to ignore, TRUE for temp file. #' @param pty Whether we create a PTY. #' @param connections Connections to inherit in the child process. #' @param poll_connection Whether to create a connection for polling. #' @param env Environment vaiables. #' @param cleanup Kill on GC? #' @param cleanup_tree Kill process tree on GC? #' @param wd working directory (or NULL) #' @param echo_cmd Echo command before starting it? #' @param supervise Should the process be supervised? #' @param encoding Assumed stdout and stderr encoding. #' @param post_process Post processing function. #' #' @keywords internal 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) { "!DEBUG process_initialize `command`" assert_that( is_string(command), is.character(args), is_std_conn(stdin), is_std_conn(stdout), is_std_conn(stderr), is_flag(pty), is.list(pty_options), is_named(pty_options), is_connection_list(connections), is.null(poll_connection) || is_flag(poll_connection), is.null(env) || is_env_vector(env), is_flag(cleanup), is_flag(cleanup_tree), is_string_or_null(wd), is_flag(echo_cmd), is_flag(windows_verbatim_args), is_flag(windows_hide_window), is_flag(windows_detached_process), is_string(encoding), is.function(post_process) || is.null(post_process)) if (cleanup_tree && !cleanup) { warning("`cleanup_tree` overrides `cleanup`, and process will be ", "killed on GC") cleanup <- TRUE } if (pty && os_type() != "unix") { throw(new_error("`pty = TRUE` is only implemented on Unix")) } if (pty && tolower(Sys.info()[["sysname"]]) == "sunos") { throw(new_error("`pty = TRUE` is not (yet) implemented on Solaris")) } if (pty && !is.null(stdin)) { throw(new_error("`stdin` must be `NULL` if `pty == TRUE`")) } if (pty && !is.null(stdout)) { throw(new_error("`stdout` must be `NULL` if `pty == TRUE`")) } if (pty && !is.null(stderr)) { throw(new_error("`stderr` must be `NULL` if `pty == TRUE`")) } def <- default_pty_options() pty_options <- utils::modifyList(def, pty_options) if (length(bad <- setdiff(names(def), names(pty_options)))) { throw(new_error("Uknown pty option(s): ", paste(paste0("`", bad, "`"), collapse = ", "))) } pty_options$rows <- as.integer(pty_options$rows) pty_options$cols <- as.integer(pty_options$cols) pty_options <- pty_options[names(def)] command <- enc2path(command) args <- enc2path(args) wd <- wd %||% getwd() private$command <- command private$args <- args private$cleanup <- cleanup private$cleanup_tree <- cleanup_tree private$wd <- wd private$pstdin <- stdin private$pstdout <- stdout private$pstderr <- stderr private$pty <- pty private$pty_options <- pty_options private$connections <- connections private$env <- env private$echo_cmd <- echo_cmd private$windows_verbatim_args <- windows_verbatim_args private$windows_hide_window <- windows_hide_window private$encoding <- encoding private$post_process <- post_process poll_connection <- poll_connection %||% (!identical(stdout, "|") && !identical(stderr, "|") && !length(connections)) if (poll_connection) { pipe <- conn_create_pipepair() connections <- c(connections, list(pipe[[2]])) private$poll_pipe <- pipe[[1]] } if (echo_cmd) do_echo_cmd(command, args) if (!is.null(env)) env <- process_env(env) private$tree_id <- get_id() if (!is.null(wd)) { wd <- normalizePath(wd, winslash = "\\", mustWork = FALSE) } connections <- c(list(stdin, stdout, stderr), connections) "!DEBUG process_initialize exec()" private$status <- rethrow_call( 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") ) ## We try the query the start time according to the OS, because we can ## use the (pid, start time) pair as an id when performing operations on ## the process, e.g. sending signals. This is only implemented on Linux, ## macOS and Windows and on other OSes it returns 0.0, so we just use the ## current time instead. (In the C process handle, there will be 0, ## still.) private$starttime <- rethrow_call(c_processx__proc_start_time, private$status) if (private$starttime == 0) private$starttime <- Sys.time() ## Need to close this, otherwise the child's end of the pipe ## will not be closed when the child exits, and then we cannot ## poll it. if (poll_connection) close(pipe[[2]]) if (is.character(stdin) && stdin != "|" && stdin != "") stdin <- full_path(stdin) if (is.character(stdout) && stdout != "|" && stdout != "") stdout <- full_path(stdout) if (is.character(stderr) && stderr != "|" && stderr != "") stderr <- full_path(stderr) ## Store the output and error files, we'll open them later if needed private$stdin <- stdin private$stdout <- stdout private$stderr <- stderr if (supervise) { supervisor_watch_pid(self$get_pid()) private$supervised <- TRUE } invisible(self) } processx/R/utils.R0000644000176200001440000001521014043033410013573 0ustar liggesusers enc2path <- function(x) { if (is_windows()) { enc2utf8(x) } else { enc2native(x) } } `%||%` <- function(l, r) if (is.null(l)) r else l os_type <- function() { .Platform$OS.type } is_windows <- function() { .Platform$OS.type == "windows" } is_linux <- function() { identical(tolower(Sys.info()[["sysname"]]), "linux") } last_char <- function(x) { nc <- nchar(x) substring(x, nc, nc) } # Given a filename, return an absolute path to that file. This has two important # differences from normalizePath(). (1) The file does not need to exist, and (2) # the path is merely absolute, whereas normalizePath() returns a canonical path, # which resolves symbolic links, gives canonical case, and, on Windows, may give # short names. # # On Windows, the returned path includes the drive ("C:") or network server # ("//myserver"). full_path <- function(path) { assert_that(is_string(path)) # Try expanding "~" path <- path.expand(path) # If relative path, prepend current dir. On Windows, also record current # drive. if (is_windows()) { path <- gsub("\\", "/", path, fixed = TRUE) if (grepl("^[a-zA-Z]:", path)) { drive <- substring(path, 1, 2) path <- substring(path, 3) } else if (substring(path, 1, 2) == "//") { # Extract server name, like "//server", and use as drive. pos <- regexec("^(//[^/]*)(.*)", path)[[1]] drive <- substring(path, pos[2], attr(pos, "match.length", exact = TRUE)[2]) path <- substring(path, pos[3]) # Must have a name, like "//server" if (drive == "//") throw(new_error("Server name not found in network path.")) } else { drive <- substring(getwd(), 1, 2) if (substr(path, 1, 1) != "/") path <- substring(file.path(getwd(), path), 3) } } else { if (substr(path, 1, 1) != "/") path <- file.path(getwd(), path) } parts <- strsplit(path, "/")[[1]] # Collapse any "..", ".", and "" in path. i <- 2 while (i <= length(parts)) { if (parts[i] == "." || parts[i] == "") { parts <- parts[-i] } else if (parts[i] == "..") { if (i == 2) { parts <- parts[-i] } else { parts <- parts[-c(i-1, i)] i <- i-1 } } else { i <- i+1 } } new_path <- paste(parts, collapse = "/") if (new_path == "") new_path <- "/" if (is_windows()) new_path <- paste0(drive, new_path) new_path } vcapply <- function (X, FUN, ..., USE.NAMES = TRUE) { vapply(X, FUN, FUN.VALUE = character(1), ..., USE.NAMES = USE.NAMES) } do_echo_cmd <- function(command, args) { quoted <- sh_quote_smart(c("Running", command, args)) out <- str_wrap_words(quoted, width = getOption("width") - 3) if ((len <- length(out)) > 1) { out[1:(len - 1)] <- paste0(out[1:(len - 1)], " \\") } cat(out, sep = "\n") } sh_quote_smart <- function(x) { if (!length(x)) return(x) ifelse(grepl("^[-a-zA-Z0-9/_\\.]*$", x), x, shQuote(x)) } strrep <- function(x, times) { x <- as.character(x) if (length(x) == 0L) return(x) r <- .mapply( function(x, times) { if (is.na(x) || is.na(times)) return(NA_character_) if (times <= 0L) return("") paste0(replicate(times, x), collapse = "") }, list(x = x, times = times), MoreArgs = list() ) unlist(r, use.names = FALSE) } str_wrap_words <- function(words, width, indent = 0, exdent = 2) { word_widths <- nchar(words, type = "width") out <- character() current_width <- indent current_line <- strrep(" ", indent) first_word <- TRUE i <- 1 while (i <= length(words)) { if (first_word) { current_width <- current_width + word_widths[i] current_line <- paste0(current_line, words[i]) first_word <- FALSE i <- i + 1 } else if (current_width + 1 + word_widths[i] <= width) { current_width <- current_width + word_widths[i] + 1 current_line <- paste0(current_line, " ", words[i]) i <- i + 1 } else { out <- c(out, current_line) current_width <- exdent current_line <- strrep(" ", exdent) first_word <- TRUE } } if (!first_word) out <- c(out, current_line) out } set_names <- function(x, n) { names(x) <- n x } get_private <- function(x) { x$.__enclos_env__$private } get_tool <- function(prog) { if (os_type() == "windows") prog <- paste0(prog, ".exe") exe <- system.file(package = "processx", "bin", .Platform$r_arch, prog) if (exe == "") { pkgpath <- system.file(package = "processx") if (basename(pkgpath) == "inst") pkgpath <- dirname(pkgpath) exe <- file.path(pkgpath, "src", "tools", prog) if (!file.exists(exe)) return("") } exe } get_id <- function() { paste0( "PS", paste(sample(c(LETTERS, 0:9), 10, replace = TRUE), collapse = ""), "_", as.integer(asNamespace("base")$.Internal(Sys.time())) ) } format_unix_time <- function(z) { structure(z, class = c("POSIXct", "POSIXt"), tzone = "GMT") } file_size <- function(x) { if (getRversion() >= "3.2.0") { file.info(x, extra_cols = FALSE)$size } else { file.info(x)$size } } disable_crash_dialog <- function() { rethrow_call(c_processx_disable_crash_dialog) } has_package <- function(pkg) { requireNamespace(pkg, quietly = TRUE) } tty_echo_off <- function() { rethrow_call(c_processx__echo_off) } tty_echo_on <- function() { rethrow_call(c_processx__echo_on) } str_trim <- function(x) { sub("^\\s+", "", sub("\\s+$", "", x)) } new_not_implemented_error <- function(message, call) { add_class(new_error(message, call. = call), c("not_implemented_error", "not_implemented")) } add_class <- function(obj, class) { class(obj) <- c(class, class(obj)) obj } is_interactive <- function() { opt <- getOption("rlib_interactive") if (isTRUE(opt)) { TRUE } else if (identical(opt, FALSE)) { FALSE } else if (tolower(getOption("knitr.in.progress", "false")) == "true") { FALSE } else if (tolower(getOption("rstudio.notebook.executing", "false")) == "true") { FALSE } else if (identical(Sys.getenv("TESTTHAT"), "true")) { FALSE } else { interactive() } } make_buffer <- function() { con <- file(open = "w+b") size <- 0L list( push = function(text) { size <<- size + nchar(text, type = "bytes") cat(text, file = con) }, read = function() { readChar(con, size, useBytes = TRUE) }, done = function() { close(con) } ) } update_vector <- function(x, y = NULL) { if (length(y) == 0L) return(x) c(x[!(names(x) %in% names(y))], y) } process_env <- function(env) { current <- env == "current" & names(env) == "" if (any(current)) env <- update_vector(Sys.getenv(), env[!current]) enc2path(paste(names(env), sep = "=", env)) } processx/R/io.R0000644000176200001440000001065713616314040013062 0ustar liggesusers process_has_input_connection <- function(self, private) { "!DEBUG process_has_input_connection `private$get_short_name()`" !is.null(private$stdin_pipe) } process_has_output_connection <- function(self, private) { "!DEBUG process_has_output_connection `private$get_short_name()`" !is.null(private$stdout_pipe) } process_has_error_connection <- function(self, private) { "!DEBUG process_has_error_connection `private$get_short_name()`" !is.null(private$stderr_pipe) } process_has_poll_connection <- function(self, private) { "!DEBUG process_has_error_connection `private$get_short_name()`" !is.null(private$poll_pipe) } process_get_input_connection <- function(self, private) { "!DEBUG process_get_input_connection `private$get_short_name()`" if (!self$has_input_connection()) throw(new_error("stdin is not a pipe.")) private$stdin_pipe } process_get_output_connection <- function(self, private) { "!DEBUG process_get_output_connection `private$get_short_name()`" if (!self$has_output_connection()) throw(new_error("stdout is not a pipe.")) private$stdout_pipe } process_get_error_connection <- function(self, private) { "!DEBUG process_get_error_connection `private$get_short_name()`" if (!self$has_error_connection()) throw(new_error("stderr is not a pipe.")) private$stderr_pipe } process_get_poll_connection <- function(self, private) { "!DEBUG process_get_poll_connection `private$get_short_name()`" if (!self$has_poll_connection()) throw(new_error("No poll connection")) private$poll_pipe } process_read_output <- function(self, private, n) { "!DEBUG process_read_output `private$get_short_name()`" con <- process_get_output_connection(self, private) if (private$pty) if (poll(list(con), 0)[[1]] == "timeout") return("") rethrow_call(c_processx_connection_read_chars, con, n) } process_read_error <- function(self, private, n) { "!DEBUG process_read_error `private$get_short_name()`" con <- process_get_error_connection(self, private) rethrow_call(c_processx_connection_read_chars, con, n) } process_read_output_lines <- function(self, private, n) { "!DEBUG process_read_output_lines `private$get_short_name()`" con <- process_get_output_connection(self, private) if (private$pty) { throw(new_error("Cannot read lines from a pty (see manual)")) } rethrow_call(c_processx_connection_read_lines, con, n) } process_read_error_lines <- function(self, private, n) { "!DEBUG process_read_error_lines `private$get_short_name()`" con <- process_get_error_connection(self, private) rethrow_call(c_processx_connection_read_lines, con, n) } process_is_incompelete_output <- function(self, private) { con <- process_get_output_connection(self, private) ! rethrow_call(c_processx_connection_is_eof, con) } process_is_incompelete_error <- function(self, private) { con <- process_get_error_connection(self, private) ! rethrow_call(c_processx_connection_is_eof, con) } process_read_all_output <- function(self, private) { result <- "" while (self$is_incomplete_output()) { self$poll_io(-1) result <- paste0(result, self$read_output()) } result } process_read_all_error <- function(self, private) { result <- "" while (self$is_incomplete_error()) { self$poll_io(-1) result <- paste0(result, self$read_error()) } result } process_read_all_output_lines <- function(self, private) { results <- character() while (self$is_incomplete_output()) { self$poll_io(-1) results <- c(results, self$read_output_lines()) } results } process_read_all_error_lines <- function(self, private) { results <- character() while (self$is_incomplete_error()) { self$poll_io(-1) results <- c(results, self$read_error_lines()) } results } process_write_input <- function(self, private, str, sep) { "!DEBUG process_write_input `private$get_short_name()`" con <- process_get_input_connection(self, private) if (is.character(str)) { pstr <- paste(str, collapse = sep) str <- iconv(pstr, "", private$encoding, toRaw = TRUE)[[1]] } invisible(rethrow_call(c_processx_connection_write_bytes, con, str)) } process_get_input_file <- function(self, private) { private$stdin } process_get_output_file <- function(self, private) { private$stdout } process_get_error_file <- function(self, private) { private$stderr } poll_codes <- c("nopipe", "ready", "timeout", "closed", "silent", "event") process_poll_io <- function(self, private, ms) { poll(list(self), ms)[[1]] } processx/R/named_pipe.R0000644000176200001440000000427013616314040014546 0ustar liggesusers# These functions are an abstraction layer for named pipes. They're necessary # because fifo() on Windows doesn't seem to work (as of R 3.3.3). named_pipe_tempfile <- function(prefix = "pipe") { if (is_windows()) { # For some reason, calling tempfile("foo", tmpdir = "\\\\pipe\\.\\") takes # several seconds the first time it's called in an R session. So we'll do it # manually with paste0. paste0("\\\\.\\pipe", tempfile(prefix, "")) } else { tempfile(prefix) } } is_pipe_open <- function(pipe) { UseMethod("is_pipe_open") } #' @export is_pipe_open.windows_named_pipe <- function(pipe) { rethrow_call(c_processx_is_named_pipe_open, pipe$handle) } #' @export is_pipe_open.unix_named_pipe <- function(pipe) { # isOpen() gives an error when passed a closed fifo object, so this is a more # robust version. if (!inherits(pipe$handle, "fifo")) throw(new_error("pipe$handle must be a fifo object")) is_open <- NA tryCatch( is_open <- isOpen(pipe$handle), error = function(e) { is_open <<- FALSE } ) is_open } create_named_pipe <- function(name) { if (is_windows()) { structure( list( handle = rethrow_call(c_processx_create_named_pipe, name, "") ), class = c("windows_named_pipe", "named_pipe") ) } else { structure( list( handle = fifo(name, "w+") ), class = c("unix_named_pipe", "named_pipe") ) } } close_named_pipe <- function(pipe) { UseMethod("close_named_pipe") } #' @export close_named_pipe.windows_named_pipe <- function(pipe) { rethrow_call(c_processx_close_named_pipe, pipe$handle) } #' @export close_named_pipe.unix_named_pipe <- function(pipe) { close(pipe$handle) } write_lines_named_pipe <- function(pipe, text) { UseMethod("write_lines_named_pipe") } #' @export write_lines_named_pipe.windows_named_pipe <- function(pipe, text) { text <- paste(text, collapse = "\n") # Make sure it ends with \n len <- nchar(text) if (substr(text, len, len) != "\n") text <- paste0(text, "\n") rethrow_call(c_processx_write_named_pipe, pipe$handle, text) } #' @export write_lines_named_pipe.unix_named_pipe <- function(pipe, text) { writeLines(text, pipe$handle) } processx/R/assertions.R0000644000176200001440000000656714026323556014662 0ustar liggesusers is_string <- function(x) { is.character(x) && length(x) == 1 && !is.na(x) } on_failure(is_string) <- function(call, env) { paste0(deparse(call$x), " is not a string (length 1 character)") } is_string_or_null <- function(x) { is.null(x) || is_string(x) } on_failure(is_string_or_null) <- function(call, env) { paste0(deparse(call$x), " must be a string (length 1 character) or NULL") } is_flag <- function(x) { is.logical(x) && length(x) == 1 && !is.na(x) } on_failure(is_flag) <- function(call, env) { paste0(deparse(call$x), " is not a flag (length 1 logical)") } 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") } is_pid <- function(x) { is.numeric(x) && length(x) == 1 && !is.na(x) && round(x) == x } on_failure(is_pid) <- function(call, env) { paste0(deparse(call$x), " is not a process id (length 1 integer)") } is_flag_or_string <- function(x) { is_string(x) || is_flag(x) } on_failure(is_flag_or_string) <- function(call, env) { paste0(deparse(call$x), " is not a flag or a string") } is_existing_file <- function(x) { is_string(x) && file.exists(x) } on_failure(is_existing_file) <- function(call, env) { paste0("File ", deparse(call$x), " does not exist") } is_time_interval <- function(x) { (inherits(x, "difftime") && length(x) == 1) || (is.numeric(x) && length(x) == 1 && !is.na(x)) } on_failure(is_time_interval) <- function(call, env) { paste0(deparse(call$x), " is not a valid time interval") } is_list_of_pollables <- function(x) { if (!is.list(x)) return(FALSE) proc <- vapply(x, inherits, FUN.VALUE = logical(1), "process") conn <- vapply(x, is_connection, logical(1)) curl <- vapply(x, inherits, FUN.VALUE = logical(1), "processx_curl_fds") all(proc | conn | curl) } on_failure(is_list_of_pollables) <- function(call, env) { paste0(deparse(call$x), " is not a list of pollable objects") } is_named_character <- function(x) { is.character(x) && !any(is.na(x)) && is_named(x) } on_failure(is_named_character) <- function(call, env) { paste0(deparse(call$x), " must be a named character vector") } is_named <- function(x) { length(names(x)) == length(x) && all(names(x) != "") } on_failure(is_named) <- function(call, env) { paste0(deparse(call$x), " must have non-empty names") } is_connection <- function(x) { inherits(x, "processx_connection") } on_failure(is_connection) <- function(call, env) { paste0(deparse(call$x), " must be a processx connection") } is_connection_list <- function(x) { all(vapply(x, is_connection, logical(1))) } on_failure(is_connection_list) <- function(call, env) { paste0(deparse(call$x), " must be a list of processx connections") } is_env_vector <- function(x) { if (is_named_character(x)) return(TRUE) if (!is.character(x) || anyNA(x)) return(FALSE) if (is.null(names(x))) { all(x == "current") } else { all(x[names(x) == ""] == "current") } } on_failure(is_env_vector) <- function(call, env) { paste0( "all elements, except \"current\" must be named in ", deparse(call$x) ) } is_std_conn <- function(x) { is.null(x) || is_string(x) || is_connection(x) } on_failure(is_std_conn) <- function(call, env) { paste0( deparse(call$x), " must be `NULL`, a string or a processx connection" ) } processx/R/errors.R0000644000176200001440000006163614043002642013767 0ustar liggesusers # # Standalone file for better error handling ---------------------------- # # If can allow package dependencies, then you are probably better off # using rlang's functions for errors. # # The canonical location of this file is in the processx package: # https://github.com/r-lib/processx/master/R/errors.R # # ## Features # # - Throw conditions and errors with the same API. # - Automatically captures the right calls and adds them to the conditions. # - Sets `.Last.error`, so you can easily inspect the errors, even if they # were not caught. # - It only sets `.Last.error` for the errors that are not caught. # - Hierarchical errors, to allow higher level error messages, that are # more meaningful for the users, while also keeping the lower level # details in the error object. (So in `.Last.error` as well.) # - `.Last.error` always includes a stack trace. (The stack trace is # common for the whole error hierarchy.) The trace is accessible within # the error, e.g. `.Last.error$trace`. The trace of the last error is # also at `.Last.error.trace`. # - Can merge errors and traces across multiple processes. # - Pretty-print errors and traces, if the cli package is loaded. # - Automatically hides uninformative parts of the stack trace when # printing. # # ## API # # ``` # new_cond(..., call. = TRUE, domain = NULL) # new_error(..., call. = TRUE, domain = NULL) # throw(cond, parent = NULL) # catch_rethrow(expr, ...) # rethrow(expr, cond) # rethrow_call(.NAME, ...) # add_trace_back(cond) # ``` # # ## Roadmap: # - better printing of anonymous function in the trace # # ## NEWS: # # ### 1.0.0 -- 2019-06-18 # # * First release. # # ### 1.0.1 -- 2019-06-20 # # * Add `rlib_error_always_trace` option to always add a trace # # ### 1.0.2 -- 2019-06-27 # # * Internal change: change topenv of the functions to baseenv() # # ### 1.1.0 -- 2019-10-26 # # * Register print methods via onload_hook() function, call from .onLoad() # * Print the error manually, and the trace in non-interactive sessions # # ### 1.1.1 -- 2019-11-10 # # * Only use `trace` in parent errors if they are `rlib_error`s. # Because e.g. `rlang_error`s also have a trace, with a slightly # different format. # # ### 1.2.0 -- 2019-11-13 # # * Fix the trace if a non-thrown error is re-thrown. # * Provide print_this() and print_parents() to make it easier to define # custom print methods. # * Fix annotating our throw() methods with the incorrect `base::`. # # ### 1.2.1 -- 2020-01-30 # # * Update wording of error printout to be less intimidating, avoid jargon # * Use default printing in interactive mode, so RStudio can detect the # error and highlight it. # * Add the rethrow_call_with_cleanup function, to work with embedded # cleancall. # # ### 1.2.2 -- 2020-11-19 # # * Add the `call` argument to `catch_rethrow()` and `rethrow()`, to be # able to omit calls. # # ### 1.2.3 -- 2021-03-06 # # * Use cli instead of crayon # # ### 1.2.4 -- 2021-04-01 # # * Allow omitting the call with call. = FALSE in `new_cond()`, etc. # # ### 1.3.0 -- 2021-04-19 # # * Avoid embedding calls in trace with embed = FALSE. # # ### 2.0.0 -- 2021-04-19 # # * Versioned classes and print methods err <- local({ # -- condition constructors ------------------------------------------- #' Create a new condition #' #' @noRd #' @param ... Parts of the error message, they will be converted to #' character and then concatenated, like in [stop()]. #' @param call. A call object to include in the condition, or `TRUE` #' or `NULL`, meaning that [throw()] should add a call object #' automatically. If `FALSE`, then no call is added. #' @param domain Translation domain, see [stop()]. #' @return Condition object. Currently a list, but you should not rely #' on that. new_cond <- function(..., call. = TRUE, domain = NULL) { message <- .makeMessage(..., domain = domain) structure( list(message = message, call = call.), class = c("condition")) } #' Create a new error condition #' #' It also adds the `rlib_error` class. #' #' @noRd #' @param ... Passed to [new_cond()]. #' @param call. Passed to [new_cond()]. #' @param domain Passed to [new_cond()]. #' @return Error condition object with classes `rlib_error`, `error` #' and `condition`. new_error <- function(..., call. = TRUE, domain = NULL) { cond <- new_cond(..., call. = call., domain = domain) class(cond) <- c("rlib_error_2_0", "rlib_error", "error", "condition") cond } # -- throwing conditions ---------------------------------------------- #' Throw a condition #' #' If the condition is an error, it will also call [stop()], after #' signalling the condition first. This means that if the condition is #' caught by an exiting handler, then [stop()] is not called. #' #' @noRd #' @param cond Condition object to throw. If it is an error condition, #' then it calls [stop()]. #' @param parent Parent condition. Use this within [rethrow()] and #' [catch_rethrow()]. throw <- function(cond, parent = NULL) { if (!inherits(cond, "condition")) { throw(new_error("You can only throw conditions")) } if (!is.null(parent) && !inherits(parent, "condition")) { throw(new_error("Parent condition must be a condition object")) } if (isTRUE(cond$call)) { cond$call <- sys.call(-1) %||% sys.call() } else if (identical(cond$call, FALSE)) { cond$call <- NULL } # Eventually the nframe numbers will help us print a better trace # When a child condition is created, the child will use the parent # error object to make note of its own nframe. Here we copy that back # to the parent. if (is.null(cond$`_nframe`)) cond$`_nframe` <- sys.nframe() if (!is.null(parent)) { cond$parent <- parent cond$call <- cond$parent$`_childcall` cond$`_nframe` <- cond$parent$`_childframe` cond$`_ignore` <- cond$parent$`_childignore` } # We can set an option to always add the trace to the thrown # conditions. This is useful for example in context that always catch # errors, e.g. in testthat tests or knitr. This options is usually not # set and we signal the condition here always_trace <- isTRUE(getOption("rlib_error_always_trace")) if (!always_trace) signalCondition(cond) # If this is not an error, then we'll just return here. This allows # throwing interrupt conditions for example, with the same UI. if (! inherits(cond, "error")) return(invisible()) if (is.null(cond$`_pid`)) cond$`_pid` <- Sys.getpid() if (is.null(cond$`_timestamp`)) cond$`_timestamp` <- Sys.time() # If we get here that means that the condition was not caught by # an exiting handler. That means that we need to create a trace. # If there is a hand-constructed trace already in the error object, # then we'll just leave it there. if (is.null(cond$trace)) cond <- add_trace_back(cond) # Set up environment to store .Last.error, it will be just before # baseenv(), so it is almost as if it was in baseenv() itself, like # .Last.value. We save the print methos here as well, and then they # will be found automatically. if (! "org:r-lib" %in% search()) { do.call("attach", list(new.env(), pos = length(search()), name = "org:r-lib")) } env <- as.environment("org:r-lib") env$.Last.error <- cond env$.Last.error.trace <- cond$trace # If we always wanted a trace, then we signal the condition here if (always_trace) signalCondition(cond) # Top-level handler, this is intended for testing only for now, # and its design might change. if (!is.null(th <- getOption("rlib_error_handler")) && is.function(th)) { th(cond) } else { if (is_interactive()) { # In interactive mode, we print the error message through # conditionMessage() and also add a note about .Last.error.trace. # R will potentially truncate the error message, so we make sure # that the note is shown. Ideally we would print the error # ourselves, but then RStudio would not highlight it. max_msg_len <- as.integer(getOption("warning.length")) if (is.na(max_msg_len)) max_msg_len <- 1000 msg <- conditionMessage(cond) adv <- style_advice( "\nType .Last.error.trace to see where the error occurred" ) dots <- "\033[0m\n[...]" if (bytes(msg) + bytes(adv) + bytes(dots) + 5L> max_msg_len) { msg <- paste0( substr(msg, 1, max_msg_len - bytes(dots) - bytes(adv) - 5L), dots ) } cond$message <- paste0(msg, adv) } else { # In non-interactive mode, we print the error + the traceback # manually, to make sure that it won't be truncated by R's error # message length limit. cat("\n", file = stderr()) cat(style_error(gettext("Error: ")), file = stderr()) out <- capture_output(print(cond)) cat(out, file = stderr(), sep = "\n") out <- capture_output(print(cond$trace)) cat(out, file = stderr(), sep = "\n") # Turn off the regular error printing to avoid printing # the error twice. opts <- options(show.error.messages = FALSE) on.exit(options(opts), add = TRUE) } # Dropping the classes and adding "duplicate_condition" is a workaround # for the case when we have non-exiting handlers on throw()-n # conditions. These would get the condition twice, because stop() # will also signal it. If we drop the classes, then only handlers # on "condition" objects (i.e. all conditions) get duplicate signals. # This is probably quite rare, but for this rare case they can also # recognize the duplicates from the "duplicate_condition" extra class. class(cond) <- c("duplicate_condition", "condition") stop(cond) } } # -- rethrowing conditions -------------------------------------------- #' Catch and re-throw conditions #' #' See [rethrow()] for a simpler interface that handles `error` #' conditions automatically. #' #' @noRd #' @param expr Expression to evaluate. #' @param ... Condition handler specification, the same way as in #' [withCallingHandlers()]. You are supposed to call [throw()] from #' the error handler, with a new error object, setting the original #' error object as parent. See examples below. #' @param call Logical flag, whether to add the call to #' `catch_rethrow()` to the error. #' @examples #' f <- function() { #' ... #' err$catch_rethrow( #' ... code that potentially errors ..., #' error = function(e) { #' throw(new_error("This will be the child error"), parent = e) #' } #' ) #' } catch_rethrow <- function(expr, ..., call = TRUE) { realcall <- if (isTRUE(call)) sys.call(-1) %||% sys.call() realframe <- sys.nframe() parent <- parent.frame() cl <- match.call() cl[[1]] <- quote(withCallingHandlers) handlers <- list(...) for (h in names(handlers)) { cl[[h]] <- function(e) { # This will be NULL if the error is not throw()-n if (is.null(e$`_nframe`)) e$`_nframe` <- length(sys.calls()) e$`_childcall` <- realcall e$`_childframe` <- realframe # We drop after realframe, until the first withCallingHandlers wch <- find_call(sys.calls(), quote(withCallingHandlers)) if (!is.na(wch)) e$`_childignore` <- list(c(realframe + 1L, wch)) handlers[[h]](e) } } eval(cl, envir = parent) } find_call <- function(calls, call) { which(vapply( calls, function(x) length(x) >= 1 && identical(x[[1]], call), logical(1)))[1] } #' Catch and re-throw conditions #' #' `rethrow()` is similar to [catch_rethrow()], but it has a simpler #' interface. It catches conditions with class `error`, and re-throws #' `cond` instead, using the original condition as the parent. #' #' @noRd #' @param expr Expression to evaluate. #' @param ... Condition handler specification, the same way as in #' [withCallingHandlers()]. #' @param call Logical flag, whether to add the call to #' `rethrow()` to the error. rethrow <- function(expr, cond, call = TRUE) { realcall <- if (isTRUE(call)) sys.call(-1) %||% sys.call() realframe <- sys.nframe() withCallingHandlers( expr, error = function(e) { # This will be NULL if the error is not throw()-n if (is.null(e$`_nframe`)) e$`_nframe` <- length(sys.calls()) e$`_childcall` <- realcall e$`_childframe` <- realframe # We just ignore the withCallingHandlers call, and the tail e$`_childignore` <- list( c(realframe + 1L, realframe + 1L), c(e$`_nframe` + 1L, sys.nframe() + 1L)) throw(cond, parent = e) } ) } #' Version of .Call that throw()s errors #' #' It re-throws error from interpreted code. If the error had class #' `simpleError`, like all errors, thrown via `error()` in C do, it also #' adds the `c_error` class. #' #' @noRd #' @param .NAME Compiled function to call, see [.Call()]. #' @param ... Function arguments, see [.Call()]. #' @return Result of the call. rethrow_call <- function(.NAME, ...) { call <- sys.call() nframe <- sys.nframe() withCallingHandlers( # do.call to work around an R CMD check issue do.call(".Call", list(.NAME, ...)), error = function(e) { e$`_nframe` <- nframe e$call <- call if (inherits(e, "simpleError")) { class(e) <- c("c_error", "rlib_error_2_0", "rlib_error", "error", "condition") } e$`_ignore` <- list(c(nframe + 1L, sys.nframe() + 1L)) throw(e) } ) } package_env <- topenv() #' Version of rethrow_call that supports cleancall #' #' This function is the same as [rethrow_call()], except that it #' uses cleancall's [.Call()] wrapper, to enable resource cleanup. #' See https://github.com/r-lib/cleancall#readme for more about #' resource cleanup. #' #' @noRd #' @param .NAME Compiled function to call, see [.Call()]. #' @param ... Function arguments, see [.Call()]. #' @return Result of the call. rethrow_call_with_cleanup <- function(.NAME, ...) { call <- sys.call() nframe <- sys.nframe() withCallingHandlers( package_env$call_with_cleanup(.NAME, ...), error = function(e) { e$`_nframe` <- nframe e$call <- call if (inherits(e, "simpleError")) { class(e) <- c("c_error", "rlib_error_2_0", "rlib_error", "error", "condition") } e$`_ignore` <- list(c(nframe + 1L, sys.nframe() + 1L)) throw(e) } ) } # -- create traceback ------------------------------------------------- #' Create a traceback #' #' [throw()] calls this function automatically if an error is not caught, #' so there is currently not much use to call it directly. #' #' @param cond Condition to add the trace to #' @param embed Whether to embed calls into the condition. #' #' @return A condition object, with the trace added. add_trace_back <- function( cond, embed = getOption("rlib_error_embed_calls", FALSE)) { idx <- seq_len(sys.parent(1L)) frames <- sys.frames()[idx] parents <- sys.parents()[idx] calls <- as.list(sys.calls()[idx]) envs <- lapply(frames, env_label) topenvs <- lapply( seq_along(frames), function(i) env_label(topenvx(environment(sys.function(i))))) nframes <- if (!is.null(cond$`_nframe`)) cond$`_nframe` else sys.parent() messages <- list(conditionMessage(cond)) ignore <- cond$`_ignore` classes <- class(cond) pids <- rep(cond$`_pid` %||% Sys.getpid(), length(calls)) if (!embed) calls <- as.list(format_calls(calls, topenvs, nframes)) if (is.null(cond$parent)) { # Nothing to do, no parent } else if (is.null(cond$parent$trace) || !inherits(cond$parent, "rlib_error_2_0")) { # If the parent does not have a trace, that means that it is using # the same trace as us. We ignore traces from non-r-lib errors. # E.g. rlang errors have a trace, but we do not use that. parent <- cond while (!is.null(parent <- parent$parent)) { nframes <- c(nframes, parent$`_nframe`) messages <- c(messages, list(conditionMessage(parent))) ignore <- c(ignore, parent$`_ignore`) } } else { # If it has a trace, that means that it is coming from another # process or top level evaluation. In this case we'll merge the two # traces. pt <- cond$parent$trace parents <- c(parents, pt$parents + length(calls)) nframes <- c(nframes, pt$nframes + length(calls)) ignore <- c(ignore, lapply(pt$ignore, function(x) x + length(calls))) envs <- c(envs, pt$envs) topenvs <- c(topenvs, pt$topenvs) calls <- c(calls, pt$calls) messages <- c(messages, pt$messages) pids <- c(pids, pt$pids) } cond$trace <- new_trace( calls, parents, envs, topenvs, nframes, messages, ignore, classes, pids) cond } topenvx <- function(x) { topenv(x, matchThisEnv = err_env) } new_trace <- function (calls, parents, envs, topenvs, nframes, messages, ignore, classes, pids) { indices <- seq_along(calls) structure( list(calls = calls, parents = parents, envs = envs, topenvs = topenvs, indices = indices, nframes = nframes, messages = messages, ignore = ignore, classes = classes, pids = pids), class = c("rlib_trace_2_0", "rlib_trace")) } env_label <- function(env) { nm <- env_name(env) if (nzchar(nm)) { nm } else { env_address(env) } } env_address <- function(env) { class(env) <- "environment" sub("^.*(0x[0-9a-f]+)>$", "\\1", format(env), perl = TRUE) } env_name <- function(env) { if (identical(env, err_env)) { return("") } if (identical(env, globalenv())) { return("global") } if (identical(env, baseenv())) { return("namespace:base") } if (identical(env, emptyenv())) { return("empty") } nm <- environmentName(env) if (isNamespace(env)) { return(paste0("namespace:", nm)) } nm } # -- printing --------------------------------------------------------- print_this <- function(x, ...) { msg <- conditionMessage(x) call <- conditionCall(x) cl <- class(x)[1L] if (!is.null(call)) { cat("<", cl, " in ", format_call(call), ":\n ", msg, ">\n", sep = "") } else { cat("<", cl, ": ", msg, ">\n", sep = "") } print_srcref(x$call) if (!identical(x$`_pid`, Sys.getpid())) { cat(" in process", x$`_pid`, "\n") } invisible(x) } print_parents <- function(x, ...) { if (!is.null(x$parent)) { cat("-->\n") print(x$parent) } invisible(x) } print_rlib_error_2_0 <- function(x, ...) { print_this(x, ...) print_parents(x, ...) } format_calls <- function(calls, topenv, nframes, messages = NULL) { calls <- map2(calls, topenv, namespace_calls) callstr <- vapply(calls, format_call_src, character(1)) if (!is.null(messages)) { callstr[nframes] <- paste0(callstr[nframes], "\n", style_error_msg(messages), "\n") } callstr } print_rlib_trace_2_0 <- function(x, ...) { cl <- paste0(" Stack trace:") cat(sep = "", "\n", style_trace_title(cl), "\n\n") callstr <- enumerate( format_calls(x$calls, x$topenv, x$nframes, x$messages) ) # Ignore what we were told to ignore ign <- integer() for (iv in x$ignore) { if (iv[2] == Inf) iv[2] <- length(callstr) ign <- c(ign, iv[1]:iv[2]) } # Plus always ignore the tail. This is not always good for # catch_rethrow(), but should be good otherwise last_err_frame <- x$nframes[length(x$nframes)] if (!is.na(last_err_frame) && last_err_frame < length(callstr)) { ign <- c(ign, (last_err_frame+1):length(callstr)) } ign <- unique(ign) if (length(ign)) callstr <- callstr[-ign] # Add markers for subprocesses if (length(unique(x$pids)) >= 2) { pids <- x$pids[-ign] pid_add <- which(!duplicated(pids)) pid_str <- style_process(paste0("Process ", pids[pid_add], ":")) callstr[pid_add] <- paste0(" ", pid_str, "\n", callstr[pid_add]) } cat(callstr, sep = "\n") invisible(x) } capture_output <- function(expr) { if (has_cli()) { opts <- options(cli.num_colors = cli::num_ansi_colors()) on.exit(options(opts), add = TRUE) } out <- NULL file <- textConnection("out", "w", local = TRUE) sink(file) on.exit(sink(NULL), add = TRUE) expr if (is.null(out)) invisible(NULL) else out } is_interactive <- function() { opt <- getOption("rlib_interactive") if (isTRUE(opt)) { TRUE } else if (identical(opt, FALSE)) { FALSE } else if (tolower(getOption("knitr.in.progress", "false")) == "true") { FALSE } else if (tolower(getOption("rstudio.notebook.executing", "false")) == "true") { FALSE } else if (identical(Sys.getenv("TESTTHAT"), "true")) { FALSE } else { interactive() } } onload_hook <- function() { reg_env <- Sys.getenv("R_LIB_ERROR_REGISTER_PRINT_METHODS", "TRUE") if (tolower(reg_env) != "false") { registerS3method("print", "rlib_error_2_0", print_rlib_error_2_0, baseenv()) registerS3method("print", "rlib_trace_2_0", print_rlib_trace_2_0, baseenv()) } } namespace_calls <- function(call, env) { if (length(call) < 1) return(call) if (typeof(call[[1]]) != "symbol") return(call) pkg <- strsplit(env, "^namespace:")[[1]][2] if (is.na(pkg)) return(call) call[[1]] <- substitute(p:::f, list(p = as.symbol(pkg), f = call[[1]])) call } print_srcref <- function(call) { src <- format_srcref(call) if (length(src)) cat(sep = "", " ", src, "\n") } `%||%` <- function(l, r) if (is.null(l)) r else l format_srcref <- function(call) { if (is.null(call)) return(NULL) file <- utils::getSrcFilename(call) if (!length(file)) return(NULL) dir <- utils::getSrcDirectory(call) if (length(dir) && nzchar(dir) && nzchar(file)) { srcfile <- attr(utils::getSrcref(call), "srcfile") if (isTRUE(srcfile$isFile)) { file <- file.path(dir, file) } else { file <- file.path("R", file) } } else { file <- "??" } line <- utils::getSrcLocation(call) %||% "??" col <- utils::getSrcLocation(call, which = "column") %||% "??" style_srcref(paste0(file, ":", line, ":", col)) } format_call <- function(call) { width <- getOption("width") str <- format(call) callstr <- if (length(str) > 1 || nchar(str[1]) > width) { paste0(substr(str[1], 1, width - 5), " ...") } else { str[1] } style_call(callstr) } format_call_src <- function(call) { callstr <- format_call(call) src <- format_srcref(call) if (length(src)) callstr <- paste0(callstr, "\n ", src) callstr } enumerate <- function(x) { paste0(style_numbers(paste0(" ", seq_along(x), ". ")), x) } map2 <- function (.x, .y, .f, ...) { mapply(.f, .x, .y, MoreArgs = list(...), SIMPLIFY = FALSE, USE.NAMES = FALSE) } bytes <- function(x) { nchar(x, type = "bytes") } # -- printing, styles ------------------------------------------------- has_cli <- function() "cli" %in% loadedNamespaces() style_numbers <- function(x) { if (has_cli()) cli::col_silver(x) else x } style_advice <- function(x) { if (has_cli()) cli::col_silver(x) else x } style_srcref <- function(x) { if (has_cli()) cli::style_italic(cli::col_cyan(x)) } style_error <- function(x) { if (has_cli()) cli::style_bold(cli::col_red(x)) else x } style_error_msg <- function(x) { sx <- paste0("\n x ", x, " ") style_error(sx) } style_trace_title <- function(x) { x } style_process <- function(x) { if (has_cli()) cli::style_bold(x) else x } style_call <- function(x) { if (!has_cli()) return(x) call <- sub("^([^(]+)[(].*$", "\\1", x) rest <- sub("^[^(]+([(].*)$", "\\1", x) if (call == x || rest == x) return(x) paste0(cli::col_yellow(call), rest) } err_env <- environment() parent.env(err_env) <- baseenv() structure( list( .internal = err_env, new_cond = new_cond, new_error = new_error, throw = throw, rethrow = rethrow, catch_rethrow = catch_rethrow, rethrow_call = rethrow_call, add_trace_back = add_trace_back, onload_hook = onload_hook, print_this = print_this, print_parents = print_parents ), class = c("standalone_errors", "standalone")) }) # These are optional, and feel free to remove them if you prefer to # call them through the `err` object. new_cond <- err$new_cond new_error <- err$new_error throw <- err$throw rethrow <- err$rethrow rethrow_call <- err$rethrow_call rethrow_call_with_cleanup <- err$.internal$rethrow_call_with_cleanup processx/R/on-load.R0000644000176200001440000000123613703607776014017 0ustar liggesusers ## nocov start .onLoad <- function(libname, pkgname) { ## This is needed to fix the boot time to a given value, ## because in a Docker container (maybe elsewhere as well?) on ## Linux it can change (!). ## See https://github.com/r-lib/processx/issues/258 if (ps::ps_is_supported()) { ps::ps_handle() bt <- ps::ps_boot_time() .Call(c_processx__set_boot_time, bt) } supervisor_reset() if (Sys.getenv("DEBUGME", "") != "" && requireNamespace("debugme", quietly = TRUE)) { debugme::debugme() } err$onload_hook() } .onUnload <- function(libpath) { rethrow_call(c_processx__unload_cleanup) supervisor_reset() } ## nocov end processx/R/run.R0000644000176200001440000004541014043035105013247 0ustar liggesusers#' Run external command, and wait until finishes #' #' `run` provides an interface similar to [base::system()] and #' [base::system2()], but based on the [process] class. This allows some #' extra features, see below. #' #' `run` supports #' * Specifying a timeout for the command. If the specified time has #' passed, and the process is still running, it will be killed #' (with all its child processes). #' * Calling a callback function for each line or each chunk of the #' standard output and/or error. A chunk may contain multiple lines, and #' can be as short as a single character. #' * Cleaning up the subprocess, or the whole process tree, before exiting. #' #' @section Callbacks: #' #' Some notes about the callback functions. The first argument of a #' callback function is a character scalar (length 1 character), a single #' output or error line. The second argument is always the [process] #' object. You can manipulate this object, for example you can call #' `$kill()` on it to terminate it, as a response to a message on the #' standard output or error. #' #' @section Error conditions: #' #' `run()` throws error condition objects if the process is interrupted, #' timeouts or fails (if `error_on_status` is `TRUE`): #' * On interrupt, a condition with classes `system_command_interrupt`, #' `interrupt`, `condition` is signalled. This can be caught with #' `tryCatch(..., interrupt = ...)`. #' * On timeout, a condition with classes `system_command_timeout_error`, #' `system_command_error`, `error`, `condition` is thrown. #' * On error (if `error_on_status` is `TRUE`), an error with classes #' `system_command_status_error`, `system_command_error`, `error`, #' `condition` is thrown. #' #' All of these conditions have the fields: #' * `message`: the error message, #' * `stderr`: the standard error of the process, or the standard output #' of the process if `stderr_to_stdout` was `TRUE`. #' * `call`: the captured call to `run()`. #' * `echo`: the value of the `echo` argument. #' * `stderr_to_stdout`: the value of the `stderr_to_stdout` argument. #' * `status`: the exit status for `system_command_status_error` errors. #' #' @param command Character scalar, the command to run. If you are #' running `.bat` or `.cmd` files on Windows, make sure you read the #' 'Batch files' section in the [process] manual page. #' @param args Character vector, arguments to the command. #' @param error_on_status Whether to throw an error if the command returns #' with a non-zero status, or it is interrupted. The error classes are #' `system_command_status_error` and `system_command_timeout_error`, #' respectively, and both errors have class `system_command_error` as #' well. See also "Error conditions" below. #' @param wd Working directory of the process. If `NULL`, the current #' working directory is used. #' @param echo_cmd Whether to print the command to run to the screen. #' @param echo Whether to print the standard output and error #' to the screen. Note that the order of the standard output and error #' lines are not necessarily correct, as standard output is typically #' buffered. If the standard output and/or error is redirected to a #' file or they are ignored, then they also not echoed. #' @param spinner Whether to show a reassuring spinner while the process #' is running. #' @param timeout Timeout for the process, in seconds, or as a `difftime` #' object. If it is not finished before this, it will be killed. #' @param stdout What to do with the standard output. By default it #' is collected in the result, and you can also use the #' `stdout_line_callback` and `stdout_callback` arguments to pass #' callbacks for output. If it is the empty string (`""`), then #' the child process inherits the standard output stream of the #' R process. (If the main R process does not have a standard output #' stream, e.g. in RGui on Windows, then an error is thrown.) #' If it is `NULL`, then standard output is discarded. If it is a string #' other than `"|"` and `""`, then it is taken as a file name and the #' output is redirected to this file. #' @param stderr What to do with the standard error. By default it #' is collected in the result, and you can also use the #' `stderr_line_callback` and `stderr_callback` arguments to pass #' callbacks for output. If it is the empty string (`""`), then #' the child process inherits the standard error stream of the #' R process. (If the main R process does not have a standard error #' stream, e.g. in RGui on Windows, then an error is thrown.) #' If it is `NULL`, then standard error is discarded. If it is a string #' other than `"|"` and `""`, then it is taken as a file name and the #' standard error is redirected to this file. #' @param stdout_line_callback `NULL`, or a function to call for every #' line of the standard output. See `stdout_callback` and also more #' below. #' @param stdout_callback `NULL`, or a function to call for every chunk #' of the standard output. A chunk can be as small as a single character. #' At most one of `stdout_line_callback` and `stdout_callback` can be #' non-`NULL`. #' @param stderr_line_callback `NULL`, or a function to call for every #' line of the standard error. See `stderr_callback` and also more #' below. #' @param stderr_callback `NULL`, or a function to call for every chunk #' of the standard error. A chunk can be as small as a single character. #' At most one of `stderr_line_callback` and `stderr_callback` can be #' non-`NULL`. #' @param stderr_to_stdout Whether to redirect the standard error to the #' standard output. Specifying `TRUE` here will keep both in the #' standard output, correctly interleaved. However, it is not possible #' to deduce where pieces of the output were coming from. If this is #' `TRUE`, the standard error callbacks (if any) are never called. #' @param env Environment variables of the child process. If `NULL`, #' the parent's environment is inherited. On Windows, many programs #' cannot function correctly if some environment variables are not #' set, so we always set `HOMEDRIVE`, `HOMEPATH`, `LOGONSERVER`, #' `PATH`, `SYSTEMDRIVE`, `SYSTEMROOT`, `TEMP`, `USERDOMAIN`, #' `USERNAME`, `USERPROFILE` and `WINDIR`. To append new environment #' variables to the ones set in the current process, specify #' `"current"` in `env`, without a name, and the appended ones with #' names. The appended ones can overwrite the current ones. #' @param windows_verbatim_args Whether to omit the escaping of the #' command and the arguments on windows. Ignored on other platforms. #' @param windows_hide_window Whether to hide the window of the #' application on windows. Ignored on other platforms. #' @param encoding The encoding to assume for `stdout` and #' `stderr`. By default the encoding of the current locale is #' used. Note that `processx` always reencodes the output of #' both streams in UTF-8 currently. #' @param cleanup_tree Whether to clean up the child process tree after #' the process has finished. #' @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 #' `stdout_callback`, `stderr_callback`, etc. arguments to manage #' the standard output and error, or the [process] class directly #' if you need more flexibility. #' @return A list with components: #' * status The exit status of the process. If this is `NA`, then the #' process was killed and had no exit status. #' * stdout The standard output of the command, in a character scalar. #' * stderr The standard error of the command, in a character scalar. #' * timeout Whether the process was killed because of a timeout. #' #' @export #' @examplesIf .Platform$OS.type == "unix" #' # This works on Unix systems #' run("ls") #' system.time(run("sleep", "10", timeout = 1, error_on_status = FALSE)) #' system.time( #' run( #' "sh", c("-c", "for i in 1 2 3 4 5; do echo $i; sleep 1; done"), #' timeout = 2, error_on_status = FALSE #' ) #' ) #' #' @examplesIf FALSE #' # This works on Windows systems, if the ping command is available #' run("ping", c("-n", "1", "127.0.0.1")) #' run("ping", c("-n", "6", "127.0.0.1"), timeout = 1, #' error_on_status = FALSE) run <- function( command = NULL, args = character(), error_on_status = TRUE, wd = NULL, echo_cmd = FALSE, echo = FALSE, spinner = FALSE, timeout = Inf, stdout = "|", stderr = "|", stdout_line_callback = NULL, stdout_callback = NULL, 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, ...) { assert_that(is_flag(error_on_status)) assert_that(is_time_interval(timeout)) assert_that(is_flag(spinner)) assert_that(is_string_or_null(stdout)) assert_that(is_string_or_null(stderr)) assert_that(is.null(stdout_line_callback) || is.function(stdout_line_callback)) assert_that(is.null(stderr_line_callback) || is.function(stderr_line_callback)) 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_flag(stderr_to_stdout)) ## The rest is checked by process$new() "!DEBUG run() Checked arguments" if (!interactive()) spinner <- FALSE ## Run the process if (stderr_to_stdout) stderr <- "2>&1" pr <- process$new( command, args, echo_cmd = echo_cmd, wd = wd, windows_verbatim_args = windows_verbatim_args, windows_hide_window = windows_hide_window, stdout = stdout, stderr = stderr, env = env, encoding = encoding, cleanup_tree = cleanup_tree, ... ) "#!DEBUG run() Started the process: `pr$get_pid()`" ## We make sure that the process is eliminated if (cleanup_tree) { on.exit(pr$kill_tree(), add = TRUE) } else { on.exit(pr$kill(), add = TRUE) } ## If echo, then we need to create our own callbacks. ## These are merged to user callbacks if there are any. if (echo) { stdout_callback <- echo_callback(stdout_callback, "stdout") stderr_callback <- echo_callback(stderr_callback, "stderr") } ## Make the process interruptible, and kill it on interrupt runcall <- sys.call() resenv <- new.env(parent = emptyenv()) has_stdout <- !is.null(stdout) && stdout == "|" has_stderr <- !is.null(stderr) && stderr %in% c("|", "2>&1") if (has_stdout) { resenv$outbuf <- make_buffer() on.exit(resenv$outbuf$done(), add = TRUE) } if (has_stderr) { resenv$errbuf <- make_buffer() on.exit(resenv$errbuf$done(), add = TRUE) } res <- tryCatch( run_manage(pr, timeout, spinner, stdout, stderr, stdout_line_callback, stdout_callback, stderr_line_callback, stderr_callback, resenv), interrupt = function(e) { "!DEBUG run() process `pr$get_pid()` killed on interrupt" out <- if (has_stdout) { resenv$outbuf$push(pr$read_output()) resenv$outbuf$push(pr$read_output()) resenv$outbuf$read() } err <- if (has_stderr) { resenv$errbuf$push(pr$read_error()) resenv$errbuf$push(pr$read_error()) resenv$errbuf$read() } tryCatch(pr$kill(), error = function(e) NULL) signalCondition(new_process_interrupt_cond( list( interrupt = TRUE, stderr = err, stdout = out, command = command, args = args ), runcall, echo = echo, stderr_to_stdout = stderr_to_stdout )) cat("\n") invokeRestart("abort") } ) if (error_on_status && (is.na(res$status) || res$status != 0)) { "!DEBUG run() error on status `res$status` for process `pr$get_pid()`" throw(new_process_error(res, call = sys.call(), echo = echo, stderr_to_stdout, res$status, command = command, args = args)) } res } echo_callback <- function(user_callback, type) { force(user_callback) force(type) function(x, ...) { if (type == "stderr" && has_package("cli")) x <- cli::col_red(x) cat(x, sep = "") if (!is.null(user_callback)) user_callback(x, ...) } } run_manage <- function(proc, timeout, spinner, stdout, stderr, stdout_line_callback, stdout_callback, stderr_line_callback, stderr_callback, resenv) { timeout <- as.difftime(timeout, units = "secs") start_time <- proc$get_start_time() has_stdout <- !is.null(stdout) && stdout == "|" has_stderr <- !is.null(stderr) && stderr %in% c("|", "2>&1") pushback_out <- "" pushback_err <- "" do_output <- function() { ok <- FALSE if (has_stdout) { newout <- tryCatch({ ret <- proc$read_output(2000) ok <- TRUE ret }, error = function(e) NULL) if (length(newout) && nzchar(newout)) { if (!is.null(stdout_callback)) stdout_callback(newout, proc) resenv$outbuf$push(newout) if (!is.null(stdout_line_callback)) { newout <- paste0(pushback_out, newout) pushback_out <<- "" lines <- strsplit(newout, "\r?\n")[[1]] if (last_char(newout) != "\n") { pushback_out <<- utils::tail(lines, 1) lines <- utils::head(lines, -1) } lapply(lines, function(x) stdout_line_callback(x, proc)) } } } if (has_stderr) { newerr <- tryCatch({ ret <- proc$read_error(2000) ok <- TRUE ret }, error = function(e) NULL) if (length(newerr) && nzchar(newerr)) { resenv$errbuf$push(newerr) if (!is.null(stderr_callback)) stderr_callback(newerr, proc) if (!is.null(stderr_line_callback)) { newerr <- paste0(pushback_err, newerr) pushback_err <<- "" lines <- strsplit(newerr, "\r?\n")[[1]] if (last_char(newerr) != "\n") { pushback_err <<- utils::tail(lines, 1) lines <- utils::head(lines, -1) } lapply(lines, function(x) stderr_line_callback(x, proc)) } } } ok } spin <- (function() { state <- 1L phases <- c("-", "\\", "|", "/") function() { cat("\r", phases[state], "\r", sep = "") state <<- state %% length(phases) + 1L utils::flush.console() } })() timeout_happened <- FALSE while (proc$is_alive()) { ## Timeout? Maybe finished by now... if (!is.null(timeout) && is.finite(timeout) && Sys.time() - start_time > timeout) { if (proc$kill(close_connections = FALSE)) timeout_happened <- TRUE "!DEBUG Timeout killed run() process `proc$get_pid()`" break } ## Otherwise just poll for 200ms, or less if a timeout is sooner. ## We cannot poll until the end, even if there is not spinner, ## because RStudio does not send a SIGINT to the R process, ## so interruption does not work. if (!is.null(timeout) && timeout < Inf) { remains <- timeout - (Sys.time() - start_time) remains <- max(0, as.integer(as.numeric(remains) * 1000)) if (spinner) remains <- min(remains, 200) } else { remains <- 200 } "!DEBUG run is polling for `remains` ms, process `proc$get_pid()`" polled <- proc$poll_io(remains) ## If output/error, then collect it if (any(polled == "ready")) do_output() if (spinner) spin() } ## Needed to get the exit status "!DEBUG run() waiting to get exit status, process `proc$get_pid()`" proc$wait() ## We might still have output "!DEBUG run() reading leftover output / error, process `proc$get_pid()`" while ((has_stdout && proc$is_incomplete_output()) || (proc$has_error_connection() && proc$is_incomplete_error())) { proc$poll_io(-1) if (!do_output()) break } if (spinner) cat("\r \r") list( status = proc$get_exit_status(), stdout = if (has_stdout) resenv$outbuf$read(), stderr = if (has_stderr) resenv$errbuf$read(), timeout = timeout_happened ) } new_process_error <- function(result, call, echo, stderr_to_stdout, status = NA_integer_, command, args) { if (isTRUE(result$timeout)) { new_process_timeout_error(result, call, echo, stderr_to_stdout, status, command, args) } else { new_process_status_error(result, call, echo, stderr_to_stdout, status, command, args) } } new_process_status_error <- function(result, call, echo, stderr_to_stdout, status = NA_integer_, command, args) { err <- new_error( "System command '", basename(command), "' failed", call. = call ) err$stderr <- if (stderr_to_stdout) result$stdout else result$stderr err$echo <- echo err$stderr_to_stdout <- stderr_to_stdout err$status <- status add_class(err, c("system_command_status_error", "system_command_error")) } new_process_interrupt_cond <- function(result, call, echo, stderr_to_stdout, status = NA_integer_) { cond <- new_cond( "System command '", basename(result$command), "' interrupted", call. = call ) cond$stderr <- if (stderr_to_stdout) result$stdout else result$stderr cond$echo <- echo cond$stderr_to_stdout <- stderr_to_stdout cond$status <- status add_class(cond, c("system_command_interrupt", "interrupt")) } new_process_timeout_error <- function(result, call, echo, stderr_to_stdout, status = NA_integer_, command, args) { err <- new_error( "System command '", basename(command), "' timed out", call. = call) err$stderr <- if (stderr_to_stdout) result$stdout else result$stderr err$echo <- echo err$stderr_to_stdout <- stderr_to_stdout err$status <- status add_class(err, c("system_command_timeout_error", "system_command_error")) } #' @export conditionMessage.system_command_error <- function(c) { paste(format(c), collapse = "\n") } #' @export format.system_command_error <- function(x, ...) { parts <- system_error_parts(x) } #' @export print.system_command_error <- function(x, ...) { cat(format(x, ...), sep = "\n") } system_error_parts <- function(x) { exit <- if (!is.na(x$status)) paste0(", exit status: ", x$status) msg <- paste0(x$message, exit) parts <- if (x$echo) { paste0(msg, ", stdout & stderr were printed") } else { std <- if (x$stderr_to_stdout) "stdout + stderr" else "stderr" out <- last_stderr_lines(x$stderr, std) c(paste0(msg, out[1]), out[-1]) } } last_stderr_lines <- function(text, std) { if (!nzchar(text)) return(paste0(", ", std, " empty")) lines <- strsplit(text, "\r?\n")[[1]] if (is_interactive()) { pref <- paste0( ", ", std, if (length(lines) > 10) " (last 10 lines)", ":") out <- paste0("E> ", utils::tail(lines, 10)) c(pref, out) } else { out <- paste0("E> ", lines) c(paste0(", ", std, ":"), out) } } processx/R/base64.R0000644000176200001440000000067613616314040013537 0ustar liggesusers #' Base64 Encoding and Decoding #' #' @param x Raw vector to encode / decode. #' @return Raw vector, result of the encoding / decoding. #' #' @export base64_decode <- function(x) { if (is.character(x)) { x <- charToRaw(paste(gsub("\\s+", "", x), collapse = "")) } rethrow_call(c_processx_base64_decode, x) } #' @export #' @rdname base64_decode base64_encode <- function(x) { rawToChar(rethrow_call(c_processx_base64_encode, x)) } processx/R/process.R0000644000176200001440000007613314043035025014130 0ustar liggesusers #' @useDynLib processx, .registration = TRUE, .fixes = "c_" NULL ## Workaround an R CMD check false positive dummy_r6 <- function() R6::R6Class #' External process #' #' @description #' Managing external processes from R is not trivial, and this #' class aims to help with this deficiency. It is essentially a small #' wrapper around the `system` base R function, to return the process #' id of the started process, and set its standard output and error #' streams. The process id is then used to manage the process. #' #' @param n Number of characters or lines to read. #' @param grace Currently not used. #' @param close_connections Whether to close standard input, standard #' output, standard error connections and the poll connection, after #' killing the process. #' @param timeout Timeout in milliseconds, for the wait or the I/O #' polling. #' #' @section Batch files: #' Running Windows batch files (`.bat` or `.cmd` files) may be complicated #' because of the `cmd.exe` command line parsing rules. For example you #' cannot easily have whitespace in both the command (path) and one of the #' arguments. To work around these limitations you need to start a #' `cmd.exe` shell explicitly and use its `call` command. For example: #' #' ```r #' process$new("cmd.exe", c("/c", "call", bat_file, "arg 1", "arg 2")) #' ``` #' #' This works even if `bat_file` contains whitespace characters. #' #' @section Polling: #' The `poll_io()` function polls the standard output and standard #' error connections of a process, with a timeout. If there is output #' in either of them, or they are closed (e.g. because the process exits) #' `poll_io()` returns immediately. #' #' In addition to polling a single process, the [poll()] function #' can poll the output of several processes, and returns as soon as any #' of them has generated output (or exited). #' #' @section Cleaning up background processes: #' processx kills processes that are not referenced any more (if `cleanup` #' is set to `TRUE`), or the whole subprocess tree (if `cleanup_tree` is #' also set to `TRUE`). #' #' The cleanup happens when the references of the processes object are #' garbage collected. To clean up earlier, you can call the `kill()` or #' `kill_tree()` method of the process(es), from an `on.exit()` expression, #' or an error handler: #' ```r #' process_manager <- function() { #' on.exit({ #' try(p1$kill(), silent = TRUE) #' try(p2$kill(), silent = TRUE) #' }, add = TRUE) #' p1 <- process$new("sleep", "3") #' p2 <- process$new("sleep", "10") #' p1$wait() #' p2$wait() #' } #' process_manager() #' ``` #' #' If you interrupt `process_manager()` or an error happens then both `p1` #' and `p2` are cleaned up immediately. Their connections will also be #' closed. The same happens at a regular exit. #' #' @export #' @examplesIf identical(Sys.getenv("IN_PKGDOWN"), "true") #' p <- process$new("sleep", "2") #' p$is_alive() #' p #' p$kill() #' p$is_alive() #' #' p <- process$new("sleep", "1") #' p$is_alive() #' Sys.sleep(2) #' p$is_alive() process <- R6::R6Class( "process", cloneable = FALSE, public = list( #' @description #' Start a new process in the background, and then return immediately. #' #' @return R6 object representing the process. #' @param command Character scalar, the command to run. #' Note that this argument is not passed to a shell, so no #' tilde-expansion or variable substitution is performed on it. #' It should not be quoted with [base::shQuote()]. See #' [base::normalizePath()] for tilde-expansion. If you want to run #' `.bat` or `.cmd` files on Windows, make sure you read the #' 'Batch files' section above. #' @param args Character vector, arguments to the command. They will be #' passed to the process as is, without a shell transforming them, #' They don't need to be escaped. #' @param stdin What to do with the standard input. Possible values: #' * `NULL`: set to the _null device_, i.e. no standard input is #' provided; #' * a file name, use this file as standard input; #' * `"|"`: create a (writeable) connection for stdin. #' * `""` (empty string): inherit it from the main R process. If the #' main R process does not have a standard input stream, e.g. in #' RGui on Windows, then an error is thrown. #' @param stdout What to do with the standard output. Possible values: #' * `NULL`: discard it; #' * a string, redirect it to this file; #' * `"|"`: create a connection for it. #' * `""` (empty string): inherit it from the main R process. If the #' main R process does not have a standard output stream, e.g. in #' RGui on Windows, then an error is thrown. #' @param stderr What to do with the standard error. Possible values: #' * `NULL`: discard it; #' * a string, redirect it to this file; #' * `"|"`: create a connection for it; #' * `"2>&1"`: redirect it to the same connection (i.e. pipe or file) #' as `stdout`. `"2>&1"` is a way to keep standard output and error #' correctly interleaved. #' * `""` (empty string): inherit it from the main R process. If the #' main R process does not have a standard error stream, e.g. in #' RGui on Windows, then an error is thrown. #' @param pty Whether to create a pseudo terminal (pty) for the #' background process. This is currently only supported on Unix #' systems, but not supported on Solaris. #' If it is `TRUE`, then the `stdin`, `stdout` and `stderr` arguments #' must be `NULL`. If a pseudo terminal is created, then processx #' will create pipes for standard input and standard output. There is #' no separate pipe for standard error, because there is no way to #' distinguish between stdout and stderr on a pty. Note that the #' standard output connection of the pty is _blocking_, so we always #' poll the standard output connection before reading from it using #' the `$read_output()` method. Also, because `$read_output_lines()` #' could still block if no complete line is available, this function #' always fails if the process has a pty. Use `$read_output()` to #' read from ptys. #' @param pty_options Unix pseudo terminal options, a named list. see #' [default_pty_options()] for details and defaults. #' @param connections A list of processx connections to pass to the #' child process. This is an experimental feature currently. #' @param poll_connection Whether to create an extra connection to the #' process that allows polling, even if the standard input and #' standard output are not pipes. If this is `NULL` (the default), #' then this connection will be only created if standard output and #' standard error are not pipes, and `connections` is an empty list. #' If the poll connection is created, you can query it via #' `p$get_poll_connection()` and it is also included in the response #' to `p$poll_io()` and [poll()]. The numeric file descriptor of the #' poll connection comes right after `stderr` (2), and the #' connections listed in `connections`. #' @param env Environment variables of the child process. If `NULL`, #' the parent's environment is inherited. On Windows, many programs #' cannot function correctly if some environment variables are not #' set, so we always set `HOMEDRIVE`, `HOMEPATH`, `LOGONSERVER`, #' `PATH`, `SYSTEMDRIVE`, `SYSTEMROOT`, `TEMP`, `USERDOMAIN`, #' `USERNAME`, `USERPROFILE` and `WINDIR`. To append new environment #' variables to the ones set in the current process, specify #' `"current"` in `env`, without a name, and the appended ones with #' names. The appended ones can overwrite the current ones. #' @param cleanup Whether to kill the process when the `process` #' 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 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 #' running it. #' @param supervise Whether to register the process with a supervisor. #' If `TRUE`, the supervisor will ensure that the process is #' killed when the R process exits. #' @param windows_verbatim_args Whether to omit quoting the arguments #' on Windows. It is ignored on other platforms. #' @param windows_hide_window Whether to hide the application's window #' on Windows. It is ignored on other platforms. #' @param windows_detached_process Whether to use the #' `DETACHED_PROCESS` flag on Windows. If this is `TRUE`, then #' the child process will have no attached console, even if the #' parent had one. #' @param encoding The encoding to assume for `stdin`, `stdout` and #' `stderr`. By default the encoding of the current locale is #' used. Note that `processx` always reencodes the output of the #' `stdout` and `stderr` streams in UTF-8 currently. #' If you want to read them without any conversion, on all platforms, #' specify `"UTF-8"` as encoding. #' @param post_process An optional function to run when the process has #' finished. Currently it only runs if `$get_result()` is called. #' 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) 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), #' @description #' Cleanup method that is called when the `process` object is garbage #' collected. If requested so in the process constructor, then it #' eliminates all processes in the process's subprocess tree. finalize = function() { if (!is.null(private$tree_id) && private$cleanup_tree && ps::ps_is_supported()) self$kill_tree() }, #' @description #' Terminate the process. It also terminate all of its child #' processes, except if they have created a new process group (on Unix), #' 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). kill = function(grace = 0.1, close_connections = TRUE) process_kill(self, private, grace, close_connections), #' @description #' Process tree cleanup. It terminates the process #' (if still alive), together with any child (or grandchild, etc.) #' processes. It uses the _ps_ package, so that needs to be installed, #' and _ps_ needs to support the current platform as well. Process tree #' cleanup works by marking the process with an environment variable, #' which is inherited in all child processes. This allows finding #' descendents, even if they are orphaned, i.e. they are not connected #' to the root of the tree cleanup in the process tree any more. #' `$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.). kill_tree = function(grace = 0.1, close_connections = TRUE) process_kill_tree(self, private, grace, close_connections), #' @description #' Send a signal to the process. On Windows only the #' `SIGINT`, `SIGTERM` and `SIGKILL` signals are interpreted, #' and the special 0 signal. The first three all kill the process. The 0 #' signal returns `TRUE` if the process is alive, and `FALSE` #' otherwise. On Unix all signals are supported that the OS supports, #' and the 0 signal as well. #' @param signal An integer scalar, the id of the signal to send to #' the process. See [tools::pskill()] for the list of signals. signal = function(signal) process_signal(self, private, signal), #' @description #' Send an interrupt to the process. On Unix this is a #' `SIGINT` signal, and it is usually equivalent to pressing CTRL+C at #' the terminal prompt. On Windows, it is a CTRL+BREAK keypress. #' Applications may catch these events. By default they will quit. interrupt = function() process_interrupt(self, private), #' @description #' Query the process id. #' @return Integer scalar, the process id of the process. get_pid = function() process_get_pid(self, private), #' @description Check if the process is alive. #' @return Logical scalar. is_alive = function() process_is_alive(self, private), #' @description #' Wait until the process finishes, or a timeout happens. #' Note that if the process never finishes, and the timeout is infinite #' (the default), then R will never regain control. In some rare cases, #' `$wait()` might take a bit longer than specified to time out. This #' happens on Unix, when another package overwrites the processx #' `SIGCHLD` signal handler, after the processx process has started. #' One such package is parallel, if used with fork clusters, e.g. #' through `parallel::mcparallel()`. #' @return It returns the process itself, invisibly. wait = function(timeout = -1) process_wait(self, private, timeout), #' @description #' `$get_exit_status` returns the exit code of the process if it has #' finished and `NULL` otherwise. On Unix, in some rare cases, the exit #' status might be `NA`. This happens if another package (or R itself) #' overwrites the processx `SIGCHLD` handler, after the processx process #' has started. In these cases processx cannot determine the real exit #' status of the process. One such package is parallel, if used with #' fork clusters, e.g. through the `parallel::mcparallel()` function. get_exit_status = function() process_get_exit_status(self, private), #' @description #' `format(p)` or `p$format()` creates a string representation of the #' process, usually for printing. format = function() process_format(self, private), #' @description #' `print(p)` or `p$print()` shows some information about the #' process on the screen, whether it is running and it's process id, etc. print = function() process_print(self, private), #' @description #' `$get_start_time()` returns the time when the process was #' started. get_start_time = function() process_get_start_time(self, private), #' @description #' `$is_supervised()` returns whether the process is being tracked by #' supervisor process. is_supervised = function() process_is_supervised(self, private), #' @description #' `$supervise()` if passed `TRUE`, tells the supervisor to start #' tracking the process. If `FALSE`, tells the supervisor to stop #' tracking the process. Note that even if the supervisor is disabled #' for a process, if it was started with `cleanup = TRUE`, the process #' will still be killed when the object is garbage collected. #' @param status Whether to turn on of off the supervisor for this #' process. supervise = function(status) process_supervise(self, private, status), ## Output #' @description #' `$read_output()` reads from the standard output connection of the #' process. If the standard output connection was not requested, then #' then it returns an error. It uses a non-blocking text connection. This #' will work only if `stdout="|"` was used. Otherwise, it will throw an #' error. read_output = function(n = -1) process_read_output(self, private, n), #' @description #' `$read_error()` is similar to `$read_output`, but it reads #' from the standard error stream. read_error = function(n = -1) process_read_error(self, private, n), #' @description #' `$read_output_lines()` reads lines from standard output connection #' of the process. If the standard output connection was not requested, #' then it returns an error. It uses a non-blocking text connection. #' This will work only if `stdout="|"` was used. Otherwise, it will #' throw an error. read_output_lines = function(n = -1) process_read_output_lines(self, private, n), #' @description #' `$read_error_lines()` is similar to `$read_output_lines`, but #' it reads from the standard error stream. read_error_lines = function(n = -1) process_read_error_lines(self, private, n), #' @description #' `$is_incomplete_output()` return `FALSE` if the other end of #' the standard output connection was closed (most probably because the #' process exited). It return `TRUE` otherwise. is_incomplete_output = function() process_is_incompelete_output(self, private), #' @description #' `$is_incomplete_error()` return `FALSE` if the other end of #' the standard error connection was closed (most probably because the #' process exited). It return `TRUE` otherwise. is_incomplete_error = function() process_is_incompelete_error(self, private), #' @description #' `$has_input_connection()` return `TRUE` if there is a connection #' object for standard input; in other words, if `stdout="|"`. It returns #' `FALSE` otherwise. has_input_connection = function() process_has_input_connection(self, private), #' @description #' `$has_output_connection()` returns `TRUE` if there is a connection #' object for standard output; in other words, if `stdout="|"`. It returns #' `FALSE` otherwise. has_output_connection = function() process_has_output_connection(self, private), #' @description #' `$has_error_connection()` returns `TRUE` if there is a connection #' object for standard error; in other words, if `stderr="|"`. It returns #' `FALSE` otherwise. has_error_connection = function() process_has_error_connection(self, private), #' @description #' `$has_poll_connection()` return `TRUE` if there is a poll connection, #' `FALSE` otherwise. has_poll_connection = function() process_has_poll_connection(self, private), #' @description #' `$get_input_connection()` returns a connection object, to the #' standard input stream of the process. get_input_connection = function() process_get_input_connection(self, private), #' @description #' `$get_output_connection()` returns a connection object, to the #' standard output stream of the process. get_output_connection = function() process_get_output_connection(self, private), #' @description #' `$get_error_conneciton()` returns a connection object, to the #' standard error stream of the process. get_error_connection = function() process_get_error_connection(self, private), #' @description #' `$read_all_output()` waits for all standard output from the process. #' It does not return until the process has finished. #' Note that this process involves waiting for the process to finish, #' polling for I/O and potentially several `readLines()` calls. #' It returns a character scalar. This will return content only if #' `stdout="|"` was used. Otherwise, it will throw an error. read_all_output = function() process_read_all_output(self, private), #' @description #' `$read_all_error()` waits for all standard error from the process. #' It does not return until the process has finished. #' Note that this process involves waiting for the process to finish, #' polling for I/O and potentially several `readLines()` calls. #' It returns a character scalar. This will return content only if #' `stderr="|"` was used. Otherwise, it will throw an error. read_all_error = function() process_read_all_error(self, private), #' @description #' `$read_all_output_lines()` waits for all standard output lines #' from a process. It does not return until the process has finished. #' Note that this process involves waiting for the process to finish, #' polling for I/O and potentially several `readLines()` calls. #' It returns a character vector. This will return content only if #' `stdout="|"` was used. Otherwise, it will throw an error. read_all_output_lines = function() process_read_all_output_lines(self, private), #' @description #' `$read_all_error_lines()` waits for all standard error lines from #' a process. It does not return until the process has finished. #' Note that this process involves waiting for the process to finish, #' polling for I/O and potentially several `readLines()` calls. #' It returns a character vector. This will return content only if #' `stderr="|"` was used. Otherwise, it will throw an error. read_all_error_lines = function() process_read_all_error_lines(self, private), #' @description #' `$write_input()` writes the character vector (separated by `sep`) to #' the standard input of the process. It will be converted to the specified #' encoding. This operation is non-blocking, and it will return, even if #' the write fails (because the write buffer is full), or if it suceeds #' partially (i.e. not the full string is written). It returns with a raw #' vector, that contains the bytes that were not written. You can supply #' this raw vector to `$write_input()` again, until it is fully written, #' and then the return value will be `raw(0)` (invisibly). #' #' @param str Character or raw vector to write to the standard input #' of the process. If a character vector with a marked encoding, #' it will be converted to `encoding`. #' @param sep Separator to add between `str` elements if it is a #' character vector. It is ignored if `str` is a raw vector. #' @return Leftover text (as a raw vector), that was not written. write_input = function(str, sep = "\n") process_write_input(self, private, str, sep), #' @description #' `$get_input_file()` if the `stdin` argument was a filename, #' this returns the absolute path to the file. If `stdin` was `"|"` or #' `NULL`, this simply returns that value. get_input_file = function() process_get_input_file(self, private), #' @description #' `$get_output_file()` if the `stdout` argument was a filename, #' this returns the absolute path to the file. If `stdout` was `"|"` or #' `NULL`, this simply returns that value. get_output_file = function() process_get_output_file(self, private), #' @description #' `$get_error_file()` if the `stderr` argument was a filename, #' this returns the absolute path to the file. If `stderr` was `"|"` or #' `NULL`, this simply returns that value. get_error_file = function() process_get_error_file(self, private), #' @description #' `$poll_io()` polls the process's connections for I/O. See more in #' the _Polling_ section, and see also the [poll()] function #' to poll on multiple processes. poll_io = function(timeout) process_poll_io(self, private, timeout), #' @description #' `$get_poll_connetion()` returns the poll connection, if the process has #' one. get_poll_connection = function() process_get_poll_connection(self, private), #' @description #' `$get_result()` returns the result of the post processesing function. #' It can only be called once the process has finished. If the process has #' no post-processing function, then `NULL` is returned. get_result = function() process_get_result(self, private), #' @description #' `$as_ps_handle()` returns a [ps::ps_handle] object, corresponding to #' the process. as_ps_handle = function() process_as_ps_handle(self, private), #' @description #' Calls [ps::ps_name()] to get the process name. get_name = function() ps_method(ps::ps_name, self), #' @description #' Calls [ps::ps_exe()] to get the path of the executable. get_exe = function() ps_method(ps::ps_exe, self), #' @description #' Calls [ps::ps_cmdline()] to get the command line. get_cmdline = function() ps_method(ps::ps_cmdline, self), #' @description #' Calls [ps::ps_status()] to get the process status. get_status = function() ps_method(ps::ps_status, self), #' @description #' calls [ps::ps_username()] to get the username. get_username = function() ps_method(ps::ps_username, self), #' @description #' Calls [ps::ps_cwd()] to get the current working directory. get_wd = function() ps_method(ps::ps_cwd, self), #' @description #' Calls [ps::ps_cpu_times()] to get CPU usage data. get_cpu_times = function() ps_method(ps::ps_cpu_times, self), #' @description #' Calls [ps::ps_memory_info()] to get memory data. get_memory_info = function() ps_method(ps::ps_memory_info, self), #' @description #' Calls [ps::ps_suspend()] to suspend the process. suspend = function() ps_method(ps::ps_suspend, self), #' @description #' Calls [ps::ps_resume()] to resume a suspended process. resume = function() ps_method(ps::ps_resume, self) ), private = list( command = NULL, # Save 'command' argument here args = NULL, # Save 'args' argument here cleanup = NULL, # cleanup argument cleanup_tree = NULL, # cleanup_tree argument stdin = NULL, # stdin argument or stream stdout = NULL, # stdout argument or stream stderr = NULL, # stderr argument or stream pty = NULL, # whether we should create a PTY pty_options = NULL, # various PTY options pstdin = NULL, # the original stdin argument pstdout = NULL, # the original stdout argument pstderr = NULL, # the original stderr argument cleanfiles = NULL, # which temp stdout/stderr file(s) to clean up wd = NULL, # working directory (or NULL for current) starttime = NULL, # timestamp of start echo_cmd = NULL, # whether to echo the command windows_verbatim_args = NULL, windows_hide_window = NULL, status = NULL, # C file handle supervised = FALSE, # Whether process is tracked by supervisor stdin_pipe = NULL, stdout_pipe = NULL, stderr_pipe = NULL, poll_pipe = NULL, encoding = "", env = NULL, connections = list(), post_process = NULL, post_process_result = NULL, post_process_done = FALSE, tree_id = NULL, get_short_name = function() process_get_short_name(self, private), close_connections = function() process_close_connections(self, private) ) ) ## See the C source code for a discussion about the implementation ## of these methods process_wait <- function(self, private, timeout) { "!DEBUG process_wait `private$get_short_name()`" rethrow_call_with_cleanup( c_processx_wait, private$status, as.integer(timeout), private$get_short_name() ) invisible(self) } process_is_alive <- function(self, private) { "!DEBUG process_is_alive `private$get_short_name()`" rethrow_call(c_processx_is_alive, private$status, private$get_short_name()) } process_get_exit_status <- function(self, private) { "!DEBUG process_get_exit_status `private$get_short_name()`" rethrow_call(c_processx_get_exit_status, private$status, private$get_short_name()) } process_signal <- function(self, private, signal) { "!DEBUG process_signal `private$get_short_name()` `signal`" rethrow_call(c_processx_signal, private$status, as.integer(signal), private$get_short_name()) } process_interrupt <- function(self, private) { "!DEBUG process_interrupt `private$get_short_name()`" if (os_type() == "windows") { pid <- as.character(self$get_pid()) st <- run(get_tool("interrupt"), c(pid, "c"), error_on_status = FALSE) if (st$status == 0) TRUE else FALSE } else { rethrow_call(c_processx_interrupt, private$status, private$get_short_name()) } } process_kill <- function(self, private, grace, close_connections) { "!DEBUG process_kill '`private$get_short_name()`', pid `self$get_pid()`" ret <- rethrow_call(c_processx_kill, private$status, as.numeric(grace), private$get_short_name()) 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()`" if (!ps::ps_is_supported()) { throw(new_not_implemented_error( "kill_tree is not supported on this platform")) } ret <- get("ps_kill_tree", asNamespace("ps"))(private$tree_id) if (close_connections) private$close_connections() ret } process_get_start_time <- function(self, private) { format_unix_time(private$starttime) } process_get_pid <- function(self, private) { rethrow_call(c_processx_get_pid, private$status) } process_is_supervised <- function(self, private) { private$supervised } process_supervise <- function(self, private, status) { if (status && !self$is_supervised()) { supervisor_watch_pid(self$get_pid()) private$supervised <- TRUE } else if (!status && self$is_supervised()) { supervisor_unwatch_pid(self$get_pid()) private$supervised <- FALSE } } process_get_result <- function(self, private) { if (self$is_alive()) throw(new_error("Process is still alive")) if (!private$post_process_done && is.function(private$post_process)) { private$post_process_result <- private$post_process() private$post_process_done <- TRUE } private$post_process_result } process_as_ps_handle <- function(self, private) { ps::ps_handle(self$get_pid(), self$get_start_time()) } ps_method <- function(fun, self) { fun(ps::ps_handle(self$get_pid(), self$get_start_time())) } process_close_connections <- function(self, private) { for (f in c("stdin_pipe", "stdout_pipe", "stderr_pipe", "poll_pipe")) { if (!is.null(p <- private[[f]])) { rethrow_call(c_processx_connection_close, p) } } } #' Default options for pseudo terminals (ptys) #' #' @return Named list of default values of pty options. #' #' Options and default values: #' * `echo` whether to keep the echo on the terminal. `FALSE` turns echo #' off. #' * `rows` the (initial) terminal size, number of rows. #' * `cols` the (initial) terminal size, number of columns. #' #' @export default_pty_options <- function() { list( echo = FALSE, rows = 25L, cols = 80L ) } processx/R/connections.R0000644000176200001440000001743014026323556015001 0ustar liggesusers #' Processx connections #' #' These functions are currently experimental and will change #' in the future. Note that processx connections are _not_ #' compatible with R's built-in connection system. #' #' `conn_create_fd()` creates a connection from a file descriptor. #' #' @param fd Integer scalar, a Unix file descriptor. #' @param encoding Encoding of the readable connection when reading. #' @param close Whether to close the OS file descriptor when closing #' the connection. Sometimes you want to leave it open, and use it again #' in a `conn_create_fd` call. #' Encoding to re-encode `str` into when writing. #' #' @rdname processx_connections #' @export conn_create_fd <- function(fd, encoding = "", close = TRUE) { assert_that( is_integerish_scalar(fd), is_string(encoding), is_flag(close)) fd <- as.integer(fd) rethrow_call(c_processx_connection_create_fd, fd, encoding, close) } #' @details #' `conn_create_pipepair()` creates a pair of connected connections, the #' first one is writeable, the second one is readable. #' #' @param nonblocking Whether the writeable and the readable ends of #' the pipe should be non-blocking connections. #' #' @rdname processx_connections #' @export conn_create_pipepair <- function(encoding = "", nonblocking = c(TRUE, FALSE)) { assert_that( is_string(encoding), is.logical(nonblocking), length(nonblocking) == 2, !any(is.na(nonblocking))) rethrow_call(c_processx_connection_create_pipepair, encoding, nonblocking) } #' @details #' `conn_read_chars()` reads UTF-8 characters from the connections. If the #' connection itself is not UTF-8 encoded, it re-encodes it. #' #' @param con Processx connection object. #' @param n Number of characters or lines to read. -1 means all available #' characters or lines. #' #' @rdname processx_connections #' @export conn_read_chars <- function(con, n = -1) UseMethod("conn_read_chars", con) #' @rdname processx_connections #' @export conn_read_chars.processx_connection <- function(con, n = -1) { processx_conn_read_chars(con, n) } #' @rdname processx_connections #' @export processx_conn_read_chars <- function(con, n = -1) { assert_that(is_connection(con), is_integerish_scalar(n)) rethrow_call(c_processx_connection_read_chars, con, n) } #' @details #' `conn_read_lines()` reads lines from a connection. #' #' @rdname processx_connections #' @export conn_read_lines <- function(con, n = -1) UseMethod("conn_read_lines", con) #' @rdname processx_connections #' @export conn_read_lines.processx_connection <- function(con, n = -1) { processx_conn_read_lines(con, n) } #' @rdname processx_connections #' @export processx_conn_read_lines <- function(con, n = -1) { assert_that(is_connection(con), is_integerish_scalar(n)) rethrow_call(c_processx_connection_read_lines, con, n) } #' @details #' `conn_is_incomplete()` returns `FALSE` if the connection surely has no #' more data. #' #' @rdname processx_connections #' @export conn_is_incomplete <- function(con) UseMethod("conn_is_incomplete", con) #' @rdname processx_connections #' @export conn_is_incomplete.processx_connection <- function(con) { processx_conn_is_incomplete(con) } #' @rdname processx_connections #' @export processx_conn_is_incomplete <- function(con) { assert_that(is_connection(con)) ! rethrow_call(c_processx_connection_is_eof, con) } #' @details #' `conn_write()` writes a character or raw vector to the connection. #' It might not be able to write all bytes into the connection, in which #' case it returns the leftover bytes in a raw vector. Call `conn_write()` #' again with this raw vector. #' #' @param str Character or raw vector to write. #' @param sep Separator to use if `str` is a character vector. Ignored if #' `str` is a raw vector. #' #' @rdname processx_connections #' @export conn_write <- function(con, str, sep = "\n", encoding = "") UseMethod("conn_write", con) #' @rdname processx_connections #' @export conn_write.processx_connection <- function(con, str, sep = "\n", encoding = "") { processx_conn_write(con, str, sep, encoding) } #' @rdname processx_connections #' @export processx_conn_write <- function(con, str, sep = "\n", encoding = "") { assert_that( is_connection(con), (is.character(str) && all(! is.na(str))) || is.raw(str), is_string(sep), is_string(encoding)) if (is.character(str)) { pstr <- paste(str, collapse = sep) str <- iconv(pstr, "", encoding, toRaw = TRUE)[[1]] } invisible(rethrow_call(c_processx_connection_write_bytes, con, str)) } #' @details #' `conn_create_file()` creates a connection to a file. #' #' @param filename File name. #' @param read Whether the connection is readable. #' @param write Whethe the connection is writeable. #' #' @rdname processx_connections #' @export conn_create_file <- function(filename, read = NULL, write = NULL) { if (is.null(read) && is.null(write)) { read <- TRUE; write <- FALSE } if (is.null(read)) read <- !write if (is.null(write)) write <- !read assert_that( is_string(filename), is_flag(read), is_flag(write), read || write) rethrow_call(c_processx_connection_create_file, filename, read, write) } #' @details #' `conn_set_stdout()` set the standard output of the R process, to the #' specified connection. #' #' @param drop Whether to close the original stdout/stderr, or keep it #' open and return a connection to it. #' #' @rdname processx_connections #' @export conn_set_stdout <- function(con, drop = TRUE) { assert_that( is_connection(con), is_flag(drop)) flush(stdout()) invisible(rethrow_call(c_processx_connection_set_stdout, con, drop)) } #' @details #' `conn_set_stderr()` set the standard error of the R process, to the #' specified connection. #' #' @rdname processx_connections #' @export conn_set_stderr <- function(con, drop = TRUE) { assert_that( is_connection(con), is_flag(drop)) flush(stderr()) invisible(rethrow_call(c_processx_connection_set_stderr, con, drop)) } #' @details #' `conn_get_fileno()` return the integer file desciptor that belongs to #' the connection. #' #' @rdname processx_connections #' @export conn_get_fileno <- function(con) { rethrow_call(c_processx_connection_get_fileno, con) } #' @details #' `conn_disable_inheritance()` can be called to disable the inheritance #' of all open handles. Call this function as soon as possible in a new #' process to avoid inheriting the inherited handles even further. #' The function is best effort to close the handles, it might still leave #' some handles open. It should work for `stdin`, `stdout` and `stderr`, #' at least. #' #' @rdname processx_connections #' @export conn_disable_inheritance <- function() { rethrow_call(c_processx_connection_disable_inheritance) } #' @rdname processx_connections #' @export close.processx_connection <- function(con, ...) { processx_conn_close(con, ...) } #' @param ... Extra arguments, for compatibility with the `close()` #' generic, currently ignored by processx. #' @rdname processx_connections #' @export processx_conn_close <- function(con, ...) { rethrow_call(c_processx_connection_close, con) } #' @details #' `is_valid_fd()` returns `TRUE` if `fd` is a valid open file #' descriptor. You can use it to check if the R process has standard #' input, output or error. E.g. R processes running in GUI (like RGui) #' might not have any of the standard streams available. #' #' If a stream is redirected to the null device (e.g. in a callr #' subprocess), that is is still a valid file descriptor. #' #' @rdname processx_connections #' @export #' @examples #' is_valid_fd(0L) # stdin #' is_valid_fd(1L) # stdout #' is_valid_fd(2L) # stderr is_valid_fd <- function(fd) { assert_that(is_integerish_scalar(fd)) fd <- as.integer(fd) rethrow_call(c_processx_is_valid_fd, fd) } processx/R/aaassertthat.R0000644000176200001440000000464413616314040015136 0ustar liggesusers assert_that <- function(..., env = parent.frame(), msg = NULL) { res <- see_if(..., env = env, msg = msg) if (res) return(TRUE) throw(new_assert_error(attr(res, "msg"))) } new_assert_error <- function (message, call = NULL) { cond <- new_error(message, call. = call) class(cond) <- c("assert_error", class(cond)) cond } see_if <- function(..., env = parent.frame(), msg = NULL) { asserts <- eval(substitute(alist(...))) for (assertion in asserts) { res <- tryCatch({ eval(assertion, env) }, new_assert_error = function(e) { structure(FALSE, msg = e$message) }) check_result(res) # Failed, so figure out message to produce if (!res) { if (is.null(msg)) msg <- get_message(res, assertion, env) return(structure(FALSE, msg = msg)) } } res } check_result <- function(x) { if (!is.logical(x)) throw(new_assert_error("assert_that: assertion must return a logical value")) if (any(is.na(x))) throw(new_assert_error("assert_that: missing values present in assertion")) if (length(x) != 1) { throw(new_assert_error("assert_that: length of assertion is not 1")) } TRUE } get_message <- function(res, call, env = parent.frame()) { stopifnot(is.call(call), length(call) >= 1) if (has_attr(res, "msg")) { return(attr(res, "msg")) } f <- eval(call[[1]], env) if (!is.primitive(f)) call <- match.call(f, call) fname <- deparse(call[[1]]) fail <- on_failure(f) %||% base_fs[[fname]] %||% fail_default fail(call, env) } # The default failure message works in the same way as stopifnot, so you can # continue to use any function that returns a logical value: you just won't # get a friendly error message. # The code below says you get the first 60 characters plus a ... fail_default <- function(call, env) { call_string <- deparse(call, width.cutoff = 60L) if (length(call_string) > 1L) { call_string <- paste0(call_string[1L], "...") } paste0(call_string, " is not TRUE") } on_failure <- function(x) attr(x, "fail") "on_failure<-" <- function(x, value) { stopifnot(is.function(x), identical(names(formals(value)), c("call", "env"))) attr(x, "fail") <- value x } has_attr <- function(x, which) !is.null(attr(x, which, exact = TRUE)) on_failure(has_attr) <- function(call, env) { paste0(deparse(call$x), " does not have attribute ", eval(call$which, env)) } "%has_attr%" <- has_attr base_fs <- new.env(parent = emptyenv()) processx/R/poll.R0000644000176200001440000000750113616314454013424 0ustar liggesusers #' Poll for process I/O or termination #' #' Wait until one of the specified connections or processes produce #' standard output or error, terminates, or a timeout occurs. #' #' @section Explanation of the return values: #' * `nopipe` means that the stdout or stderr from this process was not #' captured. #' * `ready` means that the connection or the stdout or stderr from this #' process are ready to read from. Note that end-of-file on these #' outputs also triggers `ready`. #' * timeout`: the connections or processes are not ready to read from #' and a timeout happened. #' * `closed`: the connection was already closed, before the polling #' started. #' * `silent`: the connection is not ready to read from, but another #' connection was. #' #' @param processes A list of connection objects or`process` objects to #' wait on. (They can be mixed as well.) If this is a named list, then #' the returned list will have the same names. This simplifies the #' identification of the processes. #' @param ms Integer scalar, a timeout for the polling, in milliseconds. #' Supply -1 for an infitite timeout, and 0 for not waiting at all. #' @return A list of character vectors of length one or three. #' There is one list element for each connection/process, in the same #' order as in the input list. For connections the result is a single #' string scalar. For processes the character vectors' elements are named #' `output`, `error` and `process`. Possible values for each individual #' result are: `nopipe`, `ready`, `timeout`, `closed`, `silent`. #' See details about these below. `process` refers to the poll connection, #' see the `poll_connection` argument of the `process` initializer. #' #' @export #' @examplesIf FALSE #' # Different commands to run for windows and unix #' cmd1 <- switch( #' .Platform$OS.type, #' "unix" = c("sh", "-c", "sleep 1; ls"), #' c("cmd", "/c", "ping -n 2 127.0.0.1 && dir /b") #' ) #' cmd2 <- switch( #' .Platform$OS.type, #' "unix" = c("sh", "-c", "sleep 2; ls 1>&2"), #' c("cmd", "/c", "ping -n 2 127.0.0.1 && dir /b 1>&2") #' ) #' #' ## Run them. p1 writes to stdout, p2 to stderr, after some sleep #' p1 <- process$new(cmd1[1], cmd1[-1], stdout = "|") #' p2 <- process$new(cmd2[1], cmd2[-1], stderr = "|") #' #' ## Nothing to read initially #' poll(list(p1 = p1, p2 = p2), 0) #' #' ## Wait until p1 finishes. Now p1 has some output #' p1$wait() #' poll(list(p1 = p1, p2 = p2), -1) #' #' ## Close p1's connection, p2 will have output on stderr, eventually #' close(p1$get_output_connection()) #' poll(list(p1 = p1, p2 = p2), -1) #' #' ## Close p2's connection as well, no nothing to poll #' close(p2$get_error_connection()) #' poll(list(p1 = p1, p2 = p2), 0) poll <- function(processes, ms) { pollables <- processes assert_that(is_list_of_pollables(pollables)) assert_that(is_integerish_scalar(ms)) if (length(pollables) == 0) { return(structure(list(), names = names(pollables))) } proc <- vapply(pollables, inherits, logical(1), "process") conn <- vapply(pollables, is_connection, logical(1)) type <- ifelse(proc, 1L, ifelse(conn, 2L, 3L)) pollables[proc] <- lapply(pollables[proc], function(p) { list(get_private(p)$status, get_private(p)$poll_pipe) }) res <- rethrow_call(c_processx_poll, pollables, type, as.integer(ms)) res <- lapply(res, function(x) poll_codes[x]) res[proc] <- lapply(res[proc], function(x) { set_names(x, c("output", "error", "process")) }) names(res) <- names(pollables) res } #' Create a pollable object from a curl multi handle's file descriptors #' #' @param fds A list of file descriptors, as returned by #' [curl::multi_fdset()]. #' @return Pollable object, that be used with [poll()] directly. #' #' @export curl_fds <- function(fds) { structure( list(fds$reads, fds$writes, fds$exceptions), class = "processx_curl_fds") } processx/R/client-lib.R0000644000176200001440000000710614026373604014477 0ustar liggesusers client <- new.env(parent = emptyenv()) local({ ext <- .Platform$dynlib.ext arch <- .Platform$r_arch safe_md5sum <- function(path) { stopifnot(length(path) == 1) tryCatch( tools::md5sum(path), error = function(err) { tmp <- tempfile() on.exit(unlink(tmp, force = TRUE, recursive = TRUE), add = TRUE) file.copy(path, tmp) structure(tools::md5sum(tmp), names = path) } ) } read_all <- function(x) { list( bytes = readBin(x, "raw", file.size(x)), md5 = unname(safe_md5sum(x)) # absolute file name <> stated install ) } libs <- system.file("libs", package = "processx") if (!file.exists(libs)) { # devtools single <- system.file("src", paste0("client", ext), package = "processx") client[[paste0("arch-", arch)]] <- read_all(single) } else { # not devtools single <- file.path(libs, paste0("client", ext)) if (file.exists(single)) { # not multiarch bts <- file.size(single) client[[paste0("arch-", arch)]] <- read_all(single) } else { # multiarch multi <- dir(libs) for (aa in multi) { fn <- file.path(libs, aa, paste0("client", ext)) client[[paste0("arch-", aa)]] <- read_all(fn) } } } }) # This is really only here for testing load_client_lib <- function(client) { ext <- .Platform$dynlib.ext arch <- paste0("arch-", .Platform$r_arch) tmpsofile <- tempfile(fileext = ext) writeBin(client[[arch]]$bytes, tmpsofile) tmpsofile <- normalizePath(tmpsofile) lib <- dyn.load(tmpsofile) on.exit(dyn.unload(tmpsofile)) sym_encode <- getNativeSymbolInfo("processx_base64_encode", lib) sym_decode <- getNativeSymbolInfo("processx_base64_decode", lib) sym_disinh <- getNativeSymbolInfo("processx_disable_inheritance", lib) sym_write <- getNativeSymbolInfo("processx_write", lib) sym_setout <- getNativeSymbolInfo("processx_set_stdout", lib) sym_seterr <- getNativeSymbolInfo("processx_set_stderr", lib) sym_setoutf <- getNativeSymbolInfo("processx_set_stdout_to_file", lib) sym_seterrf <- getNativeSymbolInfo("processx_set_stderr_to_file", lib) env <- new.env(parent = emptyenv()) env$.path <- tmpsofile mycall <- .Call env$base64_encode <- function(x) rawToChar(mycall(sym_encode, x)) env$base64_decode <- function(x) { if (is.character(x)) { x <- charToRaw(paste(gsub("\\s+", "", x), collapse = "")) } mycall(sym_decode, x) } env$disable_fd_inheritance <- function() mycall(sym_disinh) env$write_fd <- function(fd, data) { if (is.character(data)) data <- charToRaw(paste0(data, collapse = "")) len <- length(data) repeat { written <- mycall(sym_write, fd, data) len <- len - written if (len == 0) break if (written) data <- data[-(1:written)] Sys.sleep(.1) } } env$set_stdout <- function(fd, drop = TRUE) { mycall(sym_setout, as.integer(fd), as.logical(drop)) } env$set_stderr <- function(fd, drop = TRUE) { mycall(sym_seterr, as.integer(fd), as.logical(drop)) } env$set_stdout_file <- function(path) { mycall(sym_setoutf, as.character(path)[1]) } env$set_stderr_file <- function(path) { mycall(sym_seterrf, as.character(path)[1]) } env$.finalize <- function() { dyn.unload(env$.path) rm(list = ls(env, all.names = TRUE), envir = env) } penv <- environment() parent.env(penv) <- baseenv() reg.finalizer( env, function(e) if (".finalize" %in% names(e)) e$.finalize(), onexit = TRUE) ## Clear the cleanup method on.exit(NULL) env } environment(load_client_lib) <- baseenv() processx/NEWS.md0000644000176200001440000002260214043046326013222 0ustar liggesusers # processx 3.5.2 * `run()` now does not truncate stdout and stderr when the output contains multibyte characters (#298, @infotroph). * processx now compiles with custom compilers that enable OpenMP (#297). * processx now avoids a race condition when the working directory is changed right after starting a process, potentially before the sub-process is initialized (#300). * processx now works with non-ASCII path names on non-UTF-8 Unix platforms (#293). # processx 3.5.1 * Fix a potential failure when polling curl file descriptors on Windows. # processx 3.5.0 * You can now append environment variables to the ones set in the current process if you include `"current"` in the value of `env`, in `run()` and for `process$new()`: `env = c("current", NEW = "newvalue")` (#232). * Sub-processes can now inherit the standard input, output and error from the main R process, by setting the corresponding argument to an empty string. E.g. `run("ls", stdout = "")` (#72). * `run()` is now much faster with large standard output or standard error (#286). * `run()` can now discard the standard output and error or redirect them to file(s), instead of collecting them. * processx now optionally uses the cli package to color error messages and stack traces, instead of crayon. # processx 3.4.5 * New options in `pty_options` to set the initial size of the pseudo terminal. * Reading the standard output or error now does not crash occasionally when a `\n` character is at the beginning of the input buffer (#281). # processx 3.4.4 * processx now works correctly for non-ASCII commands and arguments passed in the native encoding, on Windows (#261, #262, #263, #264). * Providing multiple environment variables now works on windows (#267). # processx 3.4.3 * The supervisor (activated with `supervise = TRUE`) does not crash on the Windows Subsystem on Linux (WSL) now (#222). * Fix ABI compatibility for pre and post R 4.0.1 versions. Now CRAN builds (with R 4.0.2 and later 4.0.x) work well on R 4.0.0. * Now processx can run commands on UNC paths specified with forward slashes: `//hostname/...` UNC paths with the usual back-slashes were always fine (#249). * The `$as_ps_handle()` method works now better; previously it sometimes created an invalid `ps::ps_handle` object, if the system clock has changed (#258). # processx 3.4.2 * `run()` now does a better job with displaying the spinner on terminals that buffer the output (#223). * Error messages are now fully printed after an error. In non-interactive sessions, the stack trace is printed as well. * Further improved error messages. Errors from C code now include the name of the C function, and errors that belong to a process include the system command (#197). * processx does not crash now if the process receives a SIGPIPE signal when trying to write to a pipe, of which the other end has already exited. * processx now to works better with fork clusters from the parallel package. See 'Mixing processx and the parallel base R package' in the README file (#236). * processx now does no block SIGCHLD by default in the subprocess, blocking potentially causes zombie sub-subprocesses (#240). * The `process$wait()` method now does not leak file descriptors on Unix when interrupted (#141). # processx 3.4.1 * Now `run()` does not create an `ok` variable in the global environment. # processx 3.4.0 * Processx has now better error messages, in particular, all errors from C code contain the file name and line number, and the system error code and message (where applicable). * Processx now sets the `.Last.error` variable for every un-caught processx error to the error condition, and also sets `.Last.error.trace` to its stack trace. * `run()` now prints the last 10 lines of the standard error stream on error, if `echo = FALSE`, and it also prints the exit status of the process. * `run()` now includes the standard error in the condition signalled on interrupt. * `process` now supports creating pseudo terminals on Unix systems. * `conn_create_pipepair()` gets new argument to set the pipes as blocking or non-blocking. * `process` does not set the inherited extra connections as blocking, and it also does not close them after starting the subprocess. This is now the responsibility of the user. Note that this is a breaking change. * `run()` now passes extra `...` arguments to `process$new()`. * `run()` now does not error if the process is killed in a callback. # processx 3.3.1 * Fix a crash on Windows, when a connection that has a pending read internally is finalized. # processx 3.3.0 * `process` can now redirect the standard error to the standard output, via specifying `stderr = "2>&1"`. This works both with files and pipes. * `run()` can now redirect the standard error to the standard output, via the new `stderr_to_stdout` argument. * The `$kill()` and `$kill_tree()` methods get a `close_connection = TRUE` argument that closes all pipe connections of the process. * `run()` now always kills the process (and its process tree if `cleanup_tree` is `TRUE`) before exiting. This also closes all pipe connections (#149). # processx 3.2.1 * processx does not depend on assertthat now, and the crayon package is now an optional dependency. # processx 3.2.0 * New `process$kill_tree()` method, and new `cleanup_tree` arguments in `run()` and `process$new()`, to clean up the process tree rooted at a processx process. (#139, #143). * New `process$interupt()` method to send an interrupt to a process, SIGINT on Unix, CTRL+C on Windows (#127). * New `stdin` argument in `process$new()` to support writing to the standard input of a process (#27, #114). * New `connections` argument in `process$new()` to support passing extra connections to the child process, in addition to the standard streams. * New `poll_connection` argument to `process$new()`, an extra connection that can be used to poll the process, even if `stdout` and `stderr` are not pipes (#125). * `poll()` now works with connections objects, and they can be mixed with process objects (#121). * New `env` argument in `run()` and `process$new()`, to set the environment of the child process, optionally (#117, #118). * Removed the `$restart()` method, because it was less useful than expected, and hard to maintain (#116). * New `conn_set_stdout()` and `conn_set_stderr()` to set the standard output or error of the calling process. * New `conn_disable_inheritance()` to disable stdio inheritance. It is suggested that child processes call this immediately after starting, so the file handles are not inherited further. * Fixed a signal handler bug on Unix that marked the process as finished, even if it has not (d221aa1f). * Fixed a bug that occasionally caused crashes in `wait()`, on Unix (#138). * When `run()` is interrupted, no error message is printed, just like for interruption of R code in general. The thrown condition now also has the `interrupt` class (#148). # processx 3.1.0 * Fix interference with the parallel package, and other packages that redefine the `SIGCHLD` signal handler on Unix. If the processx signal handler is overwritten, we might miss the exit status of some processes (they are set to `NA`). * `run()` and `process$new()` allow specifying the working directory of the process (#63). * Make the debugme package an optional dependency (#74). * processx is now compatible with R 3.1.x. * Allow polling more than 64 connections on Windows, by using IOCP instead of `WaitForMultipleObjects()` (#81, #106). * Fix a race condition on Windows, when creating named pipes for stdout or stderr. The client sometimes didn't wait for the server, and processx failed with ERROR_PIPE_BUSY (231, All pipe instances are busy). # processx 3.0.3 * Fix a crash on windows when trying to run a non-existing command (#90) * Fix a race condition in `process$restart()` * `run()` and `process$new()` do not support the `commandline` argument any more, because process cleanup is error prone with an intermediate shell. (#88) * `processx` process objects no longer use R connection objects, because the R connection API was retroactive made private by R-core `processx` uses its own connection class now to manage standard output and error of the process. * The encoding of the standard output and error can be specified now, and `processx` re-encodes `stdout` and `stderr` in UTF-8. * Cloning of process objects is disables now, as it is likely that it causes problems (@wch). * `supervise` option to kill child process if R crashes (@wch). * Add `get_output_file` and `get_error_file`, `has_output_connection()` and `has_error_connection()` methods (@wch). * `stdout` and `stderr` default to `NULL` now, i.e. they are discarded (@wch). * Fix undefined behavior when stdout/stderr was read out after the process was already finalized, on Unix. * `run()`: Better message on interruption, kill process when interrupted. * Unix: better kill count on unloading the package. * Unix: make wait() work when SIGCHLD is not delivered for some reason. * Unix: close inherited file descriptors more conservatively. * Fix a race condition and several memory leaks on Windows. * Fixes when running under job control that does not allow breaking away from the job, on Windows. # processx 2.0.0.1 This is an unofficial release, created by CRAN, to fix compilation on Solaris. # processx 2.0.0 First public release. processx/MD50000644000176200001440000001311114043056423012426 0ustar liggesusers3dcf54f7350fd73dacab514c7bff93ad *DESCRIPTION 71a00913acfad3bf9c2d93ea5abaa910 *LICENSE a34924c47fd0645946c9675288b2ce9f *NAMESPACE e9bc9ea2ad55232d91145e9eef3f31f8 *NEWS.md a5c41da68d1c16d385fd6278a53629ba *R/aaassertthat.R 40b27e0d8a8cac92072e33f08bfaf015 *R/assertions.R a89f6486bca6fad9b7a15143c6fb2217 *R/base64.R a15ee3dddecc6fe3faaf206de2e61591 *R/cleancall.R 9f9fd40c9b92f99af062d7214b14bbe1 *R/client-lib.R 4eae71e99f65415e432ad6992edce3ff *R/connections.R 8b14d08c68b8d583e974894eb1a7fbb5 *R/errors.R 511fd6bcda2a0bf626053d44d6efc29c *R/initialize.R 8c01214d3bf73284d3a321b271a036e3 *R/io.R 2df80d561d32ea8d9f620b53e816cd22 *R/named_pipe.R bcf55d7ae2dc1f2165632c32be0fd304 *R/on-load.R 02823658bda8a1aca013d5777590a55e *R/poll.R 24b0458c7861d82ec086704f6bd46afa *R/print.R 796b4b311551a75a29304f5b5fffd67f *R/process-helpers.R 582e4b79a041f5ac45115b9f14eb931d *R/process.R b61e3846b06f4ebe1308922a2fdba6b2 *R/run.R feb91ad63da939628d3ab6fa81a0e3e8 *R/supervisor.R 60da4d1440c80fe9b9a06d4bbca74da5 *R/utils.R 093470d974cdea23acdab99159affbd9 *README.md de7d080267fecbb5892e173f90955c29 *inst/CODE_OF_CONDUCT.md 7f2564eb61705261b68ae639c214adfa *man/base64_decode.Rd ed2a0e0441362685bf283683e8a657e6 *man/curl_fds.Rd 861215ca7d7821df9021caaaa036caac *man/default_pty_options.Rd a0fca60f1fd130d6df65a226ba8cebdf *man/poll.Rd cb2b845b5dc8857b356b84bea9237550 *man/process.Rd d3751e2f395d2e918df2c0b9d6699d74 *man/process_initialize.Rd 3304c0eed8047eaecb11b4943f899077 *man/processx_connections.Rd 90b08bb97d865b0134ebeb9a12b5abf4 *man/run.Rd 360106905db4eab328231746d6f769de *man/supervisor_kill.Rd a79a45599b5cb28509916799efaeed74 *src/Makevars 0fa93fb8b4cce7f9575de7a548f31499 *src/Makevars.win e33eabedcaff1aa80996612bb5ab3588 *src/base64.c 2686333f5c6ef98c225e15a77b25eae9 *src/cleancall.c bff2a7876350a82b2c7d7e402588cddf *src/cleancall.h a4455da81dbc0535ab5a8e6728f1abe8 *src/client.c 285094d5398302c3eee29f6ab6dd1f9d *src/create-time.c bc57a7d677a95e5b3e78250e4a5e0beb *src/errors.c 001ad320075ddf2288694894dabc1354 *src/errors.h 9fb3010322eca7267c97b8980f97459f *src/init.c 3d46f4257d98652aa2044bb65b1ec242 *src/install.libs.R 1613836e9671885b35c78ac3febd453a *src/poll.c 3f055614cb388b3621fb48f2358e947b *src/processx-connection.c 6be227d4fd626d98c512800ef09b379d *src/processx-connection.h 385794aed505ce6cd9b873e4c9013367 *src/processx-types.h 2e0b5cf57ae9034e41b247cabab81c01 *src/processx-vector.c 579a6a697bd993bb441fe25026fa1a71 *src/processx.h 1ff6540023e38029519a49a803bc7931 *src/supervisor/supervisor.c 1d0d52e254c4de8be837cfc88e3ad088 *src/supervisor/utils.c 5a44a512d77ef5ce3ba8bd50add3992c *src/supervisor/utils.h 6fbd516d762ebb48c589fdc28b66a00c *src/supervisor/windows.c 690a85de42ed75d531513ce9f6152eb6 *src/supervisor/windows.h 3db35656c2495dee4cbe752196cb47b0 *src/tools/interrupt.c 10975f4da8304aad0827d736768985c0 *src/tools/px.c a662b40489e7e7b31e2a58318ef65136 *src/tools/pxu.c 492c0f3416943f12768f49f8fd0bca29 *src/unix/childlist.c c2d507fb3744eae21e5ece99fb9e6dad *src/unix/connection.c 72414ca2011ffbdafd6c90dc51dcf58f *src/unix/named_pipe.c 609e74d0a2d402aedfc86b5bc339092b *src/unix/processx-unix.h 8e6f5e53a4821b22b0d9238064b711a2 *src/unix/processx.c d64f9c3eff971a9a4386b081e224eb22 *src/unix/sigchld.c 8ce744077426fd01eaf68d33d28674a0 *src/unix/utils.c 24be67d6fba57ba094bb361e8168a645 *src/win/named_pipe.c 7041fc35a53483756606432115ccc348 *src/win/processx-stdio.h e307e6ef100c2ecbe02ae73ebd7235d4 *src/win/processx-win.h 9f92a49d133e69d5c9665fbbb4e40f01 *src/win/processx.c 31b9c63ad796287cb74ebbdd14e82623 *src/win/stdio.c 7602581f90033a58793f3ac0bb2f6c5a *src/win/thread.c 5db427905d85011dd3b9678fc8b92093 *src/win/utils.c 596e48a1aafe2cc69d9e7c873534fc28 *tests/testthat.R b4e448e8600fa63f41cc30e5e784f75c *tests/testthat/fixtures/simple.txt c3e0c5465a4fb9c0d5f9cb69f5ac6297 *tests/testthat/helper.R 964219cb978de122244d507a5112c5b7 *tests/testthat/test-assertions.R a7d8cec25d2ae07e0e130c6b005cd5ac *tests/testthat/test-chr-io.R fb8e08cd047973b8888ec60c26be338b *tests/testthat/test-cleanup.R 9d67e69e25aef93a10f6a48d3744d59b *tests/testthat/test-client-lib.R 209346f5bb7bac11526fcbc72c5c3d96 *tests/testthat/test-connections.R b984f3a62219d73e47422564a0ee0554 *tests/testthat/test-env.R 3f45ea6a1ee62a95ed5d1e3b143c5e61 *tests/testthat/test-err.R 59818c0e8090bc372c9fc519569aa089 *tests/testthat/test-errors.R 03b8222a1da03a0920c86354d401c601 *tests/testthat/test-extra-connections.R fa1202cad18d90d6ef83e2b440bab6bc *tests/testthat/test-io.R 3d0a629abc607d63bc70457a7fc1a42c *tests/testthat/test-kill-tree.R aad0029cedd0e978ede4fe08e85de89c *tests/testthat/test-poll-connections.R c73f647edaf7c1a5191d9ed21312cfa6 *tests/testthat/test-poll-curl.R a35b23d672335f2052c119468543250f *tests/testthat/test-poll-stress.R dfd98a75b0a23de29d412cdaeeb08418 *tests/testthat/test-poll.R 337605c2e031ee6a3fa1caec2acc799c *tests/testthat/test-poll2.R 444ca99e79a6c1ec898e8d22e989ec30 *tests/testthat/test-poll3.R f1bd45f8bfff9f3dffbaf76d75448f61 *tests/testthat/test-print.R 11346b2346be31a88eb80b586e1a1c9f *tests/testthat/test-process.R aab10d174d62079097e4a3a0ce1a9950 *tests/testthat/test-ps-methods.R 9e6d3113a9320fdacebc7532f6daf6c1 *tests/testthat/test-pty.R 767d49f253858b0f944dcb368fe81d6c *tests/testthat/test-run.R 8e6d86db866f5daefca84cbd5992d4dd *tests/testthat/test-set-std.R 553af723698dbb9110d4ebfd907e7568 *tests/testthat/test-sigchld.R 4044457d4bbf0bacb3c44e918b071fc3 *tests/testthat/test-stdin.R 35ce281e12bed42b399d87c1593e6b85 *tests/testthat/test-stress.R 9599d6c69b6e5ed7a625c74764bca6d4 *tests/testthat/test-utf8.R ef4b043894790dc98390226425a636f8 *tests/testthat/test-utils.R ec1823af203d03372ca3d7da3cfac677 *tests/testthat/test-wait.R processx/inst/0000755000176200001440000000000013616314040013073 5ustar liggesusersprocessx/inst/CODE_OF_CONDUCT.md0000644000176200001440000000255513616314040015701 0ustar liggesusers# Contributor Code of Conduct As contributors and maintainers of this project, we pledge to respect all people who contribute through reporting issues, posting feature requests, updating documentation, submitting pull requests or patches, and other activities. We are committed to making participation in this project a harassment-free experience for everyone, regardless of level of experience, gender, gender identity and expression, sexual orientation, disability, personal appearance, body size, race, ethnicity, age, or religion. Examples of unacceptable behavior by participants include the use of sexual language or imagery, derogatory comments or personal attacks, trolling, public or private harassment, insults, or other unprofessional conduct. Project maintainers have the right and responsibility to remove, edit, or reject comments, commits, code, wiki edits, issues, and other contributions that are not aligned to this Code of Conduct. Project maintainers who do not follow the Code of Conduct may be removed from the project team. Instances of abusive, harassing, or otherwise unacceptable behavior may be reported by opening an issue or contacting one or more of the project maintainers. This Code of Conduct is adapted from the Contributor Covenant (http://contributor-covenant.org), version 1.0.0, available at http://contributor-covenant.org/version/1/0/0/