diff --git a/NEWS.md b/NEWS.md index c17eabd0..cc462e0b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,8 @@ # packrat (development version) +- Fixed a race condition where concurrent R processes installing the same + package could fail while inserting it into the package cache. + - Update vendored `renv` to support recognition of Posit Package Manager support for manylinux binaries. diff --git a/R/cache.R b/R/cache.R index 1114fb93..9d891d50 100644 --- a/R/cache.R +++ b/R/cache.R @@ -251,26 +251,28 @@ moveInstalledPackageToCache <- function( tempPath <- tempfile(tmpdir = dirname(cachedPackagePath)) on.exit(unlink(tempPath, recursive = TRUE), add = TRUE) if (all(dir_copy(packagePath, tempPath))) { - # check to see if the cached package path exists now; if it does, - # assume that this was generated by another R process that successfully - # populated the cache - if (file.exists(cachedPackagePath)) { - return(symlinkPackageToCache(packagePath, cachedPackagePath)) - } - # attempt to rename to target path if (suppressWarnings(file.rename(tempPath, cachedPackagePath))) { return(symlinkPackageToCache(packagePath, cachedPackagePath)) } } - # failed to insert package into cache -- clean up and return error - if (!file.rename(backupPackagePath, cachedPackagePath)) { - stop( - "failed to restore package '", - packageName, - "' in cache; package may be lost from cache" - ) + # failed to insert the package; if a competing process populated the cache + # entry in the meantime, use it + if (file.exists(cachedPackagePath)) { + return(symlinkPackageToCache(packagePath, cachedPackagePath)) + } + + # failed to insert package into cache -- restore any backed-up cache entry + # and return error + if (file.exists(backupPackagePath)) { + if (!file.rename(backupPackagePath, cachedPackagePath)) { + stop( + "failed to restore package '", + packageName, + "' in cache; package may be lost from cache" + ) + } } # return failure diff --git a/R/testthat-helpers.R b/R/testthat-helpers.R index 82e8dfb7..39300f66 100644 --- a/R/testthat-helpers.R +++ b/R/testthat-helpers.R @@ -10,6 +10,19 @@ cloneTestProject <- function(projectName) { return(file.path(target, projectName)) } +# Create a minimal fake installed package in its own temporary library; +# returns the path to the package directory. +makeTestPackage <- function(packageName, version = "1.0") { + libRoot <- tempfile("packrat-lib-") + packagePath <- file.path(libRoot, packageName) + dir.create(packagePath, recursive = TRUE) + writeLines( + c(paste("Package:", packageName), paste("Version:", version)), + file.path(packagePath, "DESCRIPTION") + ) + packagePath +} + # "Rebuilds" the test repo from its package "sources" (just DESCRIPTION files). rebuildTestRepo <- function(testroot = getwd()) { # Try to guess where the DESCRIPTION file lives (for R CMD check diff --git a/tests/testthat/test-cache.R b/tests/testthat/test-cache.R index 80fd97f5..0e585a8e 100644 --- a/tests/testthat/test-cache.R +++ b/tests/testthat/test-cache.R @@ -105,6 +105,163 @@ test_that("packrat warns when lockfile hash does not match installed hash", { ) }) +test_that("moveInstalledPackageToCache caches a fresh package", { + skip_on_os("windows") + + packagePath <- makeTestPackage("oatmeal") + cacheDir <- tempfile("packrat-cache-") + on.exit( + unlink(c(dirname(packagePath), cacheDir), recursive = TRUE), + add = TRUE + ) + + hash <- strrep("a", 32) + cachedPackagePath <- file.path(cacheDir, "oatmeal", hash, "oatmeal") + + result <- moveInstalledPackageToCache(packagePath, hash, cacheDir = cacheDir) + + expect_identical(result, cachedPackagePath) + expect_true(is.symlink(packagePath)) + expect_true(file.exists(file.path(cachedPackagePath, "DESCRIPTION"))) +}) + +test_that("moveInstalledPackageToCache adopts a competing process's copy", { + skip_on_os("windows") + + packagePath <- makeTestPackage("oatmeal") + cacheDir <- tempfile("packrat-cache-") + on.exit( + unlink(c(dirname(packagePath), cacheDir), recursive = TRUE), + add = TRUE + ) + + hash <- strrep("a", 32) + cachedPackagePath <- file.path(cacheDir, "oatmeal", hash, "oatmeal") + + # Simulate losing the race to populate the cache: renames into the final + # cache location fail (as when a competing process created the destination + # first), and the competitor's byte-identical copy appears between the + # file.exists() check and the second rename. + realRename <- base::file.rename + renamesToCache <- 0 + local_mocked_bindings( + file.rename = function(from, to) { + if (!identical(to, cachedPackagePath)) { + return(realRename(from, to)) + } + renamesToCache <<- renamesToCache + 1 + if (renamesToCache == 2) { + dir.create(cachedPackagePath, recursive = TRUE) + writeLines( + c("Package: oatmeal", "Version: 1.0"), + file.path(cachedPackagePath, "DESCRIPTION") + ) + } + FALSE + }, + .package = "base" + ) + + result <- moveInstalledPackageToCache(packagePath, hash, cacheDir = cacheDir) + + expect_identical(result, cachedPackagePath) + expect_true(is.symlink(packagePath)) + expect_true(file.exists(file.path(packagePath, "DESCRIPTION"))) +}) + +test_that("moveInstalledPackageToCache reports a fresh-package cache failure", { + skip_on_os("windows") + + packagePath <- makeTestPackage("oatmeal") + cacheDir <- tempfile("packrat-cache-") + on.exit( + unlink(c(dirname(packagePath), cacheDir), recursive = TRUE), + add = TRUE + ) + + hash <- strrep("a", 32) + cachedPackagePath <- file.path(cacheDir, "oatmeal", hash, "oatmeal") + + # All renames into the final cache location fail and no competing process + # populates the cache. With no pre-existing cache entry there is nothing to + # roll back, so the error should report the copy failure rather than a + # bogus "package may be lost from cache". + realRename <- base::file.rename + local_mocked_bindings( + file.rename = function(from, to) { + if (!identical(to, cachedPackagePath)) { + return(realRename(from, to)) + } + FALSE + }, + .package = "base" + ) + + expect_error( + moveInstalledPackageToCache(packagePath, hash, cacheDir = cacheDir), + "failed to copy package 'oatmeal' to cache" + ) + + # the original installation is untouched + expect_false(is.symlink(packagePath)) + expect_true(file.exists(file.path(packagePath, "DESCRIPTION"))) +}) + +test_that("moveInstalledPackageToCache restores a backed-up cache entry", { + skip_on_os("windows") + + packagePath <- makeTestPackage("oatmeal", version = "2.0") + cacheDir <- tempfile("packrat-cache-") + on.exit( + unlink(c(dirname(packagePath), cacheDir), recursive = TRUE), + add = TRUE + ) + + hash <- strrep("a", 32) + cachedPackagePath <- file.path(cacheDir, "oatmeal", hash, "oatmeal") + + # a pre-existing cache entry that overwrite = TRUE will back up + dir.create(cachedPackagePath, recursive = TRUE) + writeLines( + c("Package: oatmeal", "Version: 1.0"), + file.path(cachedPackagePath, "DESCRIPTION") + ) + + # the first two renames into the final cache location (direct rename, then + # rename of the temporary copy) fail; the third is the rollback of the + # backup, which must be allowed through + realRename <- base::file.rename + renamesToCache <- 0 + local_mocked_bindings( + file.rename = function(from, to) { + if (!identical(to, cachedPackagePath)) { + return(realRename(from, to)) + } + renamesToCache <<- renamesToCache + 1 + if (renamesToCache <= 2) { + return(FALSE) + } + realRename(from, to) + }, + .package = "base" + ) + + expect_error( + moveInstalledPackageToCache( + packagePath, + hash, + overwrite = TRUE, + fatal = TRUE, + cacheDir = cacheDir + ), + "failed to copy package 'oatmeal' to cache" + ) + + # the pre-existing cache entry was restored from backup + desc <- readLines(file.path(cachedPackagePath, "DESCRIPTION")) + expect_true("Version: 1.0" %in% desc) +}) + test_that("packrat uses the untrusted cache when instructed", { skip_on_cran() skip_on_os("windows")