From 492f0bce2dc8b290cfe3b57deac5c14d092b59f0 Mon Sep 17 00:00:00 2001 From: marcosnav Date: Tue, 6 Oct 2026 12:54:42 -0600 Subject: [PATCH 1/7] restore: download package sources concurrently before installing restore() downloaded each package just before installing it, one curl process at a time. It now fetches the sources of every package it will install from a CRAN-like repository with a single `curl --parallel` before the install loop starts. Anything the prefetch can't fetch is downloaded by the install loop as before, and a prefetch error is a warning, never a failed restore. The prefetch runs only when curl 7.75.0 or later is the download method and packrat installs from source repositories. It reuses the download's curl arguments, so download.file.extra (user agent, .netrc) carries over. Options: packrat.prefetch.sources and packrat.prefetch.concurrency. --- NEWS.md | 7 + R/downloader.R | 70 +++++----- R/packrat.R | 9 ++ R/prefetch.R | 238 +++++++++++++++++++++++++++++++++ R/restore-routines.R | 21 ++- R/restore.R | 1 + man/restore.Rd | 9 ++ tests/testthat/test-prefetch.R | 183 +++++++++++++++++++++++++ 8 files changed, 502 insertions(+), 36 deletions(-) create mode 100644 R/prefetch.R create mode 100644 tests/testthat/test-prefetch.R diff --git a/NEWS.md b/NEWS.md index cc462e0b..1d7fc50a 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,12 @@ # packrat (development version) +- `restore()` downloads the sources of packages from CRAN-like repositories + concurrently before installing them, when `curl` 7.75.0 or later is the + download method. Restores that install many packages no longer wait on one + download at a time. Set `options(packrat.prefetch.sources = FALSE)` to turn + this off, and `packrat.prefetch.concurrency` to change the number of + simultaneous downloads (default 8). + - Fixed a race condition where concurrent R processes installing the same package could fail while inserting it into the package cache. diff --git a/R/downloader.R b/R/downloader.R index 64900947..52ef99d4 100644 --- a/R/downloader.R +++ b/R/downloader.R @@ -95,37 +95,7 @@ downloadFile <- function( # pass extra arguments for 'curl' downloader if (method == "curl") { - # use '-L' to follow redirects - if (!grepl("\\b-L\\b", extra)) { - extra <- paste(extra, "-L") - } - - # switch off the curl globbing parser - if (!grepl("\\b-g\\b", extra)) { - extra <- paste(extra, "-g") - } - - # use '-f' to ensure we fail on server errors - if (!grepl("\\b-f\\b", extra)) { - extra <- paste(extra, "-f") - } - - # make curl quiet -- avoid polluting console with e.g. - # curl: (22) The requested URL returned error: 404 Not Found - if (!grepl("\\b-s\\b", extra)) { - extra <- paste(extra, "-s") - } - - # lower connection timeout - connect.timeout <- getOption("packrat.connect.timeout") - if (!is.null(connect.timeout) && !grepl("\\b--connect-timeout\\b", extra)) { - extra <- paste(extra, "--connect-timeout", connect.timeout) - } - - # redirect stderr to stdout, for nicer output in RStudio - if (!grepl("\\b--stderr -\\b", extra)) { - extra <- paste(extra, "--stderr -") - } + extra <- curlExtraArgs(extra) } # catch warnings in the call @@ -152,6 +122,44 @@ downloadFile <- function( return(result) } +# Add the arguments packrat always passes to curl to the user's 'extra' +# arguments, unless the user already supplied them. +curlExtraArgs <- function(extra) { + # use '-L' to follow redirects + if (!grepl("\\b-L\\b", extra)) { + extra <- paste(extra, "-L") + } + + # switch off the curl globbing parser + if (!grepl("\\b-g\\b", extra)) { + extra <- paste(extra, "-g") + } + + # use '-f' to ensure we fail on server errors + if (!grepl("\\b-f\\b", extra)) { + extra <- paste(extra, "-f") + } + + # make curl quiet -- avoid polluting console with e.g. + # curl: (22) The requested URL returned error: 404 Not Found + if (!grepl("\\b-s\\b", extra)) { + extra <- paste(extra, "-s") + } + + # lower connection timeout + connect.timeout <- getOption("packrat.connect.timeout") + if (!is.null(connect.timeout) && !grepl("\\b--connect-timeout\\b", extra)) { + extra <- paste(extra, "--connect-timeout", connect.timeout) + } + + # redirect stderr to stdout, for nicer output in RStudio + if (!grepl("\\b--stderr -\\b", extra)) { + extra <- paste(extra, "--stderr -") + } + + extra +} + # Attempt download.packages multiple times. # # Assumes we are downloading a single package. diff --git a/R/packrat.R b/R/packrat.R index 2fe52da4..ccf10e2d 100644 --- a/R/packrat.R +++ b/R/packrat.R @@ -324,6 +324,15 @@ initImpl <- function( #' locations, it will use R's internal \code{tar} implementation, which may #' cause errors with long filenames. #' +#' When \code{curl} 7.75.0 or later is the download method, Packrat +#' downloads the sources of every package it needs from CRAN-like +#' repositories concurrently, before installing any of them. Set the option +#' \code{packrat.prefetch.sources} to \code{FALSE} to download each package +#' just before it is installed instead. The option +#' \code{packrat.prefetch.concurrency} sets the number of simultaneous +#' downloads (default 8). Packages that fail to download concurrently are +#' downloaded again before they are installed. +#' #' @param project The project directory. When in packrat mode, if this is #' \code{NULL}, then the directory associated with the current packrat project #' is used. Otherwise, the project directory specified is used. diff --git a/R/prefetch.R b/R/prefetch.R new file mode 100644 index 00000000..f068c6c5 --- /dev/null +++ b/R/prefetch.R @@ -0,0 +1,238 @@ +# Download package sources for a restore concurrently, before any package is +# installed. +# +# installPkg() downloads each package just before installing it, one curl +# process at a time. When most of the restore is spent in those downloads, +# fetching every needed source up front with a single `curl --parallel` is +# much faster. installPkg() skips the download for any source that is already +# in srcDir(), so the install loop is unchanged; anything the prefetch fails +# to fetch is downloaded there as before. +# +# The prefetch only handles packages from CRAN-like repositories, and only +# when curl is the download method. It never fails the restore. + +prefetchInstallActions <- c("add", "upgrade", "downgrade", "crossgrade") + +# Minimum curl version: --parallel arrived in 7.66.0 and the %{exitcode} +# write-out variable in 7.75.0. +prefetchMinimumCurlVersion <- "7.75.0" + +prefetchEnabled <- function() { + isTRUE(getOption("packrat.prefetch.sources", TRUE)) +} + +prefetchConcurrency <- function() { + concurrency <- as.integer(getOption("packrat.prefetch.concurrency", 8L)) + if (length(concurrency) != 1L || is.na(concurrency) || concurrency < 1L) { + stop("'packrat.prefetch.concurrency' must be a positive integer") + } + concurrency +} + +# Returns the curl version as a numeric_version, or NULL if curl can't be run. +curlVersion <- function() { + output <- tryCatch( + suppressWarnings(system2("curl", "--version", stdout = TRUE, stderr = FALSE)), + error = function(e) character() + ) + version <- regmatches(output[1], regexpr("(?<=^curl )[0-9.]+", output[1], perl = TRUE)) + if (!length(version)) { + return(NULL) + } + numeric_version(version) +} + +# Package records that will be installed and need a source download: from a +# CRAN-like repository, not in the cache, and not already in srcDir(). Uses +# only local checks, so a restore served entirely from the cache doesn't +# contact the repository. +prefetchCandidates <- function(pkgRecords, actions, repos, project) { + installs <- names(actions)[actions %in% prefetchInstallActions] + if (!length(installs) || !length(repos)) { + return(list()) + } + + records <- Filter(Negate(is.null), searchPackages(pkgRecords, installs)) + Filter( + function(pkgRecord) { + isFromCranlikeRepo(pkgRecord, repos) && + !identical(pkgRecord$source, "unknown") && + is.null(cachedPackagePath(project, pkgRecord)) && + !file.exists(prefetchDestfile(pkgRecord, project)) + }, + records + ) +} + +prefetchDestfile <- function(pkgRecord, project) { + file.path(srcDir(project), pkgRecord$name, pkgSrcFilename(pkgRecord)) +} + +# Download URL and destination for each candidate. Returns a data frame with +# one row per package: name, version, url, and destfile. Mirrors the URL +# choice in getSourceForPkgRecord(): the repository's current file when the +# version matches available.packages(), otherwise the CRAN archive layout of +# the first repository. +prefetchTargets <- function(records, repos, project, available) { + rows <- lapply(records, function(pkgRecord) { + pkgSrcFile <- pkgSrcFilename(pkgRecord) + current <- pkgRecord$name %in% rownames(available) && + identical(pkgRecord$version, available[pkgRecord$name, "Version"]) + url <- if (current) { + paste(available[pkgRecord$name, "Repository"], pkgSrcFile, sep = "/") + } else { + paste( + sub("/+$", "", repos[[1]]), + "src/contrib/Archive", + pkgRecord$name, + pkgSrcFile, + sep = "/" + ) + } + data.frame( + name = pkgRecord$name, + version = pkgRecord$version, + url = url, + destfile = prefetchDestfile(pkgRecord, project), + stringsAsFactors = FALSE + ) + }) + do.call(rbind, rows) +} + +# Quote a value for a curl config file. +curlConfigQuote <- function(value) { + paste0("\"", gsub("([\"\\\\])", "\\\\\\1", value), "\"") +} + +# Download every target with one `curl --parallel`. Each file is written to a +# temporary name and moved into place only when its transfer succeeded, so a +# failed or partial download never looks like a usable source. Returns the +# targets that were not downloaded. +prefetchDownload <- function(targets, concurrency) { + partial <- paste0(targets$destfile, ".prefetch") + for (dir in unique(dirname(targets$destfile))) { + dir.create(dir, recursive = TRUE, showWarnings = FALSE) + } + on.exit(unlink(partial[file.exists(partial)]), add = TRUE) + + config <- tempfile("packrat-prefetch-", fileext = ".txt") + on.exit(unlink(config), add = TRUE) + writeLines( + paste0( + "url = ", + curlConfigQuote(targets$url), + "\noutput = ", + curlConfigQuote(partial) + ), + config + ) + + # The same arguments a single-package download uses, including the user's + # download.file.extra (user agent, .netrc file, and so on). The trailing + # --write-out replaces any earlier one so each transfer reports its result. + extra <- "" + if (identical(getOption("download.file.method"), "curl")) { + extra <- paste(getOption("download.file.extra", ""), collapse = " ") + } + writeOut <- "packrat-prefetch %{exitcode} %{http_code} %{filename_effective}\\n" + command <- paste( + "curl", + curlExtraArgs(extra), + "--parallel --parallel-max", + concurrency, + "-K", + shQuote(config), + "-w", + shQuote(writeOut) + ) + output <- suppressWarnings(system(command, intern = TRUE)) + + results <- regmatches( + output, + regexec("^packrat-prefetch ([0-9]+) ([0-9]+) (.*)$", output) + ) + results <- Filter(length, results) + succeeded <- vapply(results, function(r) r[2] == "0", logical(1)) + succeededFiles <- vapply(results[succeeded], `[`, character(1), 4) + + ok <- partial %in% succeededFiles & file.exists(partial) + ok[ok] <- file.rename(partial[ok], targets$destfile[ok]) + + failed <- targets[!ok, , drop = FALSE] + failed$http_code <- vapply( + partial[!ok], + function(file) { + match <- Filter(function(r) identical(r[4], file), results) + if (length(match)) match[[1]][3] else NA_character_ + }, + character(1), + USE.NAMES = FALSE + ) + failed +} + +prefetchPackageSources <- function(pkgRecords, actions, repos, project) { + if (!prefetchEnabled() || is.windows()) { + return(invisible()) + } + # When binary repositories are in use, installPkg() installs binaries with + # install.packages() and never needs these sources. + if (hasBinaryRepositories() && binaryRepositoriesEnabled()) { + return(invisible()) + } + + tryCatch( + { + candidates <- prefetchCandidates(pkgRecords, actions, repos, project) + if (!length(candidates)) { + return(invisible()) + } + available <- availablePackagesSource(repos = repos) + targets <- prefetchTargets(candidates, repos, project, available) + if (!identical(inferAppropriateDownloadMethod(targets$url[1]), "curl")) { + return(invisible()) + } + version <- curlVersion() + if (is.null(version) || version < prefetchMinimumCurlVersion) { + return(invisible()) + } + + concurrency <- prefetchConcurrency() + message( + "Prefetching sources for ", + nrow(targets), + " packages (", + concurrency, + " at a time) ... ", + appendLF = FALSE + ) + start <- Sys.time() + failed <- prefetchDownload(targets, concurrency) + elapsed <- as.numeric(difftime(Sys.time(), start, units = "secs")) + message(sprintf( + "fetched %d of %d in %.1f seconds", + nrow(targets) - nrow(failed), + nrow(targets), + elapsed + )) + for (i in seq_len(nrow(failed))) { + message(sprintf( + "\tCould not prefetch %s (%s) from %s (HTTP %s); it will be downloaded during installation", + failed$name[i], + failed$version[i], + failed$url[i], + failed$http_code[i] + )) + } + }, + error = function(e) { + warning( + "Prefetching package sources failed; packages will be downloaded during installation: ", + conditionMessage(e), + call. = FALSE + ) + } + ) + invisible() +} diff --git a/R/restore-routines.R b/R/restore-routines.R index 30c63043..a70c57ac 100644 --- a/R/restore-routines.R +++ b/R/restore-routines.R @@ -37,32 +37,43 @@ hashTarball <- function(path) { tools::md5sum(files = normalizePath(path, mustWork = TRUE)) } -restoreWithCopyFromCache <- function(project, pkgRecord, cacheCopyStatus) { +# Returns the path to a usable global cache entry for this package record, or +# NULL when the package must be installed from somewhere else. +cachedPackagePath <- function(project, pkgRecord) { # don't copy from cache if disabled for this project if (!isUsingCache(project)) { - return(FALSE) + return(NULL) } # don't try to use cache if we don't have a hash if (!length(pkgRecord$hash)) { - return(FALSE) + return(NULL) } # don't try to cache uncacheable packages (ie, packages that # need to be reinstalled each time for whatever reason) if (!isCacheable(pkgRecord$name)) { - return(FALSE) + return(NULL) } # ensure that the cache package path exists source <- cacheLibDir(pkgRecord$name, pkgRecord$hash, pkgRecord$name) if (!file_test("-d", source)) { - return(FALSE) + return(NULL) } # sanity check for cache corruption -- we've seen some cases where # a cache entry exists, but it's just an empty folder if (isCorruptPackageCacheEntry(source)) { + return(NULL) + } + + source +} + +restoreWithCopyFromCache <- function(project, pkgRecord, cacheCopyStatus) { + source <- cachedPackagePath(project, pkgRecord) + if (is.null(source)) { return(FALSE) } diff --git a/R/restore.R b/R/restore.R index 761f47b3..a652baf0 100644 --- a/R/restore.R +++ b/R/restore.R @@ -994,6 +994,7 @@ restoreImpl <- function( # Play the list, if there's anything to play if (!dry.run) { + prefetchPackageSources(pkgRecords, actions, repos, project) playActions(pkgRecords, actions, repos, project, targetLib) if (restartNeeded) { if (!restart || !attemptRestart()) { diff --git a/man/restore.Rd b/man/restore.Rd index 990fbb96..290c3e18 100644 --- a/man/restore.Rd +++ b/man/restore.Rd @@ -92,6 +92,15 @@ will be lost. look for the system \code{tar} on Windows. If no binary is found in those locations, it will use R's internal \code{tar} implementation, which may cause errors with long filenames. + + When \code{curl} 7.75.0 or later is the download method, Packrat + downloads the sources of every package it needs from CRAN-like + repositories concurrently, before installing any of them. Set the option + \code{packrat.prefetch.sources} to \code{FALSE} to download each package + just before it is installed instead. The option + \code{packrat.prefetch.concurrency} sets the number of simultaneous + downloads (default 8). Packages that fail to download concurrently are + downloaded again before they are installed. } \seealso{ \code{\link{snapshot}}, the command that creates the snapshots diff --git a/tests/testthat/test-prefetch.R b/tests/testthat/test-prefetch.R new file mode 100644 index 00000000..4f275190 --- /dev/null +++ b/tests/testthat/test-prefetch.R @@ -0,0 +1,183 @@ +pkgRecord <- function(name, version, source = "CRAN", ...) { + list(name = name, version = version, source = source, hash = "hash", ...) +} + +availableMatrix <- function(versions, repository) { + matrix( + c(versions, rep(repository, length(versions))), + ncol = 2, + dimnames = list(names(versions), c("Version", "Repository")) + ) +} + +skip_if_no_parallel_curl <- function() { + version <- curlVersion() + if (is.null(version) || version < prefetchMinimumCurlVersion) { + skip("curl with --parallel and %{exitcode} is not available") + } +} + +test_that("prefetchTargets uses the current file or the CRAN archive", { + srcDir <- withr::local_tempdir() + withr::local_envvar(R_PACKRAT_SRC_DIR = srcDir) + local_mocked_bindings(cachedPackagePath = function(project, pkgRecord) NULL) + + repo <- "https://example.com/cran" + available <- availableMatrix( + c(current = "1.0", older = "2.0"), + paste0(repo, "/src/contrib") + ) + records <- list( + pkgRecord("current", "1.0"), + pkgRecord("older", "1.5"), + pkgRecord("missing", "0.1") + ) + actions <- c(current = "add", older = "downgrade", missing = "add") + + repos <- c(CRAN = paste0(repo, "/")) + targets <- prefetchTargets(prefetchCandidates(records, actions, repos, NULL), repos, NULL, available) + + expect_equal(targets$name, c("current", "older", "missing")) + expect_equal( + targets$url, + c( + "https://example.com/cran/src/contrib/current_1.0.tar.gz", + "https://example.com/cran/src/contrib/Archive/older/older_1.5.tar.gz", + "https://example.com/cran/src/contrib/Archive/missing/missing_0.1.tar.gz" + ) + ) + expect_equal( + targets$destfile, + file.path(srcDir, c("current", "older", "missing"), c("current_1.0.tar.gz", "older_1.5.tar.gz", "missing_0.1.tar.gz")) + ) +}) + +test_that("prefetchCandidates skips packages that won't be downloaded from a repository", { + srcDir <- withr::local_tempdir() + withr::local_envvar(R_PACKRAT_SRC_DIR = srcDir) + local_mocked_bindings( + cachedPackagePath = function(project, pkgRecord) { + if (identical(pkgRecord$name, "cached")) "/cache/cached" else NULL + } + ) + dir.create(file.path(srcDir, "present")) + file.create(file.path(srcDir, "present", "present_1.0.tar.gz")) + + records <- list( + pkgRecord("wanted", "1.0"), + pkgRecord("cached", "1.0"), + pkgRecord("present", "1.0"), + pkgRecord( + "fromgit", + "1.0", + source = "github", + remote_host = "api.github.com", + remote_repo = "fromgit" + ), + pkgRecord("local", "1.0", source = "source"), + pkgRecord("removed", "1.0") + ) + actions <- c( + wanted = "add", + cached = "add", + present = "add", + fromgit = "add", + local = "add", + removed = "remove" + ) + + candidates <- prefetchCandidates(records, actions, c(CRAN = "https://example.com/cran"), NULL) + + expect_equal(vapply(candidates, `[[`, character(1), "name"), "wanted") +}) + +test_that("prefetchDownload moves successful downloads into place and reports failures", { + skip_on_os("windows") + skip_if_no_parallel_curl() + + repo <- withr::local_tempdir() + writeLines("one", file.path(repo, "one_1.0.tar.gz")) + writeLines("two", file.path(repo, "two_1.0.tar.gz")) + srcDir <- withr::local_tempdir() + withr::local_options(download.file.method = "curl", download.file.extra = NULL) + + repoURL <- paste0("file://", normalizePath(repo)) + targets <- data.frame( + name = c("one", "two", "gone"), + version = "1.0", + url = paste0(repoURL, "/", c("one", "two", "gone"), "_1.0.tar.gz"), + destfile = file.path(srcDir, c("one", "two", "gone"), c("one_1.0.tar.gz", "two_1.0.tar.gz", "gone_1.0.tar.gz")), + stringsAsFactors = FALSE + ) + + failed <- prefetchDownload(targets, concurrency = 2L) + + expect_equal(failed$name, "gone") + expect_equal(readLines(targets$destfile[1]), "one") + expect_equal(readLines(targets$destfile[2]), "two") + expect_false(file.exists(targets$destfile[3])) + expect_length(list.files(srcDir, pattern = "\\.prefetch$", recursive = TRUE), 0) +}) + +test_that("prefetchPackageSources does nothing without a capable curl", { + local_mocked_bindings( + hasBinaryRepositories = function() FALSE, + availablePackagesSource = function(repos) { + availableMatrix(c(pkg = "1.0"), "https://example.com/cran/src/contrib") + }, + cachedPackagePath = function(project, pkgRecord) NULL, + inferAppropriateDownloadMethod = function(url) "curl", + curlVersion = function() numeric_version("7.61.1"), + prefetchDownload = function(targets, concurrency) stop("should not download") + ) + withr::local_envvar(R_PACKRAT_SRC_DIR = withr::local_tempdir()) + + expect_silent( + prefetchPackageSources(list(pkgRecord("pkg", "1.0")), c(pkg = "add"), c(CRAN = "https://example.com/cran"), NULL) + ) +}) + +test_that("prefetchPackageSources turns errors into a warning", { + local_mocked_bindings( + hasBinaryRepositories = function() FALSE, + availablePackagesSource = function(repos) { + availableMatrix(c(pkg = "1.0"), "https://example.com/cran/src/contrib") + }, + cachedPackagePath = function(project, pkgRecord) NULL, + inferAppropriateDownloadMethod = function(url) "curl", + curlVersion = function() numeric_version("8.5.0"), + prefetchDownload = function(targets, concurrency) stop("network is down") + ) + withr::local_envvar(R_PACKRAT_SRC_DIR = withr::local_tempdir()) + + expect_warning( + suppressMessages( + prefetchPackageSources(list(pkgRecord("pkg", "1.0")), c(pkg = "add"), c(CRAN = "https://example.com/cran"), NULL) + ), + "network is down" + ) +}) + +test_that("prefetchPackageSources doesn't contact the repository when everything is cached", { + local_mocked_bindings( + hasBinaryRepositories = function() FALSE, + cachedPackagePath = function(project, pkgRecord) "/cache/pkg", + availablePackagesSource = function(repos) stop("should not fetch the package index") + ) + withr::local_envvar(R_PACKRAT_SRC_DIR = withr::local_tempdir()) + + expect_silent( + prefetchPackageSources(list(pkgRecord("pkg", "1.0")), c(pkg = "add"), c(CRAN = "https://example.com/cran"), NULL) + ) +}) + +test_that("prefetchPackageSources can be turned off", { + local_mocked_bindings( + availablePackagesSource = function(repos) stop("should not run") + ) + withr::local_options(packrat.prefetch.sources = FALSE) + + expect_silent( + prefetchPackageSources(list(pkgRecord("pkg", "1.0")), c(pkg = "add"), c(CRAN = "https://example.com/cran"), NULL) + ) +}) From caa50dfbc3733760a31d07a6af8b17bc92c47c0b Mon Sep 17 00:00:00 2001 From: Marcos Date: Tue, 6 Oct 2026 13:04:20 -0600 Subject: [PATCH 2/7] Apply batched suggestions from code review Co-authored-by: github-actions[bot] <41898282+github-actions[bot]@users.noreply.github.com> --- R/prefetch.R | 15 +++++-- tests/testthat/test-prefetch.R | 72 ++++++++++++++++++++++++++++------ 2 files changed, 72 insertions(+), 15 deletions(-) diff --git a/R/prefetch.R b/R/prefetch.R index f068c6c5..a45fc4ee 100644 --- a/R/prefetch.R +++ b/R/prefetch.R @@ -32,10 +32,18 @@ prefetchConcurrency <- function() { # Returns the curl version as a numeric_version, or NULL if curl can't be run. curlVersion <- function() { output <- tryCatch( - suppressWarnings(system2("curl", "--version", stdout = TRUE, stderr = FALSE)), + suppressWarnings(system2( + "curl", + "--version", + stdout = TRUE, + stderr = FALSE + )), error = function(e) character() ) - version <- regmatches(output[1], regexpr("(?<=^curl )[0-9.]+", output[1], perl = TRUE)) + version <- regmatches( + output[1], + regexpr("(?<=^curl )[0-9.]+", output[1], perl = TRUE) + ) if (!length(version)) { return(NULL) } @@ -76,7 +84,8 @@ prefetchDestfile <- function(pkgRecord, project) { prefetchTargets <- function(records, repos, project, available) { rows <- lapply(records, function(pkgRecord) { pkgSrcFile <- pkgSrcFilename(pkgRecord) - current <- pkgRecord$name %in% rownames(available) && + current <- pkgRecord$name %in% + rownames(available) && identical(pkgRecord$version, available[pkgRecord$name, "Version"]) url <- if (current) { paste(available[pkgRecord$name, "Repository"], pkgSrcFile, sep = "/") diff --git a/tests/testthat/test-prefetch.R b/tests/testthat/test-prefetch.R index 4f275190..dadefdd6 100644 --- a/tests/testthat/test-prefetch.R +++ b/tests/testthat/test-prefetch.R @@ -35,7 +35,12 @@ test_that("prefetchTargets uses the current file or the CRAN archive", { actions <- c(current = "add", older = "downgrade", missing = "add") repos <- c(CRAN = paste0(repo, "/")) - targets <- prefetchTargets(prefetchCandidates(records, actions, repos, NULL), repos, NULL, available) + targets <- prefetchTargets( + prefetchCandidates(records, actions, repos, NULL), + repos, + NULL, + available + ) expect_equal(targets$name, c("current", "older", "missing")) expect_equal( @@ -48,7 +53,11 @@ test_that("prefetchTargets uses the current file or the CRAN archive", { ) expect_equal( targets$destfile, - file.path(srcDir, c("current", "older", "missing"), c("current_1.0.tar.gz", "older_1.5.tar.gz", "missing_0.1.tar.gz")) + file.path( + srcDir, + c("current", "older", "missing"), + c("current_1.0.tar.gz", "older_1.5.tar.gz", "missing_0.1.tar.gz") + ) ) }) @@ -86,7 +95,12 @@ test_that("prefetchCandidates skips packages that won't be downloaded from a rep removed = "remove" ) - candidates <- prefetchCandidates(records, actions, c(CRAN = "https://example.com/cran"), NULL) + candidates <- prefetchCandidates( + records, + actions, + c(CRAN = "https://example.com/cran"), + NULL + ) expect_equal(vapply(candidates, `[[`, character(1), "name"), "wanted") }) @@ -99,14 +113,21 @@ test_that("prefetchDownload moves successful downloads into place and reports fa writeLines("one", file.path(repo, "one_1.0.tar.gz")) writeLines("two", file.path(repo, "two_1.0.tar.gz")) srcDir <- withr::local_tempdir() - withr::local_options(download.file.method = "curl", download.file.extra = NULL) + withr::local_options( + download.file.method = "curl", + download.file.extra = NULL + ) repoURL <- paste0("file://", normalizePath(repo)) targets <- data.frame( name = c("one", "two", "gone"), version = "1.0", url = paste0(repoURL, "/", c("one", "two", "gone"), "_1.0.tar.gz"), - destfile = file.path(srcDir, c("one", "two", "gone"), c("one_1.0.tar.gz", "two_1.0.tar.gz", "gone_1.0.tar.gz")), + destfile = file.path( + srcDir, + c("one", "two", "gone"), + c("one_1.0.tar.gz", "two_1.0.tar.gz", "gone_1.0.tar.gz") + ), stringsAsFactors = FALSE ) @@ -116,7 +137,10 @@ test_that("prefetchDownload moves successful downloads into place and reports fa expect_equal(readLines(targets$destfile[1]), "one") expect_equal(readLines(targets$destfile[2]), "two") expect_false(file.exists(targets$destfile[3])) - expect_length(list.files(srcDir, pattern = "\\.prefetch$", recursive = TRUE), 0) + expect_length( + list.files(srcDir, pattern = "\\.prefetch$", recursive = TRUE), + 0 + ) }) test_that("prefetchPackageSources does nothing without a capable curl", { @@ -128,12 +152,19 @@ test_that("prefetchPackageSources does nothing without a capable curl", { cachedPackagePath = function(project, pkgRecord) NULL, inferAppropriateDownloadMethod = function(url) "curl", curlVersion = function() numeric_version("7.61.1"), - prefetchDownload = function(targets, concurrency) stop("should not download") + prefetchDownload = function(targets, concurrency) { + stop("should not download") + } ) withr::local_envvar(R_PACKRAT_SRC_DIR = withr::local_tempdir()) expect_silent( - prefetchPackageSources(list(pkgRecord("pkg", "1.0")), c(pkg = "add"), c(CRAN = "https://example.com/cran"), NULL) + prefetchPackageSources( + list(pkgRecord("pkg", "1.0")), + c(pkg = "add"), + c(CRAN = "https://example.com/cran"), + NULL + ) ) }) @@ -152,7 +183,12 @@ test_that("prefetchPackageSources turns errors into a warning", { expect_warning( suppressMessages( - prefetchPackageSources(list(pkgRecord("pkg", "1.0")), c(pkg = "add"), c(CRAN = "https://example.com/cran"), NULL) + prefetchPackageSources( + list(pkgRecord("pkg", "1.0")), + c(pkg = "add"), + c(CRAN = "https://example.com/cran"), + NULL + ) ), "network is down" ) @@ -162,12 +198,19 @@ test_that("prefetchPackageSources doesn't contact the repository when everything local_mocked_bindings( hasBinaryRepositories = function() FALSE, cachedPackagePath = function(project, pkgRecord) "/cache/pkg", - availablePackagesSource = function(repos) stop("should not fetch the package index") + availablePackagesSource = function(repos) { + stop("should not fetch the package index") + } ) withr::local_envvar(R_PACKRAT_SRC_DIR = withr::local_tempdir()) expect_silent( - prefetchPackageSources(list(pkgRecord("pkg", "1.0")), c(pkg = "add"), c(CRAN = "https://example.com/cran"), NULL) + prefetchPackageSources( + list(pkgRecord("pkg", "1.0")), + c(pkg = "add"), + c(CRAN = "https://example.com/cran"), + NULL + ) ) }) @@ -178,6 +221,11 @@ test_that("prefetchPackageSources can be turned off", { withr::local_options(packrat.prefetch.sources = FALSE) expect_silent( - prefetchPackageSources(list(pkgRecord("pkg", "1.0")), c(pkg = "add"), c(CRAN = "https://example.com/cran"), NULL) + prefetchPackageSources( + list(pkgRecord("pkg", "1.0")), + c(pkg = "add"), + c(CRAN = "https://example.com/cran"), + NULL + ) ) }) From 893166145cc43f31b74d77ec5c16fd649e1f5371 Mon Sep 17 00:00:00 2001 From: marcosnav Date: Tue, 6 Oct 2026 14:31:34 -0600 Subject: [PATCH 3/7] Keep Windows on sequential downloads, as renv does On Windows, restore() keeps downloading one package at a time, following the vendored renv, which runs its parallel work sequentially there. Document this, and mock is.windows() in the tests that exercise the prefetch past that check so they run on Windows too. --- NEWS.md | 3 ++- R/packrat.R | 3 ++- R/prefetch.R | 3 +++ man/restore.Rd | 3 ++- tests/testthat/test-prefetch.R | 3 +++ 5 files changed, 12 insertions(+), 3 deletions(-) diff --git a/NEWS.md b/NEWS.md index 1d7fc50a..36b4c2ad 100644 --- a/NEWS.md +++ b/NEWS.md @@ -5,7 +5,8 @@ download method. Restores that install many packages no longer wait on one download at a time. Set `options(packrat.prefetch.sources = FALSE)` to turn this off, and `packrat.prefetch.concurrency` to change the number of - simultaneous downloads (default 8). + simultaneous downloads (default 8). On Windows, packages are still + downloaded one at a time, as with renv's parallel operations. - Fixed a race condition where concurrent R processes installing the same package could fail while inserting it into the package cache. diff --git a/R/packrat.R b/R/packrat.R index ccf10e2d..25dcd130 100644 --- a/R/packrat.R +++ b/R/packrat.R @@ -331,7 +331,8 @@ initImpl <- function( #' just before it is installed instead. The option #' \code{packrat.prefetch.concurrency} sets the number of simultaneous #' downloads (default 8). Packages that fail to download concurrently are -#' downloaded again before they are installed. +#' downloaded again before they are installed. On Windows, packages are +#' downloaded one at a time, as with renv's parallel operations. #' #' @param project The project directory. When in packrat mode, if this is #' \code{NULL}, then the directory associated with the current packrat project diff --git a/R/prefetch.R b/R/prefetch.R index a45fc4ee..f38590ed 100644 --- a/R/prefetch.R +++ b/R/prefetch.R @@ -182,6 +182,9 @@ prefetchDownload <- function(targets, concurrency) { } prefetchPackageSources <- function(pkgRecords, actions, repos, project) { + # On Windows, packages keep downloading one at a time, following the + # vendored renv, which runs its parallel work sequentially there (see + # renv_parallel_cores()). if (!prefetchEnabled() || is.windows()) { return(invisible()) } diff --git a/man/restore.Rd b/man/restore.Rd index 290c3e18..d93f8670 100644 --- a/man/restore.Rd +++ b/man/restore.Rd @@ -100,7 +100,8 @@ will be lost. just before it is installed instead. The option \code{packrat.prefetch.concurrency} sets the number of simultaneous downloads (default 8). Packages that fail to download concurrently are - downloaded again before they are installed. + downloaded again before they are installed. On Windows, packages are + downloaded one at a time, as with renv's parallel operations. } \seealso{ \code{\link{snapshot}}, the command that creates the snapshots diff --git a/tests/testthat/test-prefetch.R b/tests/testthat/test-prefetch.R index dadefdd6..0568be2e 100644 --- a/tests/testthat/test-prefetch.R +++ b/tests/testthat/test-prefetch.R @@ -145,6 +145,7 @@ test_that("prefetchDownload moves successful downloads into place and reports fa test_that("prefetchPackageSources does nothing without a capable curl", { local_mocked_bindings( + is.windows = function() FALSE, hasBinaryRepositories = function() FALSE, availablePackagesSource = function(repos) { availableMatrix(c(pkg = "1.0"), "https://example.com/cran/src/contrib") @@ -170,6 +171,7 @@ test_that("prefetchPackageSources does nothing without a capable curl", { test_that("prefetchPackageSources turns errors into a warning", { local_mocked_bindings( + is.windows = function() FALSE, hasBinaryRepositories = function() FALSE, availablePackagesSource = function(repos) { availableMatrix(c(pkg = "1.0"), "https://example.com/cran/src/contrib") @@ -196,6 +198,7 @@ test_that("prefetchPackageSources turns errors into a warning", { test_that("prefetchPackageSources doesn't contact the repository when everything is cached", { local_mocked_bindings( + is.windows = function() FALSE, hasBinaryRepositories = function() FALSE, cachedPackagePath = function(project, pkgRecord) "/cache/pkg", availablePackagesSource = function(repos) { From 3ba2841fb8d78f8f30178371c5c63cf687a9ba46 Mon Sep 17 00:00:00 2001 From: marcosnav Date: Thu, 8 Oct 2026 14:22:30 -0600 Subject: [PATCH 4/7] Address review feedback on source prefetching - Send R's user agent (HTTPUserAgent) with the prefetch unless download.file.extra already sets one, so Package Manager serves binaries as it does for single-package downloads. - Prefetch on Windows too: curl --parallel doesn't fork, so renv's reason for running sequentially there doesn't apply. - With binary repositories in use, skip only the packages installPkg() installs as binaries, using the same checks (now shared as installsFromBinaryRepository()), instead of skipping the prefetch. - Move test helpers to tests/testthat/helper.R, and test that installPkg() uses a prefetched source without downloading it again. --- NEWS.md | 3 +- R/packrat.R | 3 +- R/prefetch.R | 31 +++++--- R/restore.R | 18 +++-- man/restore.Rd | 3 +- tests/testthat/helper.R | 24 +++++++ tests/testthat/test-prefetch.R | 126 ++++++++++++++++++++++++++------- 7 files changed, 162 insertions(+), 46 deletions(-) create mode 100644 tests/testthat/helper.R diff --git a/NEWS.md b/NEWS.md index 36b4c2ad..1d7fc50a 100644 --- a/NEWS.md +++ b/NEWS.md @@ -5,8 +5,7 @@ download method. Restores that install many packages no longer wait on one download at a time. Set `options(packrat.prefetch.sources = FALSE)` to turn this off, and `packrat.prefetch.concurrency` to change the number of - simultaneous downloads (default 8). On Windows, packages are still - downloaded one at a time, as with renv's parallel operations. + simultaneous downloads (default 8). - Fixed a race condition where concurrent R processes installing the same package could fail while inserting it into the package cache. diff --git a/R/packrat.R b/R/packrat.R index 25dcd130..ccf10e2d 100644 --- a/R/packrat.R +++ b/R/packrat.R @@ -331,8 +331,7 @@ initImpl <- function( #' just before it is installed instead. The option #' \code{packrat.prefetch.concurrency} sets the number of simultaneous #' downloads (default 8). Packages that fail to download concurrently are -#' downloaded again before they are installed. On Windows, packages are -#' downloaded one at a time, as with renv's parallel operations. +#' downloaded again before they are installed. #' #' @param project The project directory. When in packrat mode, if this is #' \code{NULL}, then the directory associated with the current packrat project diff --git a/R/prefetch.R b/R/prefetch.R index f38590ed..20e21278 100644 --- a/R/prefetch.R +++ b/R/prefetch.R @@ -114,6 +114,20 @@ curlConfigQuote <- function(value) { paste0("\"", gsub("([\"\\\\])", "\\\\\\1", value), "\"") } +# Send R's user agent unless 'extra' already sets one. Repositories such as +# Posit Package Manager use it to decide whether to serve binaries, and a +# single-package download (through libcurl, or through curl with a +# download.file.extra that sets it) sends it too. +prefetchUserAgentArgs <- function(extra) { + userAgent <- getOption("HTTPUserAgent") + setsUserAgent <- grepl("(^|\\s)(-A|--user-agent)(\\s|=|$)", extra) || + grepl("user-agent:", extra, ignore.case = TRUE) + if (length(userAgent) != 1L || !nzchar(userAgent) || setsUserAgent) { + return(extra) + } + paste(extra, "-A", shQuote(userAgent)) +} + # Download every target with one `curl --parallel`. Each file is written to a # temporary name and moved into place only when its transfer succeeded, so a # failed or partial download never looks like a usable source. Returns the @@ -144,6 +158,7 @@ prefetchDownload <- function(targets, concurrency) { if (identical(getOption("download.file.method"), "curl")) { extra <- paste(getOption("download.file.extra", ""), collapse = " ") } + extra <- prefetchUserAgentArgs(extra) writeOut <- "packrat-prefetch %{exitcode} %{http_code} %{filename_effective}\\n" command <- paste( "curl", @@ -182,21 +197,19 @@ prefetchDownload <- function(targets, concurrency) { } prefetchPackageSources <- function(pkgRecords, actions, repos, project) { - # On Windows, packages keep downloading one at a time, following the - # vendored renv, which runs its parallel work sequentially there (see - # renv_parallel_cores()). - if (!prefetchEnabled() || is.windows()) { - return(invisible()) - } - # When binary repositories are in use, installPkg() installs binaries with - # install.packages() and never needs these sources. - if (hasBinaryRepositories() && binaryRepositoriesEnabled()) { + if (!prefetchEnabled()) { return(invisible()) } tryCatch( { candidates <- prefetchCandidates(pkgRecords, actions, repos, project) + # installPkg() installs these from a binary repository and doesn't need + # their sources. + candidates <- Filter( + function(pkgRecord) !installsFromBinaryRepository(pkgRecord, repos), + candidates + ) if (!length(candidates)) { return(invisible()) } diff --git a/R/restore.R b/R/restore.R index a652baf0..841e205a 100644 --- a/R/restore.R +++ b/R/restore.R @@ -572,6 +572,16 @@ removePkgs <- function(project, pkgNames, lib.loc = libDir(project)) { pkgNames } +# Whether installPkg() tries to install a package as a binary from a binary +# repository, rather than from its sources. +installsFromBinaryRepository <- function(pkgRecord, repos) { + hasBinaryRepositories() && + binaryRepositoriesEnabled() && + isFromCranlikeRepo(pkgRecord, repos) && + pkgRecord$name %in% availablePackagesBinary(repos = repos)[, "Package"] && + versionMatchesDb(pkgRecord, availablePackagesBinary(repos = repos)) +} + # Installs a single package from its record. Returns the method used to install # the package (built source, downloaded binary, etc.) installPkg <- function(pkgRecord, project, repos, lib = libDir(project)) { @@ -628,13 +638,7 @@ installPkg <- function(pkgRecord, project, repos, lib = libDir(project)) { needsInstall <- TRUE # Try downloading a binary (when appropriate). - if ( - hasBinaryRepositories() && - binaryRepositoriesEnabled() && - isFromCranlikeRepo(pkgRecord, repos) && - pkgRecord$name %in% availablePackagesBinary(repos = repos)[, "Package"] && - versionMatchesDb(pkgRecord, availablePackagesBinary(repos = repos)) - ) { + if (installsFromBinaryRepository(pkgRecord, repos)) { tempdir <- tempdir() tryCatch( { diff --git a/man/restore.Rd b/man/restore.Rd index d93f8670..290c3e18 100644 --- a/man/restore.Rd +++ b/man/restore.Rd @@ -100,8 +100,7 @@ will be lost. just before it is installed instead. The option \code{packrat.prefetch.concurrency} sets the number of simultaneous downloads (default 8). Packages that fail to download concurrently are - downloaded again before they are installed. On Windows, packages are - downloaded one at a time, as with renv's parallel operations. + downloaded again before they are installed. } \seealso{ \code{\link{snapshot}}, the command that creates the snapshots diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R new file mode 100644 index 00000000..56ccf8de --- /dev/null +++ b/tests/testthat/helper.R @@ -0,0 +1,24 @@ +pkgRecord <- function(name, version, source = "CRAN", ...) { + list(name = name, version = version, source = source, hash = "hash", ...) +} + +availableMatrix <- function(versions, repository) { + matrix( + c(versions, rep(repository, length(versions))), + ncol = 2, + dimnames = list(names(versions), c("Version", "Repository")) + ) +} + +skip_if_no_parallel_curl <- function() { + version <- curlVersion() + if (is.null(version) || version < prefetchMinimumCurlVersion) { + skip("curl with --parallel and %{exitcode} is not available") + } +} + +# A file:// URL for a local directory, on any platform. +fileURL <- function(path) { + path <- normalizePath(path, winslash = "/") + paste0(if (startsWith(path, "/")) "file://" else "file:///", path) +} diff --git a/tests/testthat/test-prefetch.R b/tests/testthat/test-prefetch.R index 0568be2e..9e227500 100644 --- a/tests/testthat/test-prefetch.R +++ b/tests/testthat/test-prefetch.R @@ -1,22 +1,3 @@ -pkgRecord <- function(name, version, source = "CRAN", ...) { - list(name = name, version = version, source = source, hash = "hash", ...) -} - -availableMatrix <- function(versions, repository) { - matrix( - c(versions, rep(repository, length(versions))), - ncol = 2, - dimnames = list(names(versions), c("Version", "Repository")) - ) -} - -skip_if_no_parallel_curl <- function() { - version <- curlVersion() - if (is.null(version) || version < prefetchMinimumCurlVersion) { - skip("curl with --parallel and %{exitcode} is not available") - } -} - test_that("prefetchTargets uses the current file or the CRAN archive", { srcDir <- withr::local_tempdir() withr::local_envvar(R_PACKRAT_SRC_DIR = srcDir) @@ -106,8 +87,8 @@ test_that("prefetchCandidates skips packages that won't be downloaded from a rep }) test_that("prefetchDownload moves successful downloads into place and reports failures", { - skip_on_os("windows") skip_if_no_parallel_curl() + skip_on_cran() repo <- withr::local_tempdir() writeLines("one", file.path(repo, "one_1.0.tar.gz")) @@ -118,7 +99,7 @@ test_that("prefetchDownload moves successful downloads into place and reports fa download.file.extra = NULL ) - repoURL <- paste0("file://", normalizePath(repo)) + repoURL <- fileURL(repo) targets <- data.frame( name = c("one", "two", "gone"), version = "1.0", @@ -145,7 +126,6 @@ test_that("prefetchDownload moves successful downloads into place and reports fa test_that("prefetchPackageSources does nothing without a capable curl", { local_mocked_bindings( - is.windows = function() FALSE, hasBinaryRepositories = function() FALSE, availablePackagesSource = function(repos) { availableMatrix(c(pkg = "1.0"), "https://example.com/cran/src/contrib") @@ -171,7 +151,6 @@ test_that("prefetchPackageSources does nothing without a capable curl", { test_that("prefetchPackageSources turns errors into a warning", { local_mocked_bindings( - is.windows = function() FALSE, hasBinaryRepositories = function() FALSE, availablePackagesSource = function(repos) { availableMatrix(c(pkg = "1.0"), "https://example.com/cran/src/contrib") @@ -198,7 +177,6 @@ test_that("prefetchPackageSources turns errors into a warning", { test_that("prefetchPackageSources doesn't contact the repository when everything is cached", { local_mocked_bindings( - is.windows = function() FALSE, hasBinaryRepositories = function() FALSE, cachedPackagePath = function(project, pkgRecord) "/cache/pkg", availablePackagesSource = function(repos) { @@ -232,3 +210,103 @@ test_that("prefetchPackageSources can be turned off", { ) ) }) + +test_that("prefetchUserAgentArgs sends R's user agent unless one is set", { + withr::local_options(HTTPUserAgent = "R (4.5.0 x86_64-pc-linux-gnu)") + + expect_equal( + prefetchUserAgentArgs(""), + paste("", "-A", shQuote("R (4.5.0 x86_64-pc-linux-gnu)")) + ) + expect_equal(prefetchUserAgentArgs("-A custom"), "-A custom") + expect_equal( + prefetchUserAgentArgs("--user-agent=custom"), + "--user-agent=custom" + ) + expect_equal( + prefetchUserAgentArgs("-H 'User-Agent: custom'"), + "-H 'User-Agent: custom'" + ) + + withr::local_options(HTTPUserAgent = NULL) + expect_equal(prefetchUserAgentArgs("-L"), "-L") +}) + +test_that("prefetchPackageSources skips packages installed from a binary repository", { + local_mocked_bindings( + hasBinaryRepositories = function() TRUE, + binaryRepositoriesEnabled = function() TRUE, + availablePackagesBinary = function(repos) { + cbind( + Package = "binary", + availableMatrix(c(binary = "1.0"), "https://example.com/cran/bin") + ) + }, + availablePackagesSource = function(repos) { + availableMatrix( + c(binary = "1.0", source = "1.0"), + "https://example.com/cran/src/contrib" + ) + }, + cachedPackagePath = function(project, pkgRecord) NULL, + inferAppropriateDownloadMethod = function(url) "curl", + curlVersion = function() numeric_version("8.5.0"), + prefetchDownload = function(targets, concurrency) { + fetched <<- targets$name + targets[0, , drop = FALSE] + } + ) + withr::local_envvar(R_PACKRAT_SRC_DIR = withr::local_tempdir()) + fetched <- NULL + + suppressMessages( + prefetchPackageSources( + list(pkgRecord("binary", "1.0"), pkgRecord("source", "1.0")), + c(binary = "add", source = "add"), + c(CRAN = "https://example.com/cran"), + NULL + ) + ) + + expect_equal(fetched, "source") +}) + +test_that("installPkg uses a prefetched source without downloading it again", { + skip_if_no_parallel_curl() + skip_on_cran() + + repo <- withr::local_tempdir() + writeLines("pkg", file.path(repo, "pkg_1.0.tar.gz")) + srcDir <- withr::local_tempdir() + withr::local_envvar(R_PACKRAT_SRC_DIR = srcDir) + withr::local_options(download.file.extra = NULL) + + installed <- NULL + local_mocked_bindings( + hasBinaryRepositories = function() FALSE, + availablePackagesSource = function(repos) { + availableMatrix(c(pkg = "1.0"), fileURL(repo)) + }, + cachedPackagePath = function(project, pkgRecord) NULL, + inferAppropriateDownloadMethod = function(url) "curl", + restoreWithCopyFromCache = function(...) FALSE, + restoreWithCopyFromUntrustedCache = function(...) FALSE, + getSourceForPkgRecord = function(...) stop("should not download"), + archivePackageType = function(...) "source", + install_local_path = function(path, ...) installed <<- path, + annotatePkgDesc = function(...) NULL, + isUsingCache = function(project) FALSE + ) + + record <- pkgRecord("pkg", "1.0") + repos <- c(CRAN = "https://example.com/cran") + suppressMessages( + prefetchPackageSources(list(record), c(pkg = "add"), repos, NULL) + ) + prefetched <- file.path(srcDir, "pkg", "pkg_1.0.tar.gz") + expect_equal(readLines(prefetched), "pkg") + + installPkg(record, NULL, repos, lib = withr::local_tempdir()) + + expect_equal(installed, prefetched) +}) From f329163d61aaa3485881a9fc057551387af78a3a Mon Sep 17 00:00:00 2001 From: Marcos Date: Fri, 9 Oct 2026 16:00:03 -0600 Subject: [PATCH 5/7] Update R/prefetch.R Co-authored-by: Kara Woo --- R/prefetch.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/R/prefetch.R b/R/prefetch.R index 20e21278..1eabb411 100644 --- a/R/prefetch.R +++ b/R/prefetch.R @@ -162,6 +162,8 @@ prefetchDownload <- function(targets, concurrency) { writeOut <- "packrat-prefetch %{exitcode} %{http_code} %{filename_effective}\\n" command <- paste( "curl", + "--speed-limit 1 --speed-time", + as.integer(getOption("timeout", 60)), curlExtraArgs(extra), "--parallel --parallel-max", concurrency, From 91dccf921cff049fc3d6b7ac6eb7393043e3a202 Mon Sep 17 00:00:00 2001 From: Marcos Date: Fri, 9 Oct 2026 16:01:01 -0600 Subject: [PATCH 6/7] Update R/packrat.R Co-authored-by: Kara Woo --- R/packrat.R | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/R/packrat.R b/R/packrat.R index ccf10e2d..73b9b1ba 100644 --- a/R/packrat.R +++ b/R/packrat.R @@ -325,13 +325,13 @@ initImpl <- function( #' cause errors with long filenames. #' #' When \code{curl} 7.75.0 or later is the download method, Packrat -#' downloads the sources of every package it needs from CRAN-like -#' repositories concurrently, before installing any of them. Set the option -#' \code{packrat.prefetch.sources} to \code{FALSE} to download each package -#' just before it is installed instead. The option -#' \code{packrat.prefetch.concurrency} sets the number of simultaneous -#' downloads (default 8). Packages that fail to download concurrently are -#' downloaded again before they are installed. +#' downloads package files from CRAN-like repositories concurrently before +#' it installs them. It skips packages from the cache and, on macOS and +#' Windows, packages that it installs from a binary repository. On Linux and +#' macOS, Packrat uses curl when \code{download.file.method} is not set. Set +#' \code{packrat.prefetch.sources} to \code{FALSE} to turn this off, or +#' \code{packrat.prefetch.concurrency} to change the number of simultaneous +#' downloads (default 8). #' #' @param project The project directory. When in packrat mode, if this is #' \code{NULL}, then the directory associated with the current packrat project From 618daf24968b0d6fd7455fb46a3f88621afefbe8 Mon Sep 17 00:00:00 2001 From: marcosnav Date: Tue, 13 Oct 2026 07:35:22 -0600 Subject: [PATCH 7/7] Prefetch from every archive location downloadArchiveWithRetries tries The prefetch tried archived packages only at the CRAN archive layout of the first repository, so a package in another repository or a non-CRAN layout was left to the install loop. The archive URLs downloadArchiveWithRetries() tries are now built by archiveUrls(), and the prefetch tries them in the same order: each round is one `curl --parallel` that tries the next URL of every package not yet downloaded. archiveUrls() strips trailing slashes from repository URLs, so the install loop no longer requests paths like `cran//src/contrib`. --- R/prefetch.R | 56 +++++++++++++++------ R/restore.R | 47 +++++++++-------- tests/testthat/test-prefetch.R | 92 +++++++++++++++++++++++++++++++--- 3 files changed, 152 insertions(+), 43 deletions(-) diff --git a/R/prefetch.R b/R/prefetch.R index 1eabb411..f7c2a3d5 100644 --- a/R/prefetch.R +++ b/R/prefetch.R @@ -76,27 +76,24 @@ prefetchDestfile <- function(pkgRecord, project) { file.path(srcDir(project), pkgRecord$name, pkgSrcFilename(pkgRecord)) } -# Download URL and destination for each candidate. Returns a data frame with -# one row per package: name, version, url, and destfile. Mirrors the URL -# choice in getSourceForPkgRecord(): the repository's current file when the -# version matches available.packages(), otherwise the CRAN archive layout of -# the first repository. +# Download URLs and destination for each candidate. Returns a data frame with +# one row per URL to try, in the order to try them: name, version, url, and +# destfile. Mirrors the URL choice in getSourceForPkgRecord(): the +# repository's current file when the version matches available.packages(), +# otherwise each archive location downloadArchiveWithRetries() tries. prefetchTargets <- function(records, repos, project, available) { rows <- lapply(records, function(pkgRecord) { - pkgSrcFile <- pkgSrcFilename(pkgRecord) current <- pkgRecord$name %in% rownames(available) && identical(pkgRecord$version, available[pkgRecord$name, "Version"]) url <- if (current) { - paste(available[pkgRecord$name, "Repository"], pkgSrcFile, sep = "/") - } else { paste( - sub("/+$", "", repos[[1]]), - "src/contrib/Archive", - pkgRecord$name, - pkgSrcFile, + available[pkgRecord$name, "Repository"], + pkgSrcFilename(pkgRecord), sep = "/" ) + } else { + archiveUrls(repos, pkgRecord) } data.frame( name = pkgRecord$name, @@ -198,6 +195,32 @@ prefetchDownload <- function(targets, concurrency) { failed } +# Download each package from the first of its URLs that works. Each round +# tries the next URL of every package not yet downloaded, with one +# prefetchDownload(). Returns the last failed attempt of each package that +# could not be downloaded. +prefetchWithRetries <- function(targets, concurrency) { + failed <- targets[0, , drop = FALSE] + failed$http_code <- character() + while (nrow(targets)) { + first <- !duplicated(targets$name) + attemptFailed <- prefetchDownload( + targets[first, , drop = FALSE], + concurrency + ) + targets <- targets[ + !first & targets$name %in% attemptFailed$name, + , + drop = FALSE + ] + failed <- rbind( + failed, + attemptFailed[!attemptFailed$name %in% targets$name, , drop = FALSE] + ) + } + failed +} + prefetchPackageSources <- function(pkgRecords, actions, repos, project) { if (!prefetchEnabled()) { return(invisible()) @@ -226,21 +249,22 @@ prefetchPackageSources <- function(pkgRecords, actions, repos, project) { } concurrency <- prefetchConcurrency() + packages <- length(unique(targets$name)) message( "Prefetching sources for ", - nrow(targets), + packages, " packages (", concurrency, " at a time) ... ", appendLF = FALSE ) start <- Sys.time() - failed <- prefetchDownload(targets, concurrency) + failed <- prefetchWithRetries(targets, concurrency) elapsed <- as.numeric(difftime(Sys.time(), start, units = "secs")) message(sprintf( "fetched %d of %d in %.1f seconds", - nrow(targets) - nrow(failed), - nrow(targets), + packages - nrow(failed), + packages, elapsed )) for (i in seq_len(nrow(failed))) { diff --git a/R/restore.R b/R/restore.R index 841e205a..1c5ad4c9 100644 --- a/R/restore.R +++ b/R/restore.R @@ -426,8 +426,9 @@ useAlternativeArchiveLocations <- function() { getOption("packrat.alternative.archive.layouts", TRUE) } -# Returns TRUE when the package is downloaded, FALSE otherwise. -downloadArchiveWithRetries <- function(repos, pkgRecord, destFile) { +# The URLs where an archived version of a package may be, in the order to try +# them. +archiveUrls <- function(repos, pkgRecord) { pkgSrcFile <- pkgSrcFilename(pkgRecord) # Many repositories follow the CRAN structure, but not all. Try the CRAN @@ -465,25 +466,29 @@ downloadArchiveWithRetries <- function(repos, pkgRecord, destFile) { ) } - foundVersion <- FALSE - for (formatter in formatters) { - for (repo in repos) { - archiveUrl <- formatter(repo) - tryCatch( - { - downloadWithRetries( - archiveUrl, - destfile = destFile, - mode = "wb", - quiet = TRUE - ) - return(TRUE) - }, - error = function(e) { - # ignore error and try next repo/archive path. - } - ) - } + repos <- sub("/+$", "", repos) + unlist(lapply(formatters, function(formatter) { + vapply(repos, formatter, character(1), USE.NAMES = FALSE) + })) +} + +# Returns TRUE when the package is downloaded, FALSE otherwise. +downloadArchiveWithRetries <- function(repos, pkgRecord, destFile) { + for (archiveUrl in archiveUrls(repos, pkgRecord)) { + tryCatch( + { + downloadWithRetries( + archiveUrl, + destfile = destFile, + mode = "wb", + quiet = TRUE + ) + return(TRUE) + }, + error = function(e) { + # ignore error and try next repo/archive path. + } + ) } return(FALSE) } diff --git a/tests/testthat/test-prefetch.R b/tests/testthat/test-prefetch.R index 9e227500..b2b5e4cc 100644 --- a/tests/testthat/test-prefetch.R +++ b/tests/testthat/test-prefetch.R @@ -1,6 +1,7 @@ -test_that("prefetchTargets uses the current file or the CRAN archive", { +test_that("prefetchTargets uses the current file or the archive locations", { srcDir <- withr::local_tempdir() withr::local_envvar(R_PACKRAT_SRC_DIR = srcDir) + withr::local_options(packrat.alternative.archive.layouts = FALSE) local_mocked_bindings(cachedPackagePath = function(project, pkgRecord) NULL) repo <- "https://example.com/cran" @@ -15,7 +16,7 @@ test_that("prefetchTargets uses the current file or the CRAN archive", { ) actions <- c(current = "add", older = "downgrade", missing = "add") - repos <- c(CRAN = paste0(repo, "/")) + repos <- c(CRAN = paste0(repo, "/"), other = "https://example.com/other") targets <- prefetchTargets( prefetchCandidates(records, actions, repos, NULL), repos, @@ -23,23 +24,102 @@ test_that("prefetchTargets uses the current file or the CRAN archive", { available ) - expect_equal(targets$name, c("current", "older", "missing")) + expect_equal( + targets$name, + c("current", "older", "older", "missing", "missing") + ) expect_equal( targets$url, c( "https://example.com/cran/src/contrib/current_1.0.tar.gz", "https://example.com/cran/src/contrib/Archive/older/older_1.5.tar.gz", - "https://example.com/cran/src/contrib/Archive/missing/missing_0.1.tar.gz" + "https://example.com/other/src/contrib/Archive/older/older_1.5.tar.gz", + "https://example.com/cran/src/contrib/Archive/missing/missing_0.1.tar.gz", + "https://example.com/other/src/contrib/Archive/missing/missing_0.1.tar.gz" ) ) expect_equal( targets$destfile, file.path( srcDir, - c("current", "older", "missing"), - c("current_1.0.tar.gz", "older_1.5.tar.gz", "missing_0.1.tar.gz") + c("current", "older", "older", "missing", "missing"), + c( + "current_1.0.tar.gz", + "older_1.5.tar.gz", + "older_1.5.tar.gz", + "missing_0.1.tar.gz", + "missing_0.1.tar.gz" + ) + ) + ) +}) + +test_that("archiveUrls tries every repository with each archive layout", { + repos <- c( + CRAN = "https://example.com/cran/", + other = "https://example.com/other" + ) + record <- pkgRecord("pkg", "1.0") + + expect_equal( + archiveUrls(repos, record), + c( + "https://example.com/cran/src/contrib/Archive/pkg/pkg_1.0.tar.gz", + "https://example.com/other/src/contrib/Archive/pkg/pkg_1.0.tar.gz", + "https://example.com/cran/src/contrib/Archive/pkg/1.0/pkg_1.0.tar.gz", + "https://example.com/other/src/contrib/Archive/pkg/1.0/pkg_1.0.tar.gz", + "https://example.com/cran/src/contrib/pkg_1.0.tar.gz", + "https://example.com/other/src/contrib/pkg_1.0.tar.gz" + ) + ) + + withr::local_options(packrat.alternative.archive.layouts = FALSE) + expect_equal( + archiveUrls(repos, record), + c( + "https://example.com/cran/src/contrib/Archive/pkg/pkg_1.0.tar.gz", + "https://example.com/other/src/contrib/Archive/pkg/pkg_1.0.tar.gz" + ) + ) +}) + +test_that("prefetchWithRetries tries each package's next URL until one works", { + attempts <- list() + local_mocked_bindings( + prefetchDownload = function(targets, concurrency) { + attempts[[length(attempts) + 1L]] <<- targets$url + failed <- targets[!grepl("good", targets$url), , drop = FALSE] + failed$http_code <- rep("404", nrow(failed)) + failed + } + ) + + targets <- data.frame( + name = c("first", "second", "second", "never", "never"), + version = "1.0", + url = c( + "good/first", + "bad/second", + "good/second", + "bad/never", + "worse/never" + ), + destfile = "unused", + stringsAsFactors = FALSE + ) + + failed <- prefetchWithRetries(targets, concurrency = 2L) + + expect_equal( + attempts, + list( + c("good/first", "bad/second", "bad/never"), + c("good/second", "worse/never") ) ) + expect_equal(failed$name, "never") + expect_equal(failed$url, "worse/never") + expect_equal(failed$http_code, "404") }) test_that("prefetchCandidates skips packages that won't be downloaded from a repository", {