Use the fs package to copy files.

It has more bells and whistles, and is often more performant. In
particular, it makes use of `CopyFileW` (on Windows) and
`copy_file_range` (on Linux) when applicable. This offers a big speedup
when copying a file within a network drive, which is a common use case
for orderly.

The reason why `file.copy` was introduced in #165 is that copying
read-only files with the `fs` package wasn't working properly on Samba
drives. It turns out this situation only occurs when `overwrite = TRUE`.
When the flag is set to FALSE, the copy succeeds. To work around this we
do an initial check before the copy to delete any files in the
destination path, and copy with `overwrite = FALSE`. This was manually
tested by running the test suite with the `TMPDIR` environment variable
set to a path on a network drive.

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: orderly2
 Title: Orderly Next Generation
-Version: 1.99.38
+Version: 1.99.39
 Authors@R: c(person("Rich", "FitzJohn", role = c("aut", "cre"),
                     email = "[email protected]"),
              person("Robert", "Ashton", role = "aut"),

R/outpack_root.R

@@ -71,9 +71,10 @@ file_export <- function(root, id, there, here, dest, overwrite, call = NULL) {
         })
     }
 
-    # Set copy_mode = FALSE: files in the archive are read-only. It's easier on
-    # the user if we make them writable again.
-    copy_files(there_full, here_full, overwrite = overwrite, copy_mode = FALSE)
+    # Files in the archive are read-only. It's easier on the user if we make
+    # them writable again.
+    copy_files(there_full, here_full, overwrite = overwrite,
+               make_writable = TRUE)
   }
 }
 

R/outpack_store.R

@@ -32,11 +32,10 @@ file_store <- R6::R6Class(
                            paste(sprintf("  - %s", missing), collapse = "\n"))
         stop(not_found_error(message, missing))
       }
-      fs::dir_create(dirname(dst))
 
-      # Set copy_mode = FALSE: files in the store are read-only. It's easier on
-      # the user if we make them writable again.
-      copy_files(src, dst, overwrite = overwrite, copy_mode = FALSE)
+      # Files in the archive are read-only. It's easier on the user if we make
+      # them writable again.
+      copy_files(src, dst, overwrite = overwrite, make_writable = FALSE)
 
       invisible(dst)
     },

R/util.R

@@ -185,16 +185,44 @@ expand_dirs <- function(files, workdir) {
 
 
 copy_files <- function(src, dst, overwrite = FALSE,
-                       copy_mode = TRUE) {
+                       make_writable = FALSE) {
+  assert_character(src)
+  assert_character(dst)
+
+  if (length(src) != length(dst)) {
+    cli::cli_abort("Source and destination have different lengths")
+  }
+
+  is_dir <- fs::dir_exists(dst)
+  if (any(is_dir)) {
+    paths <- dst[is_dir]
+    cli::cli_abort(paste(
+      "Destination path{?s} {?is a directory/are directories}:",
+      "{.path {paths}}"))
+  }
+
   fs::dir_create(unique(dirname(dst)))
 
-  # mrc-5557: We intentionally don't use fs::file_copy, as it does not work
-  # reliably on mounted Samba file systems.
-  ok <- file.copy(src, dst, overwrite = overwrite,
-                  copy.mode = copy_mode,
-                  copy.date = TRUE)
-  if (any(!ok)) {
-    cli::cli_abort("Could not copy file{?s} {.file {src[!ok]}}")
+  # For some reason, file_copy does not work when `overwrite = TRUE`, the
+  # source file is read-only, the destination file is on a Samba file mount,
+  # and we are on Linux. This seems like a bug in the Linux Samba driver.
+  # See mrc-5557 for details.
+  #
+  # We work around it by always passing `overwrite = FALSE`. Instead we delete
+  # any existing files manually beforehand. It is vulnerable to race condition,
+  # as someone could recreate the file between the calls to file_delete and
+  # file_copy, but that seems unlikely.
+  #
+  # If you are going to make changes to this function, make sure to run all
+  # tests with TMPDIR set to a path on a network drive.
+  if (overwrite) {
+    exists <- fs::file_exists(dst)
+    fs::file_delete(dst[exists])
+  }
+
+  fs::file_copy(src, dst, overwrite = FALSE)
+  if (make_writable && length(dst) > 0) {
+    fs::file_chmod(dst, "a+w")
   }
 }
 

tests/testthat/helper-outpack.R

@@ -184,7 +184,7 @@ outpack_packet_end_quietly <- function(...) {
 
 forcibly_truncate_file <- function(path) {
   permissions <- fs::file_info(path)$permissions
-  fs::file_chmod(path, "a+w")
-  file.create(path)
+  fs::file_delete(path)
+  fs::file_create(path)
   fs::file_chmod(path, permissions)
 }

tests/testthat/test-outpack-store.R

@@ -34,9 +34,9 @@ test_that("Can store files", {
   expect_length(obj$list(), 10)
   expect_equal(file.exists(obj$filename(obj$list())),
                rep(TRUE, 10))
-  dest <- temp_file()
-  dir.create(dest)
-  obj$get(obj$list(), dest, TRUE)
+
+  dest <- withr::local_tempdir()
+  obj$get(obj$list(), file.path(dest, letters[1:10]), FALSE)
 })
 
 

tests/testthat/test-util.R

@@ -322,6 +322,7 @@ test_that("read_string strips newlines", {
 })
 
 
+<<<<<<< HEAD
 describe("expand_dirs_virtual", {
   files <- list(
     "d1" = c("f2", "f3"),
@@ -466,3 +467,102 @@ test_that("parse_json includes name argument in its errors", {
   expect_error(parse_json("bad json", name = "my file"),
                "Error while reading my file.*lexical error")
 })
+
+
+describe("copy_files", {
+  src1 <- withr::local_tempfile()
+  src2 <- withr::local_tempfile()
+  writeLines("Hello", src1)
+  writeLines("World", src2)
+
+  it("can copy one file", {
+    dst <- file.path(withr::local_tempdir(), "destination.txt")
+
+    copy_files(src1, dst)
+    expect_equal(readLines(dst), "Hello")
+  })
+
+
+  it("can copy multiple files", {
+    d <- withr::local_tempdir()
+    dst1 <- file.path(d, "destination1.txt")
+    dst2 <- file.path(d, "destination2.txt")
+
+    copy_files(c(src1, src2), c(dst1, dst2))
+    expect_equal(readLines(dst1), "Hello")
+    expect_equal(readLines(dst2), "World")
+  })
+
+
+  it("can copy zero files", {
+    expect_no_error(copy_files(character(0), character(0)))
+    expect_no_error(copy_files(character(0), character(0), overwrite = TRUE))
+    expect_no_error(copy_files(character(0), character(0), make_writable = TRUE))
+  })
+
+
+  it("creates parent directories", {
+    d <- withr::local_tempdir()
+    dst <- file.path(d, "path", "to", "destination.txt")
+
+    expect_false(fs::dir_exists(file.path(d, "path", "to")))
+    copy_files(src1, dst)
+    expect_true(fs::dir_exists(file.path(d, "path", "to")))
+  })
+
+
+  it("can copy a read-only file", {
+    d <- withr::local_tempdir()
+    src <- file.path(d, "source.txt")
+    dst <- file.path(d, sprintf("destination%d.txt", 1:4))
+
+    writeLines("Hello", src)
+    fs::file_chmod(src, "a-w")
+
+    copy_files(src, dst[[1]])
+    copy_files(src, dst[[2]], overwrite = TRUE)
+    copy_files(src, dst[[3]], make_writable = TRUE)
+    copy_files(src, dst[[4]], make_writable = TRUE, overwrite = TRUE)
+
+    expect_true(all(fs::file_access(dst, mode="read")))
+    expect_equal(unname(fs::file_access(dst, mode="write")),
+                 c(FALSE, FALSE, TRUE, TRUE))
+  })
+
+
+  it("can overwrite an existing file", {
+    d <- withr::local_tempdir()
+    dst <- file.path(d, "destination.txt")
+
+    fs::file_create(dst)
+
+    expect_error(copy_files(src1, dst), "file already exists")
+
+    copy_files(src1, dst, overwrite = TRUE)
+    expect_equal(readLines(dst), "Hello")
+  })
+
+
+  it("overwrites a single file out of two", {
+    d <- withr::local_tempdir()
+    dst1 <- file.path(d, "destination1.txt")
+    dst2 <- file.path(d, "destination2.txt")
+
+    fs::file_create(dst1)
+    copy_files(c(src1, src2), c(dst1, dst2), overwrite = TRUE)
+
+    expect_equal(readLines(dst1), "Hello")
+    expect_equal(readLines(dst2), "World")
+  })
+
+  it("errors if the destination is a directory", {
+    d <- withr::local_tempdir()
+    expect_error(copy_files(src1, d), "Destination path is a directory")
+  })
+
+  it("errors if argument length is different", {
+    d <- withr::local_tempfile()
+    expect_error(copy_files(c(src1, src2), d),
+                 "have different lengths")
+  })
+})