diff --git a/R/outpack_root.R b/R/outpack_root.R index 7044fa05..f075aec7 100644 --- a/R/outpack_root.R +++ b/R/outpack_root.R @@ -106,6 +106,9 @@ file_import_archive <- function(root, path, file_path, name, id) { fs::dir_create(dirname(file_path_dest)) ## overwrite = FALSE; see assertion above fs::file_copy(file.path(path, file_path), file_path_dest, overwrite = FALSE) + if (length(file_path_dest) > 0) { + fs::file_chmod(file_path_dest, "a-w") + } } diff --git a/R/outpack_store.R b/R/outpack_store.R index ba848f44..7c0b5005 100644 --- a/R/outpack_store.R +++ b/R/outpack_store.R @@ -57,7 +57,7 @@ file_store <- R6::R6Class( } else { fs::file_copy(src, dst, overwrite = FALSE) } - fs::file_chmod(dst, "a-wx") + fs::file_chmod(dst, "a-w") } else if (move) { unlink(src) } diff --git a/R/run.R b/R/run.R index f31506d8..62905ff9 100644 --- a/R/run.R +++ b/R/run.R @@ -494,7 +494,7 @@ orderly_packet_cleanup_success <- function(p, call = NULL) { orderly_packet_add_metadata(p) outpack_packet_end(p) - unlink(path, recursive = TRUE) + fs::dir_delete(path) } diff --git a/R/validate.R b/R/validate.R index b179b18e..c675e324 100644 --- a/R/validate.R +++ b/R/validate.R @@ -91,8 +91,8 @@ orderly_validate_archive_packet <- function(id, action, cache, root) { drop_local_packet(id, root) } else if (action == "delete") { drop_local_packet(id, root) - unlink(file.path(root$path, root$config$core$path_archive, res$name, id), - recursive = TRUE) + fs::dir_delete( + file.path(root$path, root$config$core$path_archive, res$name, id)) } } diff --git a/tests/testthat/helper-orderly.R b/tests/testthat/helper-orderly.R index 1e27a984..373786c6 100644 --- a/tests/testthat/helper-orderly.R +++ b/tests/testthat/helper-orderly.R @@ -6,7 +6,7 @@ options(outpack.schema_validate = test_prepare_orderly_example <- function(examples, ...) { tmp <- tempfile() - withr::defer_parent(unlink(tmp, recursive = TRUE)) + withr::defer_parent(fs::dir_delete(tmp)) suppressMessages(orderly_init(tmp, ...)) copy_examples(examples, tmp) as.character(fs::path_norm(tmp)) @@ -15,11 +15,11 @@ test_prepare_orderly_example <- function(examples, ...) { test_prepare_orderly_example_separate <- function(examples, ...) { tmp <- tempfile() - withr::defer_parent(unlink(tmp, recursive = TRUE)) + withr::defer_parent(fs::dir_delete(tmp)) path_outpack <- file.path(tmp, "outpack") suppressMessages(orderly_init(path_outpack, ...)) - unlink(file.path(path_outpack, "orderly_config.yml")) + fs::file_delete(file.path(path_outpack, "orderly_config.yml")) path_src <- file.path(tmp, "src") copy_examples(examples, path_src) diff --git a/tests/testthat/helper-outpack.R b/tests/testthat/helper-outpack.R index 12eff2a5..c6c5e9cc 100644 --- a/tests/testthat/helper-outpack.R +++ b/tests/testthat/helper-outpack.R @@ -6,7 +6,7 @@ options(outpack.schema_validate = TRUE) create_random_packet <- function(root, name = "data", parameters = NULL, id = NULL) { src <- fs::dir_create(tempfile()) - on.exit(unlink(src, recursive = TRUE)) + on.exit(fs::dir_delete(src)) saveRDS(runif(10), file.path(src, "data.rds")) p <- outpack_packet_start_quietly( src, name, parameters = parameters, id = id, root = root) @@ -18,7 +18,7 @@ create_random_packet <- function(root, name = "data", parameters = NULL, create_deterministic_packet <- function(root, name = "data", parameters = NULL) { src <- fs::dir_create(tempfile()) - on.exit(unlink(src, recursive = TRUE)) + on.exit(fs::dir_delete(src)) saveRDS(1:10, file.path(src, "data.rds")) p <- outpack_packet_start_quietly( src, name, parameters = parameters, root = root) @@ -38,7 +38,7 @@ mock_metadata_depends <- function(id, depends = character(0)) { ## other. create_random_packet_chain <- function(root, length, base = NULL) { src <- fs::dir_create(tempfile()) - on.exit(unlink(src, recursive = TRUE), add = TRUE) + on.exit(fs::dir_delete(src), add = TRUE) id <- character() suppressMessages({ @@ -69,7 +69,7 @@ create_random_packet_chain <- function(root, length, base = NULL) { create_random_dependent_packet <- function(root, name, dependency_ids) { src <- fs::dir_create(tempfile()) - on.exit(unlink(src, recursive = TRUE), add = TRUE) + on.exit(fs::dir_delete(src), add = TRUE) p <- outpack_packet_start_quietly(src, name, root = root) @@ -96,7 +96,7 @@ create_random_dependent_packet <- function(root, name, dependency_ids) { create_temporary_root <- function(...) { path <- tempfile() - withr::defer_parent(unlink(path, recursive = TRUE)) + withr::defer_parent(fs::dir_delete(path)) suppressMessages(orderly_init(path, ...)) root_open(path, locate = FALSE, require_orderly = FALSE) } @@ -105,7 +105,7 @@ create_temporary_root <- function(...) { ## A really simple example that we use in a few places create_temporary_simple_src <- function() { path <- tempfile() - withr::defer_parent(unlink(path, recursive = TRUE)) + withr::defer_parent(fs::dir_delete(path)) fs::dir_create(path) path <- tempfile() @@ -126,7 +126,11 @@ create_temporary_simple_src <- function() { temp_file <- function() { path <- tempfile() - withr::defer_parent(unlink(path, recursive = TRUE)) + withr::defer_parent({ + if (fs::file_exists(path)) { + fs::file_delete(path) + } + }) path } @@ -174,3 +178,10 @@ outpack_packet_start_quietly <- function(...) { outpack_packet_end_quietly <- function(...) { suppressMessages(outpack_packet_end(...)) } + +forcibly_truncate_file <- function(path) { + permissions <- fs::file_info(path)$permissions + fs::file_chmod(path, "a+w") + file.create(path) + fs::file_chmod(path, permissions) +} diff --git a/tests/testthat/test-init.R b/tests/testthat/test-init.R index 3a510bab..fd9f2808 100644 --- a/tests/testthat/test-init.R +++ b/tests/testthat/test-init.R @@ -1,7 +1,7 @@ test_that("Initialisation requires empty directory", { tmp <- tempfile() fs::dir_create(tmp) - on.exit(unlink(tmp, recursive = TRUE)) + on.exit(fs::dir_delete(tmp)) file.create(file.path(tmp, "file")) expect_error(orderly_init_quietly(tmp), "'root' exists but is not empty, or an outpack archive") @@ -10,7 +10,7 @@ test_that("Initialisation requires empty directory", { test_that("Can initialise a new orderly root", { tmp <- tempfile() - on.exit(unlink(tmp, recursive = TRUE)) + on.exit(fs::dir_delete(tmp)) res <- orderly_init_quietly(tmp) expect_true(file.exists(tmp)) expect_identical(normalise_path(res), normalise_path(tmp)) @@ -45,7 +45,7 @@ test_that("can initialise a repo with orderly but no .outpack directory", { path <- test_prepare_orderly_example("data") parent <- dirname(path) base <- basename(path) - unlink(file.path(path, ".outpack"), recursive = TRUE) + fs::dir_delete(file.path(path, ".outpack")) err <- expect_error( withr::with_dir(parent, orderly_run_quietly("data", root = base, envir = new.env())), diff --git a/tests/testthat/test-location-path.R b/tests/testthat/test-location-path.R index c7e88ff6..155edab2 100644 --- a/tests/testthat/test-location-path.R +++ b/tests/testthat/test-location-path.R @@ -362,7 +362,7 @@ test_that("Fail to push sensibly if files have been changed", { ## Corrupt one file: path <- file.path(client$path, "archive", "b", ids[["b"]], "script.R") - append_lines(path, "# anything") + forcibly_truncate_file(path) expect_error( suppressMessages(orderly_location_push(ids[[4]], "server", client)), diff --git a/tests/testthat/test-location.R b/tests/testthat/test-location.R index 9f260cf4..b24aec9d 100644 --- a/tests/testthat/test-location.R +++ b/tests/testthat/test-location.R @@ -433,7 +433,8 @@ test_that("detect and avoid modified files in source repository", { orderly_location_pull_metadata(root = root$dst) ## Corrupt the file in the first id by truncating it: - file.create(file.path(root$src$path, "archive", "data", id[[1]], "a.rds")) + forcibly_truncate_file( + file.path(root$src$path, "archive", "data", id[[1]], "a.rds")) ## Then pull res <- testthat::evaluate_promise( @@ -1076,8 +1077,8 @@ test_that("can prune orphans from tree", { test_that("don't prune referenced orphans", { root <- create_temporary_root() id <- create_random_packet_chain(root, 3) - unlink(file.path(root$path, "archive", "a"), recursive = TRUE) - unlink(file.path(root$path, "archive", "c"), recursive = TRUE) + fs::dir_delete(file.path(root$path, "archive", "a")) + fs::dir_delete(file.path(root$path, "archive", "c")) suppressMessages(orderly_validate_archive(action = "orphan", root = root)) expect_equal(nrow(root$index$location(orphan)), 2) diff --git a/tests/testthat/test-orderly.R b/tests/testthat/test-orderly.R index eeb7337a..fbe7c205 100644 --- a/tests/testthat/test-orderly.R +++ b/tests/testthat/test-orderly.R @@ -16,14 +16,14 @@ test_that("find expected candidates", { test_that("ignore paths without orderly file", { v <- c("data", "depends", "depends-params", "description") path <- test_prepare_orderly_example(v) - unlink(file.path(path, "src", v[1], "data.R")) + fs::file_delete(file.path(path, "src", v[1], "data.R")) expect_equal(orderly_list_src(path), v[-1]) }) test_that("no candidates returns empty character vector", { path <- test_prepare_orderly_example(character()) - unlink(file.path(path, "src"), recursive = TRUE) + fs::dir_delete(file.path(path, "src")) expect_setequal(dir(path, all.files = TRUE, no.. = TRUE), c(".outpack", "orderly_config.yml")) expect_equal(withr::with_dir(path, orderly_list_src()), character()) diff --git a/tests/testthat/test-outpack-packet.R b/tests/testthat/test-outpack-packet.R index 32c06648..faa158f1 100644 --- a/tests/testthat/test-outpack-packet.R +++ b/tests/testthat/test-outpack-packet.R @@ -268,10 +268,8 @@ test_that("validate dependencies from archive", { outpack_packet_run(p1, "script.R") outpack_packet_end_quietly(p1) - ## Change the value here: - write.csv(data.frame(x = 1:10, y = runif(10)), - file.path(root$path, "archive", "a", id1, "data.csv"), - row.names = FALSE) + ## Corrupt the file here. + forcibly_truncate_file(file.path(root$path, "archive", "a", id1, "data.csv")) p2 <- outpack_packet_start_quietly(path_src2, "b", root = root) id2 <- p2$id @@ -835,3 +833,31 @@ test_that("metadata files match their hash", { path <- file.path(root$path, ".outpack", "metadata", id) expect_no_error(hash_validate_file(path, expected_hash)) }) + + +test_that("Files in the archive are read-only", { + src <- temp_file() + fs::dir_create(src) + writeLines(c( + "d <- read.csv('data.csv')", + "png('myplot.png')", + "plot(d)", + "dev.off()"), + file.path(src, "script.R")) + write.csv(data.frame(x = 1:10, y = runif(10)), + file.path(src, "data.csv"), + row.names = FALSE) + + root <- create_temporary_root(path_archive = "archive", + use_file_store = FALSE) + path <- root$path + + p <- outpack_packet_start_quietly(src, "a", root = root) + outpack_packet_run(p, "script.R") + outpack_packet_end_quietly(p) + + files <- c("data.csv", "script.R", "myplot.png") + files_path <- file.path(path, "archive", "a", p$id, files) + expect_true(all(fs::file_access(files_path, "read"))) + expect_true(all(!fs::file_access(files_path, "write"))) +}) diff --git a/tests/testthat/test-plugin.R b/tests/testthat/test-plugin.R index be91da49..f894df73 100644 --- a/tests/testthat/test-plugin.R +++ b/tests/testthat/test-plugin.R @@ -179,7 +179,7 @@ test_that("validate that plugins make sense", { orderly_plugin("pkg", config, NULL, deserialise, NULL, NULL), "If 'deserialise' is given, then 'serialise' must be non-NULL") - unlink(schema) + fs::file_delete(schema) expect_error( orderly_plugin("pkg", config, serialise, deserialise, cleanup, basename(schema)), diff --git a/tests/testthat/test-root.R b/tests/testthat/test-root.R index 9fb12579..d1ff24df 100644 --- a/tests/testthat/test-root.R +++ b/tests/testthat/test-root.R @@ -1,6 +1,6 @@ test_that("Configuration must be empty", { tmp <- tempfile() - on.exit(unlink(tmp, recursive = TRUE)) + on.exit(fs::dir_delete(tmp)) fs::dir_create(tmp) writeLines(c(empty_config_contents(), "a: 1"), file.path(tmp, "orderly_config.yml")) @@ -11,7 +11,7 @@ test_that("Configuration must be empty", { test_that("Configuration must exist", { tmp <- tempfile() - on.exit(unlink(tmp, recursive = TRUE)) + on.exit(fs::dir_delete(tmp)) fs::dir_create(tmp) outpack_init_no_orderly(tmp) expect_error(orderly_config_read(tmp), @@ -55,7 +55,7 @@ test_that("pass back a root", { test_that("can silently detect that git setup is ok", { root <- create_temporary_root() info <- helper_add_git(root$path) - unlink(file.path(root$path, ".outpack", "r", "git_ok")) + expect_false(file.exists(file.path(root$path, ".outpack", "r", "git_ok"))) expect_silent(root_check_git(root, NULL)) expect_true(file.exists(file.path(root$path, ".outpack", "r", "git_ok"))) }) @@ -74,7 +74,7 @@ test_that("can add gitignore if git setup is ok, but not present", { root <- create_temporary_root() info <- helper_add_git(root$path) fs::file_delete(file.path(root$path, ".gitignore")) - unlink(file.path(root$path, ".outpack", "r", "git_ok")) + expect_false(file.exists(file.path(root$path, ".outpack", "r", "git_ok"))) expect_message(root_check_git(root, NULL), "Wrote '.gitignore'") expect_true(file.exists(file.path(root$path, ".outpack", "r", "git_ok"))) expect_true(file.exists(file.path(root$path, ".gitignore"))) diff --git a/tests/testthat/test-run.R b/tests/testthat/test-run.R index dcad6f34..a8d53f0c 100644 --- a/tests/testthat/test-run.R +++ b/tests/testthat/test-run.R @@ -188,6 +188,12 @@ test_that("Can run simple case with dependency", { envir2 <- new.env() id2 <- orderly_run_quietly("depends", root = path, envir = envir2) + ## Nothing left in drafts + expect_true(is_directory(file.path(path, "draft", "data"))) + expect_true(is_directory(file.path(path, "draft", "depends"))) + expect_false(file.exists(file.path(path, "draft", "data", id1))) + expect_false(file.exists(file.path(path, "draft", "depends", id2))) + path1 <- file.path(path, "archive", "data", id1) path2 <- file.path(path, "archive", "depends", id2) @@ -316,7 +322,7 @@ test_that("can validate shared resource arguments", { test_that("can't use shared resources if not enabled", { path <- test_prepare_orderly_example("shared") - unlink(file.path(path, "shared"), recursive = TRUE) + fs::dir_delete(file.path(path, "shared")) envir <- new.env() path_src <- file.path(path, "src", "shared") err <- expect_error( @@ -1156,7 +1162,7 @@ test_that("cope with manually deleted packets, exclude from deps", { }) id <- ids[[3]] - unlink(file.path(path, "archive", "data", id), recursive = TRUE) + fs::dir_delete(file.path(path, "archive", "data", id)) err <- expect_error( orderly_run_quietly("depends", root = path, envir = new.env()), @@ -1191,7 +1197,7 @@ test_that("cope with corrupted packets, exclude from deps", { }) id <- ids[[3]] - file.create(file.path(path, "archive", "data", id, "data.rds")) # truncate + forcibly_truncate_file(file.path(path, "archive", "data", id, "data.rds")) err <- expect_error( orderly_run_quietly("depends", root = path, envir = new.env()), @@ -1342,7 +1348,7 @@ test_that("can read about dependencies", { test_that("nice error if resource file not found", { path <- test_prepare_orderly_example("explicit") envir <- new.env() - unlink(file.path(path, "src", "explicit", "data.csv")) + fs::file_delete(file.path(path, "src", "explicit", "data.csv")) err <- expect_error( orderly_run_quietly("explicit", root = path, envir = envir), "Resource file does not exist: 'data.csv'") diff --git a/tests/testthat/test-validate.R b/tests/testthat/test-validate.R index 23e366d8..9dd14428 100644 --- a/tests/testthat/test-validate.R +++ b/tests/testthat/test-validate.R @@ -11,7 +11,7 @@ test_that("Can validate a packet that is invalid", { root <- create_temporary_root() id <- create_random_packet(root = root) path <- file.path(root$path, "archive", "data", id, "data.rds") - file.create(path) # truncate file + forcibly_truncate_file(path) res <- evaluate_promise(orderly_validate_archive(id, root = root)) expect_match(res$messages, sprintf("%s (data) is invalid", id), fixed = TRUE) expect_equal(res$result, id) @@ -25,7 +25,7 @@ test_that("Can orphan an invalid packet", { ids <- replicate(3, create_random_packet(root = root)) id <- ids[[2]] path <- file.path(root$path, "archive", "data", id, "data.rds") - file.create(path) # truncate file + forcibly_truncate_file(path) res <- evaluate_promise( orderly_validate_archive(id, action = "orphan", root = root)) expect_match(res$messages, sprintf("%s (data) is invalid", id), fixed = TRUE) @@ -41,7 +41,7 @@ test_that("Can delete an invalid packet", { ids <- replicate(3, create_random_packet(root = root)) id <- ids[[2]] path <- file.path(root$path, "archive", "data", id, "data.rds") - file.create(path) # truncate file + forcibly_truncate_file(path) res <- evaluate_promise( orderly_validate_archive(action = "delete", root = root)) expect_match(res$messages, sprintf("%s (data) is invalid", id), fixed = TRUE, @@ -65,7 +65,8 @@ test_that("recursively validate, errors in upstream are a problem", { root <- create_temporary_root(require_complete_tree = TRUE) ids <- create_random_packet_chain(5, root = root) - file.create(file.path(root$path, "archive", "c", ids[["c"]], "data.rds")) + forcibly_truncate_file( + file.path(root$path, "archive", "c", ids[["c"]], "data.rds")) res <- evaluate_promise( orderly_validate_archive(ids[["d"]], root = root)) @@ -108,7 +109,8 @@ test_that("invalidate all children of corrupt parent", { evaluate_promise(orderly_validate_archive(id3, root = root)), res) - file.create(file.path(root$path, "archive", "child", id2[[1]], "data.rds")) + forcibly_truncate_file( + file.path(root$path, "archive", "child", id2[[1]], "data.rds")) res <- evaluate_promise(orderly_validate_archive(id3, root = root)) expect_match(res$messages[c(1, 3, 4)], re, all = TRUE) expect_match(res$messages[[2]], @@ -137,7 +139,8 @@ test_that("don't invalidate children when complete tree off", { expect_length(res$messages, 1) ## We no longer know, or care, if this is invalid due to children - file.create(file.path(root$path, "archive", "child", id2[[1]], "data.rds")) + forcibly_truncate_file( + file.path(root$path, "archive", "child", id2[[1]], "data.rds")) expect_equal( evaluate_promise(orderly_validate_archive(id3, root = root)), res) diff --git a/vignettes/introduction.Rmd b/vignettes/introduction.Rmd index 19ff1f8d..5b8634cd 100644 --- a/vignettes/introduction.Rmd +++ b/vignettes/introduction.Rmd @@ -400,7 +400,7 @@ orderly2::orderly_metadata_extract( ```{r include = FALSE, inwd = path} id_latest <- orderly2::orderly_search("latest", name = "incoming_data") -unlink(file.path(path, "archive", "incoming_data", id_latest), recursive = TRUE) +fs::dir_delete(file.path(path, "archive", "incoming_data", id_latest)) ``` When we run the `analysis` task, it will pull in the most recent version (`r inline(id_latest)`). However, if you had deleted this manually (e.g., to save space or accidentally) or corrupted it (e.g., by opening some output in Excel and letting it save changes) it will not be able to be included, and running `analysis` will fail: