ECDC - daily

renv/.gitignore

@@ -1,3 +1,4 @@
+sandbox/
 library/
 local/
 cellar/

renv/activate.R

@@ -185,43 +185,80 @@ local({
     if (fixup)
       mode <- "w+b"
 
-    utils::download.file(
+    args <- list(
       url      = url,
       destfile = destfile,
       mode     = mode,
       quiet    = TRUE
     )
 
+    if ("headers" %in% names(formals(utils::download.file)))
+      args$headers <- renv_bootstrap_download_custom_headers(url)
+
+    do.call(utils::download.file, args)
+
+  }
+
+  renv_bootstrap_download_custom_headers <- function(url) {
+
+    headers <- getOption("renv.download.headers")
+    if (is.null(headers))
+      return(character())
+
+    if (!is.function(headers))
+      stopf("'renv.download.headers' is not a function")
+
+    headers <- headers(url)
+    if (length(headers) == 0L)
+      return(character())
+
+    if (is.list(headers))
+      headers <- unlist(headers, recursive = FALSE, use.names = TRUE)
+
+    ok <-
+      is.character(headers) &&
+      is.character(names(headers)) &&
+      all(nzchar(names(headers)))
+
+    if (!ok)
+      stop("invocation of 'renv.download.headers' did not return a named character vector")
+
+    headers
+
   }
 
   renv_bootstrap_download_cran_latest <- function(version) {
 
     spec <- renv_bootstrap_download_cran_latest_find(version)
+    type  <- spec$type
+    repos <- spec$repos
 
     message("* Downloading renv ", version, " ... ", appendLF = FALSE)
 
-    type  <- spec$type
-    repos <- spec$repos
+    baseurl <- utils::contrib.url(repos = repos, type = type)
+    ext <- if (identical(type, "source"))
+      ".tar.gz"
+    else if (Sys.info()[["sysname"]] == "Windows")
+      ".zip"
+    else
+      ".tgz"
+    name <- sprintf("renv_%s%s", version, ext)
+    url <- paste(baseurl, name, sep = "/")
 
-    info <- tryCatch(
-      utils::download.packages(
-        pkgs    = "renv",
-        destdir = tempdir(),
-        repos   = repos,
-        type    = type,
-        quiet   = TRUE
-      ),
+    destfile <- file.path(tempdir(), name)
+    status <- tryCatch(
+      renv_bootstrap_download_impl(url, destfile),
       condition = identity
     )
 
-    if (inherits(info, "condition")) {
+    if (inherits(status, "condition")) {
       message("FAILED")
       return(FALSE)
     }
 
     # report success and return
     message("OK (downloaded ", type, ")")
-    info[1, 2]
+    destfile
 
   }
 
@@ -678,7 +715,7 @@ local({
       return(profile)
 
     # check for a profile file (nothing to do if it doesn't exist)
-    path <- renv_bootstrap_paths_renv("profile", profile = FALSE)
+    path <- renv_bootstrap_paths_renv("profile", profile = FALSE, project = project)
     if (!file.exists(path))
       return(NULL)
 
@@ -805,9 +842,23 @@ local({
 
   renv_json_read <- function(file = NULL, text = NULL) {
 
+    # if jsonlite is loaded, use that instead
+    if ("jsonlite" %in% loadedNamespaces())
+      renv_json_read_jsonlite(file, text)
+    else
+      renv_json_read_default(file, text)
+
+  }
+
+  renv_json_read_jsonlite <- function(file = NULL, text = NULL) {
     text <- paste(text %||% read(file), collapse = "\n")
+    jsonlite::fromJSON(txt = text, simplifyVector = FALSE)
+  }
+
+  renv_json_read_default <- function(file = NULL, text = NULL) {
 
     # find strings in the JSON
+    text <- paste(text %||% read(file), collapse = "\n")
     pattern <- '["](?:(?:\\\\.)|(?:[^"\\\\]))*?["]'
     locs <- gregexpr(pattern, text, perl = TRUE)[[1]]
 
@@ -838,8 +889,9 @@ local({
 
     # transform the JSON into something the R parser understands
     transformed <- replaced
-    transformed <- gsub("[[{]", "list(", transformed)
-    transformed <- gsub("[]}]", ")", transformed)
+    transformed <- gsub("{}", "`names<-`(list(), character())", transformed, fixed = TRUE)
+    transformed <- gsub("[[{]", "list(", transformed, perl = TRUE)
+    transformed <- gsub("[]}]", ")", transformed, perl = TRUE)
     transformed <- gsub(":", "=", transformed, fixed = TRUE)
     text <- paste(transformed, collapse = "\n")