#' Attempts to install a package directly from GitHub.
#'
#' This function is vectorised on `repo` so you can install multiple
#' packages in a single command.
#'
#' @param repo Repository address in the format
#' `username/repo[/subdir][@@ref|#pull|@@*release]`. Alternatively, you can
#' specify `subdir` and/or `ref` using the respective parameters
#' (see below); if both are specified, the values in `repo` take
#' precedence.
#' @param ref Desired git reference. Could be a commit, tag, or branch
#' name, or a call to [github_pull()] or [github_release()]. Defaults to
#' `"HEAD"`, which means the default branch on GitHub and for git remotes.
#' See [setting-the-default-branch](https://help.github.com/en/github/administering-a-repository/setting-the-default-branch)
#' 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) 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.
#' @param host GitHub API host to use. Override with your GitHub enterprise
#' hostname, for example, `"github.hostname.com/api/v3"`.
#' @param force Force installation, even if the remote state has not changed
#' since the previous install.
#' @inheritParams install_deps
#' @param ... Other arguments passed on to [utils::install.packages()].
#' @details
#' If the repository uses submodules a command-line git client is required to
#' clone the submodules.
#' @family package installation
#' @export
#' @seealso [github_pull()]
#' @examples
#' \dontrun{
#' install_github("klutometis/roxygen")
#' install_github("wch/ggplot2", ref = github_pull("142"))
#' install_github(c("rstudio/httpuv", "rstudio/shiny"))
#' install_github(c("hadley/httr@@v0.4", "klutometis/roxygen#142",
#' "r-lib/roxygen2@@*release", "mfrasca/r-logging/pkg"))
#'
#' # To install from a private repo, use auth_token with a token
#' # from https://github.com/settings/tokens. You only need the
#' # repo scope. Best practice is to save your PAT in env var called
#' # GITHUB_PAT.
#' install_github("hadley/private", auth_token = "abc")
#'
#' # To pass option arguments to `R CMD INSTALL` use `INSTALL_opts`. e.g. to
#' install a package with source references and tests
#' install_github("rstudio/shiny", INSTALL_opts = c("--with-keep.source", "--install-tests"))
#' }
install_github <- function(repo,
ref = "HEAD",
subdir = NULL,
auth_token = github_pat(quiet),
host = "api.github.com",
dependencies = NA,
upgrade = c("default", "ask", "always", "never"),
force = FALSE,
quiet = FALSE,
build = TRUE, build_opts = c("--no-resave-data", "--no-manual", "--no-build-vignettes"),
build_manual = FALSE, build_vignettes = FALSE,
repos = getOption("repos"),
type = getOption("pkgType"),
...) {
remotes <- lapply(repo, github_remote, ref = ref,
subdir = subdir, auth_token = auth_token, host = host)
install_remotes(remotes, auth_token = auth_token, host = host,
dependencies = dependencies,
upgrade = upgrade,
force = force,
quiet = quiet,
build = build,
build_opts = build_opts,
build_manual = build_manual,
build_vignettes = build_vignettes,
repos = repos,
type = type,
...)
}
#' Create a new github_remote
#'
#' This is an internal function to create a new github_remote, users should
#' generally have no need for it.
#' @inheritParams install_github
#' @export
#' @keywords internal
github_remote <- function(repo, ref = "HEAD", subdir = NULL,
auth_token = github_pat(), sha = NULL,
host = "api.github.com", ...) {
meta <- parse_git_repo(repo)
meta <- github_resolve_ref(meta$ref %||% ref, meta, host = host, auth_token = auth_token)
remote("github",
host = host,
package = meta$package,
repo = meta$repo,
subdir = meta$subdir %||% subdir,
username = meta$username,
ref = meta$ref,
sha = sha,
auth_token = auth_token
)
}
#' @export
remote_download.github_remote <- function(x, quiet = FALSE) {
if (!quiet) {
message("Downloading GitHub repo ", x$username, "/", x$repo, "@", x$ref)
}
dest <- tempfile(fileext = paste0(".tar.gz"))
src_root <- build_url(x$host, "repos", x$username, x$repo)
src <- paste0(src_root, "/tarball/", utils::URLencode(x$ref, reserved = TRUE))
download(dest, src, auth_token = x$auth_token)
}
#' @export
remote_metadata.github_remote <- function(x, bundle = NULL, source = NULL, sha = NULL) {
if (!is.null(bundle)) {
# Might be able to get from archive
sha <- git_extract_sha1_tar(bundle)
} else if (is_na(sha)) {
sha <- NULL
}
list(
RemoteType = "github",
RemoteHost = x$host,
RemotePackage = x$package,
RemoteRepo = x$repo,
RemoteUsername = x$username,
RemoteRef = x$ref,
RemoteSha = sha,
RemoteSubdir = x$subdir,
# Backward compatibility for packrat etc.
GithubRepo = x$repo,
GithubUsername = x$username,
GithubRef = x$ref,
GithubSHA1 = sha,
GithubSubdir = x$subdir
)
}
#' GitHub references
#'
#' Use as `ref` parameter to [install_github()].
#' Allows installing a specific pull request or the latest release.
#'
#' @param pull Character string specifying the pull request to install
#' @seealso [install_github()]
#' @examples
#' github_pull("42")
#' @rdname github_refs
#' @export
github_pull <- function(pull) structure(pull, class = "github_pull")
#' @rdname github_refs
#' @export
github_release <- function() structure(NA_integer_, class = "github_release")
github_resolve_ref <- function(x, params, ...) UseMethod("github_resolve_ref")
#' @export
github_resolve_ref.default <- function(x, params, ...) {
params$ref <- x
params
}
#' @export
github_resolve_ref.NULL <- function(x, params, ...) {
params$ref <- "HEAD"
params
}
#' @export
github_resolve_ref.github_pull <- function(x, params, ..., host, auth_token = github_pat()) {
# GET /repos/:user/:repo/pulls/:number
path <- file.path("repos", params$username, params$repo, "pulls", x)
response <- tryCatch(
github_GET(path, host = host, pat = auth_token),
error = function(e) e
)
## Just because libcurl might download the error page...
if (methods::is(response, "error") || is.null(response$head)) {
stop("Cannot find GitHub pull request ", params$username, "/",
params$repo, "#", x, "\n",
response$message)
}
params$username <- response$head$user$login
params$ref <- response$head$ref
params
}
# Retrieve the ref for the latest release
#' @export
github_resolve_ref.github_release <- function(x, params, ..., host, auth_token = github_pat()) {
# GET /repos/:user/:repo/releases
path <- paste("repos", params$username, params$repo, "releases", sep = "/")
response <- tryCatch(
github_GET(path, host = host, pat = auth_token),
error = function(e) e
)
if (methods::is(response, "error") || !is.null(response$message)) {
stop("Cannot find repo ", params$username, "/", params$repo, ".", "\n",
response$message)
}
if (length(response) == 0L)
stop("No releases found for repo ", params$username, "/", params$repo, ".")
params$ref <- response[[1L]]$tag_name
params
}
#' @export
remote_package_name.github_remote <- function(remote, ..., use_local = TRUE,
use_curl = !is_standalone() && pkg_installed("curl")) {
# If the package name was explicitly specified, use that
if (!is.null(remote$package)) {
return(remote$package)
}
# Otherwise if the repo is an already installed package assume that.
if (isTRUE(use_local)) {
local_name <- suppressWarnings(utils::packageDescription(remote$repo, fields = "Package"))
if (!is.na(local_name)) {
return(local_name)
}
}
# Otherwise lookup the package name from the remote DESCRIPTION file
desc <- github_DESCRIPTION(username = remote$username, repo = remote$repo,
subdir = remote$subdir, host = remote$host, ref = remote$ref,
pat = remote$auth_token %||% github_pat(), use_curl = use_curl)
if (is.null(desc)) {
return(NA_character_)
}
tmp <- tempfile()
writeChar(desc, tmp)
on.exit(unlink(tmp))
read_dcf(tmp)$Package
}
#' @export
remote_sha.github_remote <- function(remote, ..., use_curl = !is_standalone() && pkg_installed("curl")) {
tryCatch(
github_commit(username = remote$username, repo = remote$repo,
host = remote$host, ref = remote$ref, pat = remote$auth_token %||% github_pat(), use_curl = use_curl),
# 422 errors most often occur when a branch or PR has been deleted, so we
# ignore the error in this case
http_422 = function(e) NA_character_
)
}
#' @export
format.github_remote <- function(x, ...) {
"GitHub"
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.