propagate repos when running renv::init()

NEWS.md

@@ -81,3 +81,5 @@
 * Fixed issue where Windows shortcuts were not resolved correctly in file dialogs. (#7327)
 * Fixed issue where failure to rotate a log file could cause a process crash (Pro #1779)
 * Fixed issue where saving workspace could emit 'package may not be available when loading' warning (#7001)
+* Fixed issue where active repositories were not propagated to newly-created `renv` projects (#7136)
+

rstudio.Rproj

@@ -3,7 +3,6 @@ Version: 1.0
 RestoreWorkspace: No
 SaveWorkspace: No
 AlwaysSaveHistory: No
-QuitChildProcessesOnExit: Default
 
 EnableCodeIndexing: Yes
 UseSpacesForTab: Yes
@@ -12,3 +11,5 @@ Encoding: UTF-8
 
 RnwWeave: Sweave
 LaTeX: pdfLaTeX
+
+AutoAppendNewline: Yes

src/cpp/session/modules/SessionRUtil.R

@@ -20,7 +20,7 @@
 
 .rs.addFunction("readIniFile", function(filePath)
 {
-   as.list(.Call("rs_readIniFile", filePath))
+   as.list(.Call("rs_readIniFile", filePath, PACKAGE = "(embedding)"))
 })
 
 .rs.addFunction("runAsyncRProcess", function(
@@ -48,3 +48,98 @@
       PACKAGE = "(embedding)"
    )
 })
+
+#' Run an R script in a separate R process, via `system2()`.
+#' 
+#' Run `code` in a child \R process, launched via `system2()`.
+#' 
+#' @param callback An \R function, to be executed within the child process.
+#'   It should take a single parameter, which represents the `data` to
+#'   be supplied to the callback.
+#' 
+#' @param data An optional list of side-car data, to be referenced from
+#'   `code` via the `data` argument. These arguments will be applied to
+#'   the callback via `do.call(callback, data)`, and so should normally
+#'   be a named list mapping argument names to their appropriate values.
+#'   
+#' @param workingDir An optional working directory in which `code`
+#'   should be run.
+#' 
+#' @param libPaths The library paths to be set and used by the child process.
+#'   By default, the parent's library paths are used.
+#'
+#' @param ... Optional arguments passed to `system2()`.
+#' 
+.rs.addFunction("executeFunctionInChildProcess", function(callback, 
+                                                          data = list(),
+                                                          workingDir = NULL,
+                                                          libPaths = .libPaths(),
+                                                          ...)
+{
+   # create and move to directory we'll use to stage our scripts
+   scriptDir <- tempfile("rstudio-script-")
+   dir.create(scriptDir, recursive = TRUE, showWarnings = FALSE)
+   on.exit(unlink(scriptDir, recursive = TRUE), add = TRUE)
+
+   # move to that directory
+   owd <- setwd(scriptDir)
+   on.exit(setwd(owd), add = TRUE)
+
+   # set R_LIBS so that library paths are propagated to child process
+   rlibs <- Sys.getenv("R_LIBS", unset = NA)
+   Sys.setenv(R_LIBS = paste(libPaths, collapse = .Platform$path.sep))
+   on.exit({
+      if (is.na(rlibs))
+         Sys.unsetenv("R_LIBS")
+      else
+         Sys.setenv(R_LIBS = rlibs)
+   }, add = TRUE)
+
+   # create data bundle powering script
+   bundle <- list(
+      callback   = callback,
+      data       = data,
+      workingDir = workingDir
+   )
+
+   # define runner script (will load data and execute user-defined callback)
+   script <- quote({
+
+      # read side-car data file
+      bundle <- readRDS("bundle.rds")
+
+      # move to requested working directory
+      workingDir <- bundle[["workingDir"]]
+      if (!is.null(workingDir)) {
+         dir.create(workingDir, recursive = TRUE, showWarnings = FALSE)
+         owd <- setwd(workingDir)
+         on.exit(setwd(owd), add = TRUE)
+      }
+
+      # retrieve callback data
+      callback <- bundle[["callback"]]
+      data     <- bundle[["data"]]
+
+      # execute callback
+      do.call(callback, data)
+
+   })
+
+   # write bundle to file
+   # (suppress 'may not be available when loading' warnings)
+   suppressWarnings(saveRDS(bundle, file = "bundle.rds"))
+
+   # write script to file
+   writeLines(deparse(script), con = "script.R")
+
+   # form path to R
+   exe <- if (Sys.info()[["sysname"]] == "Windows") "R.exe" else "R"
+   r <- file.path(R.home("bin"), exe)
+
+   # form command line arguments
+   args <- c("--vanilla", "-s", "-f", shQuote("script.R"))
+
+   # run the script
+   system2(r, args, ...)
+
+})

src/cpp/session/modules/SessionRenv.R

@@ -17,25 +17,14 @@
 
 .rs.addJsonRpcHandler("renv_init", function(project)
 {
-   # the project directory should already exist, but be extra careful
-   # and create it if necessary
-   dir.create(project, showWarnings = FALSE, recursive = TRUE)
-   owd <- setwd(project)
-   on.exit(setwd(owd), add = TRUE)
-
-   # set library paths to be inherited by child process
-   libs <- paste(.libPaths(), collapse = .Platform$path.sep)
-   renv:::renv_scope_envvars(R_LIBS = libs)
-
-   # form path to R
-   exe <- if (Sys.info()[["sysname"]] == "Windows") "R.exe" else "R"
-   r <- file.path(R.home("bin"), exe)
-
-   # form command line arguments
-   args <- c("--vanilla", "--slave", "-e", shQuote("renv::init()"))
+   # run script in child process (done so that `renv::init()` doesn't
+   # change the state of the running session)
+   .rs.executeFunctionInChildProcess(
+      callback   = .rs.renv.initCallback,
+      data       = list(repos = getOption("repos")),
+      workingDir = project
+   )
 
-   # invoke R
-   system2(r, args)
 })
 
 .rs.addJsonRpcHandler("renv_actions", function(action)
@@ -164,3 +153,16 @@
    )
 
 })
+
+.rs.addFunction("renv.initCallback", function(repos)
+{
+   # set active repos
+   options(repos = repos)
+
+   # avoid timeouts when querying unresponsive R package repositories
+   options(renv.config.connect.timeout = 0L)
+   options(renv.config.connect.retry = 0L)
+
+   # initialize project
+   renv::init()
+})

src/cpp/tests/testthat/test-renv.R

@@ -0,0 +1,42 @@
+#
+# test-renv.R
+#
+# Copyright (C) 2020 by RStudio, PBC
+#
+# Unless you have received this program directly from RStudio pursuant
+# to the terms of a commercial license agreement with RStudio, then
+# this program is licensed to you under the terms of version 3 of the
+# GNU Affero General Public License. This program is distributed WITHOUT
+# ANY EXPRESS OR IMPLIED WARRANTY, INCLUDING THOSE OF NON-INFRINGEMENT,
+# MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. Please refer to the
+# AGPL (http://www.gnu.org/licenses/agpl-3.0.txt) for more details.
+#
+#
+
+context("renv")
+
+test_that(".rs.rpc.renv_init() preserves current repositories", {
+
+   skip_if_not_installed("renv")
+
+   # scope repos option in this scope
+   renv:::renv_scope_options(
+      repos = list(RSPM = "https://packagemanager.rstudio.com/cran/latest")
+   )
+
+   # initialize project
+   project <- tempfile("renv-project-")
+   on.exit(unlink(project, recursive = TRUE), add = TRUE)
+   .rs.rpc.renv_init(project)
+
+   # check that the renv lockfile has the expected repositories
+   lockpath <- file.path(project, "renv.lock")
+   lockfile <- renv:::renv_lockfile_read(lockpath)
+
+   # validate correct repositories
+   expect_identical(
+      as.list(lockfile$R$Repositories),
+      list(RSPM = "https://packagemanager.rstudio.com/cran/latest")
+   )
+
+})