diff --git a/NEWS.md b/NEWS.md index db8cc60..423f9e3 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,18 @@ # pkgcache (development version) +* Fixed a bug where the `Path` field of a `PACKAGES` entry was silently + ignored when the entry also had a `File` field. The target/download + URL for such entries is now correctly derived from both fields, + as `//`. See + https://github.com/r-universe-org/help/issues/715. + +* Fixed a bug where a query string in the `File` or `Path` field of a + `PACKAGES` entry (e.g. `foo_1.0.0.tar.gz?sha256=...`) was included + verbatim in the local on-disk cache path. This broke downloads on + Windows, because `?` (and other query string characters) are not + legal in Windows file names. The query string is now only used for + the download URL, and stripped from the local cache path. + * New `PKG_USE_BIOCONDUCTOR` environment variable and new `pkg.use_bioconductor` option to opt out from automatic Bioconductor support. diff --git a/R/packages-gz.R b/R/packages-gz.R index 00bdbc1..9db32da 100644 --- a/R/packages-gz.R +++ b/R/packages-gz.R @@ -114,7 +114,14 @@ 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( + + # The 'File' and/or 'Path' fields may contain a query string, e.g. + # `foo_1.0.0.tar.gz?sha256=...&file=`, that some repositories (e.g. + # r-universe) use for routing the download on the server side. We + # need to strip the query part from the `target` which we use as a + # local (on-disk) cache path because `?` is an illegal character for + # Windows file names. + url_target <- packages_make_target( pkgs$platform, repodir, pkgs$package, @@ -122,11 +129,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 +348,18 @@ packages_parse_deps <- function(pkgs) { parsed } +## Strips a trailing URL query string (`?...`), if any. Used to sanitize +## 'File'/'Path' field values before they are used to construct a local +## (on-disk) cache path, since query strings may contain characters that +## are illegal in file names on some platforms (e.g. `?` and `&` on +## Windows). +packages_strip_query <- function(x) { + if (is.null(x)) { + return(x) + } + sub("[?].*$", "", x) +} + packages_make_target <- function( platform, repodir, @@ -359,34 +386,41 @@ 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) + + ## Both 'Path' and 'File' fields are present: the file named in 'File' + ## lives in the subdirectory named in 'Path'. + 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] - ) - } + ## Only 'File' field is present, use it as is, relative to 'repodir' + wh <- have_file & !have_path + if (any(wh)) { + res[wh] <- paste0(repodir, "/", file[wh]) + } + + ## Only 'Path' field is present, it is a subdirectory of 'repodir', and + ## the file name is the default one, from the package name and version + 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) + ## Neither is present, use the default target path + 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..f1929ba 100644 --- a/tests/testthat/test-packages-gz.R +++ b/tests/testthat/test-packages-gz.R @@ -23,6 +23,9 @@ test_that("packages_make_target", { c("src/contrib/foo", "src/contrib/bar") ) + # When both 'File' and 'Path' are given, they must be combined into + # repodir/path/file, instead of dropping 'Path'. See + # https://github.com/r-universe-org/help/issues/715 expect_equal( packages_make_target( "source", @@ -32,7 +35,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( @@ -47,6 +50,8 @@ test_that("packages_make_target", { c("src/contrib/foo/p1_1.0.tar.gz", "src/contrib/bar/p2_2.0.tar.gz") ) + # Mix of: both 'File' and 'Path' present, only 'Path' present, and + # neither present. expect_equal( packages_make_target( "source", @@ -57,13 +62,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 +303,72 @@ test_that("rbind_expand", { expect_identical(m$d, c(NA, NA, 1L, 2L)) }) +test_that("read_packages_file combines Path and File fields", { + # Regression test for https://github.com/r-universe-org/help/issues/715 + # When a PACKAGES entry has both a 'Path' and a 'File' field, the + # resulting target/download URL must combine them as repodir/path/file, + # instead of silently dropping 'Path'. + 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", { + # Regression test for a query string in 'Path' (or 'File'), e.g. as used + # by r-universe. + 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(