From ed705aab7ab4a758d3c11a8ddfbc8b05b09ebe8f Mon Sep 17 00:00:00 2001 From: Lionel Henry Date: Wed, 1 Jul 2026 14:31:18 +0200 Subject: [PATCH 1/2] Prevent parallel functions from running --- crates/ark/src/modules/positron/fork_guard.R | 83 ++++++++++++++ crates/ark/src/modules/positron/init.R | 1 + crates/ark/src/modules/positron/system.R | 12 ++ .../tests/integration/kernel_fork_guard.rs | 103 ++++++++++++++++++ crates/ark/tests/integration/main.rs | 1 + 5 files changed, 200 insertions(+) create mode 100644 crates/ark/src/modules/positron/fork_guard.R create mode 100644 crates/ark/tests/integration/kernel_fork_guard.rs diff --git a/crates/ark/src/modules/positron/fork_guard.R b/crates/ark/src/modules/positron/fork_guard.R new file mode 100644 index 0000000000..1b7becb435 --- /dev/null +++ b/crates/ark/src/modules/positron/fork_guard.R @@ -0,0 +1,83 @@ +# +# fork_guard.R +# +# Copyright (C) 2026 Posit Software, PBC. All rights reserved. +# +# + +# ark's IOPub/ZMQ background threads don't survive `fork()` +# (posit-dev/positron#3817). Every forking path in {parallel} funnels through +# the internal `mcfork()`, the only R-level caller of the C fork primitive. So +# shimming `mcfork()` with a stub that errors immediately blocks them all, +# pointing the user at backends that launch fresh subprocesses instead. +# +# We also shim `makeForkCluster()` directly. It wraps `mcfork()` in a +# `tryCatch()` and rethrows a generic "Cluster setup failed." on any error, so +# our message would never reach the user otherwise. `makeCluster(type = "FORK")` +# dispatches to `makeForkCluster()` through the namespace, so it is covered too. +# +# `mclapply()` and friends fall back to a serial `lapply()`/`mapply()` when +# `mc.cores = 1` or the input has fewer than two elements. Those paths never +# reach `mcfork()`, so they keep working and run serially, matching Windows +# where {parallel} ships serial stubs (`R/windows/mcdummies.R`) and never forks. + +initialize_fork_guard <- function() { + # These functions only fork on Unix. On Windows {parallel} never forks, so + # there is nothing to guard. + if (is_windows()) { + return(invisible()) + } + + if (isNamespaceLoaded("parallel")) { + bind_fork_guard_ns() + if ("package:parallel" %in% search()) { + bind_fork_guard_pkg() + } + } + + setHook(packageEvent("parallel", "onLoad"), function(...) { + bind_fork_guard_ns() + }) + setHook(packageEvent("parallel", "attach"), function(...) { + bind_fork_guard_pkg() + }) +} + +# `mcfork()` is internal, so the namespace binding covers every caller. Only +# `makeForkCluster()` is exported, so it also needs a package binding for +# unqualified calls after `library(parallel)`. +fork_guard_ns_names <- c("mcfork", "makeForkCluster") +fork_guard_pkg_names <- "makeForkCluster" + +bind_fork_guard_ns <- function() { + for (name in fork_guard_ns_names) { + ns_bind("parallel", name, make_fork_guard_shim(name)) + } +} + +bind_fork_guard_pkg <- function() { + for (name in fork_guard_pkg_names) { + pkg_bind("parallel", name, make_fork_guard_shim(name)) + } +} + +make_fork_guard_shim <- function(name) { + original <- utils::getFromNamespace(name, "parallel") + + # `ns_bind()`/`pkg_bind()` require the replacement to share the original's + # formals. + shim <- function() {} + formals(shim) <- formals(original) + body(shim) <- quote(stop_no_fork()) + + shim +} + +stop_no_fork <- function() { + msg <- paste_line(c( + sprintf("Can't fork the R session in %s.", app_name()), + "Use a backend that starts fresh R processes instead: PSOCK clusters,", + "`future::multisession()`, or mirai." + )) + stop(msg, call. = FALSE) +} diff --git a/crates/ark/src/modules/positron/init.R b/crates/ark/src/modules/positron/init.R index 60690fb068..ddf0ee6745 100644 --- a/crates/ark/src/modules/positron/init.R +++ b/crates/ark/src/modules/positron/init.R @@ -158,4 +158,5 @@ initialize <- function() { initialize_debug() initialize_hooks() initialize_hooks_source() + initialize_fork_guard() } diff --git a/crates/ark/src/modules/positron/system.R b/crates/ark/src/modules/positron/system.R index 0f4271c8cf..da105d32b1 100644 --- a/crates/ark/src/modules/positron/system.R +++ b/crates/ark/src/modules/positron/system.R @@ -18,6 +18,18 @@ is_windows <- function() { system_os() == "windows" } +#' Name of the frontend Ark is running under. +#' +#' Positron sets the `POSITRON` env var when it launches Ark. Same signal +#' `positron.R` uses to set `.Platform$GUI`. +app_name <- function() { + if (Sys.getenv("POSITRON") == 1) { + "Positron" + } else { + "Ark" + } +} + has_aqua <- function() { capabilities("aqua") } diff --git a/crates/ark/tests/integration/kernel_fork_guard.rs b/crates/ark/tests/integration/kernel_fork_guard.rs new file mode 100644 index 0000000000..c3df4515fe --- /dev/null +++ b/crates/ark/tests/integration/kernel_fork_guard.rs @@ -0,0 +1,103 @@ +use ark_test::DummyArkFrontend; + +// `parallel` ships with base R, so no extra test dependency is needed. +// +// The fork guard only installs on Unix, because forking is the hazard and +// Windows `parallel` never forks (it ships its own serial/`stop()` stubs in +// `R/windows/mcdummies.R`). So the error tests below are `#[cfg(unix)]`: on +// Windows these calls hit R's native behavior, which uses different messages +// and even runs serially in some cases. The PSOCK tests stay cross-platform. + +#[cfg(unix)] +#[test] +fn test_fork_functions_error() { + let frontend = DummyArkFrontend::lock(); + + frontend.execute_request_error( + "parallel::mclapply(1:2, identity, mc.cores = 2)", + |error_msg| { + assert!(error_msg.contains("fork the R session")); + }, + ); + + // `library(parallel)` attaches the package, exercising the `pkg_bind` / + // attach path. Unqualified `mclapply` should then hit the shim too. + frontend.execute_request_error("library(parallel); mclapply(1:2, identity)", |error_msg| { + assert!(error_msg.contains("fork the R session")); + }); + + frontend.execute_request_error("parallel::mcparallel(1)", |error_msg| { + assert!(error_msg.contains("fork the R session")); + }); + + frontend.execute_request_error("parallel::pvec(1:10, sqrt, mc.cores = 2)", |error_msg| { + assert!(error_msg.contains("fork the R session")); + }); + + frontend.execute_request_error( + "parallel::mcmapply(`+`, 1:2, 3:4, mc.cores = 2)", + |error_msg| { + assert!(error_msg.contains("fork the R session")); + }, + ); + + frontend.execute_request_error("parallel::mcMap(`+`, 1:2, 3:4)", |error_msg| { + assert!(error_msg.contains("fork the R session")); + }); + + frontend.execute_request_error("parallel::makeForkCluster(2)", |error_msg| { + assert!(error_msg.contains("fork the R session")); + }); + + // `mcfork` is unexported, so triple-colon access exercises the + // namespace-only binding. + frontend.execute_request_error("parallel:::mcfork()", |error_msg| { + assert!(error_msg.contains("fork the R session")); + }); + + // The public `makeCluster(type = "FORK")` dispatches to `makeForkCluster` + // resolved through parallel's namespace, so it hits our shim too. + frontend.execute_request_error("parallel::makeCluster(2, type = \"FORK\")", |error_msg| { + assert!(error_msg.contains("fork the R session")); + }); +} + +// The multicore family runs serially, without forking, when `mc.cores = 1` or +// the input has fewer than two elements. Those calls never reach `mcfork()`, so +// the guard must leave them alone. This matches Windows, where {parallel} always +// runs these serially. + +#[test] +fn test_serial_execution_works() { + let frontend = DummyArkFrontend::lock(); + + frontend.execute_request( + "unlist(parallel::mclapply(1:4, function(x) x * 2L, mc.cores = 1))", + |result| assert_eq!(result, "[1] 2 4 6 8"), + ); + + frontend.execute_request( + "parallel::pvec(1:4, function(x) x * 2L, mc.cores = 1)", + |result| assert_eq!(result, "[1] 2 4 6 8"), + ); +} + +// PSOCK clusters start fresh R worker processes instead of forking the session, +// so the guard must leave them untouched. These spawn real worker processes and +// run a small parallel computation, asserting it returns the correct result. + +#[test] +fn test_psock_cluster_works() { + let frontend = DummyArkFrontend::lock(); + + frontend.execute_request( + "local({ cl <- parallel::makePSOCKcluster(2); on.exit(parallel::stopCluster(cl)); sum(unlist(parallel::parLapply(cl, 1:4, function(x) x * 2L))) })", + |result| assert_eq!(result, "[1] 20"), + ); + + // `makeCluster()` defaults to a PSOCK cluster, which we don't guard. + frontend.execute_request( + "local({ cl <- parallel::makeCluster(2); on.exit(parallel::stopCluster(cl)); unlist(parallel::clusterApply(cl, 1:3, function(x) x + 1L)) })", + |result| assert_eq!(result, "[1] 2 3 4"), + ); +} diff --git a/crates/ark/tests/integration/main.rs b/crates/ark/tests/integration/main.rs index 75c7071559..032bb77018 100644 --- a/crates/ark/tests/integration/main.rs +++ b/crates/ark/tests/integration/main.rs @@ -26,6 +26,7 @@ mod kernel_captured_output; mod kernel_debugger; mod kernel_execute; mod kernel_execute_error; +mod kernel_fork_guard; mod kernel_hooks_session; mod kernel_hooks_source; mod kernel_hooks_timestamp; From 7b0ab9176471db5f93a0efc98976eed7ec5e1c25 Mon Sep 17 00:00:00 2001 From: Lionel Henry Date: Fri, 3 Jul 2026 10:41:33 +0200 Subject: [PATCH 2/2] Mention purrr --- crates/ark/src/modules/positron/fork_guard.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/crates/ark/src/modules/positron/fork_guard.R b/crates/ark/src/modules/positron/fork_guard.R index 1b7becb435..d254d0c318 100644 --- a/crates/ark/src/modules/positron/fork_guard.R +++ b/crates/ark/src/modules/positron/fork_guard.R @@ -77,7 +77,7 @@ stop_no_fork <- function() { msg <- paste_line(c( sprintf("Can't fork the R session in %s.", app_name()), "Use a backend that starts fresh R processes instead: PSOCK clusters,", - "`future::multisession()`, or mirai." + "`future::multisession()`, mirai, or `purrr::in_parallel()`." )) stop(msg, call. = FALSE) }