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