remove overwrite arg from moveInstalledPackageToCache

R/aaa-globals.R

@@ -35,11 +35,11 @@ new_defaults <- function(value = list()) {
     if (is.null(names(dots)) && length(dots) == 1 && is.list(dots[[1]])) {
       if (length(dots <- dots[[1]]) == 0) return()
     }
-    defaults <<- merge(dots)
+    defaults <<- merge(dots) # nolint
     invisible(NULL)
   }
   merge <- function(values) merge_list(defaults, values)
-  restore <- function(target = value) defaults <<- target
+  restore <- function(target = value) defaults <<- target # nolint
 
   list(get = get, set = set, merge = merge, restore = restore)
 }

R/cache.R

@@ -194,47 +194,58 @@ symlinkPackageToCache <- function(packagePath, cachedPackagePath) {
   return(cachedPackagePath)
 }
 
+# Record that the freshly-built package at packagePath is being discarded in
+# favor of an existing cache entry (either one that predates this call, or one
+# a competing process just won the race to populate). Logs the reason when
+# cache verbosity is on, and if cacheCopyStatus is supplied, sets its $type
+# field so callers can report what actually happened instead of the outcome
+# they expected before caching was attempted.
+discardBuildForCacheEntry <- function(packageName, reason, cacheCopyStatus) {
+  if (isVerboseCache()) {
+    message(
+      "Discarding freshly-built ",
+      packageName,
+      "; ",
+      reason,
+      "."
+    )
+  }
+  if (!is.null(cacheCopyStatus)) {
+    cacheCopyStatus$type <- "symlinked cache"
+  }
+}
+
 # Given a path to an installed package (outside the packrat cache), move that
 # package into the cache and replace the original directory with a symbolic
 # link into the package cache.
 #
-# If the package already exists inside the cache, overwrite=TRUE causes
-# replacement of the cached content while overwrite=FALSE with fatal=FALSE
-# uses the cached package. Using overwrite=TRUE with fatal=TRUE will err.
+# If the package already exists inside the cache, its content is adopted
+# as-is and the freshly-built package at packagePath is discarded. This
+# function never overwrites an existing cache entry.
+#
+# cacheCopyStatus, if supplied, is an environment that gets a $type field set
+# to "symlinked cache" whenever a freshly-built package is discarded in favor
+# of an existing cache entry, so callers can report what actually happened
+# instead of the outcome they expected before caching was attempted.
 moveInstalledPackageToCache <- function(
   packagePath,
   hash,
-  overwrite = TRUE,
-  fatal = FALSE,
-  cacheDir = cacheLibDir()
+  cacheDir = cacheLibDir(),
+  cacheCopyStatus = NULL
 ) {
   ensureDirectory(cacheDir)
 
   packageName <- basename(packagePath)
   cachedPackagePath <- file.path(cacheDir, packageName, hash, packageName)
-  backupPackagePath <- tempfile(tmpdir = dirname(cachedPackagePath))
 
   # check for existence of package in cache
   if (file.exists(cachedPackagePath)) {
-    if (fatal && !overwrite) {
-      stop("cached package already exists at path '", cachedPackagePath, "'")
-    }
-
-    if (!fatal) {
-      return(symlinkPackageToCache(packagePath, cachedPackagePath))
-    }
-  }
-
-  # back up a pre-existing cached package (restore on failure)
-  if (file.exists(cachedPackagePath)) {
-    if (!file.rename(cachedPackagePath, backupPackagePath)) {
-      stop(
-        "failed to back up package '",
-        packageName,
-        "'; cannot safely copy to cache"
-      )
-    }
-    on.exit(unlink(backupPackagePath, recursive = TRUE), add = TRUE)
+    discardBuildForCacheEntry(
+      packageName,
+      "already present in cache",
+      cacheCopyStatus
+    )
+    return(symlinkPackageToCache(packagePath, cachedPackagePath))
   }
 
   if (isVerboseCache()) {
@@ -246,8 +257,11 @@ moveInstalledPackageToCache <- function(
     return(symlinkPackageToCache(packagePath, cachedPackagePath))
   }
 
-  # rename failed; copy to temporary destination in same directory
-  # and then attempt to rename from there
+  # rename failed. this can happen when the library and cache live on different
+  # filesystems, when a competing process created the cache entry first, or on
+  # other OS errors (permissions, disk full). copy to a temporary destination in
+  # the same directory as the target (so the final rename stays within one
+  # filesystem) and attempt to rename from there
   tempPath <- tempfile(tmpdir = dirname(cachedPackagePath))
   on.exit(unlink(tempPath, recursive = TRUE), add = TRUE)
   if (all(dir_copy(packagePath, tempPath))) {
@@ -260,21 +274,14 @@ moveInstalledPackageToCache <- function(
   # failed to insert the package; if a competing process populated the cache
   # entry in the meantime, use it
   if (file.exists(cachedPackagePath)) {
+    discardBuildForCacheEntry(
+      packageName,
+      "a competing process cached it first",
+      cacheCopyStatus
+    )
     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
   stop("failed to copy package '", packageName, "' to cache")
 }

R/restore.R

@@ -791,8 +791,12 @@ installPkg <- function(pkgRecord, project, repos, lib = libDir(project)) {
         moveInstalledPackageToCache(
           packagePath = pkgInstallPath,
           hash = hash,
-          cacheDir = cacheLibDir()
+          cacheDir = cacheLibDir(),
+          cacheCopyStatus = cacheCopyStatus
         )
+        if (!is.null(cacheCopyStatus$type)) {
+          type <- cacheCopyStatus$type
+        }
       }
     } else {
       tarballName <- pkgSrcFilename(pkgRecord)
@@ -804,8 +808,12 @@ installPkg <- function(pkgRecord, project, repos, lib = libDir(project)) {
         moveInstalledPackageToCache(
           packagePath = pkgInstallPath,
           hash = hash,
-          cacheDir = untrustedCacheLibDir()
+          cacheDir = untrustedCacheLibDir(),
+          cacheCopyStatus = cacheCopyStatus
         )
+        if (!is.null(cacheCopyStatus$type)) {
+          type <- cacheCopyStatus$type
+        }
       }
     }
   }

tests/testthat/test-cache.R

@@ -118,11 +118,57 @@ test_that("moveInstalledPackageToCache caches a fresh package", {
   hash <- strrep("a", 32)
   cachedPackagePath <- file.path(cacheDir, "oatmeal", hash, "oatmeal")
 
-  result <- moveInstalledPackageToCache(packagePath, hash, cacheDir = cacheDir)
+  cacheCopyStatus <- new.env(parent = emptyenv())
+  result <- moveInstalledPackageToCache(
+    packagePath,
+    hash,
+    cacheDir = cacheDir,
+    cacheCopyStatus = cacheCopyStatus
+  )
 
   expect_identical(result, cachedPackagePath)
   expect_true(is.symlink(packagePath))
   expect_true(file.exists(file.path(cachedPackagePath, "DESCRIPTION")))
+
+  # a fresh insert isn't a discard, so no status is reported
+  expect_null(cacheCopyStatus$type)
+})
+
+test_that("moveInstalledPackageToCache adopts a pre-existing 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")
+
+  dir.create(cachedPackagePath, recursive = TRUE)
+  writeLines(
+    c("Package: oatmeal", "Version: 1.0"),
+    file.path(cachedPackagePath, "DESCRIPTION")
+  )
+
+  cacheCopyStatus <- new.env(parent = emptyenv())
+  result <- moveInstalledPackageToCache(
+    packagePath,
+    hash,
+    cacheDir = cacheDir,
+    cacheCopyStatus = cacheCopyStatus
+  )
+
+  expect_identical(result, cachedPackagePath)
+  expect_true(is.symlink(packagePath))
+
+  # the pre-existing cache entry is untouched; the freshly-built package
+  # (version 2.0) was discarded in favor of it
+  desc <- readLines(file.path(cachedPackagePath, "DESCRIPTION"))
+  expect_true("Version: 1.0" %in% desc)
+  expect_identical(cacheCopyStatus$type, "symlinked cache")
 })
 
 test_that("moveInstalledPackageToCache adopts a competing process's copy", {
@@ -162,11 +208,18 @@ test_that("moveInstalledPackageToCache adopts a competing process's copy", {
     .package = "base"
   )
 
-  result <- moveInstalledPackageToCache(packagePath, hash, cacheDir = cacheDir)
+  cacheCopyStatus <- new.env(parent = emptyenv())
+  result <- moveInstalledPackageToCache(
+    packagePath,
+    hash,
+    cacheDir = cacheDir,
+    cacheCopyStatus = cacheCopyStatus
+  )
 
   expect_identical(result, cachedPackagePath)
   expect_true(is.symlink(packagePath))
   expect_true(file.exists(file.path(packagePath, "DESCRIPTION")))
+  expect_identical(cacheCopyStatus$type, "symlinked cache")
 })
 
 test_that("moveInstalledPackageToCache reports a fresh-package cache failure", {
@@ -207,61 +260,6 @@ test_that("moveInstalledPackageToCache reports a fresh-package cache failure", {
   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")