Nothing
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()
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.