1#' Install a package from GitLab 2#' 3#' This function is vectorised on `repo` so you can install multiple 4#' packages in a single command. Like other remotes the repository will skip 5#' installation if `force == FALSE` (the default) and the remote state has 6#' not changed since the previous installation. 7#' 8#' @inheritParams install_github 9#' @param repo Repository address in the format 10#' `username/repo[@@ref]`. 11#' @param host GitLab API host to use. Override with your GitLab enterprise 12#' hostname, for example, `"<PROTOCOL://>gitlab.hostname.com"`. 13#' The PROTOCOL is required by packrat during RStudio Connect deployment. While 14#' \link{install_gitlab} may work without, omitting it generally 15#' leads to package restoration errors. 16#' @param auth_token To install from a private repo, generate a personal access 17#' token (PAT) with at least read_api scope in 18#' \url{https://docs.gitlab.com/ee/user/profile/personal_access_tokens.html} and 19#' supply to this argument. This is safer than using a password because you 20#' can easily delete a PAT without affecting any others. Defaults to the 21#' GITLAB_PAT environment variable. 22#' @inheritParams install_github 23#' @export 24#' @family package installation 25#' @examples 26#' \dontrun{ 27#' install_gitlab("jimhester/covr") 28#' } 29install_gitlab <- function(repo, 30 subdir = NULL, 31 auth_token = gitlab_pat(quiet), 32 host = "gitlab.com", 33 dependencies = NA, 34 upgrade = c("default", "ask", "always", "never"), 35 force = FALSE, 36 quiet = FALSE, 37 build = TRUE, build_opts = c("--no-resave-data", "--no-manual", "--no-build-vignettes"), 38 build_manual = FALSE, build_vignettes = FALSE, 39 repos = getOption("repos"), 40 type = getOption("pkgType"), 41 ...) { 42 43 remotes <- lapply(repo, gitlab_remote, subdir = subdir, auth_token = auth_token, host = host) 44 45 install_remotes(remotes, auth_token = auth_token, host = host, 46 dependencies = dependencies, 47 upgrade = upgrade, 48 force = force, 49 quiet = quiet, 50 build = build, 51 build_opts = build_opts, 52 build_manual = build_manual, 53 build_vignettes = build_vignettes, 54 repos = repos, 55 type = type, 56 ...) 57} 58 59gitlab_remote <- function(repo, subdir = NULL, 60 auth_token = gitlab_pat(), sha = NULL, 61 host = "gitlab.com", ...) { 62 63 meta <- parse_git_repo(repo) 64 meta$ref <- meta$ref %||% "HEAD" 65 66 remote("gitlab", 67 host = host, 68 repo = paste(c(meta$repo, meta$subdir), collapse = "/"), 69 subdir = subdir, 70 username = meta$username, 71 ref = meta$ref, 72 sha = sha, 73 auth_token = auth_token 74 ) 75} 76 77#' @export 78remote_download.gitlab_remote <- function(x, quiet = FALSE) { 79 dest <- tempfile(fileext = paste0(".tar.gz")) 80 81 project_id <- gitlab_project_id(x$username, x$repo, x$ref, x$host, x$auth_token) 82 83 src_root <- build_url(x$host, "api", "v4", "projects", project_id) 84 src <- paste0(src_root, "/repository/archive.tar.gz?sha=", utils::URLencode(x$ref, reserved = TRUE)) 85 86 if (!quiet) { 87 message("Downloading GitLab repo ", x$username, "/", x$repo, "@", x$ref, 88 "\nfrom URL ", src) 89 } 90 91 download(dest, src, headers = c("Private-Token" = x$auth_token)) 92} 93 94#' @export 95remote_metadata.gitlab_remote <- function(x, bundle = NULL, source = NULL, sha = NULL) { 96 97 if (!is.null(bundle)) { 98 # Might be able to get from archive 99 sha <- git_extract_sha1_tar(bundle) 100 } else if (is_na(sha)) { 101 sha <- NULL 102 } 103 104 list( 105 RemoteType = "gitlab", 106 RemoteHost = x$host, 107 RemoteRepo = x$repo, 108 RemoteUsername = x$username, 109 RemoteRef = x$ref, 110 RemoteSha = sha, 111 RemoteSubdir = x$subdir 112 ) 113} 114 115#' @export 116remote_package_name.gitlab_remote <- function(remote, ...) { 117 118 tmp <- tempfile() 119 120 src_root <- build_url( 121 remote$host, "api", "v4", "projects", 122 utils::URLencode(paste0(remote$username, "/", remote$repo), 123 reserved = TRUE), 124 "repository") 125 126 src <- paste0( 127 src_root, "/files/", 128 ifelse( 129 is.null(remote$subdir), 130 "DESCRIPTION", 131 utils::URLencode(paste0(remote$subdir, "/DESCRIPTION"), reserved = TRUE)), 132 "/raw?ref=", utils::URLencode(remote$ref, reserved = TRUE)) 133 134 dest <- tempfile() 135 res <- download(dest, src, headers = c("Private-Token" = remote$auth_token)) 136 137 tryCatch( 138 read_dcf(dest)$Package, 139 error = function(e) remote$repo) 140} 141 142#' @export 143remote_sha.gitlab_remote <- function(remote, ...) { 144 gitlab_commit(username = remote$username, repo = remote$repo, 145 host = remote$host, ref = remote$ref, pat = remote$auth_token) 146} 147 148#' @export 149format.gitlab_remote <- function(x, ...) { 150 "GitLab" 151} 152 153gitlab_commit <- function(username, repo, ref = "HEAD", 154 host = "gitlab.com", pat = gitlab_pat()) { 155 156 url <- build_url(host, "api", "v4", "projects", utils::URLencode(paste0(username, "/", repo), reserved = TRUE), "repository", "commits", utils::URLencode(ref, reserved = TRUE)) 157 158 tmp <- tempfile() 159 download(tmp, url, headers = c("Private-Token" = pat)) 160 161 json$parse_file(tmp)$id 162} 163 164#' Retrieve GitLab personal access token. 165#' 166#' A GitLab personal access token 167#' Looks in env var `GITLAB_PAT` 168#' 169#' @keywords internal 170#' @export 171gitlab_pat <- function(quiet = TRUE) { 172 pat <- Sys.getenv("GITLAB_PAT") 173 if (nzchar(pat)) { 174 if (!quiet) { 175 message("Using GitLab PAT from envvar GITLAB_PAT") 176 } 177 return(pat) 178 } 179 return(NULL) 180} 181 182gitlab_project_id <- function(username, repo, ref = "HEAD", 183 host = "gitlab.com", pat = gitlab_pat()) { 184 185 url <- build_url(host, "api", "v4", "projects", utils::URLencode(paste0(username, "/", repo), reserved = TRUE), "repository", "commits", utils::URLencode(ref, reserved = TRUE)) 186 187 tmp <- tempfile() 188 download(tmp, url, headers = c("Private-Token" = pat)) 189 190 json$parse_file(tmp)$project_id 191} 192