unlock sandbox on exit after calling use (closes #2076)

NEWS.md

@@ -15,6 +15,11 @@
 
 ## Other Fixes
 
+* The `renv` sandbox is now unlocked on exit after a call to `renv::use()`.
+  This should alleviate issues seen where R's attempts to clean up the
+  temporary directory could fail due to inadequate permissions on the
+  sandbox directory. (#2076)
+
 * Fixed an issue where `renv::restore()` did not respect the named repository
   within the lockfile when installing packages from the archives of the
   configured package repositories. (#2081)

R/job.R

@@ -24,7 +24,7 @@ job <- function(callback, data = list()) {
   save(callback, data, file = paths$workspace)
 
   # find path where renv is installed
-  library <- if (devmode()) {
+  library <- if (devmode() || testing()) {
     dirname(renv_package_find("renv"))
   } else {
     dirname(renv_namespace_path("renv"))
@@ -39,7 +39,7 @@ job <- function(callback, data = list()) {
 
     # invoke the provided callback
     result <- catch({
-      options(readRDS(!!paths$options));
+      options(readRDS(!!paths$options))
       base::load(!!paths$workspace)
       do.call(callback, data)
     })
@@ -55,13 +55,15 @@ job <- function(callback, data = list()) {
   # run that code
   renv_scope_envvars(RENV_WATCHDOG_ENABLED = FALSE)
   args <- c("--vanilla", "-s", "-f", renv_shell_path(paths$script))
-  r(args)
+  status <- r(args)
+  if (status != 0L)
+    stopf("error executing job [error code %i]", status)
 
   # collect the result
-  status <- readRDS(paths$result)
-  if (inherits(status, "error"))
-    stop(status)
+  result <- readRDS(paths$result)
+  if (inherits(result, "error"))
+    stop(result)
 
-  status
+  result
 
 }

R/sandbox.R

@@ -144,9 +144,9 @@ renv_sandbox_activate_check <- function(libs) {
 renv_sandbox_generate <- function(sandbox) {
 
   # make the library temporarily writable
-  lock <- getOption("renv.sandbox.locking_enabled", default = TRUE)
+  lockable <- renv_sandbox_lockable()
 
-  if (lock) {
+  if (lockable) {
     dlog("sandbox", "unlocking sandbox")
     renv_sandbox_unlock(sandbox)
   }
@@ -176,7 +176,7 @@ renv_sandbox_generate <- function(sandbox) {
   Sys.setFileTime(sandbox, time = Sys.time())
 
   # make the library unwritable again
-  if (lock) {
+  if (lockable) {
     dlog("sandbox", "locking sandbox")
     renv_sandbox_lock(sandbox)
   }
@@ -235,20 +235,25 @@ renv_sandbox_path <- function(project = NULL) {
   renv_paths_sandbox(project = project)
 }
 
+renv_sandbox_lockable <- function(sandbox = NULL) {
+  getOption("renv.sandbox.locking_enabled", default = TRUE)
+}
+
 renv_sandbox_lock <- function(sandbox = NULL, project = NULL) {
   sandbox <- sandbox %||% renv_sandbox_path(project = project)
-  Sys.chmod(sandbox, mode = "0555")
+  mode <- file.mode(sandbox) & "577"
+  Sys.chmod(sandbox, mode = mode)
 }
 
 renv_sandbox_locked <- function(sandbox = NULL, project = NULL) {
   sandbox <- sandbox %||% renv_sandbox_path(project = project)
-  mode <- suppressWarnings(file.mode(sandbox))
-  mode == 365L  # as.integer(as.octmode("0555"))
+  file.exists(sandbox) && file.access(sandbox, mode = 7L) != 0L
 }
 
 renv_sandbox_unlock <- function(sandbox = NULL, project = NULL) {
   sandbox <- sandbox %||% renv_sandbox_path(project = project)
-  Sys.chmod(sandbox, mode = "0755")
+  mode <- file.mode(sandbox) | "200"
+  Sys.chmod(sandbox, mode = mode)
 }
 
 #' The default library sandbox

R/use.R

@@ -44,7 +44,7 @@ the$use_libpath <- NULL
 use <- function(...,
                 lockfile = NULL,
                 library  = NULL,
-                isolate  = sandbox,
+                isolate  = TRUE,
                 sandbox  = TRUE,
                 attach   = FALSE,
                 verbose  = TRUE)
@@ -81,26 +81,26 @@ use <- function(...,
 
   # remove any remotes which already appear to be installed
   compat <- enum_lgl(records, function(package, record) {
-    
+
     # check if the package is installed
     if (!renv_package_installed(package, lib.loc = library))
       return(FALSE)
-    
+
     # check if the installed package is compatible
     record <- resolve(record)
     current <- renv_snapshot_description(package = package)
     diff <- renv_lockfile_diff_record(record, current)
-    
+
     # a null diff implies the two records are compatible
     is.null(diff)
-    
+
   })
-  
+
   # drop the already-installed compatible records
   records <- records[!compat]
   if (empty(records))
     return(invisible())
-  
+
   # install packages
   records <- local({
     renv_scope_options(renv.verbose = verbose)
@@ -139,4 +139,11 @@ renv_use_sandbox <- function(sandbox) {
   renv_scope_options(renv.config.sandbox.enabled = TRUE)
   renv_sandbox_activate_impl(sandbox = sandbox)
 
+  reg.finalizer(renv_envir_self(), function(envir) {
+    tryCatch(
+      renv_sandbox_unlock(sandbox),
+      condition = identity
+    )
+  }, onexit = TRUE)
+
 }

tests/testthat/test-job.R

@@ -1,5 +1,6 @@
 
 test_that("jobs can be run", {
+  skip_on_cran()
   encoded <- job(function() { renv_base64_encode("hello") })
   expect_equal(encoded, "aGVsbG8=")
 })