Skip to main content
  • Home
  • Development
  • Documentation
  • Donate
  • Operational login
  • Browse the archive

swh logo
SoftwareHeritage
Software
Heritage
Archive
Features
  • Search

  • Downloads

  • Save code now

  • Add forge now

  • Help

Revision df465aa02367bc8bf2fa3f2e3827be5f8713569a authored by Hadley Wickham on 03 December 2021, 09:00:02 UTC, committed by cran-robot on 03 December 2021, 09:00:02 UTC
version 2.0.1
1 parent be39bf7
  • Files
  • Changes
  • 2000f0b
  • /
  • R
  • /
  • deploy-site.R
Raw File Download
Permalinks

To reference or cite the objects present in the Software Heritage archive, permalinks based on SoftWare Hash IDentifiers (SWHIDs) must be used.
Select below a type of object currently browsed in order to display its associated SWHID and permalink.

  • revision
  • directory
  • content
revision badge
swh:1:rev:df465aa02367bc8bf2fa3f2e3827be5f8713569a
directory badge Iframe embedding
swh:1:dir:367dbd97ccdd73e773f4be611a8fbfb5f743c97f
content badge Iframe embedding
swh:1:cnt:83293b041bd07ac6bf61a1c1654c197998715bb6
Citations

This interface enables to generate software citations, provided that the root directory of browsed objects contains a citation.cff or codemeta.json file.
Select below a type of object currently browsed in order to generate citations for them.

  • revision
  • directory
  • content
Generate software citation in BibTex format (requires biblatex-software package)
Generating citation ...
Generate software citation in BibTex format (requires biblatex-software package)
Generating citation ...
Generate software citation in BibTex format (requires biblatex-software package)
Generating citation ...
deploy-site.R
#' Deploy a pkgdown site on Travis-CI to Github Pages
#'
#' @description
#' `r lifecycle::badge('superseded')`
#'
#' `deploy_site_github()` was designed to deploy your site from Travis CI,
#' which we no longer recommend, so this function is deprecated. There are
#' two replacements:
#'
#' * [usethis::use_pkgdown_github_pages()] will setup a GitHub action to
#'   automatically build and deploy your package website to GitHub pages.
#'
#' * [deploy_to_branch()] can be called locally to build and deploy your
#'   website to any desired branch.
#'
#' @inheritParams build_site
#' @param install Optionally, opt-out of automatic installation. This is
#'   necessary if the package you're documenting is a dependency of pkgdown
#' @param tarball The location of the built package tarball. The default Travis
#'   configuration for R packages sets `PKG_TARBALL` to this path.
#' @param ssh_id The private id to use, a base64 encoded content of the private
#'   pem file. This should _not_ be your personal private key. Instead create a
#'   new keypair specifically for deploying the site. The easiest way is to use
#'   `travis::use_travis_deploy()`.
#' @param commit_message The commit message to be used for the commit.
#' @param clean Clean all files from old site.
#' @param verbose Print verbose output
#' @param ... Additional arguments passed to [build_site()].
#' @param host The GitHub host url.
#' @param repo_slug The `user/repo` slug for the repository.
#' @export
#' @keywords internal
deploy_site_github <- function(
  pkg = ".",
  install = TRUE,
  tarball = Sys.getenv("PKG_TARBALL", ""),
  ssh_id = Sys.getenv("id_rsa", ""),
  commit_message = construct_commit_message(pkg),
  clean = FALSE,
  verbose = FALSE,
  host = "github.com",
  ...,
  repo_slug = Sys.getenv("TRAVIS_REPO_SLUG", "")) {
  rlang::check_installed("openssl")
  if (!nzchar(tarball)) {
    stop("No built tarball detected, please provide the location of one with `tarball`", call. = FALSE)
  }

  if (!nzchar(ssh_id)) {
    stop("No deploy key found, please setup with `travis::use_travis_deploy()`", call. = FALSE)
  }

  if (!nzchar(repo_slug)) {
    stop("No repo detected, please supply one with `repo_slug`", call. = FALSE)
  }

  rule("Deploying site", line = 2)
  if (install) {
    rule("Installing package", line = 1)
    callr::rcmd("INSTALL", tarball, show = verbose, fail_on_status = TRUE)
  }

  ssh_id_file <- "~/.ssh/id_rsa"
  rule("Setting up SSH id", line = 1)
  cat_line("Copying private key to: ", ssh_id_file)
  write_lines(rawToChar(openssl::base64_decode(ssh_id)), ssh_id_file)
  cat_line("Setting private key permissions to 0600")
  fs::file_chmod(ssh_id_file, "0600")

  cat_line("Setting remote to use the ssh url")

  git("remote", "set-url", "origin", sprintf("git@%s:%s.git", host, repo_slug))

  deploy_to_branch(
    pkg,
    commit_message = commit_message,
    clean = clean,
    branch = "gh-pages",
    ...
  )

  rule("Deploy completed", line = 2)
}

#' Build and deploy a site locally
#'
#' Assumes that you're in a git clone of the project, and the package is
#' already installed. Use [usethis::use_pkgdown_github_pages()] to automate
#' this process using GitHub actions.
#'
#' @param branch The git branch to deploy to
#' @param remote The git remote to deploy to
#' @param github_pages Is this a GitHub pages deploy. If `TRUE`, adds a `CNAME`
#'   file for custom domain name support, and a `.nojekyll` file to suppress
#'   jekyll rendering.
#' @param ... Additional arguments passed to [build_site()].
#' @inheritParams build_site
#' @inheritParams deploy_site_github
#' @export
deploy_to_branch <- function(pkg = ".",
                         commit_message = construct_commit_message(pkg),
                         clean = TRUE,
                         branch = "gh-pages",
                         remote = "origin",
                         github_pages = (branch == "gh-pages"),
                         ...) {
  dest_dir <- fs::dir_create(fs::file_temp())
  on.exit(fs::dir_delete(dest_dir))

  if (!git_has_remote_branch(remote, branch)) {
    old_branch <- git_current_branch()

    # If no remote branch, we need to create it
    git("checkout", "--orphan", branch)
    git("rm", "-rf", "--quiet", ".")
    git("commit", "--allow-empty", "-m", sprintf("Initializing %s branch", branch))
    git("push", remote, paste0("HEAD:", branch))

    # checkout the previous branch
    git("checkout", old_branch)
  }

  # Explicitly set the branches tracked by the origin remote.
  # Needed if we are using a shallow clone, such as on travis-CI
  git("remote", "set-branches", "--add", remote, branch)

  git("fetch", remote, branch)

  github_worktree_add(dest_dir, remote, branch)
  on.exit(github_worktree_remove(dest_dir), add = TRUE)

  build_site_github_pages(pkg, dest_dir = dest_dir, ..., clean = clean)

  github_push(dest_dir, commit_message, remote, branch)

  invisible()
}

git_has_remote_branch <- function(remote, branch) {
  has_remote_branch <- git("ls-remote", "--quiet", "--exit-code", remote, branch, echo = FALSE, echo_cmd = FALSE, error_on_status = FALSE)$status == 0
}
git_current_branch <- function() {
  branch <- git("rev-parse", "--abbrev-ref", "HEAD", echo = FALSE, echo_cmd = FALSE)$stdout
  sub("\n$", "", branch)
}

github_worktree_add <- function(dir, remote, branch) {
  rule("Adding worktree", line = 1)
  git("worktree",
    "add",
    "--track", "-B", branch,
    dir,
    paste0(remote, "/", branch)
  )
}

github_worktree_remove <- function(dir) {
  rule("Removing worktree", line = 1)
  git("worktree", "remove", dir)
}

github_push <- function(dir, commit_message, remote, branch) {
  # force execution before changing working directory
  force(commit_message)

  rule("Commiting updated site", line = 1)

  with_dir(dir, {
    git("add", "-A", ".")
    git("commit", "--allow-empty", "-m", commit_message)

    rule("Deploying to GitHub Pages", line = 1)
    git("remote", "-v")
    git("push", "--force", remote, paste0("HEAD:", branch))
  })
}

git <- function(..., echo_cmd = TRUE, echo = TRUE, error_on_status = TRUE) {
  callr::run("git", c(...), echo_cmd = echo_cmd, echo = echo, error_on_status = error_on_status)
}

construct_commit_message <- function(pkg, commit = ci_commit_sha()) {
  pkg <- as_pkgdown(pkg)

  sprintf("Built site for %s: %s@%s", pkg$package, pkg$version, substr(commit, 1, 7))
}

ci_commit_sha <- function() {
  env_vars <- c(
    # https://docs.travis-ci.com/user/environment-variables/#default-environment-variables
    "TRAVIS_COMMIT",
    # https://help.github.com/en/actions/configuring-and-managing-workflows/using-environment-variables#default-environment-variables
    "GITHUB_SHA"
  )

  for (var in env_vars) {
    commit_sha <- Sys.getenv(var, "")
    if (commit_sha != "")
      return(commit_sha)
  }

  ""
}
The diff you're trying to view is too large. Only the first 1000 changed files have been loaded.
Showing with 0 additions and 0 deletions (0 / 0 diffs computed)
swh spinner

Computing file changes ...

back to top

Software Heritage — Copyright (C) 2015–2025, The Software Heritage developers. License: GNU AGPLv3+.
The source code of Software Heritage itself is available on our development forge.
The source code files archived by Software Heritage are available under their own copyright and licenses.
Terms of use: Archive access, API— Contact— JavaScript license information— Web API