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