From e12a5f66b27b142c8e51d9bf4afdf2401124fee3 Mon Sep 17 00:00:00 2001 From: Aron Atkins Date: Tue, 2 Jan 2024 13:49:45 -0500 Subject: [PATCH 01/11] remove the uncalled annotatePkgs() --- R/restore.R | 8 -------- 1 file changed, 8 deletions(-) diff --git a/R/restore.R b/R/restore.R index 244c68b1..86c6d532 100644 --- a/R/restore.R +++ b/R/restore.R @@ -395,14 +395,6 @@ annotatePkgDesc <- function(pkgRecord, project, lib = libDir(project)) { write_dcf(content, descFile) } -# Annotate a set of packages by name. -annotatePkgs <- function(pkgNames, project, lib = libDir(project)) { - records <- searchPackages(lockInfo(project), pkgNames) - lapply(records, function(record) { - annotatePkgDesc(record, project, lib) - }) -} - # Takes a vector of package names, and returns a logical vector that indicates # whether the package was not installed by packrat. installedByPackrat <- function(pkgNames, lib.loc, default = NA) { From 537aaa646bdd19d2f47600c51a3899cb30520d6f Mon Sep 17 00:00:00 2001 From: Aron Atkins Date: Tue, 2 Jan 2024 14:18:03 -0500 Subject: [PATCH 02/11] write annotated DESCRIPTION to temporary location then rename --- R/restore.R | 6 ++++-- tests/testthat/test-restore.R | 29 +++++++++++++++++++++++++++++ 2 files changed, 33 insertions(+), 2 deletions(-) diff --git a/R/restore.R b/R/restore.R index 86c6d532..adb4a44d 100644 --- a/R/restore.R +++ b/R/restore.R @@ -391,8 +391,10 @@ annotatePkgDesc <- function(pkgRecord, project, lib = libDir(project)) { content[name] <- records[name] } - # Write it out - write_dcf(content, descFile) + # Write it out using a temporary file so DESCRIPTION is never partial. + tmpf <- tempfile(tmpdir = dirname(descFile)) + write_dcf(content, tmpf) + file.rename(tmpf, descFile) } # Takes a vector of package names, and returns a logical vector that indicates diff --git a/tests/testthat/test-restore.R b/tests/testthat/test-restore.R index 447773bf..e587ddca 100644 --- a/tests/testthat/test-restore.R +++ b/tests/testthat/test-restore.R @@ -67,3 +67,32 @@ test_that("appendRemoteInfoToDescription modifies DESCRIPTION file", { expect_identical(tail(desc, 6), expected_desc_tail) getwd() }) + +test_that("annotatePkgDesc annotates a package description", { + project <- tempfile() + dir.create(project) + lib <- libDir(project) + package <- file.path(lib, "fake") + dir.create(package, recursive = TRUE) + desc <- file.path(package, "DESCRIPTION") + write_dcf( + list( + Package = "fake", + Version = "1.2.3", + InstallAgent = "testthat" + ), + desc + ) + pkgRecord <- list( + name = "fake", + source = "CRAN", + version = "1.2.3" + ) + + annotatePkgDesc(pkgRecord, project) + result <- as.data.frame(readDcf(desc)) + expect_equal(result$Package, "fake") + expect_equal(result$Version, "1.2.3") + expect_equal(result$InstallAgent, paste('packrat', packageVersion('packrat'))) + expect_equal(result$InstallSource, "CRAN") +}) From e144351e287c013cc37aac1dd960c7f7c738b797 Mon Sep 17 00:00:00 2001 From: Aron Atkins Date: Tue, 2 Jan 2024 14:42:47 -0500 Subject: [PATCH 03/11] compute pkgSrc only when needed --- R/restore.R | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/R/restore.R b/R/restore.R index adb4a44d..0be9ca8c 100644 --- a/R/restore.R +++ b/R/restore.R @@ -427,7 +427,6 @@ installPkg <- function(pkgRecord, repos, lib = libDir(project)) { - pkgSrc <- NULL type <- "built source" needsInstall <- TRUE @@ -525,14 +524,11 @@ installPkg <- function(pkgRecord, }) } - if (is.null(pkgSrc)) { + if (needsInstall) { # When installing from github/bitbucket/gitlab or an older version, use the cached source # tarball or zip created in snapshotSources pkgSrc <- file.path(srcDir(project), pkgRecord$name, pkgSrcFilename(pkgRecord)) - } - - if (needsInstall) { if (!file.exists(pkgSrc)) { # If the source file is missing, try to download it. (Could happen in the From 82f8e420b911bef87a0f57afc12eb939d95e86fc Mon Sep 17 00:00:00 2001 From: Aron Atkins Date: Tue, 2 Jan 2024 14:56:30 -0500 Subject: [PATCH 04/11] do no additional work when package present in cache --- R/restore.R | 26 +++++++++++--------------- 1 file changed, 11 insertions(+), 15 deletions(-) diff --git a/R/restore.R b/R/restore.R index 0be9ca8c..34c65434 100644 --- a/R/restore.R +++ b/R/restore.R @@ -427,9 +427,6 @@ installPkg <- function(pkgRecord, repos, lib = libDir(project)) { - type <- "built source" - needsInstall <- TRUE - # If we're trying to install a package that overwrites a symlink, e.g. for a # cached package, we need to move that symlink out of the way (otherwise # `install.packages()` or `R CMD INSTALL` will fail with surprising errors, @@ -444,7 +441,6 @@ installPkg <- function(pkgRecord, # NOTE: a symlink that points to a path that doesn't exist # will return FALSE when queried by `file.exists()`! if (file.exists(pkgInstallPath) || is.symlink(pkgInstallPath)) { - temp <- tempfile(tmpdir = lib) file.rename(pkgInstallPath, temp) on.exit({ @@ -460,23 +456,21 @@ installPkg <- function(pkgRecord, cacheCopyStatus <- new.env(parent = emptyenv()) copiedFromCache <- restoreWithCopyFromCache(project, pkgRecord, cacheCopyStatus) if (copiedFromCache) { - type <- cacheCopyStatus$type - needsInstall <- FALSE + return(cacheCopyStatus$type) } # Try restoring the package from the 'unsafe' cache, if applicable. copiedFromUntrustedCache <- restoreWithCopyFromUntrustedCache(project, pkgRecord, cacheCopyStatus) if (copiedFromUntrustedCache) { - type <- cacheCopyStatus$type - needsInstall <- FALSE + return(cacheCopyStatus$type) } - # if we still need to attempt an installation at this point, - # remove a prior installation / file from library (if necessary). - # we move the old directory out of the way temporarily, and then + # The package was not in a cache and needs to be installed. + # Remove a prior installation / file from library (if necessary). + # We move the old directory out of the way temporarily, and then # delete if if all went well, or restore it if installation failed - # for some reason - if (needsInstall && file.exists(pkgInstallPath)) { + # for some reason. + if (file.exists(pkgInstallPath)) { pkgRenamePath <- tempfile(tmpdir = lib) file.rename(pkgInstallPath, pkgRenamePath) on.exit({ @@ -487,9 +481,11 @@ installPkg <- function(pkgRecord, }, add = TRUE) } + type <- "built source" + needsInstall <- TRUE + # Try downloading a binary (when appropriate). - if (!(copiedFromCache || copiedFromUntrustedCache) && - hasBinaryRepositories() && + if (hasBinaryRepositories() && binaryRepositoriesEnabled() && isFromCranlikeRepo(pkgRecord, repos) && pkgRecord$name %in% availablePackagesBinary(repos = repos)[, "Package"] && From 88bcdfa22be1c68bbace62b2ab260edcfe9bf026 Mon Sep 17 00:00:00 2001 From: Aron Atkins Date: Tue, 2 Jan 2024 15:45:17 -0500 Subject: [PATCH 05/11] news update --- NEWS.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/NEWS.md b/NEWS.md index fd76f026..64401c1c 100644 --- a/NEWS.md +++ b/NEWS.md @@ -11,6 +11,9 @@ - Update vendored `renv` package to include a fix for load-testing certain binary packages. (#716) - Update package documentation according to r-lib/roxygen2#1491. (#721) +- Improve package installation in a multi-process environment. Do less work + when a target package is in the cache and write package `DESCRIPTION` + updates to temporary files before persisting. (#720) # Packrat 0.9.1 From ef56e2ca7882f32650dec044626bbd325c3e7e3b Mon Sep 17 00:00:00 2001 From: Aron Atkins Date: Tue, 2 Jan 2024 16:03:59 -0500 Subject: [PATCH 06/11] avoid redundant package-install path declarations --- R/restore.R | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/R/restore.R b/R/restore.R index 34c65434..b01e9296 100644 --- a/R/restore.R +++ b/R/restore.R @@ -588,23 +588,20 @@ installPkg <- function(pkgRecord, # copy package into cache if enabled if (isUsingCache(project)) { - pkgPath <- file.path(lib, pkgRecord$name) - # copy into global cache if this is a trusted package if (isTrustedPackage(pkgRecord$name)) { - descPath <- file.path(pkgPath, "DESCRIPTION") + descPath <- file.path(pkgInstallPath, "DESCRIPTION") if (!file.exists(descPath)) { warning("cannot cache package: no DESCRIPTION file at path '", descPath, "'") } else { hash <- hash(descPath) moveInstalledPackageToCache( - packagePath = pkgPath, + packagePath = pkgInstallPath, hash = hash, cacheDir = cacheLibDir() ) } } else { - pkgPath <- file.path(lib, pkgRecord$name) tarballName <- pkgSrcFilename(pkgRecord) tarballPath <- file.path(srcDir(project), pkgRecord$name, tarballName) if (!file.exists(tarballPath)) { @@ -612,7 +609,7 @@ installPkg <- function(pkgRecord, } else { hash <- hashTarball(tarballPath) moveInstalledPackageToCache( - packagePath = pkgPath, + packagePath = pkgInstallPath, hash = hash, cacheDir = untrustedCacheLibDir() ) From 51dd9d6e4fd8b41f3e5c8f8eb63cc24c358b935b Mon Sep 17 00:00:00 2001 From: Aron Atkins Date: Tue, 2 Jan 2024 16:10:32 -0500 Subject: [PATCH 07/11] remove redundant existing-library-restore-on-error --- R/restore.R | 16 ---------------- 1 file changed, 16 deletions(-) diff --git a/R/restore.R b/R/restore.R index b01e9296..ad39f86b 100644 --- a/R/restore.R +++ b/R/restore.R @@ -465,22 +465,6 @@ installPkg <- function(pkgRecord, return(cacheCopyStatus$type) } - # The package was not in a cache and needs to be installed. - # Remove a prior installation / file from library (if necessary). - # We move the old directory out of the way temporarily, and then - # delete if if all went well, or restore it if installation failed - # for some reason. - if (file.exists(pkgInstallPath)) { - pkgRenamePath <- tempfile(tmpdir = lib) - file.rename(pkgInstallPath, pkgRenamePath) - on.exit({ - if (file.exists(pkgInstallPath)) - unlink(pkgRenamePath, recursive = !is.symlink(pkgRenamePath)) - else - file.rename(pkgRenamePath, pkgInstallPath) - }, add = TRUE) - } - type <- "built source" needsInstall <- TRUE From 5456d3e58354ac300f482912caae71af90c887f4 Mon Sep 17 00:00:00 2001 From: Aron Atkins Date: Tue, 2 Jan 2024 16:20:09 -0500 Subject: [PATCH 08/11] stop when rename of annotated DESCRIPTION fails --- R/restore.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/R/restore.R b/R/restore.R index ad39f86b..0b3cd049 100644 --- a/R/restore.R +++ b/R/restore.R @@ -394,7 +394,9 @@ annotatePkgDesc <- function(pkgRecord, project, lib = libDir(project)) { # Write it out using a temporary file so DESCRIPTION is never partial. tmpf <- tempfile(tmpdir = dirname(descFile)) write_dcf(content, tmpf) - file.rename(tmpf, descFile) + if (!file.rename(tmpf, descFile)) { + stop("Unable to rename annotated package DESCRIPTION") + } } # Takes a vector of package names, and returns a logical vector that indicates From 346c8a5a79602e15457d89061e8efb9cfc86111b Mon Sep 17 00:00:00 2001 From: Aron Atkins Date: Tue, 2 Jan 2024 17:05:48 -0500 Subject: [PATCH 09/11] cleanup on description annotation error --- R/restore.R | 8 +++++++- tests/testthat/test-packrat.R | 25 ++++++++++++++++++++++--- tests/testthat/test-restore.R | 2 +- 3 files changed, 30 insertions(+), 5 deletions(-) diff --git a/R/restore.R b/R/restore.R index 0b3cd049..3d977cc6 100644 --- a/R/restore.R +++ b/R/restore.R @@ -570,7 +570,13 @@ installPkg <- function(pkgRecord, } # Annotate DESCRIPTION file so we know we installed it - annotatePkgDesc(pkgRecord, project, lib) + withCallingHandlers( + annotatePkgDesc(pkgRecord, project, lib), + error = function(e) { + unlink(pkgInstallPath, recursive = TRUE) + return(e) + } + ) # copy package into cache if enabled if (isUsingCache(project)) { diff --git a/tests/testthat/test-packrat.R b/tests/testthat/test-packrat.R index b6918fdc..bb8f71cc 100644 --- a/tests/testthat/test-packrat.R +++ b/tests/testthat/test-packrat.R @@ -7,9 +7,21 @@ library(testthat) +# Confirm that the package name still exists in the DESCRIPTION along with +# the install-time annotation. +# +# Other fields are not included in this check. +expect_annotated_description <- function(lib, name) { + desc <- file.path(lib, name, "DESCRIPTION") + result <- as.data.frame(readDcf(desc), stringsAsFactors = FALSE) + + expect_equal(result$Package, name) + expect_equal(result$InstallAgent, paste('packrat', packageVersion('packrat'))) +} + withTestContext({ - test_that("init creates project structure and installs dependencies", { + test_that("init creates project structure and installs dependencies with annotated DESCRIPTION", { skip_on_cran() projRoot <- cloneTestProject("sated") init(enter = FALSE, projRoot, options = list(local.repos = "packages")) @@ -17,11 +29,17 @@ withTestContext({ expect_true(file.exists(lockFilePath(projRoot))) expect_true(file.exists(srcDir(projRoot))) expect_true(file.exists(libDir(projRoot))) + + expect_true(file.exists(file.path(lib, "packrat"))) expect_true(file.exists(file.path(lib, "breakfast"))) expect_true(file.exists(file.path(lib, "bread"))) expect_true(file.exists(file.path(lib, "oatmeal"))) - expect_true(file.exists(file.path(lib, "packrat"))) expect_true(file.exists(file.path(lib, "toast"))) + + expect_annotated_description(lib, "breakfast") + expect_annotated_description(lib, "bread") + expect_annotated_description(lib, "oatmeal") + expect_annotated_description(lib, "toast") }) test_that("init does not install dependencies when infer.dependencies is false", { @@ -33,10 +51,11 @@ withTestContext({ expect_true(file.exists(lockFilePath(projRoot))) expect_true(file.exists(srcDir(projRoot))) expect_true(file.exists(libDir(projRoot))) + + expect_true(file.exists(file.path(lib, "packrat"))) expect_false(file.exists(file.path(lib, "breakfast"))) expect_false(file.exists(file.path(lib, "bread"))) expect_false(file.exists(file.path(lib, "oatmeal"))) - expect_true(file.exists(file.path(lib, "packrat"))) expect_false(file.exists(file.path(lib, "toast"))) }) diff --git a/tests/testthat/test-restore.R b/tests/testthat/test-restore.R index e587ddca..940a6bb3 100644 --- a/tests/testthat/test-restore.R +++ b/tests/testthat/test-restore.R @@ -90,7 +90,7 @@ test_that("annotatePkgDesc annotates a package description", { ) annotatePkgDesc(pkgRecord, project) - result <- as.data.frame(readDcf(desc)) + result <- as.data.frame(readDcf(desc), stringsAsFactors = FALSE) expect_equal(result$Package, "fake") expect_equal(result$Version, "1.2.3") expect_equal(result$InstallAgent, paste('packrat', packageVersion('packrat'))) From ffb676bddbf9397057f2e29724ead1c5eb5cdee5 Mon Sep 17 00:00:00 2001 From: Aron Atkins Date: Wed, 3 Jan 2024 09:22:52 -0500 Subject: [PATCH 10/11] NEWS clean-up --- NEWS.md | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/NEWS.md b/NEWS.md index 64401c1c..fa73b3c6 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,8 +1,10 @@ # packrat (development version) -# packrat 0.9.2 +- Improve package installation in a multi-process environment. Do less work + when a target package is in the cache and write package `DESCRIPTION` + updates to temporary files before persisting. (#720) -# Packrat 0.9.2 (UNRELEASED) +# Packrat 0.9.2 - Update vendored `renv` package to include functions for normalizing and transforming Posit Package Manager URLs. (#711) @@ -11,9 +13,6 @@ - Update vendored `renv` package to include a fix for load-testing certain binary packages. (#716) - Update package documentation according to r-lib/roxygen2#1491. (#721) -- Improve package installation in a multi-process environment. Do less work - when a target package is in the cache and write package `DESCRIPTION` - updates to temporary files before persisting. (#720) # Packrat 0.9.1 From 37a879a355230fa1a32961930e1b7b63444c7623 Mon Sep 17 00:00:00 2001 From: Aron Atkins Date: Wed, 3 Jan 2024 13:04:10 -0500 Subject: [PATCH 11/11] simpler error handler --- R/restore.R | 1 - 1 file changed, 1 deletion(-) diff --git a/R/restore.R b/R/restore.R index 3d977cc6..e55bad1d 100644 --- a/R/restore.R +++ b/R/restore.R @@ -574,7 +574,6 @@ installPkg <- function(pkgRecord, annotatePkgDesc(pkgRecord, project, lib), error = function(e) { unlink(pkgInstallPath, recursive = TRUE) - return(e) } )