diff --git a/NEWS.md b/NEWS.md index 8824448..cc39b28 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,12 @@ # pkgcache (development version) +* pkgcache now treats `PACKAGES` entries with `Path` and/or `File` + fields correctly (#141, @jeroen). + +* pkgcache now drops HTTP query parameter from `Path` and `File` + entries in `PACKAGES` when creating the path of the target filename + (#141, @jeroen). + * All HTTP requests now honor the `pkgcache_http_version` option and `PKGCACHE_HTTP_VERSION` environment variable. Closes https://github.com/r-lib/pkgcache/issues/140. diff --git a/R/packages-gz.R b/R/packages-gz.R index 00bdbc1..40493cc 100644 --- a/R/packages-gz.R +++ b/R/packages-gz.R @@ -114,7 +114,9 @@ read_packages_file <- function( pkgs$type <- if (nrow(pkgs)) type else character() pkgs$direct <- if (nrow(pkgs)) FALSE else logical() pkgs$status <- if (nrow(pkgs)) "OK" else character() - pkgs$target <- packages_make_target( + + # Strip query parameters from the final file names + url_target <- packages_make_target( pkgs$platform, repodir, pkgs$package, @@ -122,11 +124,19 @@ read_packages_file <- function( pkgs[["file"]], pkgs[["path"]] ) + pkgs$target <- packages_make_target( + pkgs$platform, + repodir, + pkgs$package, + pkgs$version, + packages_strip_query(pkgs[["file"]]), + packages_strip_query(pkgs[["path"]]) + ) pkgs$mirror <- if (nrow(pkgs)) mirror else character() pkgs$sources <- packages_make_sources( mirror, pkgs$platform, - pkgs$target, + url_target, repodir, pkgs$package, pkgs$version, @@ -333,6 +343,13 @@ packages_parse_deps <- function(pkgs) { parsed } +packages_strip_query <- function(x) { + if (is.null(x)) { + return(x) + } + sub("[?].*$", "", x) +} + packages_make_target <- function( platform, repodir, @@ -359,34 +376,39 @@ packages_make_target <- function( res <- rep(NA_character_, length(package)) ext <- get_cran_extension(platform) - ## 'File' field, if present - if (!is.null(file)) { - wh <- !is.na(file) - if (any(wh)) { - res[wh] <- paste0(repodir, "/", file[wh]) - } + have_file <- if (is.null(file)) rep(FALSE, length(package)) else !is.na(file) + have_path <- if (is.null(path)) rep(FALSE, length(package)) else !is.na(path) + + ## repodir / 'Path' / 'File' + wh <- have_path & have_file + if (any(wh)) { + res[wh] <- paste0(repodir, "/", path[wh], "/", file[wh]) } - ## 'Path' field, if present - if (!is.null(path)) { - wh <- is.na(res) & !is.na(path) - if (any(wh)) { - res[wh] <- paste0( - repodir, - "/", - path[wh], - "/", - package[wh], - "_", - version[wh], - ext[wh] - ) - } + ## 'File' only + wh <- have_file & !have_path + if (any(wh)) { + res[wh] <- paste0(repodir, "/", file[wh]) + } + + ## 'Path' only: relative to repodir + wh <- have_path & !have_file + if (any(wh)) { + res[wh] <- paste0( + repodir, + "/", + path[wh], + "/", + package[wh], + "_", + version[wh], + ext[wh] + ) } - ## Otherwise default - if (anyNA(res)) { - wh <- is.na(res) + ## Default + wh <- !have_file & !have_path + if (any(wh)) { res[wh] <- paste0(repodir, "/", package[wh], "_", version[wh], ext[wh]) } diff --git a/tests/testthat/test-packages-gz.R b/tests/testthat/test-packages-gz.R index 734af15..9852fa9 100644 --- a/tests/testthat/test-packages-gz.R +++ b/tests/testthat/test-packages-gz.R @@ -23,6 +23,7 @@ test_that("packages_make_target", { c("src/contrib/foo", "src/contrib/bar") ) + # repodir / Path / File expect_equal( packages_make_target( "source", @@ -32,7 +33,7 @@ test_that("packages_make_target", { c("foo", "bar"), c("1", "2") ), - c("src/contrib/foo", "src/contrib/bar") + c("src/contrib/1/foo", "src/contrib/2/bar") ) expect_equal( @@ -57,13 +58,29 @@ test_that("packages_make_target", { c("foox", "bar", NA) ), c( - "src/contrib/foo", + "src/contrib/foox/foo", "src/contrib/bar/p2_2.0.tar.gz", "src/contrib/p3_3.0.tar.gz" ) ) }) +test_that("packages_strip_query", { + expect_equal(packages_strip_query(NULL), NULL) + expect_equal( + packages_strip_query(c("foo_1.0.tar.gz", NA, "")), + c("foo_1.0.tar.gz", NA, "") + ) + expect_equal( + packages_strip_query("foo_1.0.tar.gz?sha256=abc&file="), + "foo_1.0.tar.gz" + ) + expect_equal( + packages_strip_query(c("foo_1.0.tar.gz?sha256=abc", "bar_2.0.tar.gz")), + c("foo_1.0.tar.gz", "bar_2.0.tar.gz") + ) +}) + test_that("packages_make_sources", { expect_equal( packages_make_sources( @@ -282,6 +299,66 @@ test_that("rbind_expand", { expect_identical(m$d, c(NA, NA, 1L, 2L)) }) +test_that("read_packages_file combines Path and File fields", { + pkgs_file <- test_temp_file() + cat( + "Package: foo\n", + "Version: 1.0.0\n", + "Path: Archive/foo\n", + "File: foo_1.0.0.tar.gz\n", + "\n", + file = pkgs_file, + sep = "" + ) + + data <- read_packages_file( + pkgs_file, + mirror = "https://example.com", + repodir = "src/contrib", + platform = "source", + rversion = "*" + ) + + expect_equal(data$pkgs$target, "src/contrib/Archive/foo/foo_1.0.0.tar.gz") + expect_equal( + data$pkgs$sources[[1]], + "https://example.com/src/contrib/Archive/foo/foo_1.0.0.tar.gz" + ) +}) + +test_that("read_packages_file strips query string from target, keeps it in sources", { + pkgs_file <- test_temp_file() + cat( + "Package: unrtf\n", + "Version: 1.4.9000\n", + "NeedsCompilation: yes\n", + "Path: unrtf_1.4.9000.tar.gz?sha256=362c95be248cce252ba2e1a1386711a67e6f724544701ab4fa1c7693741f59b1&file=\n", + "\n", + file = pkgs_file, + sep = "" + ) + + data <- read_packages_file( + pkgs_file, + mirror = "https://jeroen.r-universe.dev", + repodir = "src/contrib", + platform = "source", + rversion = "*" + ) + + expect_false(grepl("[?]", data$pkgs$target)) + expect_true(grepl("[?]sha256=", data$pkgs$sources[[1]])) + expect_equal( + data$pkgs$sources[[1]], + paste0( + "https://jeroen.r-universe.dev/src/contrib/", + "unrtf_1.4.9000.tar.gz?sha256=", + "362c95be248cce252ba2e1a1386711a67e6f724544701ab4fa1c7693741f59b1", + "&file=/unrtf_1.4.9000.tar.gz" + ) + ) +}) + test_that("empty PACKAGES file", { pkgs <- test_temp_file() data <- read_packages_file(