├── .Rbuildignore ├── .github ├── .gitignore └── workflows │ └── R-CMD-check.yaml ├── .gitignore ├── DESCRIPTION ├── LICENSE ├── NAMESPACE ├── NEWS ├── R ├── astext.R ├── callr.R ├── deprecated.R ├── exec.R └── quote.R ├── inst ├── WORDLIST └── utf8.txt ├── man ├── as_text.Rd ├── deprecated.Rd ├── exec.Rd ├── exec_r.Rd └── quote.Rd ├── readme.md ├── src ├── Makevars.win ├── exec.c ├── init.c └── win32 │ └── exec.c ├── sys.Rproj └── tests ├── spelling.R ├── testthat.R └── testthat ├── test-binary.R ├── test-encoding.R ├── test-error.R ├── test-nesting.R ├── test-quote.R ├── test-stdin.R ├── test-stdout.R └── test-timeout.R /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^\.travis\.yml$ 4 | ^appveyor\.yml$ 5 | ^.gitignore$ 6 | ^readme.md$ 7 | ^.*\.o$ 8 | ^src/Makevars$ 9 | ^readme.md$ 10 | ^revdep 11 | ^\.github$ 12 | -------------------------------------------------------------------------------- /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | pull_request: 6 | 7 | name: R-CMD-check.yaml 8 | 9 | permissions: read-all 10 | 11 | jobs: 12 | R-CMD-check: 13 | runs-on: ${{ matrix.config.os }} 14 | 15 | name: ${{ matrix.config.os }} (${{ matrix.config.r }}) 16 | 17 | strategy: 18 | fail-fast: false 19 | matrix: 20 | config: 21 | - {os: macos-13, r: 'release'} 22 | - {os: macos-14, r: 'release'} 23 | - {os: windows-latest, r: '4.1'} 24 | - {os: windows-latest, r: '4.2'} 25 | - {os: windows-latest, r: 'release'} 26 | - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} 27 | - {os: ubuntu-latest, r: 'release'} 28 | - {os: ubuntu-latest, r: 'oldrel-1'} 29 | 30 | env: 31 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 32 | R_KEEP_PKG_SOURCE: yes 33 | 34 | steps: 35 | - uses: actions/checkout@v4 36 | 37 | - uses: r-lib/actions/setup-pandoc@v2 38 | 39 | - uses: r-lib/actions/setup-r@v2 40 | with: 41 | r-version: ${{ matrix.config.r }} 42 | http-user-agent: ${{ matrix.config.http-user-agent }} 43 | use-public-rspm: true 44 | 45 | - uses: r-lib/actions/setup-r-dependencies@v2 46 | with: 47 | extra-packages: any::rcmdcheck 48 | needs: check 49 | 50 | - uses: r-lib/actions/check-r-package@v2 51 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | *.o 5 | src/*.so 6 | src/*.dll 7 | src/Makevars 8 | revdep 9 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: sys 2 | Type: Package 3 | Title: Powerful and Reliable Tools for Running System Commands in R 4 | Version: 3.4.3 5 | Authors@R: c(person("Jeroen", "Ooms", role = c("aut", "cre"), 6 | email = "jeroenooms@gmail.com", comment = c(ORCID = "0000-0002-4035-0289")), 7 | person("Gábor", "Csárdi", , "csardi.gabor@gmail.com", role = "ctb")) 8 | Description: Drop-in replacements for the base system2() function with fine control 9 | and consistent behavior across platforms. Supports clean interruption, timeout, 10 | background tasks, and streaming STDIN / STDOUT / STDERR over binary or text 11 | connections. Arguments on Windows automatically get encoded and quoted to work 12 | on different locales. 13 | License: MIT + file LICENSE 14 | URL: https://jeroen.r-universe.dev/sys 15 | BugReports: https://github.com/jeroen/sys/issues 16 | Encoding: UTF-8 17 | Roxygen: list(markdown = TRUE) 18 | RoxygenNote: 7.1.1 19 | Suggests: 20 | unix (>= 1.4), 21 | spelling, 22 | testthat 23 | Language: en-US 24 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2019 2 | COPYRIGHT HOLDER: Jeroen Ooms 3 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export(as_text) 4 | export(eval_fork) 5 | export(eval_safe) 6 | export(exec_background) 7 | export(exec_internal) 8 | export(exec_status) 9 | export(exec_wait) 10 | export(r_background) 11 | export(r_internal) 12 | export(r_wait) 13 | export(windows_quote) 14 | useDynLib(sys,C_execute) 15 | useDynLib(sys,R_exec_status) 16 | -------------------------------------------------------------------------------- /NEWS: -------------------------------------------------------------------------------- 1 | 3.4.2 2 | - Fix some more strict-prototypes warnings on Windows 3 | 4 | 3.4.1 5 | - Fix strict-prototypes warnings 6 | 7 | 3.4 8 | - Fix performance bug for systems with very large _SC_OPEN_MAX, notably docker. 9 | 10 | 3.3 11 | - Unix: automatially path.expand() to normalize e.g. homedir 12 | - Unix: skip unicode path test on systems without UTF-8 locale. 13 | 14 | 3.2 15 | - Windows: only use CREATE_BREAKAWAY_FROM_JOB if the process has the permission to 16 | do so. This fixes permission errors in certain restricted environments. 17 | - Windows: enable JOB_OBJECT_LIMIT_KILL_ON_JOB_CLOSE to kill orphaned children 18 | - Windows: enable JOB_OBJECT_LIMIT_SILENT_BREAKAWAY_OK to allow for nested jobs 19 | 20 | 3.1 21 | - Windows: run programs through utils::shortPathName() 22 | - New function as_text() for parsing raw vectors into text 23 | - Skip a unit test if the 'whoami' program is not available 24 | 25 | 3.0 26 | - Major cleanup: moved all of the unix specific functions into the unix package 27 | - The 'sys' package now only focuses on executing shell commands 28 | - Removed configure script, no longer needed 29 | - Windows: fix error message when running non-existing command 30 | - Fix support for callback functions as std_out / std_err as documented 31 | 32 | 2.1 33 | - Windows: fix bug introduced in 2.0 when std_out = FALSE 34 | - Support std_in = FALSE to restore old behavior of an unreadable stdin (for rtika) 35 | - Use fcntl instead of dup2() on unix 36 | 37 | 2.0 38 | - Breaking change on Windows: the exec functions now automatically convert 39 | filepaths to shortpath and quote arguments when needed. Therefore the 40 | caller should not shQuote() arguments, because then they will be quoted 41 | twice. This makes Windows behavior more consistent with Unix. 42 | - Windows: switch to wchar_t filepaths and args for better UTF-8 support 43 | - Exec functions have gained a std_in file argument 44 | - Add wrappers r_wait() r_internal() and r_background() for convenience 45 | - No longer enforce the libapparmor-dev dependency on Debian/Ubuntu. 46 | 47 | 1.6 48 | - Faster serialization for raw vectors in eval_fork() 49 | 50 | 1.5 51 | - rlimit values 0 are now ignored and Inf means RLIM_INFINITY 52 | - Windows: fix crash for very long commands 53 | 54 | 1.4 55 | - Fix bug when 'timeout' was given as integer instead of double 56 | - Workaround undefined RLIMIT_AS on OpenBSD 57 | - Use graphics.off() instead of dev.off() to shut down all graphics devices 58 | - Added aa_config() to query apparmor status on supported platforms 59 | - On Linux, eval_fork() now kills entire child process group when parent dies 60 | - The exec() functions no longer change process group on OSX 61 | 62 | 1.3 63 | - Use AppArmor (required) on Debian/Ubuntu in eval_safe() 64 | - Disable console and finalizers inside forked procs 65 | - Add support for rlimits, priority, uid, gid and profile in eval_safe() 66 | 67 | 1.2: 68 | - Windows: show informative system error messages on failures 69 | - Unix: exec_background() does not wait for 1/2 a second 70 | (#6, #7, @gaborcsardi) 71 | - Unix: new functions eval_fork() and eval_safe() 72 | - Many little tweaks 73 | 74 | 1.1: 75 | - Switch from SIGHUP to SIGKILL to kill child process 76 | - Child now uses a pipe to send errno to parent when execvp() fails 77 | - Unit tests that require 'ping' are skipped if 'ping' is not available 78 | 79 | 1.0: 80 | - CRAN release 81 | -------------------------------------------------------------------------------- /R/astext.R: -------------------------------------------------------------------------------- 1 | #' Convert Raw to Text 2 | #' 3 | #' Parses a raw vector as lines of text. This is similar to [charToRaw] but 4 | #' splits output by (platform specific) linebreaks and allows for marking 5 | #' output with a given encoding. 6 | #' 7 | #' 8 | #' @export 9 | #' @seealso [base::charToRaw] 10 | #' @param x vector to be converted to text 11 | #' @param ... parameters passed to [readLines] such as `encoding` or `n` 12 | as_text <- function(x, ...){ 13 | if(length(x)){ 14 | con <- rawConnection(x) 15 | on.exit(close(con)) 16 | readLines(con, ...) 17 | } else { 18 | character(0) 19 | } 20 | } 21 | -------------------------------------------------------------------------------- /R/callr.R: -------------------------------------------------------------------------------- 1 | #' Execute R from R 2 | #' 3 | #' Convenience wrappers for [exec_wait] and [exec_internal] that shell out to 4 | #' R itself: `R.home("bin/R")`. 5 | #' 6 | #' This is a simple but robust way to invoke R commands in a separate process. 7 | #' Use the [callr](https://cran.r-project.org/package=callr) package if you 8 | #' need more sophisticated control over (multiple) R process jobs. 9 | #' 10 | #' @export 11 | #' @rdname exec_r 12 | #' @name exec_r 13 | #' @family sys 14 | #' @inheritParams exec 15 | #' @param args command line arguments for R 16 | #' @param std_in a file to send to stdin, usually an R script (see examples). 17 | #' @examples # Hello world 18 | #' r_wait("--version") 19 | #' 20 | #' # Run some code 21 | #' r_wait(c('--vanilla', '-q', '-e', 'sessionInfo()')) 22 | #' 23 | #' # Run a script via stdin 24 | #' tmp <- tempfile() 25 | #' writeLines(c("x <- rnorm(100)", "mean(x)"), con = tmp) 26 | #' r_wait(std_in = tmp) 27 | r_wait <- function(args = '--vanilla', std_out = stdout(), std_err = stderr(), std_in = NULL){ 28 | exec_wait(rbin(), args = args, std_out = std_out, std_err = std_err, std_in = std_in) 29 | } 30 | 31 | #' @export 32 | #' @rdname exec_r 33 | r_internal <- function(args = '--vanilla', std_in = NULL, error = TRUE){ 34 | exec_internal(rbin(), args = args, std_in = std_in, error = error) 35 | } 36 | 37 | #' @export 38 | #' @rdname exec_r 39 | r_background <- function(args = '--vanilla', std_out = TRUE, std_err = TRUE, std_in = NULL){ 40 | exec_background(rbin(), args = args, std_out = std_out, std_err = std_err, std_in = std_in) 41 | } 42 | 43 | rbin <- function(){ 44 | cmd <- ifelse(.Platform$OS.type == 'windows', 'Rterm', 'R') 45 | file.path(R.home('bin'), cmd) 46 | } 47 | -------------------------------------------------------------------------------- /R/deprecated.R: -------------------------------------------------------------------------------- 1 | #' Deprecated functions 2 | #' 3 | #' These functions have moved into the `unix` package. Please update 4 | #' your references. 5 | #' 6 | #' @export 7 | #' @name sys-deprecated 8 | #' @rdname deprecated 9 | #' @param ... see respective functions in the unix package 10 | eval_safe <- function(...){ 11 | .Deprecated('unix::eval_safe', 'sys') 12 | unix::eval_safe(...) 13 | } 14 | 15 | #' @export 16 | #' @rdname deprecated 17 | eval_fork <- function(...){ 18 | .Deprecated('unix::eval_fork', 'sys') 19 | unix::eval_fork(...) 20 | } 21 | -------------------------------------------------------------------------------- /R/exec.R: -------------------------------------------------------------------------------- 1 | #' Running System Commands 2 | #' 3 | #' Powerful replacements for [system2] with support for interruptions, background 4 | #' tasks and fine grained control over `STDOUT` / `STDERR` binary or text streams. 5 | #' 6 | #' Each value within the `args` vector will automatically be quoted when needed; 7 | #' you should not quote arguments yourself. Doing so anyway could lead to the value 8 | #' being quoted twice on some platforms. 9 | #' 10 | #' The `exec_wait` function runs a system command and waits for the child process 11 | #' to exit. When the child process completes normally (either success or error) it 12 | #' returns with the program exit code. Otherwise (if the child process gets aborted) 13 | #' R raises an error. The R user can interrupt the program by sending SIGINT (press 14 | #' ESC or CTRL+C) in which case the child process tree is properly terminated. 15 | #' Output streams `STDOUT` and `STDERR` are piped back to the parent process and can 16 | #' be sent to a connection or callback function. See the section on *Output Streams* 17 | #' below for details. 18 | #' 19 | #' The `exec_background` function starts the program and immediately returns the 20 | #' PID of the child process. This is useful for running a server daemon or background 21 | #' process. 22 | #' Because this is non-blocking, `std_out` and `std_out` can only be `TRUE`/`FALSE` or 23 | #' a file path. The state of the process can be checked with `exec_status` which 24 | #' returns the exit status, or `NA` if the process is still running. If `wait = TRUE` 25 | #' then `exec_status` blocks until the process completes (but can be interrupted). 26 | #' The child can be killed with [tools::pskill]. 27 | #' 28 | #' The `exec_internal` function is a convenience wrapper around `exec_wait` which 29 | #' automatically captures output streams and raises an error if execution fails. 30 | #' Upon success it returns a list with status code, and raw vectors containing 31 | #' stdout and stderr data (use [as_text] for converting to text). 32 | #' 33 | #' @section Output Streams: 34 | #' 35 | #' The `std_out` and `std_err` parameters are used to control how output streams 36 | #' of the child are processed. Possible values for both foreground and background 37 | #' processes are: 38 | #' 39 | #' - `TRUE`: print child output in R console 40 | #' - `FALSE`: suppress output stream 41 | #' - *string*: name or path of file to redirect output 42 | #' 43 | #' In addition the `exec_wait` function also supports the following `std_out` and `std_err` 44 | #' types: 45 | #' 46 | #' - *connection* a writable R [connection] object such as [stdout] or [stderr] 47 | #' - *function*: callback function with one argument accepting a raw vector (use 48 | #' [as_text] to convert to text). 49 | #' 50 | #' When using `exec_background` with `std_out = TRUE` or `std_err = TRUE` on Windows, 51 | #' separate threads are used to print output. This works in RStudio and RTerm but 52 | #' not in RGui because the latter has a custom I/O mechanism. Directing output to a 53 | #' file is usually the safest option. 54 | #' 55 | #' @export 56 | #' @return `exec_background` returns a pid. `exec_wait` returns an exit code. 57 | #' `exec_internal` returns a list with exit code, stdout and stderr strings. 58 | #' @name exec 59 | #' @aliases sys 60 | #' @seealso Base [system2] and [pipe] provide other methods for running a system 61 | #' command with output. 62 | #' @family sys 63 | #' @rdname exec 64 | #' @param cmd the command to run. Either a full path or the name of a program on 65 | #' the `PATH`. On Windows this is automatically converted to a short path using 66 | #' [Sys.which], unless wrapped in [I()]. 67 | #' @param args character vector of arguments to pass. On Windows these automatically 68 | #' get quoted using [windows_quote], unless the value is wrapped in [I()]. 69 | #' @param std_out if and where to direct child process `STDOUT`. Must be one of 70 | #' `TRUE`, `FALSE`, filename, connection object or callback function. See section 71 | #' on *Output Streams* below for details. 72 | #' @param std_err if and where to direct child process `STDERR`. Must be one of 73 | #' `TRUE`, `FALSE`, filename, connection object or callback function. See section 74 | #' on *Output Streams* below for details. 75 | #' @param std_in file path to map std_in 76 | #' @param timeout maximum time in seconds 77 | #' @examples # Run a command (interrupt with CTRL+C) 78 | #' status <- exec_wait("date") 79 | #' 80 | #' # Capture std/out 81 | #' out <- exec_internal("date") 82 | #' print(out$status) 83 | #' cat(as_text(out$stdout)) 84 | #' 85 | #' if(nchar(Sys.which("ping"))){ 86 | #' 87 | #' # Run a background process (daemon) 88 | #' pid <- exec_background("ping", "localhost") 89 | #' 90 | #' # Kill it after a while 91 | #' Sys.sleep(2) 92 | #' tools::pskill(pid) 93 | #' 94 | #' # Cleans up the zombie proc 95 | #' exec_status(pid) 96 | #' rm(pid) 97 | #' } 98 | exec_wait <- function(cmd, args = NULL, std_out = stdout(), std_err = stderr(), std_in = NULL, timeout = 0){ 99 | # Convert TRUE or filepath into connection objects 100 | std_out <- if(isTRUE(std_out) || identical(std_out, "")){ 101 | stdout() 102 | } else if(is.character(std_out)){ 103 | file(normalizePath(std_out, mustWork = FALSE)) 104 | } else std_out 105 | 106 | std_err <- if(isTRUE(std_err) || identical(std_err, "")){ 107 | stderr() 108 | } else if(is.character(std_err)){ 109 | std_err <- file(normalizePath(std_err, mustWork = FALSE)) 110 | } else std_err 111 | 112 | # Define the callbacks 113 | outfun <- if(inherits(std_out, "connection")){ 114 | if(!isOpen(std_out)){ 115 | open(std_out, "wb") 116 | on.exit(close(std_out), add = TRUE) 117 | } 118 | if(identical(summary(std_out)$text, "text")){ 119 | function(x){ 120 | cat(rawToChar(x), file = std_out) 121 | flush(std_out) 122 | } 123 | } else { 124 | function(x){ 125 | writeBin(x, con = std_out) 126 | flush(std_out) 127 | } 128 | } 129 | } else if(is.function(std_out)){ 130 | if(!length(formals(std_out))) 131 | stop("Function std_out must take at least one argument") 132 | std_out 133 | } 134 | 135 | errfun <- if(inherits(std_err, "connection")){ 136 | if(!isOpen(std_err)){ 137 | open(std_err, "wb") 138 | on.exit(close(std_err), add = TRUE) 139 | } 140 | if(identical(summary(std_err)$text, "text")){ 141 | function(x){ 142 | cat(rawToChar(x), file = std_err) 143 | flush(std_err) 144 | } 145 | } else { 146 | function(x){ 147 | writeBin(x, con = std_err) 148 | flush(std_err) 149 | } 150 | } 151 | } else if(is.function(std_err)){ 152 | if(!length(formals(std_err))) 153 | stop("Function std_err must take at least one argument") 154 | std_err 155 | } 156 | execute(cmd = cmd, args = args, std_out = outfun, std_err = errfun, 157 | std_in = std_in, wait = TRUE, timeout = timeout) 158 | } 159 | 160 | #' @export 161 | #' @rdname exec 162 | exec_background <- function(cmd, args = NULL, std_out = TRUE, std_err = TRUE, std_in = NULL){ 163 | if(!is.character(std_out) && !is.logical(std_out)) 164 | stop("argument 'std_out' must be TRUE / FALSE or a filename") 165 | if(!is.character(std_err) && !is.logical(std_err)) 166 | stop("argument 'std_err' must be TRUE / FALSE or a filename") 167 | execute(cmd = cmd, args = args, std_out = std_out, std_err = std_err, 168 | wait = FALSE, std_in = std_in, timeout = 0) 169 | } 170 | 171 | #' @export 172 | #' @rdname exec 173 | #' @param error automatically raise an error if the exit status is non-zero. 174 | exec_internal <- function(cmd, args = NULL, std_in = NULL, error = TRUE, timeout = 0){ 175 | outcon <- rawConnection(raw(0), "r+") 176 | on.exit(close(outcon), add = TRUE) 177 | errcon <- rawConnection(raw(0), "r+") 178 | on.exit(close(errcon), add = TRUE) 179 | status <- exec_wait(cmd, args, std_out = outcon, 180 | std_err = errcon, std_in = std_in, timeout = timeout) 181 | if(isTRUE(error) && !identical(status, 0L)) 182 | stop(sprintf("Executing '%s' failed with status %d", cmd, status)) 183 | list( 184 | status = status, 185 | stdout = rawConnectionValue(outcon), 186 | stderr = rawConnectionValue(errcon) 187 | ) 188 | } 189 | 190 | #' @export 191 | #' @rdname exec 192 | #' @useDynLib sys R_exec_status 193 | #' @param pid integer with a process ID 194 | #' @param wait block until the process completes 195 | exec_status <- function(pid, wait = TRUE){ 196 | .Call(R_exec_status, pid, wait) 197 | } 198 | 199 | #' @useDynLib sys C_execute 200 | execute <- function(cmd, args, std_out, std_err, std_in, wait, timeout){ 201 | stopifnot(is.character(cmd)) 202 | if(.Platform$OS.type == 'windows'){ 203 | if(!inherits(cmd, 'AsIs')) 204 | cmd <- utils::shortPathName(path.expand(cmd)) 205 | if(!inherits(args, 'AsIs')) 206 | args <- windows_quote(args) 207 | } else { 208 | if(!inherits(cmd, 'AsIs')) 209 | cmd <- path.expand(cmd) 210 | } 211 | stopifnot(is.logical(wait)) 212 | argv <- enc2utf8(c(cmd, args)) 213 | if(length(std_in) && !is.logical(std_in)) # Only files supported for stdin 214 | std_in <- enc2utf8(normalizePath(std_in, mustWork = TRUE)) 215 | .Call(C_execute, cmd, argv, std_out, std_err, std_in, wait, timeout) 216 | } 217 | -------------------------------------------------------------------------------- /R/quote.R: -------------------------------------------------------------------------------- 1 | #' Quote arguments on Windows 2 | #' 3 | #' Quotes and escapes shell arguments when needed so that they get properly parsed 4 | #' by most Windows programs. This function is used internally to automatically quote 5 | #' system commands, the user should normally not quote arguments manually. 6 | #' 7 | #' Algorithm is ported to R from 8 | #' [libuv](https://github.com/libuv/libuv/blob/v1.23.0/src/win/process.c#L454-L524). 9 | #' 10 | #' @export 11 | #' @rdname quote 12 | #' @name quote 13 | #' @param args character vector with arguments 14 | windows_quote <- function(args){ 15 | if(is.null(args)) 16 | return(args) 17 | stopifnot(is.character(args)) 18 | args <- enc2utf8(args) 19 | vapply(args, windows_quote_one, character(1), USE.NAMES = FALSE) 20 | } 21 | 22 | windows_quote_one <- function(str){ 23 | if(!nchar(str)){ 24 | return('""') 25 | } 26 | if(!grepl('[ \t"]', str)){ 27 | return(str) 28 | } 29 | if(!grepl('["\\]', str)){ 30 | return(paste0('"', str, '"')) 31 | } 32 | str <- gsub('([\\]*)"', '\\1\\1\\\\"', str, useBytes = TRUE) 33 | str <- gsub('([\\]+)$', '\\1\\1', str, useBytes = TRUE) 34 | paste0('"', str, '"') 35 | } 36 | -------------------------------------------------------------------------------- /inst/WORDLIST: -------------------------------------------------------------------------------- 1 | AppVeyor 2 | CTRL 3 | ESC 4 | PID 5 | RGui 6 | RStudio 7 | RTerm 8 | SIGINT 9 | STDERR 10 | STDIN 11 | STDOUT 12 | callr 13 | libuv 14 | linebreaks 15 | pid 16 | pskill 17 | stderr 18 | stdin 19 | stdout 20 | -------------------------------------------------------------------------------- /inst/utf8.txt: -------------------------------------------------------------------------------- 1 | すし,寿司,鮨 2 | -------------------------------------------------------------------------------- /man/as_text.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/astext.R 3 | \name{as_text} 4 | \alias{as_text} 5 | \title{Convert Raw to Text} 6 | \usage{ 7 | as_text(x, ...) 8 | } 9 | \arguments{ 10 | \item{x}{vector to be converted to text} 11 | 12 | \item{...}{parameters passed to \link{readLines} such as \code{encoding} or \code{n}} 13 | } 14 | \description{ 15 | Parses a raw vector as lines of text. This is similar to \link{charToRaw} but 16 | splits output by (platform specific) linebreaks and allows for marking 17 | output with a given encoding. 18 | } 19 | \seealso{ 20 | \link[base:rawConversion]{base::charToRaw} 21 | } 22 | -------------------------------------------------------------------------------- /man/deprecated.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/deprecated.R 3 | \name{sys-deprecated} 4 | \alias{sys-deprecated} 5 | \alias{eval_safe} 6 | \alias{eval_fork} 7 | \title{Deprecated functions} 8 | \usage{ 9 | eval_safe(...) 10 | 11 | eval_fork(...) 12 | } 13 | \arguments{ 14 | \item{...}{see respective functions in the unix package} 15 | } 16 | \description{ 17 | These functions have moved into the \code{unix} package. Please update 18 | your references. 19 | } 20 | -------------------------------------------------------------------------------- /man/exec.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/exec.R 3 | \name{exec} 4 | \alias{exec} 5 | \alias{exec_wait} 6 | \alias{sys} 7 | \alias{exec_background} 8 | \alias{exec_internal} 9 | \alias{exec_status} 10 | \title{Running System Commands} 11 | \usage{ 12 | exec_wait( 13 | cmd, 14 | args = NULL, 15 | std_out = stdout(), 16 | std_err = stderr(), 17 | std_in = NULL, 18 | timeout = 0 19 | ) 20 | 21 | exec_background( 22 | cmd, 23 | args = NULL, 24 | std_out = TRUE, 25 | std_err = TRUE, 26 | std_in = NULL 27 | ) 28 | 29 | exec_internal(cmd, args = NULL, std_in = NULL, error = TRUE, timeout = 0) 30 | 31 | exec_status(pid, wait = TRUE) 32 | } 33 | \arguments{ 34 | \item{cmd}{the command to run. Either a full path or the name of a program on 35 | the \code{PATH}. On Windows this is automatically converted to a short path using 36 | \link{Sys.which}, unless wrapped in \code{\link[=I]{I()}}.} 37 | 38 | \item{args}{character vector of arguments to pass. On Windows these automatically 39 | get quoted using \link{windows_quote}, unless the value is wrapped in \code{\link[=I]{I()}}.} 40 | 41 | \item{std_out}{if and where to direct child process \code{STDOUT}. Must be one of 42 | \code{TRUE}, \code{FALSE}, filename, connection object or callback function. See section 43 | on \emph{Output Streams} below for details.} 44 | 45 | \item{std_err}{if and where to direct child process \code{STDERR}. Must be one of 46 | \code{TRUE}, \code{FALSE}, filename, connection object or callback function. See section 47 | on \emph{Output Streams} below for details.} 48 | 49 | \item{std_in}{file path to map std_in} 50 | 51 | \item{timeout}{maximum time in seconds} 52 | 53 | \item{error}{automatically raise an error if the exit status is non-zero.} 54 | 55 | \item{pid}{integer with a process ID} 56 | 57 | \item{wait}{block until the process completes} 58 | } 59 | \value{ 60 | \code{exec_background} returns a pid. \code{exec_wait} returns an exit code. 61 | \code{exec_internal} returns a list with exit code, stdout and stderr strings. 62 | } 63 | \description{ 64 | Powerful replacements for \link{system2} with support for interruptions, background 65 | tasks and fine grained control over \code{STDOUT} / \code{STDERR} binary or text streams. 66 | } 67 | \details{ 68 | Each value within the \code{args} vector will automatically be quoted when needed; 69 | you should not quote arguments yourself. Doing so anyway could lead to the value 70 | being quoted twice on some platforms. 71 | 72 | The \code{exec_wait} function runs a system command and waits for the child process 73 | to exit. When the child process completes normally (either success or error) it 74 | returns with the program exit code. Otherwise (if the child process gets aborted) 75 | R raises an error. The R user can interrupt the program by sending SIGINT (press 76 | ESC or CTRL+C) in which case the child process tree is properly terminated. 77 | Output streams \code{STDOUT} and \code{STDERR} are piped back to the parent process and can 78 | be sent to a connection or callback function. See the section on \emph{Output Streams} 79 | below for details. 80 | 81 | The \code{exec_background} function starts the program and immediately returns the 82 | PID of the child process. This is useful for running a server daemon or background 83 | process. 84 | Because this is non-blocking, \code{std_out} and \code{std_out} can only be \code{TRUE}/\code{FALSE} or 85 | a file path. The state of the process can be checked with \code{exec_status} which 86 | returns the exit status, or \code{NA} if the process is still running. If \code{wait = TRUE} 87 | then \code{exec_status} blocks until the process completes (but can be interrupted). 88 | The child can be killed with \link[tools:pskill]{tools::pskill}. 89 | 90 | The \code{exec_internal} function is a convenience wrapper around \code{exec_wait} which 91 | automatically captures output streams and raises an error if execution fails. 92 | Upon success it returns a list with status code, and raw vectors containing 93 | stdout and stderr data (use \link{as_text} for converting to text). 94 | } 95 | \section{Output Streams}{ 96 | 97 | 98 | The \code{std_out} and \code{std_err} parameters are used to control how output streams 99 | of the child are processed. Possible values for both foreground and background 100 | processes are: 101 | \itemize{ 102 | \item \code{TRUE}: print child output in R console 103 | \item \code{FALSE}: suppress output stream 104 | \item \emph{string}: name or path of file to redirect output 105 | } 106 | 107 | In addition the \code{exec_wait} function also supports the following \code{std_out} and \code{std_err} 108 | types: 109 | \itemize{ 110 | \item \emph{connection} a writable R \link{connection} object such as \link{stdout} or \link{stderr} 111 | \item \emph{function}: callback function with one argument accepting a raw vector (use 112 | \link{as_text} to convert to text). 113 | } 114 | 115 | When using \code{exec_background} with \code{std_out = TRUE} or \code{std_err = TRUE} on Windows, 116 | separate threads are used to print output. This works in RStudio and RTerm but 117 | not in RGui because the latter has a custom I/O mechanism. Directing output to a 118 | file is usually the safest option. 119 | } 120 | 121 | \examples{ 122 | # Run a command (interrupt with CTRL+C) 123 | status <- exec_wait("date") 124 | 125 | # Capture std/out 126 | out <- exec_internal("date") 127 | print(out$status) 128 | cat(as_text(out$stdout)) 129 | 130 | if(nchar(Sys.which("ping"))){ 131 | 132 | # Run a background process (daemon) 133 | pid <- exec_background("ping", "localhost") 134 | 135 | # Kill it after a while 136 | Sys.sleep(2) 137 | tools::pskill(pid) 138 | 139 | # Cleans up the zombie proc 140 | exec_status(pid) 141 | rm(pid) 142 | } 143 | } 144 | \seealso{ 145 | Base \link{system2} and \link{pipe} provide other methods for running a system 146 | command with output. 147 | 148 | Other sys: 149 | \code{\link{exec_r}} 150 | } 151 | \concept{sys} 152 | -------------------------------------------------------------------------------- /man/exec_r.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/callr.R 3 | \name{exec_r} 4 | \alias{exec_r} 5 | \alias{r_wait} 6 | \alias{r_internal} 7 | \alias{r_background} 8 | \title{Execute R from R} 9 | \usage{ 10 | r_wait( 11 | args = "--vanilla", 12 | std_out = stdout(), 13 | std_err = stderr(), 14 | std_in = NULL 15 | ) 16 | 17 | r_internal(args = "--vanilla", std_in = NULL, error = TRUE) 18 | 19 | r_background(args = "--vanilla", std_out = TRUE, std_err = TRUE, std_in = NULL) 20 | } 21 | \arguments{ 22 | \item{args}{command line arguments for R} 23 | 24 | \item{std_out}{if and where to direct child process \code{STDOUT}. Must be one of 25 | \code{TRUE}, \code{FALSE}, filename, connection object or callback function. See section 26 | on \emph{Output Streams} below for details.} 27 | 28 | \item{std_err}{if and where to direct child process \code{STDERR}. Must be one of 29 | \code{TRUE}, \code{FALSE}, filename, connection object or callback function. See section 30 | on \emph{Output Streams} below for details.} 31 | 32 | \item{std_in}{a file to send to stdin, usually an R script (see examples).} 33 | 34 | \item{error}{automatically raise an error if the exit status is non-zero.} 35 | } 36 | \description{ 37 | Convenience wrappers for \link{exec_wait} and \link{exec_internal} that shell out to 38 | R itself: \code{R.home("bin/R")}. 39 | } 40 | \details{ 41 | This is a simple but robust way to invoke R commands in a separate process. 42 | Use the \href{https://cran.r-project.org/package=callr}{callr} package if you 43 | need more sophisticated control over (multiple) R process jobs. 44 | } 45 | \examples{ 46 | # Hello world 47 | r_wait("--version") 48 | 49 | # Run some code 50 | r_wait(c('--vanilla', '-q', '-e', 'sessionInfo()')) 51 | 52 | # Run a script via stdin 53 | tmp <- tempfile() 54 | writeLines(c("x <- rnorm(100)", "mean(x)"), con = tmp) 55 | r_wait(std_in = tmp) 56 | } 57 | \seealso{ 58 | Other sys: 59 | \code{\link{exec}} 60 | } 61 | \concept{sys} 62 | -------------------------------------------------------------------------------- /man/quote.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/quote.R 3 | \name{quote} 4 | \alias{quote} 5 | \alias{windows_quote} 6 | \title{Quote arguments on Windows} 7 | \usage{ 8 | windows_quote(args) 9 | } 10 | \arguments{ 11 | \item{args}{character vector with arguments} 12 | } 13 | \description{ 14 | Quotes and escapes shell arguments when needed so that they get properly parsed 15 | by most Windows programs. This function is used internally to automatically quote 16 | system commands, the user should normally not quote arguments manually. 17 | } 18 | \details{ 19 | Algorithm is ported to R from 20 | \href{https://github.com/libuv/libuv/blob/v1.23.0/src/win/process.c#L454-L524}{libuv}. 21 | } 22 | -------------------------------------------------------------------------------- /readme.md: -------------------------------------------------------------------------------- 1 | # sys 2 | 3 | > Portable System Utilities 4 | 5 | [![CRAN_Status_Badge](http://www.r-pkg.org/badges/version/sys)](https://cran.r-project.org/package=sys) 6 | [![CRAN RStudio mirror downloads](http://cranlogs.r-pkg.org/badges/sys)](https://cran.r-project.org/package=sys) 7 | 8 | Powerful replacements for base system2 with consistent behavior across 9 | platforms. Supports interruption, background tasks, and full control over 10 | STDOUT / STDERR binary or text streams. 11 | 12 | ## Hello World 13 | 14 | Run a blocking process 15 | 16 | ```r 17 | # Blocks until done, interrupt with ESC or CTRL+C 18 | res <- exec_wait("ping", "google.com") 19 | ``` 20 | 21 | To run as a background process: 22 | 23 | ```r 24 | # Run as a background process 25 | pid <- exec_background("ping", "google.com") 26 | 27 | # Kill it after a while 28 | sleep(4) 29 | tools::pskill(pid) 30 | ``` 31 | 32 | See the `?sys` manual page for details. 33 | 34 | ## Details 35 | 36 | The `exec_wait` function runs a system command and waits for the child process 37 | to exit. When the child process completes normally (either success or error) it 38 | returns with the program exit code. Otherwise (if the child process gets aborted) 39 | R raises an error. The R user can interrupt the program by sending SIGINT (press 40 | ESC or CTRL+C) in which case the child process tree is properly terminated. 41 | Output streams `STDOUT` and `STDERR` are piped back to the parent process and can 42 | be sent to a connection or callback function. See the section on *Output Streams* 43 | below for details. 44 | 45 | The `exec_background` function starts the program and immediately returns the 46 | PID of the child process. Because this is non-blocking, `std_out` and `std_out` 47 | can only be `TRUE`/`FALSE` or a file path. The state of the process is not 48 | controlled by R but the child can be killed manually with [tools::pskill]. This 49 | is useful for running a server daemon or background process. 50 | 51 | The `exec_internal` function is a convenience wrapper around `exec_wait` which 52 | automatically captures output streams and raises an error if execution fails. 53 | Upon success it returns a list with status code, and raw vectors containing 54 | stdout and stderr data (use `as_text` for converting to text). 55 | 56 | ## Output Streams: 57 | 58 | The `std_out` and `std_err` parameters are used to control how output streams 59 | of the child are processed. Possible values for both foreground and background 60 | processes are: 61 | 62 | - `TRUE`: print child output in R console 63 | - `FALSE`: suppress output stream 64 | - *string*: name or path of file to redirect output 65 | 66 | In addition the `exec_wait` function also supports the following `std_out` and `std_err` 67 | types: 68 | 69 | - *connection* a writable R [connection] object such as [stdout] or [stderr] 70 | - *function*: callback function with one argument accepting a raw vector (use 71 | `as_text` to convert to text). 72 | 73 | When using `exec_background` with `std_out = TRUE` or `std_err = TRUE` on Windows, 74 | separate threads are used to print output. This works in RStudio and RTerm but 75 | not in RGui because the latter has a custom I/O mechanism. Directing output to a 76 | file is usually the safest option. 77 | -------------------------------------------------------------------------------- /src/Makevars.win: -------------------------------------------------------------------------------- 1 | OBJECTS = win32/exec.o init.o 2 | -------------------------------------------------------------------------------- /src/exec.c: -------------------------------------------------------------------------------- 1 | /* For SIG_BLOCK */ 2 | #ifndef _GNU_SOURCE 3 | #define _GNU_SOURCE 4 | #endif 5 | 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | #include 12 | #include 13 | #include 14 | #include 15 | #include 16 | 17 | #ifdef __linux__ 18 | #include 19 | #endif 20 | 21 | #define r 0 22 | #define w 1 23 | #define waitms 200 24 | #define IS_STRING(x) (Rf_isString(x) && Rf_length(x)) 25 | #define IS_TRUE(x) (Rf_isLogical(x) && Rf_length(x) && asLogical(x)) 26 | #define IS_FALSE(x) (Rf_isLogical(x) && Rf_length(x) && !asLogical(x)) 27 | 28 | void kill_process_group(int signum) { 29 | kill(0, SIGKILL); // kills process group 30 | raise(SIGKILL); // just to be sure 31 | } 32 | 33 | /* prevent potential handlers from cleaning up exit codes */ 34 | static void block_sigchld(void){ 35 | sigset_t block_sigchld; 36 | sigemptyset(&block_sigchld); 37 | sigaddset(&block_sigchld, SIGCHLD); 38 | sigprocmask(SIG_BLOCK, &block_sigchld, NULL); 39 | } 40 | 41 | static void resume_sigchild(void){ 42 | sigset_t block_sigchld; 43 | sigemptyset(&block_sigchld); 44 | sigaddset(&block_sigchld, SIGCHLD); 45 | sigprocmask(SIG_UNBLOCK, &block_sigchld, NULL); 46 | } 47 | 48 | /* check for system errors */ 49 | void bail_if(int err, const char * what){ 50 | if(err) 51 | Rf_errorcall(R_NilValue, "System failure for: %s (%s)", what, strerror(errno)); 52 | } 53 | 54 | /* In the fork we don't want to use the R API anymore */ 55 | void print_if(int err, const char * what){ 56 | if(err){ 57 | FILE *stream = fdopen(STDERR_FILENO, "w"); 58 | if(stream){ 59 | fprintf(stream, "System failure for: %s (%s)\n", what, strerror(errno)); 60 | fclose(stream); 61 | } 62 | } 63 | } 64 | 65 | void warn_if(int err, const char * what){ 66 | if(err) 67 | Rf_warningcall(R_NilValue, "System failure for: %s (%s)", what, strerror(errno)); 68 | } 69 | 70 | void set_pipe(int input, int output[2]){ 71 | print_if(dup2(output[w], input) < 0, "dup2() stdout/stderr"); 72 | close(output[r]); 73 | close(output[w]); 74 | } 75 | 76 | void pipe_set_read(int pipe[2]){ 77 | close(pipe[w]); 78 | bail_if(fcntl(pipe[r], F_SETFL, O_NONBLOCK) < 0, "fcntl() in pipe_set_read"); 79 | } 80 | 81 | void set_input(const char * file){ 82 | close(STDIN_FILENO); 83 | int fd = open(file, O_RDONLY); //lowest numbered FD should be 0 84 | print_if(fd != 0, "open() set_input not equal to STDIN_FILENO"); 85 | } 86 | 87 | void set_output(int target, const char * file){ 88 | close(target); 89 | int fd = open(file, O_WRONLY | O_CREAT, S_IRUSR | S_IWUSR); 90 | print_if(fd < 0, "open() set_output"); 91 | if(fd == target) 92 | return; 93 | print_if(fcntl(fd, F_DUPFD, target) < 0, "fcntl() set_output"); 94 | close(fd); 95 | } 96 | 97 | void safe_close(int target){ 98 | set_output(target, "/dev/null"); 99 | } 100 | 101 | static void check_child_success(int fd, const char * cmd){ 102 | int child_errno; 103 | int n = read(fd, &child_errno, sizeof(child_errno)); 104 | close(fd); 105 | if (n) { 106 | Rf_errorcall(R_NilValue, "Failed to execute '%s' (%s)", cmd, strerror(child_errno)); 107 | } 108 | } 109 | 110 | /* Check for interrupt without long jumping */ 111 | void check_interrupt_fn(void *dummy) { 112 | R_CheckUserInterrupt(); 113 | } 114 | 115 | int pending_interrupt(void) { 116 | return !(R_ToplevelExec(check_interrupt_fn, NULL)); 117 | } 118 | 119 | int wait_for_action2(int fd1, int fd2){ 120 | short events = POLLIN | POLLERR | POLLHUP; 121 | struct pollfd ufds[2] = { 122 | {fd1, events, events}, 123 | {fd2, events, events} 124 | }; 125 | return poll(ufds, 2, waitms); 126 | } 127 | 128 | static void R_callback(SEXP fun, const char * buf, ssize_t len){ 129 | if(!isFunction(fun)) return; 130 | int ok; 131 | SEXP str = PROTECT(allocVector(RAWSXP, len)); 132 | memcpy(RAW(str), buf, len); 133 | SEXP call = PROTECT(LCONS(fun, LCONS(str, R_NilValue))); 134 | R_tryEval(call, R_GlobalEnv, &ok); 135 | UNPROTECT(2); 136 | } 137 | 138 | void print_output(int pipe_out[2], SEXP fun){ 139 | static ssize_t len; 140 | static char buffer[65336]; 141 | while ((len = read(pipe_out[r], buffer, sizeof(buffer))) > 0) 142 | R_callback(fun, buffer, len); 143 | } 144 | 145 | SEXP C_execute(SEXP command, SEXP args, SEXP outfun, SEXP errfun, SEXP input, SEXP wait, SEXP timeout){ 146 | //split process 147 | int block = asLogical(wait); 148 | int pipe_out[2]; 149 | int pipe_err[2]; 150 | int failure[2]; 151 | 152 | //setup execvp errno pipe 153 | bail_if(pipe(failure), "pipe(failure)"); 154 | 155 | //create io pipes only in blocking mode 156 | if(block){ 157 | bail_if(pipe(pipe_out) || pipe(pipe_err), "create pipe"); 158 | block_sigchld(); 159 | } 160 | 161 | //fork the main process 162 | pid_t pid = fork(); 163 | bail_if(pid < 0, "fork()"); 164 | 165 | //CHILD PROCESS 166 | if(pid == 0){ 167 | if(block){ 168 | //undo blocking in child (is this needed at all?) 169 | resume_sigchild(); 170 | 171 | // send stdout/stderr to pipes 172 | set_pipe(STDOUT_FILENO, pipe_out); 173 | set_pipe(STDERR_FILENO, pipe_err); 174 | } else { 175 | //redirect stdout in background process 176 | if(IS_STRING(outfun)){ 177 | set_output(STDOUT_FILENO, CHAR(STRING_ELT(outfun, 0))); 178 | } else if(!IS_TRUE(outfun)){ 179 | safe_close(STDOUT_FILENO); 180 | } 181 | //redirect stderr in background process 182 | if(IS_STRING(errfun)){ 183 | set_output(STDERR_FILENO, CHAR(STRING_ELT(errfun, 0))); 184 | } else if(!IS_TRUE(errfun)){ 185 | safe_close(STDERR_FILENO); 186 | } 187 | } 188 | 189 | //Linux only: set pgid and commit suicide when parent dies 190 | #ifdef PR_SET_PDEATHSIG 191 | setpgid(0, 0); 192 | prctl(PR_SET_PDEATHSIG, SIGTERM); 193 | signal(SIGTERM, kill_process_group); 194 | #endif 195 | //OSX: do NOT change pgid, so we receive signals from parent group 196 | 197 | // Set STDIN for child (default is /dev/null) 198 | if(IS_FALSE(input)){ 199 | //set stdin to unreadable /dev/null (O_WRONLY) 200 | safe_close(STDIN_FILENO); 201 | } else if(!IS_TRUE(input)){ 202 | set_input(IS_STRING(input) ? CHAR(STRING_ELT(input, 0)) : "/dev/null"); 203 | } 204 | 205 | //close all file descriptors before exit, otherwise they can segfault 206 | for (int i = 3; i < sysconf(_SC_OPEN_MAX); i++) { 207 | if(i != failure[w]){ 208 | int err = close(i); 209 | if(i > 200 && err < 0) 210 | break; 211 | } 212 | } 213 | 214 | //prepare execv 215 | int len = Rf_length(args); 216 | char * argv[len + 1]; 217 | argv[len] = NULL; 218 | for(int i = 0; i < len; i++){ 219 | argv[i] = strdup(CHAR(STRING_ELT(args, i))); 220 | } 221 | 222 | //execvp never returns if successful 223 | fcntl(failure[w], F_SETFD, FD_CLOEXEC); 224 | execvp(CHAR(STRING_ELT(command, 0)), argv); 225 | 226 | //execvp failed! Send errno to parent 227 | print_if(write(failure[w], &errno, sizeof(errno)) < 0, "write to failure pipe"); 228 | close(failure[w]); 229 | 230 | //exit() not allowed by CRAN. raise() should suffice 231 | //exit(EXIT_FAILURE); 232 | raise(SIGKILL); 233 | } 234 | 235 | //PARENT PROCESS: 236 | close(failure[w]); 237 | if (!block){ 238 | check_child_success(failure[r], CHAR(STRING_ELT(command, 0))); 239 | return ScalarInteger(pid); 240 | } 241 | 242 | //blocking: close write end of IO pipes 243 | pipe_set_read(pipe_out); 244 | pipe_set_read(pipe_err); 245 | 246 | //start timer 247 | struct timeval start, end; 248 | double elapsed, totaltime = REAL(timeout)[0]; 249 | gettimeofday(&start, NULL); 250 | 251 | //status -1 means error, 0 means running 252 | int status = 0; 253 | int killcount = 0; 254 | while (waitpid(pid, &status, WNOHANG) >= 0){ 255 | //check for timeout 256 | if(totaltime > 0){ 257 | gettimeofday(&end, NULL); 258 | elapsed = (end.tv_sec - start.tv_sec) + (end.tv_usec - start.tv_usec) / 1e6; 259 | if(killcount == 0 && elapsed > totaltime){ 260 | warn_if(kill(pid, SIGINT), "interrupt child"); 261 | killcount++; 262 | } else if(killcount == 1 && elapsed > (totaltime + 1)){ 263 | warn_if(kill(pid, SIGKILL), "force kill child"); 264 | killcount++; 265 | } 266 | } 267 | 268 | //for well behaved programs, SIGINT is automatically forwarded 269 | if(pending_interrupt()){ 270 | //pass interrupt to child. On second try we SIGKILL. 271 | warn_if(kill(pid, killcount ? SIGKILL : SIGINT), "kill child"); 272 | killcount++; 273 | } 274 | //make sure to empty the pipes, even if fun == NULL 275 | wait_for_action2(pipe_out[r], pipe_err[r]); 276 | 277 | //print stdout/stderr buffers 278 | print_output(pipe_out, outfun); 279 | print_output(pipe_err, errfun); 280 | } 281 | warn_if(close(pipe_out[r]), "close stdout"); 282 | warn_if(close(pipe_err[r]), "close stderr"); 283 | 284 | // check for execvp() error *after* closing pipes and zombie 285 | resume_sigchild(); 286 | check_child_success(failure[r], CHAR(STRING_ELT(command, 0))); 287 | 288 | if(WIFEXITED(status)){ 289 | return ScalarInteger(WEXITSTATUS(status)); 290 | } else { 291 | int signal = WTERMSIG(status); 292 | if(signal != 0){ 293 | if(killcount && elapsed > totaltime){ 294 | Rf_errorcall(R_NilValue, "Program '%s' terminated (timeout reached: %.2fsec)", 295 | CHAR(STRING_ELT(command, 0)), totaltime); 296 | } else { 297 | Rf_errorcall(R_NilValue, "Program '%s' terminated by SIGNAL (%s)", 298 | CHAR(STRING_ELT(command, 0)), strsignal(signal)); 299 | } 300 | } 301 | Rf_errorcall(R_NilValue, "Program terminated abnormally"); 302 | } 303 | } 304 | 305 | SEXP R_exec_status(SEXP rpid, SEXP wait){ 306 | int wstat = NA_INTEGER; 307 | pid_t pid = asInteger(rpid); 308 | do { 309 | int res = waitpid(pid, &wstat, WNOHANG); 310 | bail_if(res < 0, "waitpid()"); 311 | if(res) 312 | break; 313 | usleep(100*1000); 314 | } while (asLogical(wait) && !pending_interrupt()); 315 | return ScalarInteger(wstat); 316 | } 317 | -------------------------------------------------------------------------------- /src/init.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include // for NULL 4 | #include 5 | 6 | /* .Call calls */ 7 | extern SEXP C_execute(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); 8 | extern SEXP R_exec_status(SEXP, SEXP); 9 | 10 | static const R_CallMethodDef CallEntries[] = { 11 | {"C_execute", (DL_FUNC) &C_execute, 7}, 12 | {"R_exec_status", (DL_FUNC) &R_exec_status, 2}, 13 | {NULL, NULL, 0} 14 | }; 15 | 16 | void R_init_sys(DllInfo *dll){ 17 | R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); 18 | R_useDynamicSymbols(dll, FALSE); 19 | } 20 | -------------------------------------------------------------------------------- /src/win32/exec.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | 5 | /* NOTES 6 | * On Windows, when wait = FALSE and std_out = TRUE or std_err = TRUE 7 | * then stdout / stderr get piped to background threads to simulate 8 | * the unix behavior of inheriting stdout/stderr in by child. 9 | */ 10 | 11 | #define IS_STRING(x) (Rf_isString(x) && Rf_length(x)) 12 | #define IS_TRUE(x) (Rf_isLogical(x) && Rf_length(x) && asLogical(x)) 13 | #define IS_FALSE(x) (Rf_isLogical(x) && Rf_length(x) && !asLogical(x)) 14 | 15 | /* copy from R source */ 16 | 17 | static const char *formatError(DWORD res){ 18 | static char buf[1000], *p; 19 | FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS, 20 | NULL, res, 21 | MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), 22 | buf, 1000, NULL); 23 | p = buf+strlen(buf) -1; 24 | if(*p == '\n') *p = '\0'; 25 | p = buf+strlen(buf) -1; 26 | if(*p == '\r') *p = '\0'; 27 | p = buf+strlen(buf) -1; 28 | if(*p == '.') *p = '\0'; 29 | return buf; 30 | } 31 | 32 | 33 | /* check for system errors */ 34 | static void bail_if(int err, const char * what){ 35 | if(err) 36 | Rf_errorcall(R_NilValue, "System failure for: %s (%s)", what, formatError(GetLastError())); 37 | } 38 | 39 | static void warn_if(int err, const char * what){ 40 | if(err) 41 | Rf_warningcall(R_NilValue, "System failure for: %s (%s)", what, formatError(GetLastError())); 42 | } 43 | 44 | static BOOL can_create_job(void){ 45 | BOOL is_job = 0; 46 | bail_if(!IsProcessInJob(GetCurrentProcess(), NULL, &is_job), "IsProcessInJob"); 47 | //Rprintf("Current process is %s\n", is_job ? "a job" : "not a job"); 48 | if(!is_job) 49 | return 1; 50 | JOBOBJECT_BASIC_LIMIT_INFORMATION info; 51 | bail_if(!QueryInformationJobObject(NULL, JobObjectBasicLimitInformation, &info, 52 | sizeof(JOBOBJECT_BASIC_LIMIT_INFORMATION), NULL), "QueryInformationJobObject"); 53 | return info.LimitFlags & JOB_OBJECT_LIMIT_SILENT_BREAKAWAY_OK || 54 | info.LimitFlags & JOB_OBJECT_LIMIT_BREAKAWAY_OK; 55 | } 56 | 57 | /* Check for interrupt without long jumping */ 58 | static void check_interrupt_fn(void *dummy) { 59 | R_CheckUserInterrupt(); 60 | } 61 | 62 | static int pending_interrupt(void) { 63 | return !(R_ToplevelExec(check_interrupt_fn, NULL)); 64 | } 65 | 66 | static int str_to_wchar(const char * str, wchar_t **wstr){ 67 | int len = MultiByteToWideChar( CP_UTF8 , 0 , str , -1, NULL , 0 ); 68 | *wstr = calloc(len, sizeof(*wstr)); 69 | MultiByteToWideChar( CP_UTF8 , 0 , str , -1, *wstr , len ); 70 | return len; 71 | } 72 | 73 | static wchar_t* sexp_to_wchar(SEXP args){ 74 | int total = 1; 75 | wchar_t *out = calloc(total, sizeof(*out)); 76 | wchar_t *space = NULL; 77 | int spacelen = str_to_wchar(" ", &space); 78 | for(int i = 0; i < Rf_length(args); i++){ 79 | wchar_t *arg = NULL; 80 | const char *str = CHAR(STRING_ELT(args, i)); 81 | int len = str_to_wchar(str, &arg); 82 | total = total + len; 83 | out = realloc(out, (total + spacelen) * sizeof(*out)); 84 | if(wcsncat(out, arg, len) == NULL) 85 | Rf_error("Failure in wcsncat"); 86 | if(i < Rf_length(args) - 1 && wcsncat(out, space, spacelen) == NULL) 87 | Rf_error("Failure in wcsncat"); 88 | free(arg); 89 | } 90 | return out; 91 | } 92 | 93 | static void R_callback(SEXP fun, const char * buf, ssize_t len){ 94 | if(!isFunction(fun)) return; 95 | int ok; 96 | SEXP str = PROTECT(allocVector(RAWSXP, len)); 97 | memcpy(RAW(str), buf, len); 98 | SEXP call = PROTECT(LCONS(fun, LCONS(str, R_NilValue))); 99 | R_tryEval(call, R_GlobalEnv, &ok); 100 | UNPROTECT(2); 101 | } 102 | 103 | //ReadFile blocks so no need to sleep() 104 | //Do NOT call RPrintf here because R is not thread safe! 105 | static DWORD WINAPI PrintPipe(HANDLE pipe, FILE *stream){ 106 | while(1){ 107 | unsigned long len; 108 | char buffer[65336]; 109 | if(!ReadFile(pipe, buffer, 65337, &len, NULL)){ 110 | int err = GetLastError(); 111 | if(err != ERROR_BROKEN_PIPE) 112 | Rprintf("ReadFile(pipe) failed (%d)\n", err); 113 | CloseHandle(pipe); 114 | ExitThread(0); 115 | return(0); 116 | } 117 | fprintf(stream, "%.*s", (int) len, buffer); 118 | } 119 | } 120 | 121 | static DWORD WINAPI PrintOut(HANDLE pipe){ 122 | return PrintPipe(pipe, stdout); 123 | } 124 | 125 | static DWORD WINAPI PrintErr(HANDLE pipe){ 126 | return PrintPipe(pipe, stderr); 127 | } 128 | 129 | static void ReadFromPipe(SEXP fun, HANDLE pipe){ 130 | unsigned long len = 1; 131 | while(1){ 132 | bail_if(!PeekNamedPipe(pipe, NULL, 0, NULL, &len, NULL), "PeekNamedPipe"); 133 | if(!len) 134 | break; 135 | char buffer[len]; 136 | unsigned long outlen; 137 | if(ReadFile(pipe, buffer, len, &outlen, NULL)) 138 | R_callback(fun, buffer, outlen); 139 | } 140 | } 141 | 142 | static HANDLE fd_read(const char *path){ 143 | SECURITY_ATTRIBUTES sa = {0}; 144 | sa.lpSecurityDescriptor = NULL; 145 | sa.bInheritHandle = TRUE; 146 | DWORD dwFlags = FILE_ATTRIBUTE_NORMAL; 147 | wchar_t *wpath; 148 | str_to_wchar(path, &wpath); 149 | HANDLE out = CreateFileW(wpath, GENERIC_READ, FILE_SHARE_READ, 150 | &sa, OPEN_EXISTING, dwFlags, NULL); 151 | free(wpath); 152 | bail_if(out == INVALID_HANDLE_VALUE, "CreateFile"); 153 | return out; 154 | } 155 | 156 | /* Create FD in Windows */ 157 | static HANDLE fd_write(const char * path){ 158 | SECURITY_ATTRIBUTES sa = {0}; 159 | sa.lpSecurityDescriptor = NULL; 160 | sa.bInheritHandle = TRUE; 161 | DWORD dwFlags = FILE_ATTRIBUTE_NORMAL; 162 | wchar_t *wpath; 163 | str_to_wchar(path, &wpath); 164 | HANDLE out = CreateFileW(wpath, GENERIC_WRITE, FILE_SHARE_WRITE, 165 | &sa, CREATE_ALWAYS, dwFlags, NULL); 166 | free(wpath); 167 | bail_if(out == INVALID_HANDLE_VALUE, "CreateFile"); 168 | return out; 169 | } 170 | 171 | static BOOL CALLBACK closeWindows(HWND hWnd, LPARAM lpid) { 172 | DWORD pid = (DWORD)lpid; 173 | DWORD win; 174 | GetWindowThreadProcessId(hWnd, &win); 175 | if(pid == win) 176 | CloseWindow(hWnd); 177 | return TRUE; 178 | } 179 | 180 | static void fin_proc(SEXP ptr){ 181 | if(!R_ExternalPtrAddr(ptr)) return; 182 | CloseHandle(R_ExternalPtrAddr(ptr)); 183 | R_ClearExternalPtr(ptr); 184 | } 185 | 186 | // Keeps one process handle open to let exec_status() read exit code 187 | static SEXP make_handle_ptr(HANDLE proc){ 188 | SEXP ptr = PROTECT(R_MakeExternalPtr(proc, R_NilValue, R_NilValue)); 189 | R_RegisterCFinalizerEx(ptr, fin_proc, 1); 190 | setAttrib(ptr, R_ClassSymbol, mkString("handle_ptr")); 191 | UNPROTECT(1); 192 | return ptr; 193 | } 194 | 195 | SEXP C_execute(SEXP command, SEXP args, SEXP outfun, SEXP errfun, SEXP input, SEXP wait, SEXP timeout){ 196 | int block = asLogical(wait); 197 | SECURITY_ATTRIBUTES sa; 198 | sa.nLength = sizeof(sa); 199 | sa.lpSecurityDescriptor = NULL; 200 | sa.bInheritHandle = TRUE; 201 | 202 | STARTUPINFOW si = {0}; 203 | si.cb = sizeof(STARTUPINFOW); 204 | si.dwFlags |= STARTF_USESTDHANDLES; 205 | HANDLE pipe_out = NULL; 206 | HANDLE pipe_err = NULL; 207 | 208 | //set STDOUT pipe 209 | if(block || IS_TRUE(outfun)){ 210 | bail_if(!CreatePipe(&pipe_out, &si.hStdOutput, &sa, 0), "CreatePipe stdout"); 211 | bail_if(!SetHandleInformation(pipe_out, HANDLE_FLAG_INHERIT, 0), "SetHandleInformation stdout"); 212 | } else if(IS_STRING(outfun)){ 213 | si.hStdOutput = fd_write(CHAR(STRING_ELT(outfun, 0))); 214 | } 215 | 216 | //set STDERR 217 | if(block || IS_TRUE(errfun)){ 218 | bail_if(!CreatePipe(&pipe_err, &si.hStdError, &sa, 0), "CreatePipe stderr"); 219 | bail_if(!SetHandleInformation(pipe_err, HANDLE_FLAG_INHERIT, 0), "SetHandleInformation stdout"); 220 | } else if(IS_STRING(errfun)){ 221 | si.hStdError = fd_write(CHAR(STRING_ELT(errfun, 0))); 222 | } 223 | 224 | if(IS_STRING(input)){ 225 | si.hStdInput = fd_read(CHAR(STRING_ELT(input, 0))); 226 | } 227 | 228 | //append args into full command line 229 | wchar_t *argv = sexp_to_wchar(args); 230 | if(wcslen(argv) >= 32768) 231 | Rf_error("Windows commands cannot be longer than 32,768 characters"); 232 | PROCESS_INFORMATION pi = {0}; 233 | const char * cmd = CHAR(STRING_ELT(command, 0)); 234 | 235 | // set the process flags 236 | BOOL use_job = can_create_job(); 237 | DWORD dwCreationFlags = CREATE_NO_WINDOW | CREATE_SUSPENDED | CREATE_BREAKAWAY_FROM_JOB * use_job; 238 | /* This will cause orphans unless we install a SIGBREAK handler on the child 239 | if(!block) 240 | dwCreationFlags |= CREATE_NEW_PROCESS_GROUP; //allows sending CTRL+BREAK 241 | */ 242 | 243 | //printf("ARGV: %S\n", argv); //NOTE capital %S for formatting wchar_t str 244 | if(!CreateProcessW(NULL, argv, &sa, &sa, TRUE, dwCreationFlags, NULL, NULL, &si, &pi)){ 245 | //Failure to start, probably non existing program. Cleanup. 246 | const char *errmsg = formatError(GetLastError()); 247 | CloseHandle(pipe_out); CloseHandle(pipe_err); 248 | CloseHandle(si.hStdInput); CloseHandle(si.hStdOutput); CloseHandle(si.hStdInput); 249 | Rf_errorcall(R_NilValue, "Failed to execute '%s' (%s)", cmd, errmsg); 250 | } 251 | 252 | //CloseHandle(pi.hThread); 253 | DWORD pid = GetProcessId(pi.hProcess); 254 | HANDLE proc = pi.hProcess; 255 | HANDLE thread = pi.hThread; 256 | 257 | //A 'job' is some sort of process container 258 | HANDLE job = CreateJobObject(NULL, NULL); 259 | if(use_job){ 260 | JOBOBJECT_EXTENDED_LIMIT_INFORMATION joblimits; 261 | memset(&joblimits, 0, sizeof joblimits); 262 | joblimits.BasicLimitInformation.LimitFlags = 263 | JOB_OBJECT_LIMIT_BREAKAWAY_OK | 264 | JOB_OBJECT_LIMIT_SILENT_BREAKAWAY_OK | 265 | JOB_OBJECT_LIMIT_DIE_ON_UNHANDLED_EXCEPTION | 266 | JOB_OBJECT_LIMIT_KILL_ON_JOB_CLOSE; 267 | SetInformationJobObject(job, JobObjectExtendedLimitInformation, &joblimits, sizeof joblimits); 268 | bail_if(!AssignProcessToJobObject(job, proc), "AssignProcessToJobObject"); 269 | } 270 | ResumeThread(thread); 271 | CloseHandle(thread); 272 | free(argv); 273 | 274 | //start timer 275 | int timeout_reached = 0; 276 | struct timeval start, end; 277 | double totaltime = REAL(timeout)[0]; 278 | gettimeofday(&start, NULL); 279 | 280 | int res = pid; 281 | if(block){ 282 | int running = 1; 283 | while(running){ 284 | //wait 1ms, enough to fix busy waiting. Windows does not support polling on pipes. 285 | running = WaitForSingleObject(proc, 1); 286 | ReadFromPipe(outfun, pipe_out); 287 | ReadFromPipe(errfun, pipe_err); 288 | 289 | //check for timeout 290 | if(totaltime > 0){ 291 | gettimeofday(&end, NULL); 292 | timeout_reached = ((end.tv_sec - start.tv_sec) + (end.tv_usec - start.tv_usec) / 1e6) > totaltime; 293 | } 294 | if(pending_interrupt() || timeout_reached){ 295 | running = 0; 296 | EnumWindows(closeWindows, pid); 297 | if(use_job){ 298 | bail_if(!TerminateJobObject(job, -2), "TerminateJobObject"); 299 | } else { 300 | bail_if(!TerminateProcess(proc, -2), "TerminateProcess"); 301 | } 302 | /*** TerminateJobObject kills all procs and threads 303 | if(!TerminateThread(thread, 99)) 304 | Rf_errorcall(R_NilValue, "TerminateThread failed %d", GetLastError()); 305 | if(!TerminateProcess(proc, 99)) 306 | Rf_errorcall(R_NilValue, "TerminateProcess failed: %d", GetLastError()); 307 | */ 308 | } 309 | } 310 | DWORD exit_code; 311 | warn_if(!CloseHandle(pipe_out), "CloseHandle pipe_out"); 312 | warn_if(!CloseHandle(pipe_err), "CloseHandle pipe_err"); 313 | warn_if(GetExitCodeProcess(proc, &exit_code) == 0, "GetExitCodeProcess"); 314 | warn_if(!CloseHandle(proc), "CloseHandle proc"); 315 | warn_if(!CloseHandle(job), "CloseHandle job"); 316 | res = exit_code; //if wait=TRUE, return exit code 317 | } else { 318 | //create background threads to print stdout/stderr 319 | if(IS_TRUE(outfun)) 320 | bail_if(!CreateThread(NULL, 0, PrintOut, pipe_out, 0, 0), "CreateThread stdout"); 321 | if(IS_TRUE(errfun)) 322 | bail_if(!CreateThread(NULL, 0, PrintErr, pipe_err, 0, 0), "CreateThread stderr"); 323 | } 324 | CloseHandle(si.hStdError); 325 | CloseHandle(si.hStdOutput); 326 | CloseHandle(si.hStdInput); 327 | if(timeout_reached && res){ 328 | Rf_errorcall(R_NilValue, "Program '%s' terminated (timeout reached: %.2fsec)", 329 | CHAR(STRING_ELT(command, 0)), totaltime); 330 | } 331 | SEXP out = PROTECT(ScalarInteger(res)); 332 | if(!block){ 333 | setAttrib(out, install("handle"), make_handle_ptr(proc)); 334 | if(use_job){ 335 | setAttrib(out, install("job"), make_handle_ptr(job)); 336 | } 337 | } 338 | UNPROTECT(1); 339 | return out; 340 | } 341 | 342 | SEXP R_exec_status(SEXP rpid, SEXP wait){ 343 | DWORD exit_code = NA_INTEGER; 344 | int pid = asInteger(rpid); 345 | HANDLE proc = OpenProcess(PROCESS_QUERY_INFORMATION | SYNCHRONIZE, FALSE, pid); 346 | bail_if(!proc, "OpenProcess()"); 347 | do { 348 | DWORD res = WaitForSingleObject(proc, 200); 349 | bail_if(res == WAIT_FAILED, "WaitForSingleObject()"); 350 | if(res != WAIT_TIMEOUT) 351 | break; 352 | } while(asLogical(wait) && !pending_interrupt()); 353 | warn_if(GetExitCodeProcess(proc, &exit_code) == 0, "GetExitCodeProcess"); 354 | CloseHandle(proc); 355 | return ScalarInteger(exit_code == STILL_ACTIVE ? NA_INTEGER : exit_code); 356 | } 357 | -------------------------------------------------------------------------------- /sys.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | StripTrailingWhitespace: Yes 17 | 18 | BuildType: Package 19 | PackageUseDevtools: Yes 20 | PackageInstallArgs: --no-multiarch --with-keep.source --install-tests 21 | PackageRoxygenize: rd,collate,namespace 22 | -------------------------------------------------------------------------------- /tests/spelling.R: -------------------------------------------------------------------------------- 1 | if(requireNamespace('spelling', quietly=TRUE)) 2 | spelling::spell_check_test(vignettes = TRUE, error = FALSE, skip_on_cran = TRUE) 3 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(sys) 3 | 4 | test_check("sys") 5 | -------------------------------------------------------------------------------- /tests/testthat/test-binary.R: -------------------------------------------------------------------------------- 1 | context("binary streams") 2 | 3 | test_that("copy a binary image", { 4 | is_windows <- identical("windows", tolower(Sys.info()[["sysname"]])) 5 | olddir <- getwd() 6 | on.exit(setwd(olddir)) 7 | setwd(tempdir()) 8 | buf <- serialize(rnorm(1e6), NULL) 9 | writeBin(buf, "input.bin") 10 | if(is_windows){ 11 | res1 <- exec_wait("cmd", c("/C", "type", "input.bin"), std_out = "out1.bin") 12 | res2 <- exec_wait("cmd", c("/C", "type", "input.bin", ">&2"), std_err = "out2.bin") 13 | pid1 <- exec_background("cmd", c("/C", "type", "input.bin"), std_out = "out3.bin") 14 | pid2 <- exec_background("cmd", c("/C", "type", "input.bin", ">&2"), std_err = "out4.bin") 15 | data1 <- exec_internal("cmd", c("/C", "type", "input.bin")) 16 | data2 <- exec_internal("cmd", c("/C", "type", "input.bin", ">&2")) 17 | writeBin(data1$stdout, "out5.bin") 18 | writeBin(data2$stderr, "out6.bin") 19 | } else { 20 | res1 <- exec_wait("cat", "input.bin", std_out = "out1.bin") 21 | res2 <- exec_wait("sh", c("-c", "cat input.bin >&2"), std_err = "out2.bin") 22 | pid1 <- exec_background("cat", "input.bin", std_out = "out3.bin") 23 | pid2 <- exec_background("sh", c("-c", "cat input.bin >&2"), std_err = "out4.bin") 24 | data1 <- exec_internal("cat", "input.bin") 25 | data2 <- exec_internal("sh", c("-c", "cat input.bin >&2")) 26 | writeBin(data1$stdout, "out5.bin") 27 | writeBin(data2$stderr, "out6.bin") 28 | } 29 | on.exit(tools::pskill(pid1), add = TRUE) 30 | on.exit(tools::pskill(pid2), add = TRUE) 31 | on.exit(unlink(sprintf("out%d.bin", 1:6)), add = TRUE) 32 | expect_equal(res1, 0) 33 | expect_equal(res2, 0) 34 | expect_equal(data1$status, 0) 35 | expect_equal(data2$status, 0) 36 | expect_is(pid1, "integer") 37 | expect_is(pid2, "integer") 38 | Sys.sleep(1) 39 | hash <- unname(tools::md5sum("input.bin")) 40 | expect_equal(hash, unname(tools::md5sum("out1.bin"))) 41 | expect_equal(hash, unname(tools::md5sum("out2.bin"))) 42 | expect_equal(hash, unname(tools::md5sum("out3.bin"))) 43 | expect_equal(hash, unname(tools::md5sum("out4.bin"))) 44 | expect_equal(hash, unname(tools::md5sum("out5.bin"))) 45 | expect_equal(hash, unname(tools::md5sum("out6.bin"))) 46 | }) 47 | -------------------------------------------------------------------------------- /tests/testthat/test-encoding.R: -------------------------------------------------------------------------------- 1 | context("test-encoding") 2 | 3 | support_unicode_path <- function(){ 4 | getRversion() >= "3.6.0" && grepl("(UTF-8|1252)", Sys.getlocale('LC_CTYPE')) 5 | } 6 | 7 | test_that("UTF-8 encoded text arguments", { 8 | txt <- readLines(system.file('utf8.txt', package = 'sys', mustWork = TRUE), encoding = 'UTF-8') 9 | res <- sys::exec_internal('echo', txt) 10 | expect_equal(res$status, 0) 11 | con <- rawConnection(res$stdout) 12 | output <- readLines(con, encoding = 'UTF-8') 13 | close(con) 14 | expect_equal(txt, output) 15 | }) 16 | 17 | test_that("UTF-8 filenames, binary data", { 18 | skip_if_not(support_unicode_path(), 'System does not support unicode paths') 19 | tmp <- paste(tempdir(), "\u0420\u0423\u0421\u0421\u041a\u0418\u0419.txt", sep = "/") 20 | tmp <- normalizePath(tmp, mustWork = FALSE) 21 | f <- file(tmp, 'wb') 22 | serialize(iris, f) 23 | close(f) 24 | expect_true(file.exists(tmp)) 25 | 26 | # As a file path 27 | res <- if(.Platform$OS.type == "windows"){ 28 | sys::exec_internal('cmd', c("/C", "type", tmp)) 29 | } else { 30 | sys::exec_internal('cat', tmp) 31 | } 32 | expect_equal(res$status, 0) 33 | expect_equal(unserialize(res$stdout), iris) 34 | }) 35 | 36 | test_that("UTF-8 filename as std_in", { 37 | skip_if_not(support_unicode_path(), 'System does not support unicode paths') 38 | input <- c("foo", "bar", "baz") 39 | txt <- readLines(system.file('utf8.txt', package = 'sys', mustWork = TRUE), encoding = 'UTF-8') 40 | tmp <- normalizePath(paste(tempdir(), txt, sep = "/"), mustWork = FALSE) 41 | f <- file(tmp, 'wb') 42 | writeBin(charToRaw(paste(input, collapse = "\n")), con = f, useBytes = TRUE) 43 | close(f) 44 | expect_true(file.exists(tmp)) 45 | res <- exec_internal('sort', std_in = tmp) 46 | expect_equal(res$status, 0) 47 | con <- rawConnection(res$stdout) 48 | output <- readLines(con) 49 | close(con) 50 | expect_equal(output, sort(input)) 51 | }) 52 | -------------------------------------------------------------------------------- /tests/testthat/test-error.R: -------------------------------------------------------------------------------- 1 | context("error handling") 2 | 3 | test_that("catching execution errors", { 4 | # Test that 'ping' is on the path 5 | skip_if_not(as.logical(nchar(Sys.which('ping'))), "ping utility is not available") 6 | 7 | # Ping has different args for each platform 8 | sysname <- tolower(Sys.info()[["sysname"]]) 9 | args <- switch(sysname, 10 | windows = c("-n", "2", "localhost"), 11 | darwin = c("-t2", "localhost"), 12 | sunos = c("-s", "localhost", "64", "2"), 13 | c("-c2", "localhost") #linux/default 14 | ) 15 | 16 | # Run ping 17 | expect_equal(exec_wait("ping", args, std_out = FALSE), 0) 18 | 19 | # Error for non existing program (win-builder gives a german error) 20 | expect_error(exec_wait("doesnotexist"), "Failed to execute.*(file|Datei)") 21 | expect_error(exec_background("doesnotexist"), "Failed to execute.*(file|Datei)") 22 | 23 | # Same without stdout 24 | expect_error(exec_wait("doesnotexist", std_out = FALSE, std_err = FALSE), "Failed to execute") 25 | expect_error(exec_background("doesnotexist", std_out = FALSE, std_err = FALSE), "Failed to execute") 26 | 27 | # Program error 28 | expect_is(exec_wait("ping", "999.999.999.999.999", std_err = FALSE, std_out = FALSE), "integer") 29 | expect_is(exec_background("ping", "999.999.999.999.999", std_err = FALSE, std_out = FALSE), "integer") 30 | 31 | # Program error with exec_internal 32 | expect_error(exec_internal('ping', "999.999.999.999.999")) 33 | out <- exec_internal('ping', "999.999.999.999.999", error = FALSE) 34 | expect_gt(out$status, 0) 35 | }) 36 | -------------------------------------------------------------------------------- /tests/testthat/test-nesting.R: -------------------------------------------------------------------------------- 1 | context("nested jobs") 2 | 3 | test_that("Jobs can be nested", { 4 | skip_if_not(nchar(Sys.which('whoami')) > 0) 5 | res1 <- sys::exec_internal("whoami") 6 | expect_equal(res1$status, 0) 7 | user <- as_text(res1$stdout) 8 | res2 <- sys::r_internal(c('--silent', '-e', 'sys::exec_wait("whoami")')) 9 | expect_equal(res2$status, 0) 10 | output <- as_text(res2$stdout) 11 | expect_equal(output[2], user) 12 | }) 13 | -------------------------------------------------------------------------------- /tests/testthat/test-quote.R: -------------------------------------------------------------------------------- 1 | context("test-quote") 2 | 3 | # Test cases: https://github.com/libuv/libuv/blob/v1.23.0/src/win/process.c#L486-L502 4 | test_that("windows quoting arguments", { 5 | input <- c('hello"world', 'hello""world', 'hello\\world', 'hello\\\\world', 6 | 'hello\\"world', 'hello\\\\"world', 'hello world\\', '') 7 | output <- c('"hello\\"world"', '"hello\\"\\"world"', 'hello\\world', 'hello\\\\world', 8 | '"hello\\\\\\"world"', '"hello\\\\\\\\\\"world"', '"hello world\\\\"', '""') 9 | expect_equal(windows_quote(input), output) 10 | 11 | if(.Platform$OS.type == 'windows'){ 12 | args <- c('/C', 'echo', 'foo bar') 13 | out1 <- exec_internal('cmd', args) 14 | out2 <- exec_internal('cmd', I(args)) 15 | expect_equal(as_text(out1$stdout), '"foo bar"') 16 | expect_equal(as_text(out2$stdout), 'foo bar') 17 | } 18 | }) 19 | 20 | -------------------------------------------------------------------------------- /tests/testthat/test-stdin.R: -------------------------------------------------------------------------------- 1 | context("test-stdin") 2 | 3 | test_that("streaming from stdin works", { 4 | tmp <- tempfile() 5 | input <- c("foo", "bar", "baz") 6 | writeLines(input, con = tmp) 7 | res <- exec_internal('sort', std_in = tmp) 8 | expect_equal(res$status, 0) 9 | con <- rawConnection(res$stdout) 10 | output <- readLines(con) 11 | close(con) 12 | expect_equal(output, sort(input)) 13 | }) 14 | -------------------------------------------------------------------------------- /tests/testthat/test-stdout.R: -------------------------------------------------------------------------------- 1 | context("stdout and stderr") 2 | 3 | test_that("test output for std_out equals TRUE/FALSE", { 4 | skip_if_not(packageVersion("base") >= "3.2.2", "skipping capture.output tests") 5 | is_windows <- identical("windows", tolower(Sys.info()[["sysname"]])) 6 | string <- "helloworld" 7 | if(is_windows){ 8 | output1 <- capture.output(res <- exec_wait('cmd', c('/C', 'echo', string))) 9 | output2 <- capture.output(res <- exec_wait('cmd', c('/C', 'echo', string), std_out = FALSE)) 10 | output3 <- capture.output(res <- exec_wait('cmd', c('/C', 'echo', string, ">&2"), std_out = FALSE), type = 'message') 11 | output4 <- capture.output(res <- exec_wait('cmd', c('/C', 'echo', string, ">&2"), std_out = FALSE, std_err = FALSE), type = 'message') 12 | } else { 13 | output1 <- capture.output(res <- exec_wait('echo', string)) 14 | output2 <- capture.output(res <- exec_wait('echo', string, std_out = FALSE)) 15 | command <- sprintf("echo %s >&2", string) 16 | output3 <- capture.output(res <- exec_wait("sh", c("-c", command)), type = 'message') 17 | output4 <- capture.output(res <- exec_wait("sh", c("-c", command), std_err = FALSE), type = 'message') 18 | } 19 | expect_equal(sub("\\W+$", "", output1), string) 20 | expect_equal(output2, character()) 21 | expect_equal(sub("\\W+$", "", output3), string) 22 | expect_equal(output4, character()) 23 | }) 24 | 25 | test_that("User supplied callback function", { 26 | skip_if_not(nchar(Sys.which('whoami')) > 0) 27 | user <- system2("whoami", stdout = TRUE) 28 | out <- NULL 29 | add <- function(x){ 30 | out <<- c(out, x) 31 | } 32 | res <- exec_wait('whoami', std_out = add) 33 | expect_equal(res, 0) 34 | expect_equal(as_text(out), user) 35 | 36 | }) 37 | -------------------------------------------------------------------------------- /tests/testthat/test-timeout.R: -------------------------------------------------------------------------------- 1 | context("test-timeout") 2 | 3 | test_that("exec timeout works", { 4 | if(.Platform$OS.type == "windows"){ 5 | command = "ping" 6 | args = c("-n", "5", "localhost") 7 | } else { 8 | command = 'sleep' 9 | args = '5' 10 | } 11 | times <- system.time({ 12 | expect_error(exec_wait(command, args, timeout = 1.50, std_out = FALSE), "timeout") 13 | }) 14 | expect_gte(times[['elapsed']], 1.45) 15 | expect_lt(times[['elapsed']], 2.50) 16 | 17 | # Also try with exec_internal 18 | times <- system.time({ 19 | expect_error(exec_internal(command, args, timeout = 0.50), "timeout") 20 | }) 21 | expect_gte(times[['elapsed']], 0.45) 22 | expect_lt(times[['elapsed']], 1.50) 23 | }) 24 | --------------------------------------------------------------------------------