From 5d67f03b3517ae28277f0a85795aea9e11543db5 Mon Sep 17 00:00:00 2001 From: Kevin Ushey Date: Mon, 5 Oct 2026 12:58:55 -0700 Subject: [PATCH] harden the ipc transport used by background jobs Adds a version 2 request format used when RStudio advertises it via RSTUDIOAPI_IPC_VERSION: a plain-text ticket (secret + request id) with the serialized call in a sibling payload file, so RStudio can verify the secret before deserializing anything, and a response of list(id, value | error) so stale responses are discarded. Falls back to the existing format for older RStudio versions. The shared secret is moved from the environment into an option when the package loads, so processes spawned by a job no longer inherit the ability to call into the IDE. --- NEWS.md | 8 ++ R/remote.R | 166 ++++++++++++++++++++++++++------ R/zzz.R | 11 +++ tests/testthat/test-remote.R | 179 +++++++++++++++++++++++++++++++++++ 4 files changed, 335 insertions(+), 29 deletions(-) create mode 100644 R/zzz.R create mode 100644 tests/testthat/test-remote.R diff --git a/NEWS.md b/NEWS.md index 2cd1ca5..fcc6dae 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,13 @@ # rstudioapi (development version) +* The IPC transport used by background jobs to call back into RStudio has + been hardened. Newer RStudio versions check the shared secret before + deserializing a request, responses are written atomically and matched to + their request, and the secret is removed from the job's environment when + rstudioapi loads, so processes spawned by a job no longer inherit the + ability to call into the IDE. Older versions of RStudio continue to use the + previous transport. + # rstudioapi 0.19.0 * `getDelegatedAzureToken()` gains an `as` argument. With `as = "AzureToken"`, diff --git a/R/remote.R b/R/remote.R index af5ad60..232971a 100644 --- a/R/remote.R +++ b/R/remote.R @@ -1,4 +1,3 @@ - #' Detect RStudio Jobs #' #' Use this function to detect whether RStudio is running an R "job". @@ -34,17 +33,102 @@ isWorkbenchJob <- function() { identical(Sys.getenv("RSTUDIO_WORKBENCH_JOB"), "1") } +# IPC with the parent RStudio session +# +# When RStudio launches an R process (e.g. a background job), it hands the +# process a request path, a response path and a shared secret via environment +# variables. rstudioapi calls made from that process are serialized into a +# request file; RStudio picks the request up while polling the job, evaluates +# the call, and writes a response file. +# +# RStudio advertises the newest request format it accepts through the +# RSTUDIOAPI_IPC_VERSION environment variable: +# +# - Version 1 (unset): the request is a single RDS payload containing both the +# secret and the call, and the response is the bare result. +# +# - Version 2: the request is a plain-text ticket (magic line, then +# 'key=value' lines for version, secret and id) and the call is written to a +# sibling '.payload' file. RStudio checks the secret before +# deserializing anything, and the response is list(id, value) or +# list(id, error), so a stale response can be told apart from the real one. +# +# The shared secret is moved out of the environment into an R option when the +# package loads (see .onLoad), so processes spawned by the job can't use it to +# call back into the IDE. The request and response paths stay put, since they +# only identify the job and other packages use them to detect jobs. + +ipcSecret <- function() { + secret <- getOption("rstudioapi.ipc.secret", default = NA) + if (is.na(secret)) + secret <- Sys.getenv("RSTUDIOAPI_IPC_SHARED_SECRET", unset = NA) + secret +} + +ipcVersion <- function() { + version <- Sys.getenv("RSTUDIOAPI_IPC_VERSION", unset = "1") + version <- suppressWarnings(as.integer(version)) + if (is.na(version)) 1L else version +} + +ipcRequestId <- function() { + # tempfile() gives us a unique token without touching the user's RNG + basename(tempfile(paste0("rstudioapi-", Sys.getpid(), "-"))) +} + +# Write 'writer(path)' output into a sibling temporary file, then rename it +# into place, so the reader never observes a partially-written file. +ipcWriteAtomic <- function(path, writer) { + tmp <- tempfile(tmpdir = dirname(path)) + on.exit(unlink(tmp), add = TRUE) + writer(tmp) + if (!file.rename(tmp, path)) + stop("failed to write rstudioapi IPC file '", path, "'") + invisible(path) +} + +# Poll until 'responseFile' holds a response that 'accept' is happy with, or +# the timeout elapses. Unreadable or rejected responses are discarded and the +# poll continues, so a half-written or stale file never masquerades as ours. +ipcAwaitResponse <- function(responseFile, accept) { + + # in theory we'd just do a blocking read but there isn't really a good + # way to do this in a cross-platform way without additional dependencies + now <- Sys.time() + timeout <- getOption("rstudioapi.remote.timeout", default = 10) + repeat { + + if (file.exists(responseFile)) { + response <- tryCatch(readRDS(responseFile), error = function(e) NULL) + if (!is.null(response) && accept(response)) + return(response) + if (!is.null(response)) + unlink(responseFile) + } + + diff <- difftime(Sys.time(), now, units = "secs") + if (diff > timeout) + stop("RStudio did not respond to rstudioapi IPC request") + + Sys.sleep(0.1) + + } + +} + callRemote <- function(call, frame) { # check for active request / response requestFile <- Sys.getenv("RSTUDIOAPI_IPC_REQUESTS_FILE", unset = NA) responseFile <- Sys.getenv("RSTUDIOAPI_IPC_RESPONSE_FILE", unset = NA) - secret <- Sys.getenv("RSTUDIOAPI_IPC_SHARED_SECRET", unset = NA) - if (is.na(requestFile) || is.na(responseFile) || is.na(secret)) + if (is.na(requestFile) || is.na(responseFile)) stop("internal error: callRemote() called without remote connection") - - # clean up on exit - on.exit(unlink(c(requestFile, responseFile)), add = TRUE) + + secret <- ipcSecret() + if (is.na(secret)) { + stop("this R process has no rstudioapi IPC credentials; only the R ", + "process launched by RStudio itself can call back into the IDE") + } # remove srcrefs (un-needed for serialization here) attr(call, "srcref") <- NULL @@ -62,35 +146,59 @@ callRemote <- function(call, frame) { call <- as.call(c(callFun, args)) - # write to tempfile and rename, to ensure atomicity - data <- list(secret = secret, call = call) - tmp <- tempfile(tmpdir = dirname(requestFile)) - saveRDS(data, file = tmp) - file.rename(tmp, requestFile) + if (ipcVersion() >= 2L) + callRemoteV2(call, requestFile, responseFile, secret) + else + callRemoteV1(call, requestFile, responseFile, secret) - # loop until response is ready (poll) - # in theory we'd just do a blocking read but there isn't really a good - # way to do this in a cross-platform way without additional dependencies - now <- Sys.time() - timeout <- getOption("rstudioapi.remote.timeout", default = 10) - repeat { +} - # check for response - if (file.exists(responseFile)) - break +callRemoteV2 <- function(call, requestFile, responseFile, secret) { - # check for lack of response - diff <- difftime(Sys.time(), now, units = "secs") - if (diff > timeout) - stop("RStudio did not respond to rstudioapi IPC request") + id <- ipcRequestId() + payloadFile <- paste(requestFile, "payload", sep = ".") + on.exit(unlink(c(requestFile, payloadFile, responseFile)), add = TRUE) - # wait a bit - Sys.sleep(0.1) + # the payload goes first and the ticket last: RStudio only looks for the + # ticket, so a complete ticket implies a complete payload + ipcWriteAtomic(payloadFile, function(path) { + saveRDS(call, file = path) + }) - } + ticket <- c( + "rstudioapi-ipc", + "version=2", + paste0("secret=", secret), + paste0("id=", id) + ) + + ipcWriteAtomic(requestFile, function(path) { + writeLines(ticket, con = path) + }) + + response <- ipcAwaitResponse(responseFile, function(response) { + is.list(response) && identical(response$id, id) + }) + + if ("error" %in% names(response)) + stop(response$error) + + response$value + +} + +callRemoteV1 <- function(call, requestFile, responseFile, secret) { + + on.exit(unlink(c(requestFile, responseFile)), add = TRUE) + + data <- list(secret = secret, call = call) + ipcWriteAtomic(requestFile, function(path) { + saveRDS(data, file = path) + }) - # read response - response <- readRDS(responseFile) + # older RStudio versions write the response in place, so accept whatever + # readRDS() manages to read and retry while the file is being written + response <- ipcAwaitResponse(responseFile, function(response) TRUE) if (inherits(response, "error")) stop(response) diff --git a/R/zzz.R b/R/zzz.R new file mode 100644 index 0000000..2e733f5 --- /dev/null +++ b/R/zzz.R @@ -0,0 +1,11 @@ +.onLoad <- function(libname, pkgname) { + + # take the IPC secret out of the environment, so that processes spawned by + # an RStudio job don't inherit the ability to call back into the IDE + secret <- Sys.getenv("RSTUDIOAPI_IPC_SHARED_SECRET", unset = NA) + if (!is.na(secret)) { + options(rstudioapi.ipc.secret = secret) + Sys.unsetenv("RSTUDIOAPI_IPC_SHARED_SECRET") + } + +} diff --git a/tests/testthat/test-remote.R b/tests/testthat/test-remote.R new file mode 100644 index 0000000..0e2b6ec --- /dev/null +++ b/tests/testthat/test-remote.R @@ -0,0 +1,179 @@ + +# Simulates the RStudio side of the IPC transport in a separate R process: +# waits for a request, answers it with 'responder', and exits. Returns the +# path to a file the server writes its own diagnostics to. +startFakeServer <- function(requestFile, responseFile, secret, version, error = FALSE) { + + script <- tempfile("rstudioapi-fake-server-", fileext = ".R") + log <- tempfile("rstudioapi-fake-server-", fileext = ".log") + + code <- substitute({ + + deadline <- Sys.time() + 20 + while (!file.exists(requestFile) && Sys.time() < deadline) + Sys.sleep(0.05) + + if (version >= 2) { + ticket <- readLines(requestFile) + fields <- strsplit(ticket[-1], "=", fixed = TRUE) + ticket <- setNames( + vapply(fields, `[[`, 2L, FUN.VALUE = ""), + vapply(fields, `[[`, 1L, FUN.VALUE = "") + ) + call <- readRDS(paste(requestFile, "payload", sep = ".")) + ok <- identical(ticket[["secret"]], secret) + response <- if (error) + list(id = ticket[["id"]], error = simpleError("boom")) + else + list(id = ticket[["id"]], value = list(ok = ok, call = call)) + } else { + data <- readRDS(requestFile) + ok <- identical(data[["secret"]], secret) + response <- list(ok = ok, call = data[["call"]]) + } + + # write in place (not atomically), as older RStudio versions do, so the + # client must tolerate reading a partially-written file + saveRDS(response, file = responseFile) + writeLines("done", log) + + }, list( + requestFile = requestFile, + responseFile = responseFile, + secret = secret, + version = version, + error = error, + log = log + )) + + writeLines(deparse(code), script) + rscript <- file.path(R.home("bin"), "Rscript") + system2(rscript, shQuote(script), wait = FALSE, stdout = FALSE, stderr = FALSE) + + log + +} + +withIpcEnvironment <- function(version, secret, expr) { + + dir <- tempfile("rstudioapi-ipc-") + dir.create(dir) + on.exit(unlink(dir, recursive = TRUE), add = TRUE) + + requestFile <- file.path(dir, "requests.rds") + responseFile <- file.path(dir, "response.rds") + + old <- Sys.getenv( + c("RSTUDIOAPI_IPC_REQUESTS_FILE", "RSTUDIOAPI_IPC_RESPONSE_FILE", "RSTUDIOAPI_IPC_VERSION"), + unset = NA + ) + on.exit({ + for (name in names(old)) { + if (is.na(old[[name]])) Sys.unsetenv(name) else do.call(Sys.setenv, as.list(old[name])) + } + }, add = TRUE) + + Sys.setenv( + RSTUDIOAPI_IPC_REQUESTS_FILE = requestFile, + RSTUDIOAPI_IPC_RESPONSE_FILE = responseFile + ) + if (version >= 2) Sys.setenv(RSTUDIOAPI_IPC_VERSION = version) else Sys.unsetenv("RSTUDIOAPI_IPC_VERSION") + + oldOptions <- options(rstudioapi.ipc.secret = secret, rstudioapi.remote.timeout = 15) + on.exit(options(oldOptions), add = TRUE) + + expr(requestFile, responseFile) + +} + +test_that("version 2 requests are written as a ticket plus payload and matched by id", { + + withIpcEnvironment(2L, "s3cret", function(requestFile, responseFile) { + + startFakeServer(requestFile, responseFile, "s3cret", 2L) + + # a stale response from an earlier request must be ignored, not returned + saveRDS(list(id = "stale", value = "stale"), responseFile) + + result <- callRemote(quote(versionInfo(1, x = "two")), environment()) + expect_true(result$ok) + expect_identical(result$call, quote(rstudioapi::versionInfo(1, x = "two"))) + + # the transport cleans up after itself + expect_false(file.exists(requestFile)) + expect_false(file.exists(paste(requestFile, "payload", sep = "."))) + expect_false(file.exists(responseFile)) + + }) + +}) + +test_that("version 1 requests are used when RStudio doesn't advertise a newer protocol", { + + withIpcEnvironment(1L, "s3cret", function(requestFile, responseFile) { + + startFakeServer(requestFile, responseFile, "s3cret", 1L) + + result <- callRemote(quote(rstudioapi::versionInfo()), environment()) + expect_true(result$ok) + expect_identical(result$call, quote(rstudioapi::versionInfo())) + expect_false(file.exists(requestFile)) + expect_false(file.exists(responseFile)) + + }) + +}) + +test_that("version 2 errors from RStudio are re-raised in the client", { + + withIpcEnvironment(2L, "s3cret", function(requestFile, responseFile) { + startFakeServer(requestFile, responseFile, "s3cret", 2L, error = TRUE) + expect_error(callRemote(quote(versionInfo()), environment()), "boom") + }) + +}) + +test_that("callRemote() times out when RStudio doesn't answer", { + + withIpcEnvironment(2L, "s3cret", function(requestFile, responseFile) { + options(rstudioapi.remote.timeout = 0.5) + expect_error( + callRemote(quote(versionInfo()), environment()), + "did not respond" + ) + }) + +}) + +test_that("callRemote() refuses to run without a secret", { + + withIpcEnvironment(2L, NA, function(requestFile, responseFile) { + old <- Sys.getenv("RSTUDIOAPI_IPC_SHARED_SECRET", unset = NA) + on.exit(if (is.na(old)) Sys.unsetenv("RSTUDIOAPI_IPC_SHARED_SECRET") else Sys.setenv(RSTUDIOAPI_IPC_SHARED_SECRET = old)) + Sys.unsetenv("RSTUDIOAPI_IPC_SHARED_SECRET") + + expect_error( + callRemote(quote(versionInfo()), environment()), + "no rstudioapi IPC credentials" + ) + }) + +}) + +test_that(".onLoad() moves the IPC secret out of the environment", { + + old <- Sys.getenv("RSTUDIOAPI_IPC_SHARED_SECRET", unset = NA) + oldOptions <- options(rstudioapi.ipc.secret = NULL) + on.exit({ + options(oldOptions) + if (is.na(old)) Sys.unsetenv("RSTUDIOAPI_IPC_SHARED_SECRET") else Sys.setenv(RSTUDIOAPI_IPC_SHARED_SECRET = old) + }, add = TRUE) + + Sys.setenv(RSTUDIOAPI_IPC_SHARED_SECRET = "s3cret") + .onLoad(NULL, "rstudioapi") + + expect_identical(Sys.getenv("RSTUDIOAPI_IPC_SHARED_SECRET", unset = NA), NA_character_) + expect_identical(getOption("rstudioapi.ipc.secret"), "s3cret") + expect_identical(ipcSecret(), "s3cret") + +})