safe expression evaluation with callr

NAMESPACE

@@ -6,6 +6,8 @@ export(initialize_tutorial)
 export(question)
 export(quiz)
 export(run_tutorial)
+export(safe)
+export(safe_env)
 export(tutorial)
 export(tutorial_html_dependency)
 export(tutorial_options)

NEWS.md

@@ -3,6 +3,8 @@ learnr 0.9.3
 
 * Fixed a spurious console warning when running exercises using Pandoc 2.0. ([#154](https://github.com/rstudio/learnr/issues/154))
 
+* Added a new function, `safe`, which evaluates code in a new, safe R environment. ([#174](https://github.com/rstudio/learnr/pull/174))
+
 learnr 0.9.2
 ===========
 

R/run.R

@@ -1,39 +1,109 @@
 
 #' Run a tutorial
-#' 
+#'
 #' Run a tutorial which is contained within an R package.
-#' 
-#' @param name Tutorial name (subdirectory within \code{tutorials/} 
+#'
+#' @param name Tutorial name (subdirectory within \code{tutorials/}
 #'   directory of installed package).
 #' @param package Name of package
-#' @param shiny_args Additional arguments to forward to 
-#'   \code{\link[shiny:runApp]{shiny::runApp}}. 
-#' 
+#' @param shiny_args Additional arguments to forward to
+#'   \code{\link[shiny:runApp]{shiny::runApp}}.
+#'
 #' @details Note that when running a tutorial Rmd file with \code{run_tutorial}
-#'   the tutorial Rmd should have already been rendered as part of the 
-#'   development of the package (i.e. the correponding tutorial .html file for 
+#'   the tutorial Rmd should have already been rendered as part of the
+#'   development of the package (i.e. the correponding tutorial .html file for
 #'   the .Rmd file must exist).
-#' 
+#'
+#' @seealso \code{\link{safe}}
 #' @export
 run_tutorial <- function(name, package, shiny_args = NULL) {
-  
+
   # get path to tutorial
   tutorial_path <- system.file("tutorials", name, package = package)
- 
+
   # validate that it's a direcotry
-  if (!utils::file_test("-d", tutorial_path)) 
+  if (!utils::file_test("-d", tutorial_path))
     stop("Tutorial ", name, " was not found in the ", package, " package.")
-    
+
   # provide launch_browser if it's not specified in the shiny_args
   if (is.null(shiny_args))
     shiny_args <- list()
   if (is.null(shiny_args$launch.browser))
     shiny_args$launch.browser <- interactive()
-  
+
   # run within tutorial wd and ensure we don't call rmarkdown::render
   withr::with_dir(tutorial_path, {
     withr::with_envvar(c(RMARKDOWN_RUN_PRERENDER = "0"), {
       rmarkdown::run(file = NULL, dir = tutorial_path, shiny_args = shiny_args)
     })
   })
 }
+
+
+#' Safe R CMD environment
+#'
+#' By default, \code{callr::\link[callr]{rcmd_safe_env}} suppresses the ability
+#' to open a browser window.  This is the default execution evnironment within
+#' \code{callr::\link[callr]{r}}.  However, opening a browser is expected
+#' behavior within the learnr package and should not be suppressed.
+#' @export
+safe_env <- function() {
+  envs <- callr::rcmd_safe_env()
+  envs[!(names(envs) %in% c("R_BROWSER"))]
+}
+
+
+callr_try_catch <- function(...) {
+  tryCatch(
+    ...,
+    # TODO when processx 3.2.0 is released, _downgrade_ to "interrupt" call instead of "system_command_interrupt".
+    # https://github.com/r-lib/processx/issues/148
+
+    # if a user sends an interrupt, return silently
+    system_command_interrupt = function() invisible(NULL)
+  )
+}
+
+
+#' Execute R code in a safe R environment
+#'
+#' When rendering (or running) a document with R markdown, it inherits the
+#' current R Global environment.  This will produce unexpected behaviors,
+#' such as poisoning the R Global environment with existing variables.  By
+#' rendering the document in a new, safe R environment, a \emph{vanilla},
+#' rendered document is produced.
+#'
+#' Using \code{safe} should only be necessary when locally deployed.
+#'
+#' @param expr expression that contains all the necessary library calls to
+#'   execute.  Expressions within callr do not inherit the existing,
+#'   loaded libraries.
+#' @export
+#' @examples
+#' \dontrun{
+#' # Direct usage
+#' safe({learnr::run_tutorial("slidy", package = "learnr")})
+#'
+#' # Programmatic usage
+#' library(rlang)
+#'
+#' expr <- quote(learnr::run_tutorial("slidy", package = "learnr"))
+#' safe(!!expr)
+#'
+#' tutorial <- "slidy"
+#' safe({learnr::run_tutorial(!!tutorial, package = "learnr")})
+#' }
+safe <- function(expr, ..., show = TRUE, env = safe_env()) {
+  expr <- rlang::enquo(expr)
+  callr_try_catch({
+    callr::r(
+      function(exp) {
+        rlang::eval_tidy(exp)
+      },
+      list(exp = expr),
+      ...,
+      show = show,
+      env = env
+    )
+  })
+}

tests/testthat/test-safe.R

@@ -0,0 +1,21 @@
+
+context("safe r call")
+
+test_that("safe() executes code expression directly and programmatically", {
+  library(rlang)
+
+  file = tempfile()
+
+  # Direct usage
+  safe(cat("1\n", file = file))
+  expect_equal(readLines(file), "1")
+
+  # Programmatic usage
+  exp <- quote(cat("2\n", file = file))
+  safe(!!exp)
+  expect_equal(readLines(file), "2")
+
+  x <- "3\n"
+  safe(cat(!!x, file = file))
+  expect_equal(readLines(file), "3")
+})