Use dev pkgdepends

DESCRIPTION

@@ -68,7 +68,7 @@ Config/needs/dependencies:
     jsonlite,
     pkgbuild,
     pkgcache,
-    pkgdepends,
+    r-lib/pkgdepends,
     pkgsearch,
     processx,
     ps,

src/library/pkgdepends/DESCRIPTION

@@ -1,6 +1,6 @@
 Package: pkgdepends
 Title: Package Dependency Resolution and Downloads
-Version: 0.7.2
+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"))
@@ -31,11 +31,9 @@ Config/Needs/website: r-lib/asciicast, pkgdown (>= 2.0.2),
         tidyverse/tidytemplate
 Config/testthat/edition: 3
 Encoding: UTF-8
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1.9000
 NeedsCompilation: no
-Packaged: 2024-03-17 14:42:39 UTC; gaborcsardi
+Packaged: 2024-04-05 10:14:55 UTC; gaborcsardi
 Author: Gábor Csárdi [aut, cre],
   Posit Software, PBC [cph, fnd]
 Maintainer: Gábor Csárdi <[email protected]>
-Repository: CRAN
-Date/Publication: 2024-03-17 15:10:02 UTC

src/library/pkgdepends/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)
 }

src/library/pkgdepends/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)

src/library/pkgdepends/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]
@@ -501,20 +525,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 +580,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 +825,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 +845,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 +918,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 +1044,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 +1696,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 +1778,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 +1807,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 +1836,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