From eb15a1eb21cca47ce5601747fd4e033d8606a648 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Achim=20G=C3=A4dke?= Date: Wed, 20 Oct 2021 04:19:51 +1300 Subject: [PATCH] add regression test for issue #646 and fixup git_remote (#658) --- NEWS.md | 2 ++ R/install-git.R | 10 +++++++--- inst/install-github.R | 16 +++++++++++----- install-github.R | 16 +++++++++++----- tests/testthat/test-install-git.R | 15 ++++++++++++++- 5 files changed, 45 insertions(+), 14 deletions(-) diff --git a/NEWS.md b/NEWS.md index ad037b5e..9c6cbb77 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,7 @@ # remotes (development version) +* Fix regex to handle user names in URL in `git_remote`, add regression tests (@achimgaedke, #646). + # remotes 2.4.1 * pkgbuild is no longer accidentally loaded even in standalone mode (#548) diff --git a/R/install-git.R b/R/install-git.R index fb5d2de8..10170b0b 100644 --- a/R/install-git.R +++ b/R/install-git.R @@ -79,10 +79,14 @@ git_remote <- function(url, subdir = NULL, ref = NULL, credentials = git_credent stop("`credentials` can only be used with `git = \"git2r\"`", call. = FALSE) } - meta <- re_match(url, "(?(?:git@)?[^@]*)(?:@(?.*))?") - ref <- ref %||% (if (meta$ref == "") NULL else meta$ref) + url_parts = re_match( url, + "(?[^/]*://)?(?[^/]+)(?[^@]*)(@(?.*))?") - list(git2r = git_remote_git2r, external = git_remote_xgit)[[git]](meta$url, subdir, ref, credentials) + ref <- ref %||% (if (url_parts$ref == "") NULL else url_parts$ref) + + url = paste0(url_parts$protocol, url_parts$authhost, url_parts$path) + + list(git2r = git_remote_git2r, external = git_remote_xgit)[[git]](url, subdir, ref, credentials) } diff --git a/inst/install-github.R b/inst/install-github.R index 1f41bbbb..55242702 100644 --- a/inst/install-github.R +++ b/inst/install-github.R @@ -2666,10 +2666,14 @@ function(...) { stop("`credentials` can only be used with `git = \"git2r\"`", call. = FALSE) } - meta <- re_match(url, "(?(?:git@)?[^@]*)(?:@(?.*))?") - ref <- ref %||% (if (meta$ref == "") NULL else meta$ref) + url_parts = re_match( url, + "(?[^/]*://)?(?[^/]+)(?[^@]*)(@(?.*))?") - list(git2r = git_remote_git2r, external = git_remote_xgit)[[git]](meta$url, subdir, ref, credentials) + ref <- ref %||% (if (url_parts$ref == "") NULL else url_parts$ref) + + url = paste0(url_parts$protocol, url_parts$authhost, url_parts$path) + + list(git2r = git_remote_git2r, external = git_remote_xgit)[[git]](url, subdir, ref, credentials) } @@ -2928,7 +2932,8 @@ function(...) { #' for more details. #' @param subdir Subdirectory within repo that contains the R package. #' @param auth_token To install from a private repo, generate a personal - #' access token (PAT) in "https://github.com/settings/tokens" and + #' access token (PAT) with at least repo scope in + #' \url{https://github.com/settings/tokens} and #' supply to this argument. This is safer than using a password because #' you can easily delete a PAT without affecting any others. Defaults to #' the `GITHUB_PAT` environment variable. @@ -3201,7 +3206,8 @@ function(...) { #' \link{install_gitlab} may work without, omitting it generally #' leads to package restoration errors. #' @param auth_token To install from a private repo, generate a personal access - #' token (PAT) in \url{https://docs.gitlab.com/ee/user/profile/personal_access_tokens.html} and + #' token (PAT) with at least read_api scope in + #' \url{https://docs.gitlab.com/ee/user/profile/personal_access_tokens.html} and #' supply to this argument. This is safer than using a password because you #' can easily delete a PAT without affecting any others. Defaults to the #' GITLAB_PAT environment variable. diff --git a/install-github.R b/install-github.R index 1f41bbbb..55242702 100644 --- a/install-github.R +++ b/install-github.R @@ -2666,10 +2666,14 @@ function(...) { stop("`credentials` can only be used with `git = \"git2r\"`", call. = FALSE) } - meta <- re_match(url, "(?(?:git@)?[^@]*)(?:@(?.*))?") - ref <- ref %||% (if (meta$ref == "") NULL else meta$ref) + url_parts = re_match( url, + "(?[^/]*://)?(?[^/]+)(?[^@]*)(@(?.*))?") - list(git2r = git_remote_git2r, external = git_remote_xgit)[[git]](meta$url, subdir, ref, credentials) + ref <- ref %||% (if (url_parts$ref == "") NULL else url_parts$ref) + + url = paste0(url_parts$protocol, url_parts$authhost, url_parts$path) + + list(git2r = git_remote_git2r, external = git_remote_xgit)[[git]](url, subdir, ref, credentials) } @@ -2928,7 +2932,8 @@ function(...) { #' for more details. #' @param subdir Subdirectory within repo that contains the R package. #' @param auth_token To install from a private repo, generate a personal - #' access token (PAT) in "https://github.com/settings/tokens" and + #' access token (PAT) with at least repo scope in + #' \url{https://github.com/settings/tokens} and #' supply to this argument. This is safer than using a password because #' you can easily delete a PAT without affecting any others. Defaults to #' the `GITHUB_PAT` environment variable. @@ -3201,7 +3206,8 @@ function(...) { #' \link{install_gitlab} may work without, omitting it generally #' leads to package restoration errors. #' @param auth_token To install from a private repo, generate a personal access - #' token (PAT) in \url{https://docs.gitlab.com/ee/user/profile/personal_access_tokens.html} and + #' token (PAT) with at least read_api scope in + #' \url{https://docs.gitlab.com/ee/user/profile/personal_access_tokens.html} and #' supply to this argument. This is safer than using a password because you #' can easily delete a PAT without affecting any others. Defaults to the #' GITLAB_PAT environment variable. diff --git a/tests/testthat/test-install-git.R b/tests/testthat/test-install-git.R index f2389ad1..11e9fda6 100644 --- a/tests/testthat/test-install-git.R +++ b/tests/testthat/test-install-git.R @@ -166,11 +166,24 @@ test_that("git_remote returns the url", { remote <- git_remote(url) expect_equal(remote$url, "git@github.com:cran/falsy.git") - # works with ref (git protocal) + # works with ref (git protocol) url <- "git@github.com:cran/falsy.git@master" remote <- git_remote(url) expect_equal(remote$url, "git@github.com:cran/falsy.git") expect_equal(remote$ref, "master") + + url <- "ssh://git@git.host.com:7999/proj/name.git" + remote <- git_remote(url) + expect_equal(remote$url, "ssh://git@git.host.com:7999/proj/name.git") + + url <- "ssh://git@git.host.com:7999/proj/name.git@fixup/issue" + remote <- git_remote(url) + expect_equal(remote$url, "ssh://git@git.host.com:7999/proj/name.git") + expect_equal(remote$ref, "fixup/issue") + + url <- "https://someuser@dev.azure.com/someuser/MyProject/_git/MyPackage" + remote <- git_remote(url) + expect_equal(remote$url, "https://someuser@dev.azure.com/someuser/MyProject/_git/MyPackage") }) test_that("remote_package_name.git2r_remote returns the package name if it exists", {