1
2#' Install a package from a git repository
3#'
4#' It is vectorised so you can install multiple packages with
5#' a single command. You do not need to have the `git2r` package,
6#' or an external git client installed.
7#'
8#' If you need to set git credentials for use in the `Remotes` field you can do
9#' so by placing the credentials in the `remotes.git_credentials` global
10#' option.
11#'
12#' @param url Location of package. The url should point to a public or
13#'   private repository.
14#' @param ref Name of branch, tag or SHA reference to use, if not HEAD.
15#' @param branch Deprecated, synonym for ref.
16#' @param subdir A sub-directory within a git repository that may
17#'   contain the package we are interested in installing.
18#' @param credentials A git2r credentials object passed through to clone.
19#'   Supplying this argument implies using `git2r` with `git`.
20#' @param git Whether to use the `git2r` package, or an external
21#'   git client via system. Default is `git2r` if it is installed,
22#'   otherwise an external git installation.
23#' @param ... Other arguments passed on to [utils::install.packages()].
24#' @inheritParams install_github
25#' @family package installation
26#' @export
27#' @examples
28#' \dontrun{
29#' install_git("https://github.com/hadley/stringr.git")
30#' install_git("https://github.com/hadley/stringr.git", ref = "stringr-0.2")
31#' }
32install_git <- function(url, subdir = NULL, ref = NULL, branch = NULL,
33                        credentials = git_credentials(),
34                        git = c("auto", "git2r", "external"),
35                        dependencies = NA,
36                        upgrade = c("default", "ask", "always", "never"),
37                        force = FALSE,
38                        quiet = FALSE,
39                        build = TRUE, build_opts = c("--no-resave-data", "--no-manual", "--no-build-vignettes"),
40                        build_manual = FALSE, build_vignettes = FALSE,
41                        repos = getOption("repos"),
42                        type = getOption("pkgType"),
43                        ...) {
44  if (!missing(branch)) {
45    warning("`branch` is deprecated, please use `ref`")
46    ref <- branch
47  }
48
49  remotes <- lapply(url, git_remote,
50    subdir = subdir, ref = ref,
51    credentials = credentials, git = match.arg(git)
52  )
53
54  install_remotes(remotes,
55    credentials = credentials,
56    dependencies = dependencies,
57    upgrade = upgrade,
58    force = force,
59    quiet = quiet,
60    build = build,
61    build_opts = build_opts,
62    build_manual = build_manual,
63    build_vignettes = build_vignettes,
64    repos = repos,
65    type = type,
66    ...
67  )
68}
69
70
71git_remote <- function(url, subdir = NULL, ref = NULL, credentials = git_credentials(),
72                       git = c("auto", "git2r", "external"), ...) {
73  git <- match.arg(git)
74  if (git == "auto") {
75    git <- if (!is_standalone() && pkg_installed("git2r")) "git2r" else "external"
76  }
77
78  if (!is.null(credentials) && git != "git2r") {
79    stop("`credentials` can only be used with `git = \"git2r\"`", call. = FALSE)
80  }
81
82   url_parts = re_match( url,
83         "(?<protocol>[^/]*://)?(?<authhost>[^/]+)(?<path>[^@]*)(@(?<ref>.*))?")
84
85  ref <- ref %||% (if (url_parts$ref == "") NULL else url_parts$ref)
86
87  url = paste0(url_parts$protocol, url_parts$authhost, url_parts$path)
88
89  list(git2r = git_remote_git2r, external = git_remote_xgit)[[git]](url, subdir, ref, credentials)
90}
91
92
93git_remote_git2r <- function(url, subdir = NULL, ref = NULL, credentials = git_credentials()) {
94  remote("git2r",
95    url = url,
96    subdir = subdir,
97    ref = ref,
98    credentials = credentials
99  )
100}
101
102
103git_remote_xgit <- function(url, subdir = NULL, ref = NULL, credentials = git_credentials()) {
104  remote("xgit",
105    url = url,
106    subdir = subdir,
107    ref = ref
108  )
109}
110
111#' @export
112remote_download.git2r_remote <- function(x, quiet = FALSE) {
113  if (!quiet) {
114    message("Downloading git repo ", x$url)
115  }
116
117  bundle <- tempfile()
118  git2r::clone(x$url, bundle, credentials = x$credentials, progress = FALSE)
119
120  if (!is.null(x$ref)) {
121    r <- git2r::repository(bundle)
122    git2r::checkout(r, x$ref)
123  }
124
125  bundle
126}
127
128#' @export
129remote_metadata.git2r_remote <- function(x, bundle = NULL, source = NULL, sha = NULL) {
130  if (!is.null(bundle)) {
131    r <- git2r::repository(bundle)
132    sha <- git2r::commits(r)[[1]]$sha
133  } else {
134    sha <- NULL
135  }
136
137  list(
138    RemoteType = "git2r",
139    RemoteUrl = x$url,
140    RemoteSubdir = x$subdir,
141    RemoteRef = x$ref,
142    RemoteSha = sha
143  )
144}
145
146#' @export
147remote_package_name.git2r_remote <- function(remote, ...) {
148  tmp <- tempfile()
149  on.exit(unlink(tmp))
150  description_path <- paste0(collapse = "/", c(remote$subdir, "DESCRIPTION"))
151
152  if (grepl("^https?://", remote$url)) {
153    # assumes GitHub-style "<repo>/raw/<ref>/<path>" url
154    url <- build_url(sub("\\.git$", "", remote$url), "raw", remote_sha(remote, ...), description_path)
155    download_args <- list(path = tmp, url = url)
156    if (!is.null(remote$credentials)) {
157      if (inherits(remote$credentials, "cred_user_pass")) {
158        download_args$basic_auth <- list(
159          user = remote$credentials$username,
160          password = remote$credentials$password
161        )
162      } else if (inherits(remote$credentials, "cred_env")) {
163        if (Sys.getenv(remote$credentials$username) == "") {
164          stop(paste0("Environment variable `", remote$credentials$username, "` is unset."), .call = FALSE)
165        }
166        if (Sys.getenv(remote$credentials$password) == "") {
167          stop(paste0("Environment variable `", remote$credentials$password, "` is unset."), .call = FALSE)
168        }
169        download_args$basic_auth <- list(
170          user = Sys.getenv(remote$credentials$username),
171          password = Sys.getenv(remote$credentials$username)
172       )
173      } else if (inherits(remote$credentials, "cred_token")) {
174        if (Sys.getenv(remote$credentials$token) == "") {
175          stop(paste0("Environment variable `", remote$credentials$token, "` is unset."), .call = FALSE)
176        }
177        download_args$auth_token <- Sys.getenv(remote$credentials$token)
178      } else if (inherits(remote$credentials, "cred_ssh_key")) {
179        stop(paste(
180          "Unable to fetch the package DESCRIPTION file using SSH key authentication.",
181          "Try using `git2r::cred_user_pass`, `git2r::cred_env`, or `git2r::cred_token` instead of `git2r::cred_ssh_key` for authentication."
182        ), .call = FALSE)
183      } else {
184        stop(paste(
185          "`remote$credentials` is not NULL and it does not inherit from a recognized class.",
186          "Recognized classes for `remote$credentials` are `cred_user_pass`, `cred_env`, `cred_token`, and `cred_ssh_key`."
187        ), .call = FALSE)
188      }
189    }
190    tryCatch({
191      do.call(download, args = download_args)
192      read_dcf(tmp)$Package
193    }, error = function(e) {
194      NA_character_
195    })
196  } else {
197    # Try using git archive --remote to retrieve the DESCRIPTION, if the protocol
198    # or server doesn't support that return NA
199    res <- try(
200      silent = TRUE,
201      system_check(git_path(),
202        args = c(
203          "archive", "-o", tmp, "--remote", remote$url,
204          if (is.null(remote$ref)) "HEAD" else remote$ref,
205          description_path
206        ),
207        quiet = TRUE
208      )
209    )
210
211    if (inherits(res, "try-error")) {
212      return(NA_character_)
213    }
214
215    # git archive returns a tar file, so extract it to tempdir and read the DCF
216    utils::untar(tmp, files = description_path, exdir = tempdir())
217
218    read_dcf(file.path(tempdir(), description_path))$Package
219  }
220}
221
222#' @export
223remote_sha.git2r_remote <- function(remote, ...) {
224  tryCatch(
225    {
226      # set suppressWarnings in git2r 0.23.0+
227      res <- suppressWarnings(git2r::remote_ls(remote$url, credentials = remote$credentials))
228
229      ref <- remote$ref %||% "HEAD"
230
231      if (ref != "HEAD") ref <- paste0("/", ref)
232
233      found <- grep(pattern = paste0(ref, "$"), x = names(res))
234
235      # If none found, it is either a SHA, so return the pinned sha or NA
236      if (length(found) == 0) {
237        return(remote$ref %||% NA_character_)
238      }
239
240      unname(res[found[1]])
241    },
242    error = function(e) {
243      warning(e)
244      NA_character_
245    }
246  )
247}
248
249#' @export
250format.xgit_remote <- function(x, ...) {
251  "Git"
252}
253
254#' @export
255format.git2r_remote <- function(x, ...) {
256  "Git"
257}
258
259#' @export
260remote_download.xgit_remote <- function(x, quiet = FALSE) {
261  if (!quiet) {
262    message("Downloading git repo ", x$url)
263  }
264
265  bundle <- tempfile()
266
267  args <- c("clone", "--depth", "1", "--no-hardlinks")
268  args <- c(args, x$args, x$url, bundle)
269  git(paste0(args, collapse = " "), quiet = quiet)
270
271  if (!is.null(x$ref)) {
272    git(paste0(c("fetch", "origin", x$ref), collapse = " "), quiet = quiet, path = bundle)
273    git(paste0(c("checkout", "FETCH_HEAD"), collapse = " "), quiet = quiet, path = bundle)
274  }
275
276  bundle
277}
278
279#' @export
280remote_metadata.xgit_remote <- function(x, bundle = NULL, source = NULL, sha = NULL) {
281  if (is_na(sha)) {
282    sha <- NULL
283  }
284
285  list(
286    RemoteType = "xgit",
287    RemoteUrl = x$url,
288    RemoteSubdir = x$subdir,
289    RemoteRef = x$ref,
290    RemoteSha = sha,
291    RemoteArgs = if (length(x$args) > 0) paste0(deparse(x$args), collapse = " ")
292  )
293}
294
295#' @importFrom utils read.delim
296
297#' @export
298remote_package_name.xgit_remote <- remote_package_name.git2r_remote
299
300#' @export
301remote_sha.xgit_remote <- function(remote, ...) {
302  url <- remote$url
303  ref <- remote$ref
304
305  refs <- git(paste("ls-remote", url, ref))
306
307  # If none found, it is either a SHA, so return the pinned SHA or NA
308  if (length(refs) == 0) {
309    return(remote$ref %||% NA_character_)
310  }
311
312  refs_df <- read.delim(
313    text = refs, stringsAsFactors = FALSE, sep = "\t",
314    header = FALSE
315  )
316  names(refs_df) <- c("sha", "ref")
317
318  refs_df$sha[[1]]
319}
320
321#' Specify git credentials to use
322#'
323#' The global option `remotes.git_credentials` is used to set the git
324#' credentials.
325#' @export
326#' @keywords internal
327git_credentials <- function() {
328  getOption("remotes.git_credentials", NULL)
329}
330