Fix windows filenames

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 `<repodir>/<path>/<file>`. 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.

R/packages-gz.R

@@ -114,19 +114,34 @@ 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,
     pkgs$version,
     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])
   }
 

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(