Respect custom hosts

NEWS.md

@@ -1,5 +1,7 @@
 # remotes (development version)
 
+* It is now possible to specify a custom host for dependencies listed in the `DESCRIPTION` file with `Remotes: <type>[@host]::<username>/<repo>[@ref]`. The `ref` now supports `/` in it for `GitLab` repositories as it did for `GitHub`repositories. (@dagola, #448)
+
 * `install_*()` functions will no longer fail by default if there warnings from `install.packages()`. Concretely the default value of `R_REMOTES_NO_ERRORS_FROM_WARNINGS` has changed to `true` from the previous value of `false`. (#403)
 
 * `system_requirements()` now supports querying released packages as well as development dependencies (#545)

R/deps.R

@@ -532,14 +532,28 @@ parse_one_extra <- function(x, ...) {
   } else {
     stop("Malformed remote specification '", x, "'", call. = FALSE)
   }
+
+  if (grepl("@", type)) {
+    # Custom host
+    tah <- strsplit(type, "@", fixed = TRUE)[[1]]
+    type <- tah[1]
+    host <- tah[2]
+  } else {
+    host <- NULL
+  }
+
   tryCatch({
     # We need to use `environment(sys.function())` instead of
     # `asNamespace("remotes")` because when used as a script in
     # install-github.R there is no remotes namespace.
 
     fun <- get(paste0(tolower(type), "_remote"), mode = "function", inherits = TRUE)
 
-    res <- fun(repo, ...)
+    if (!is.null(host)) {
+      res <- fun(repo, host = host, ...)
+    } else {
+      res <- fun(repo, ...)
+    }
     }, error = function(e) stop("Unknown remote type: ", type, "\n  ", conditionMessage(e), call. = FALSE)
   )
   res

R/install-gitlab.R

@@ -125,7 +125,7 @@ remote_package_name.gitlab_remote <- function(remote, ...) {
       is.null(remote$subdir),
       "DESCRIPTION",
       utils::URLencode(paste0(remote$subdir, "/DESCRIPTION"), reserved = TRUE)),
-    "/raw?ref=", remote$ref)
+    "/raw?ref=", utils::URLencode(remote$ref, reserved = TRUE))
 
   dest <- tempfile()
   res <- download(dest, src, headers = c("Private-Token" = remote$auth_token))
@@ -149,7 +149,7 @@ format.gitlab_remote <- function(x, ...) {
 gitlab_commit <- function(username, repo, ref = "HEAD",
   host = "gitlab.com", pat = gitlab_pat()) {
 
-  url <- build_url(host, "api", "v4", "projects", utils::URLencode(paste0(username, "/", repo), reserved = TRUE), "repository", "commits", ref)
+  url <- build_url(host, "api", "v4", "projects", utils::URLencode(paste0(username, "/", repo), reserved = TRUE), "repository", "commits", utils::URLencode(ref, reserved = TRUE))
 
   tmp <- tempfile()
   download(tmp, url, headers = c("Private-Token" = pat))
@@ -178,7 +178,7 @@ gitlab_pat <- function(quiet = TRUE) {
 gitlab_project_id <- function(username, repo, ref = "HEAD",
   host = "gitlab.com", pat = gitlab_pat()) {
 
-  url <- build_url(host, "api", "v4", "projects", utils::URLencode(paste0(username, "/", repo), reserved = TRUE), "repository", "commits", ref)
+  url <- build_url(host, "api", "v4", "projects", utils::URLencode(paste0(username, "/", repo), reserved = TRUE), "repository", "commits", utils::URLencode(ref, reserved = TRUE))
 
   tmp <- tempfile()
   download(tmp, url, headers = c("Private-Token" = pat))

tests/testthat/test-deps.R

@@ -180,7 +180,7 @@ test_that("Additional_repositories field", {
   )
 
   pkg <- list(
-    additional_repositories = 
+    additional_repositories =
       "\n  http://packages.ropensci.org, \nhttp://foo.bar.com"
   )
 
@@ -347,6 +347,18 @@ test_that("remotes are parsed with explicit types", {
 
 })
 
+test_that("remotes are parsed with explicit host", {
+
+  expect_equal(
+    parse_one_extra("github@api.github.com::hadley/testthat"),
+    github_remote("hadley/testthat"))
+
+  expect_equal(
+    parse_one_extra("gitlab@gitlab.com::r-packages/psyverse"),
+    gitlab_remote("r-packages/psyverse"))
+
+})
+
 test_that("type = 'both' works well", {
 
   skip_on_cran()

tests/testthat/test-install-gitlab.R

@@ -117,6 +117,18 @@ test_that("remote_sha.gitlab_remote", {
     "0f39d9eb735bf16909831c0bb129063dda388375"
   )
 
+  expect_equal(
+    remote_sha(
+      remote("gitlab",
+        host = "https://gitlab.com",
+        username = "drgola",
+        repo = "r_pkg_test",
+        ref = "feature/foo_mult"
+      )
+    ),
+    "58376e96e9b42baece2ab7c0414db6064740c6b6"
+  )
+
 })
 
 test_that("gitlab_project_id", {