diff --git a/DESCRIPTION b/DESCRIPTION index 3feb15caf..36435eb6c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -68,7 +68,7 @@ Config/needs/dependencies: jsonlite, pkgbuild, pkgcache, - pkgdepends, + r-lib/pkgdepends, pkgsearch, processx, ps, diff --git a/src/library/pkgdepends/DESCRIPTION b/src/library/pkgdepends/DESCRIPTION index 3bda62fc3..719d640c4 100644 --- a/src/library/pkgdepends/DESCRIPTION +++ b/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", , "csardi.gabor@gmail.com", 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 -Repository: CRAN -Date/Publication: 2024-03-17 15:10:02 UTC diff --git a/src/library/pkgdepends/R/git-app.R b/src/library/pkgdepends/R/git-app.R index 7db82943c..3ee741142 100644 --- a/src/library/pkgdepends/R/git-app.R +++ b/src/library/pkgdepends/R/git-app.R @@ -192,8 +192,9 @@ parse_url <- function(url) { re_url <- paste0( "^(?[a-zA-Z0-9]+)://", "(?:(?[^@/:]+)(?::(?[^@/]+))?@)?", - "(?[^/]+)", - "(?.*)$" # don't worry about query params here... + "(?(?[^:/]+)", + "(?::(?[0-9]+))?", + "(?/.*))$" # don't worry about query params here... ) - re_match(url, re_url)$groups + re_match(url, re_url) } diff --git a/src/library/pkgdepends/R/git-auth.R b/src/library/pkgdepends/R/git-auth.R index ab49842ee..4f968a86e 100644 --- a/src/library/pkgdepends/R/git-auth.R +++ b/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) diff --git a/src/library/pkgdepends/R/git-protocol.R b/src/library/pkgdepends/R/git-protocol.R index 0f41cb7a9..c7306a6b0 100644 --- a/src/library/pkgdepends/R/git-protocol.R +++ b/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 diff --git a/src/library/pkgdepends/R/git-submodules.R b/src/library/pkgdepends/R/git-submodules.R new file mode 100644 index 000000000..217955f01 --- /dev/null +++ b/src/library/pkgdepends/R/git-submodules.R @@ -0,0 +1,233 @@ +# From remotes +parse_submodules <- function(file) { + if (grepl("\n", file)) { + # fix windows line endings + file <- gsub("\r\n", "\n", file, fixed = TRUE) + x <- strsplit(file, "\n")[[1]] + } else { + x <- readLines(file) + } + + # https://git-scm.com/docs/git-config#_syntax + # Subsection names are case sensitive and can contain any characters except + # newline and the null byte. Doublequote " and backslash can be included by + # escaping them as \" and \\ + double_quoted_string_with_escapes <- '(?:\\\\.|[^"])*' + + # Otherwise extract section names + section_names <- re_match( + x, + sprintf( + '^[[:space:]]*\\[submodule "(?%s)"\\][[:space:]]*$', + double_quoted_string_with_escapes + ) + )$submodule + + # If no sections found return the empty list + if (all(is.na(section_names))) { + return(list()) + } + + # Extract name = value + # The variable names are case-insensitive, allow only alphanumeric characters + # and -, and must start with an alphabetic character. + variable_name <- "[[:alpha:]][[:alnum:]\\-]*" + mapping_values <- re_match( + x, + sprintf( + '^[[:space:]]*(?%s)[[:space:]]*=[[:space:]]*(?.*)[[:space:]]*$', + variable_name + ) + ) + + values <- cbind( + submodule = fill(section_names), mapping_values[c("name", "value")], + stringsAsFactors = FALSE + ) + values <- values[!is.na(mapping_values$.match), ] + + # path and valid url are required + if (!all(c("path", "url") %in% values$name)) { + warning( + "Invalid submodule definition, skipping submodule installation", + immediate. = TRUE, + call. = FALSE + ) + return(list()) + } + + # Roughly equivalent to tidyr::spread(values, name, value) + res <- stats::reshape( + values, + idvar = "submodule", + timevar = "name", + v.name = "value", + direction = "wide" + ) + + # Set the column names, reshape prepends `value.` to path, url and branch + colnames(res) <- gsub("value[.]", "", colnames(res)) + + # path and valid url are required + if (any(is.na(res$url), is.na(res$path))) { + warning( + "Invalid submodule definition, skipping submodule installation", + immediate. = TRUE, + call. = FALSE + ) + return(list()) + } + + # branch is optional + if (!exists("branch", res)) { + res$branch <- NA_character_ + } + + # Remove unneeded attribute + attr(res, "reshapeWide") <- NULL + + # Remove rownames + rownames(res) <- NULL + + res +} + +# Adapted from https://stackoverflow.com/a/9517731/2055486 +fill <- function(x) { + not_missing <- !is.na(x) + + res <- x[not_missing] + res[cumsum(not_missing)] +} + +update_submodule <- function(url, path, branch) { + synchronize(async_update_submodule(url, path, branch)) # nocov +} + +async_update_submodule <- function(url, path, branch) { + url; path; branch + # if the directory already exists and not empty, we assume that + # it was already downloaded. We still to update the submodules + # recursively. This is problematic if a git download is interrupted + # and then stated again with the same output, but that does not happen + # during normal operation of pkgdepends, I think. A better solution + # would be to download the submodule to a temporary directory, and if + # successful, then move the temporary directory to the correct place. + if (file.exists(path) && + length(dir(path, all.files = TRUE, no.. = TRUE)) > 0) { + # message(path, " exists") + async_update_git_submodules(path) + + } else { + if (is.null(branch) || is.na(branch)) branch <- "HEAD" + # message("getting ", path) + async_git_download_repo( + url, + ref = branch, + output = path, + submodules = TRUE + ) + } +} + +update_git_submodules_r <- function(path, subdir) { + synchronize(async_update_git_submodules_r(path, subdir)) # nocov +} + +async_update_git_submodules_r <- function(path, subdir) { + subdir <- subdir %||% "." + smfile <- file.path(path, ".gitmodules") + if (!file.exists(smfile)) return() + + info <- parse_submodules(smfile) + if (length(info) == 0) return() + + to_ignore <- in_r_build_ignore(info$path, file.path(path, subdir, ".Rbuildignore")) + info <- info[!to_ignore, ] + if (nrow(info) == 0) return() + + async_map(seq_len(nrow(info)), function(i) { + async_update_submodule( + info$url[i], + file.path(path, + info$path[i]), + info$branch[i] + ) + })$ + then(function() invisible()) +} + +update_git_submodules <- function(path) { + synchronize(async_update_git_submodules(path)) +} + +async_update_git_submodules <- function(path) { + smfile <- file.path(path, ".gitmodules") + if (!file.exists(smfile)) return() + + info <- parse_submodules(smfile) + if (nrow(info) == 0) return() + + async_map(seq_len(nrow(info)), function(i) { + async_update_submodule( + info$url[i], + file.path(path, + info$path[i]), + info$branch[i] + ) + })$ + then(function() invisible()) +} + +r_build_ignore_patterns <- c( + "^\\.Rbuildignore$", + "(^|/)\\.DS_Store$", + "^\\.(RData|Rhistory)$", + "~$", + "\\.bak$", + "\\.swp$", + "(^|/)\\.#[^/]*$", + "(^|/)#[^/]*#$", + "^TITLE$", + "^data/00Index$", + "^inst/doc/00Index\\.dcf$", + "^config\\.(cache|log|status)$", + "(^|/)autom4te\\.cache$", + "^src/.*\\.d$", + "^src/Makedeps$", + "^src/so_locations$", + "^inst/doc/Rplots\\.(ps|pdf)$" +) + +in_r_build_ignore <- function(paths, ignore_file) { + ignore <- tryCatch( + asNamespace("tools")$get_exclude_patterns(), + error = function(e) r_build_ignore_patterns + ) + + if (file.exists(ignore_file)) { + ignore <- c(ignore, readLines(ignore_file, warn = FALSE)) + } + + matches_ignores <- function(x) { + any(vlapply(ignore, grepl, x, perl = TRUE, ignore.case = TRUE)) + } + + # We need to search for the paths as well as directories in the path, so + # `^foo$` matches `foo/bar` + should_ignore <- function(path) { + any(vlapply(c(path, directories(path)), matches_ignores)) + } + + vlapply(paths, should_ignore) +} + +directories <- function (paths) { + dirs <- unique(dirname(paths)) + out <- dirs[dirs != "."] + while (length(dirs) > 0 && any(dirs != ".")) { + out <- unique(c(out, dirs[dirs != "."])) + dirs <- unique(dirname(dirs)) + } + sort(out) +} diff --git a/src/library/pkgdepends/R/install-plan.R b/src/library/pkgdepends/R/install-plan.R index fa5d104dc..73e6fb924 100644 --- a/src/library/pkgdepends/R/install-plan.R +++ b/src/library/pkgdepends/R/install-plan.R @@ -667,7 +667,7 @@ stop_task_package_build <- function(state, worker) { state$cache$add(state$plan$file[pkgidx], state$plan$target[pkgidx], package = pkg, version = version, built = TRUE, sha256 = state$plan$extra[[pkgidx]]$remotesha, - vignettes = state$plan$vignette[pkgidx], + vignettes = state$plan$vignettes[pkgidx], platform = "source"), error = function(err) { alert("warning", "Failed to add {.pkg {pkg}} \\ @@ -744,7 +744,7 @@ stop_task_build <- function(state, worker) { state$cache$add(state$plan$file[pkgidx], target, package = pkg, version = version, built = TRUE, sha256 = state$plan$extra[[pkgidx]]$remotesha, - vignettes = state$plan$vignette[pkgidx], + vignettes = state$plan$vignettes[pkgidx], platform = ptfm, rversion = rv), error = function(err) { alert("warning", "Failed to add {.pkg {pkg}} \\ diff --git a/src/library/pkgdepends/R/parse-remotes.R b/src/library/pkgdepends/R/parse-remotes.R index 2e3142ee2..019cea189 100644 --- a/src/library/pkgdepends/R/parse-remotes.R +++ b/src/library/pkgdepends/R/parse-remotes.R @@ -272,8 +272,15 @@ add_ref_params <- function(res, params) { res } -known_query_params <- c("ignore", "ignore-before-r", "ignore-build-errors", - "nocache", "reinstall", "source") +known_query_params <- c( + "ignore", + "ignore-before-r", + "ignore-build-errors", + "ignore-unavailable", + "nocache", + "reinstall", + "source" +) parse_query <- function(ref) { query <- sub("^[^?]*(\\?|$)", "", ref) diff --git a/src/library/pkgdepends/R/resolution-df.R b/src/library/pkgdepends/R/resolution-df.R index 212e84852..33cffabf5 100644 --- a/src/library/pkgdepends/R/resolution-df.R +++ b/src/library/pkgdepends/R/resolution-df.R @@ -33,7 +33,8 @@ res_make_empty_df <- local({ extra = list(), # any extra data (e.g. GitHub sha) dep_types= list(), params = list(), - sysreqs = character() + sysreqs = character(), + os_type = character() ) } data @@ -70,7 +71,8 @@ res_df_defaults <- local({ extra = list(list()), dep_types= list("default"), params = list(character()), - sysreqs = NA_character_ + sysreqs = NA_character_, + os_type = NA_character_ ) } data diff --git a/src/library/pkgdepends/R/resolution.R b/src/library/pkgdepends/R/resolution.R index f18d86ba0..18b099fdf 100644 --- a/src/library/pkgdepends/R/resolution.R +++ b/src/library/pkgdepends/R/resolution.R @@ -667,7 +667,7 @@ resolve_from_metadata <- function(remotes, direct, config, cache, "ref", "type", "status", "package", "version", "license", "needscompilation", "priority", "md5sum", "platform", "rversion", "repodir", "target", "deps", "sources", "mirror", - "filesize", "sha256", "sysreqs") + "filesize", "sha256", "sysreqs", "os_type") cols <- intersect(names(data), cols) diff --git a/src/library/pkgdepends/R/solve.R b/src/library/pkgdepends/R/solve.R index 72b74f9f4..9df68309e 100644 --- a/src/library/pkgdepends/R/solve.R +++ b/src/library/pkgdepends/R/solve.R @@ -211,6 +211,7 @@ pkgplan_i_create_lp_problem <- function(pkgs, config, policy) { lp <- pkgplan_i_lp_init(pkgs, config, policy) lp <- pkgplan_i_lp_objectives(lp) + lp <- pkgplan_i_lp_os_type(config, lp) lp <- pkgplan_i_lp_force_source(lp) lp <- pkgplan_i_lp_failures(lp) lp <- pkgplan_i_lp_ignore(lp) @@ -301,6 +302,20 @@ pkgplan_i_lp_objectives <- function(lp) { lp } +pkgplan_i_lp_os_type <- function(config, lp) { + if (config$get("goal") != "install") return(lp) + if (! "os_type" %in% names(lp$pkgs)) return(lp) + os <- os_type() + bad <- which(!is.na(lp$pkgs$os_type) & lp$pkgs$os_type != os) + for (wh in bad) { + lp <- pkgplan_i_lp_add_cond(lp, wh, op = "==", rhs = 0, + type = "matching-platform") + } + lp$ruled_out <- c(lp$ruled_out, bad) + + lp +} + pkgplan_i_lp_force_source <- function(lp) { # if source package is forced, then rule out binaries src_req <- vlapply(lp$pkgs$params, is_true_param, "source") @@ -606,6 +621,7 @@ pkgplan_i_lp_dependencies <- function(lp, config) { num_candidates <- lp$num_candidates ruled_out <- lp$ruled_out base <- base_packages() + ignored <- vlapply(pkgs$params, is_true_param, "ignore") ignore_rver <- vcapply(pkgs$params, get_param_value, "ignore-before-r") if (any(!is.na(ignore_rver))) { @@ -614,6 +630,21 @@ pkgplan_i_lp_dependencies <- function(lp, config) { ignored2 <- package_version(ignore_rver) > current ignored <- ignored | ignored2 } + ignore_unavail <- vlapply( + pkgs$params, + is_true_param, + "ignore-unavailable" + ) + failed <- pkgs$status == "FAILED" + ignored <- ignored | (ignore_unavail & failed) + + # ignore packages with the wrong OS type + if (config$get("goal") == "install") { + os <- os_type() + bad <- which(!is.na(pkgs$os_type) & pkgs$os_type != os) + if (length(bad) > 0) ignored[bad] <- TRUE + } + soft_deps <- tolower(pkg_dep_types_soft()) ## 4. Package dependencies must be satisfied diff --git a/src/library/pkgdepends/R/type-git.R b/src/library/pkgdepends/R/type-git.R index f15276c1d..1ddb6aa68 100644 --- a/src/library/pkgdepends/R/type-git.R +++ b/src/library/pkgdepends/R/type-git.R @@ -77,8 +77,8 @@ download_remote_git <- function(resolution, target, target_tree, ## 3. Check if we have a repo snapshot in the cache. rel_target <- resolution$target + subdir <- resolution$remote[[1]]$subdir if (!nocache) { - subdir <- resolution$remote[[1]]$subdir hit <- cache$package$copy_to( target_tree, package = package, sha256 = sha, built = FALSE) if (nrow(hit)) { @@ -88,14 +88,21 @@ download_remote_git <- function(resolution, target, target_tree, ## 4. Need to download the repo - url <- git_auth_url(resolution$remote[[1]]) + url <- resolution$remote[[1]]$url sha <- resolution$metadata[[1]][["RemoteSha"]] pkgdir <- file.path(target_tree, resolution$package) mkdirp(pkgdir) - async_git_download_repo(url, ref = sha, output = pkgdir)$ - then(function() { - "Got" - }) + p <- async_git_download_repo(url, ref = sha, output = pkgdir) + + # submodules? + submodules <- config$get("git-submodules") + if (submodules) { + p <- p$then(function(x) async_update_git_submodules_r(pkgdir, subdir)) + } + + p$then(function() { + "Got" + }) } satisfy_remote_git <- function(resolution, candidate, @@ -161,36 +168,18 @@ git_rx <- function() { ) } -git_auth_url <- function(remote) { - url <- remote$url - auth <- tryCatch(gitcreds_get(url), error = function(err) NULL) - if (is.null(auth)) { - url - } else { - paste0( - remote$protocol, - "://", - auth$username, - ":", - auth$password, - "@", - sub(paste0("^", remote$protocol, "://"), "", remote$url) - ) - } -} - type_git_get_data <- function(remote) { remote + url <- remote$url sha <- NULL dsc <- NULL - auth_url <- git_auth_url(remote) desc_path <- if (is.null(remote$subdir) || remote$subdir == "") { "DESCRIPTION" } else { paste0(remote$subdir, "/", "DESCRIPTION") } - async_git_list_files(auth_url, remote$commitish)$ + async_git_list_files(url, remote$commitish)$ catch(error = function(err) { throw(pkg_error( "Failed to download {.path {desc_path}} from git repo at {.url {remote$url}}." @@ -212,7 +201,7 @@ type_git_get_data <- function(remote) { files$files$hash[desc_idx] })$ then(function(desc_hash) { - async_git_download_file(auth_url, desc_hash, output = NULL)$ + async_git_download_file(url, desc_hash, output = NULL)$ catch(error = function(err) { throw(pkg_error( "Failed to download {.path {desc_path}} from git repo at {.url {remote$url}}." diff --git a/src/library/pkgdepends/R/type-gitlab.R b/src/library/pkgdepends/R/type-gitlab.R index 52bd7f56d..bf0346e57 100644 --- a/src/library/pkgdepends/R/type-gitlab.R +++ b/src/library/pkgdepends/R/type-gitlab.R @@ -1,18 +1,17 @@ parse_remote_gitlab <- function(specs, config, ...) { - pds <- re_match(specs, gitlab_rx()) pds$ref <- pds$.text pds$protocol[pds$protocol == ""] <- "https" pds$host[pds$host == ""] <- "gitlab.com" - pds$path <- paste0("/", pds$username, "/") + pds$path <- paste0("/", pds$projectpath, "/", pds$project) pds$dotgit <- "" pds$commitish[pds$commitish == ""] <- "HEAD" - pds$url <- paste0(pds$protocol, "://", pds$host, pds$path, pds$repo, ".git") + pds$url <- paste0(pds$protocol, "://", pds$host, pds$path, ".git") cn <- setdiff(colnames(pds), c(".match", ".text")) pds <- pds[, cn] pds$type <- "gitlab" - pds$package <- ifelse(nzchar(pds$package), pds$package, pds$repo) + pds$package <- ifelse(nzchar(pds$package), pds$package, pds$project) lapply( seq_len(nrow(pds)), function(i) as.list(pds[i,]) @@ -24,8 +23,8 @@ resolve_remote_gitlab <- function(remote, direct, config, cache, resolve_remote_git(remote, direct, config, cache, dependencies, ...)$ then(function(res) { res$metadata["RemoteHost"] <- remote$host - res$metadata["RemoteRepo"] <- remote$repo - res$metadata["RemoteUsername"] <- remote$username + res$metadata["RemoteRepo"] <- remote$project + res$metadata["RemoteUsername"] <- remote$projectpath res$metadata["RemoteType"] <- "gitlab" if (!is.null(remote$subdir) && remote$subdir != "") { res$metadata["RemoteSubdir"] <- remote$subdir @@ -55,16 +54,31 @@ installedok_remote_gitlab <- function(installed, solution, config, ...) { installedok_remote_git(installed, solution, config, ...) } +# source: https://docs.gitlab.com/ee/user/reserved_names.html#limitations-on-usernames-project-and-group-names +gitlab_slug_rx <- function() { + "[a-zA-Z0-9][-._a-zA-Z0-9]*[a-zA-Z0-9]" +} + +gitlab_project_rx <- function() { + paste0("(?", gitlab_slug_rx(), ")") +} + +gitlab_project_path_rx <- function() { + paste0("(?", gitlab_slug_rx(), "(?:/", gitlab_slug_rx(), ")*)") +} + gitlab_rx <- function() { paste0( "^", ## Optional package name "(?:(?", package_name_rx(), ")=)?", "gitlab::", - "(?:(?[^/]*)://(?[^/]+))?", - github_username_rx(), "/", - github_repo_rx(), - github_subdir_rx(), "?", + ## Optional protocol::host + "(?:(?[^/]*)://(?[^/]+)/)?", + gitlab_project_path_rx(), "/", + gitlab_project_rx(), + ## Optional subdirectory, prefixed with /-, ie project/-/sub/dir + "(?:/-", github_subdir_rx(), ")?", "(?:", github_commitish_rx(), ")?", "$" ) diff --git a/src/library/pkgdepends/R/utils.R b/src/library/pkgdepends/R/utils.R index 617aabd93..7b57cd78f 100644 --- a/src/library/pkgdepends/R/utils.R +++ b/src/library/pkgdepends/R/utils.R @@ -315,6 +315,10 @@ new_async_timer <- function(...) { asNamespace("pkgcache")$async_timer$new(...) } +async_delay <- function(...) { + asNamespace("pkgcache")$delay(...) +} + external_process <- function(...) { asNamespace("pkgcache")$external_process(...) } @@ -490,4 +494,8 @@ backtick <- function(x) { collapse <- function(x, ...) { cli::ansi_collapse(x, ...) -} \ No newline at end of file +} + +na_omit <- function(x) { + x[!is.na(x)] +} diff --git a/src/library/pkgdepends/R/zzz-pkgdepends-config.R b/src/library/pkgdepends/R/zzz-pkgdepends-config.R index 022752628..dab0c4392 100644 --- a/src/library/pkgdepends/R/zzz-pkgdepends-config.R +++ b/src/library/pkgdepends/R/zzz-pkgdepends-config.R @@ -123,6 +123,18 @@ pkgdepends_config <- sort_by_name(list( details." ), + # ----------------------------------------------------------------------- + git_submodules = list( + type = "flag", + default = FALSE, + docs = + "Whether or not to update submodules in git repositories. This + affects `git::` and `gitlab::` package sources only. + If the R package is in a subdirectory then only the submodules + within that directory are updated. If a submodule appears in + `.Rbuildignore`, then it is skipped." + ), + # ----------------------------------------------------------------------- include_linkingto = list( type = "flag", diff --git a/src/library/pkgdepends/inst/WORDLIST b/src/library/pkgdepends/inst/WORDLIST index 7337eaeaf..d3182ab03 100644 --- a/src/library/pkgdepends/inst/WORDLIST +++ b/src/library/pkgdepends/inst/WORDLIST @@ -37,5 +37,7 @@ pkgdown prettyunits rprojroot shorthands +submodule +submodules tibbles uncompress diff --git a/src/library/pkgdepends/inst/docs/download-result.rds b/src/library/pkgdepends/inst/docs/download-result.rds index af5af23af..af9a60cd6 100644 Binary files a/src/library/pkgdepends/inst/docs/download-result.rds and b/src/library/pkgdepends/inst/docs/download-result.rds differ diff --git a/src/library/pkgdepends/inst/docs/pak-config-docs.rds b/src/library/pkgdepends/inst/docs/pak-config-docs.rds index fa21c7bbe..eff5493c9 100644 Binary files a/src/library/pkgdepends/inst/docs/pak-config-docs.rds and b/src/library/pkgdepends/inst/docs/pak-config-docs.rds differ diff --git a/src/library/pkgdepends/inst/docs/pkg-refs.rds b/src/library/pkgdepends/inst/docs/pkg-refs.rds index b774acf7c..7aa6f2925 100644 Binary files a/src/library/pkgdepends/inst/docs/pkg-refs.rds and b/src/library/pkgdepends/inst/docs/pkg-refs.rds differ diff --git a/src/library/pkgdepends/inst/docs/resolution-result.rds b/src/library/pkgdepends/inst/docs/resolution-result.rds index 30dfae83b..79e8764cf 100644 Binary files a/src/library/pkgdepends/inst/docs/resolution-result.rds and b/src/library/pkgdepends/inst/docs/resolution-result.rds differ