Merge branch 'main' into feature/builder

.github/workflows/R-CMD-check.yaml

@@ -54,10 +54,18 @@ jobs:
           use-public-rspm: true
 
       - uses: r-lib/actions/setup-r-dependencies@v2
+        if: runner.os != 'Windows'
         with:
           extra-packages: any::rcmdcheck
           needs: check
 
+      - uses: r-lib/actions/setup-r-dependencies@v2
+        if: runner.os == 'Windows'
+        with:
+          extra-packages: any::rcmdcheck, asciicast=?ignore-before-r=4.0.0
+          needs: check
+
+
       - name: "Set environmental variables"
         run: |
           cat(paste0("R_USER_CACHE_DIR=", Sys.getenv("GITHUB_WORKSPACE"), "/.github/cache\n"), file = Sys.getenv("GITHUB_ENV"), append = TRUE)

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: pkgdepends
 Title: Package Dependency Resolution and Downloads
-Version: 0.7.1.9000
+Version: 0.7.2.9000
 Authors@R: c(
     person("Gábor", "Csárdi", , "[email protected]", role = c("aut", "cre")),
     person("Posit Software, PBC", role = c("cph", "fnd"))
@@ -72,4 +72,4 @@ Config/Needs/website:
     tidyverse/tidytemplate
 Config/testthat/edition: 3
 Encoding: UTF-8
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1.9000

NEWS.md

@@ -1,5 +1,26 @@
 # pkgdepends (development version)
 
+* pkgdepends now supports `gitlab::` package sources better, by adding
+  explicit syntax to specify subdirectories (#353, @dgkf).
+
+* `gitlab::` and `git::` package sources now support git submodules if
+  the `git-submodules` configuration option is set to `TRUE`. See
+  `?"pkgdepends-config"` (#354).
+
+* The new `?ignore-unavailable` parameter makes it easy to ignore soft
+  dependencies that are unavailable
+  (https://github.com/r-lib/pak/issues/606).
+
+* pkgdepends now automatically ignores soft dependencies that have an
+  incompatible OS type (`OS_type` entry in `DESCRIPTION`) when installing
+  packages.
+
+# pkgdepends 0.7.2
+
+* pkgdepends now supports the `*` wildcard for parameter specifications,
+  for parameters applied to all packages. E.g. `*=?source` means
+  compiling all packages from source.
+
 # pkgdepends 0.7.1
 
 * pkgdepends now does not import the glue, rprojroot and prettyunits

R/git-app.R

@@ -192,8 +192,9 @@ parse_url <- function(url) {
   re_url <- paste0(
     "^(?<protocol>[a-zA-Z0-9]+)://",
     "(?:(?<username>[^@/:]+)(?::(?<password>[^@/]+))?@)?",
-    "(?<host>[^/]+)",
-    "(?<path>.*)$"            # don't worry about query params here...
+    "(?<url>(?<host>[^:/]+)",
+    "(?::(?<port>[0-9]+))?",
+    "(?<path>/.*))$"            # don't worry about query params here...
   )
-  re_match(url, re_url)$groups
+  re_match(url, re_url)
 }

R/git-auth.R

@@ -1,4 +1,3 @@
-
 # nocov start
 
 gitcreds_get <- NULL
@@ -379,15 +378,23 @@ gitcreds_run <- function(command, input, args = character()) {
 git_run <- function(args, input = NULL) {
   stderr_file <- tempfile("gitcreds-stderr-")
   on.exit(unlink(stderr_file, recursive = TRUE), add = TRUE)
+  if (!is.null(input)) {
+    stdin_file <- tempfile("gitcreds-stdin-")
+    on.exit(unlink(stdin_file, recursive = TRUE), add = TRUE)
+    writeBin(charToRaw(input), stdin_file)
+    stdin <- stdin_file
+  } else {
+    stdin <- ""
+  }
   out <- tryCatch(
     suppressWarnings(system2(
-      "git", args, input = input, stdout = TRUE, stderr = stderr_file
+      "git", args, stdin = stdin, stdout = TRUE, stderr = stderr_file
     )),
     error = function(e) NULL
   )
 
   if (!is.null(attr(out, "status")) && attr(out, "status") != 0) {
-    throw(new_error(
+    throw(new_git_error(
       "git_error",
       args = args,
       stdout = out,
@@ -416,7 +423,7 @@ ack <- function(url, current, what = "Replace") {
   msg(paste0(format(current, header = FALSE), collapse = "\n"), "\n")
 
   choices <- c(
-    "Keep these credentials",
+    "Abort update with error, and keep the existing credentials",
     paste(what, "these credentials"),
     if (has_password(current)) "See the password / token"
   )
@@ -578,6 +585,12 @@ new_error <- function(class, ..., message = "", call. = TRUE, domain = NULL) {
   cond
 }
 
+new_git_error <- function(class, ..., stderr) {
+  cond <- new_error(class, ..., stderr = stderr)
+  cond$message <- paste0(cond$message, ": ", stderr)
+  cond
+}
+
 new_warning <- function(class, ..., message = "", call. = TRUE, domain = NULL) {
   if (message == "") message <- gitcred_errors()[[class]]
   message <- .makeMessage(message, domain = domain)

R/git-protocol.R

@@ -1,4 +1,3 @@
-
 #' git protocol notes, for developers
 #'
 #' Assumptions, they might be relaxed or checked for later:
@@ -39,6 +38,30 @@ NULL
 
 # -------------------------------------------------------------------------
 
+git_creds_for_url <- function(url) {
+  creds <- tryCatch(
+    gitcreds_get(url)[c("username", "password")],
+    error = function(e) NULL
+  )
+  if (is.null(creds)) {
+    do.call(
+      Sys.setenv,
+      structure(list("FAIL"), names = gitcreds_cache_envvar(url))
+    )
+  }
+  creds
+}
+
+git_http_get <- function(url, options = list(), ...) {
+  options <- c(options, git_creds_for_url(url))
+  http_get(url, options = options, ...)
+}
+
+git_http_post <- function(url, options = list(), ...) {
+  options <- c(options, git_creds_for_url(url))
+  http_post(url, options = options, ...)
+}
+
 #' List references in a remote git repository
 #'
 #' @details
@@ -133,6 +156,7 @@ async_git_resolve_ref <- function(url, ref) {
       paste0(c("", "refs/heads/", "refs/tags/"), ref)
     }
     async_git_list_refs(url, filt)$
+      catch(error = function(e) async_git_list_refs_v1(url))$
       then(function(refs) {
         result <- if (ref %in% refs$refs$ref) {
           refs$refs$hash[refs$refs$ref == ref]
@@ -163,6 +187,7 @@ async_git_resolve_ref <- function(url, ref) {
         }
 
         attr(result, "protocol") <- if ("version 2" %in% refs$caps) 2 else 1
+        attr(result, "filter") <- any(grepl("\\bfilter\\b", refs$caps))
         result
       })
 
@@ -360,6 +385,10 @@ async_git_fetch_v1 <- function(url, sha, blobs) {
 }
 
 async_git_fetch_v2 <- function(url, sha, blobs) {
+  # If 'filter' is not supported, then we need to get the blobs
+  if (!is.null(attr(sha, "filter")) && !attr(sha, "filter")) {
+    blobs <- TRUE
+  }
   async_git_send_message_v2(
     url,
     "fetch",
@@ -501,20 +530,30 @@ git_fetch_process <- function(reply, url, sha) {
 
 # -------------------------------------------------------------------------
 
-git_download_repo <- function(url, ref = "HEAD", output = ref) {
-  synchronize(async_git_download_repo(url, ref, output))
+git_download_repo <- function(url, ref = "HEAD", output = ref,
+                              submodules = FALSE) {
+  synchronize(async_git_download_repo(url, ref, output, submodules))
 }
 
-async_git_download_repo <- function(url, ref = "HEAD", output = ref) {
+async_git_download_repo <- function(url, ref = "HEAD", output = ref,
+                                    submodules = FALSE) {
   url; ref
   async_git_resolve_ref(url, ref)$
-    then(function(sha) async_git_download_repo_sha(url, sha, output))
+    then(function(sha) {
+      async_git_download_repo_sha(url, sha, output, submodules)
+    })
 }
 
-async_git_download_repo_sha <- function(url, sha, output) {
+async_git_download_repo_sha <- function(url, sha, output,
+                                        submodules = FALSE) {
   url; sha; output
-  async_git_fetch(url, sha, blobs = TRUE)$
+  p <- async_git_fetch(url, sha, blobs = TRUE)$
     then(function(packfile) unpack_packfile_repo(packfile, output, url))
+  if (!submodules) {
+    p
+  } else {
+    p$then(function() async_update_git_submodules(output))
+  }
 }
 
 unpack_packfile_repo <- function(parsed, output, url) {
@@ -546,7 +585,10 @@ unpack_packfile_repo <- function(parsed, output, url) {
         process_tree(tidx)
         wd <<- utils::head(wd, -1)
       } else if (tr$type[l] == "blob") {
-        writeBin(parsed[[tr$hash[l]]]$raw, opath)
+        # for submodules this is NULL
+        if (!is.null(parsed[[tr$hash[l]]])) {
+          writeBin(parsed[[tr$hash[l]]]$raw, opath)
+        }
       }
     }
   }
@@ -788,7 +830,8 @@ async_git_send_message_v2 <- function(
     "git-protocol" = "version=2",
     "content-length" = as.character(length(msg))
   )
-  http_post(
+
+  git_http_post(
     url2,
     data = msg,
     headers = headers
@@ -807,7 +850,7 @@ async_git_send_message_v1 <- function(url, args, caps) {
     "accept" = "application/x-git-upload-pack-result",
     "content-length" = as.character(length(msg))
   )
-  http_post(
+  git_http_post(
     url2,
     data = msg,
     headers = headers
@@ -880,7 +923,7 @@ git_list_refs_v1 <- function(url) {
 async_git_list_refs_v1 <- function(url) {
   url
   url1 <- paste0(url, "/info/refs?service=git-upload-pack")
-  http_get(url1, headers = c("User-Agent" = git_ua()))$
+  git_http_get(url1, headers = c("User-Agent" = git_ua()))$
     then(http_stop_for_status)$
     then(function(response) git_list_refs_v1_process(response, url))
 }
@@ -1006,11 +1049,13 @@ async_git_list_refs_v2 <- function(url, prefixes = character()) {
   url; prefixes
 
   url1 <- paste0(url, "/info/refs?service=git-upload-pack")
+
   headers <- c(
     "User-Agent" = git_ua(),
     "git-protocol" = "version=2"
   )
-  http_get(url1, headers = headers)$
+
+  git_http_get(url1, headers = headers)$
     then(http_stop_for_status)$
     then(function(res) async_git_list_refs_v2_process_1(res, url, prefixes))
 }
@@ -1656,9 +1701,9 @@ async_git_dumb_list_refs <- function(url) {
     "User-Agent" = git_ua()
   )
   when_all(
-    http_get(url1, headers = headers)$
+    git_http_get(url1, headers = headers)$
       then(http_stop_for_status),
-    http_get(url2, headers = headers)$
+    git_http_get(url2, headers = headers)$
       then(http_stop_for_status)
   )$
     then(function(res) async_git_dumb_list_refs_process(res, url))
@@ -1738,7 +1783,7 @@ async_git_dumb_get_commit <- function(url, sha) {
     "User-Agent" = git_ua(),
     "accept-encoding" = "deflate, gzip"
   )
-  http_get(url = url1, headers = headers)$
+  git_http_get(url = url1, headers = headers)$
     then(http_stop_for_status)$
     then(function(res) {
       cmt <- zip::inflate(res$content)$output
@@ -1767,7 +1812,7 @@ async_git_dumb_get_tree <- function(url, sha) {
     "User-Agent" = git_ua(),
     "accept-encoding" = "deflate, gzip"
   )
-  http_get(url = url1, headers = headers)$
+  git_http_get(url = url1, headers = headers)$
     then(http_stop_for_status)$
     then(function(res) {
       cmt <- zip::inflate(res$content)$output
@@ -1796,7 +1841,7 @@ async_git_dumb_get_blob <- function(url, sha) {
     "User-Agent" = git_ua(),
     "accept-encoding" = "deflate, gzip"
   )
-  http_get(url = url1, headers = headers)$
+  git_http_get(url = url1, headers = headers)$
     then(http_stop_for_status)$
     then(function(res) {
       cmt <- zip::inflate(res$content)$output