build-cran-binaries/local/build-one.R

# Targeted (re)build of specific versions of a single package.
# Invoked inside a build-env container (see docker/build-one.Dockerfile).
# Usage: build-one.R [--sensitive-only] <package> <version> [<version> ...]
# Sensitivity is auto-detected per version via bincraft's ABI classifier:
# risky packages go to the per-minor slot, everything else to the generic slot.
# With --sensitive-only, non-risky versions are skipped (used for the extra
# per-minor passes under non-primary R versions).

options(crayon.enabled = TRUE, future.globals.onReference = NULL)

args <- commandArgs(trailingOnly = TRUE)
sensitive_only <- "--sensitive-only" %in% args
args <- args[args != "--sensitive-only"]
if (length(args) < 2L) {
  stop(
    "usage: build-one.R [--sensitive-only] <package> <version> [<version> ...]",
    call. = FALSE
  )
}
package <- args[1L]
versions <- args[-1L]

library(bincraft, quietly = TRUE)

s3 <- list(
  s3_endpoint = "https://s3.eu-central-003.backblazeb2.com",
  s3_region = "eu-central-003",
  s3_bucket = "devxy-rpkgs-binaries",
  s3_access_key_id = Sys.getenv("B2_S3_ACCESS_KEY"),
  s3_secret_access_key = Sys.getenv("B2_S3_SECRET_KEY")
)

# Clone the CRAN source for a version and ask the ABI classifier whether it
# must be rebuilt per R minor. Fails safe to TRUE so a possibly-fragile binary
# is never served from the cross-minor generic slot by mistake.
classify <- function(pkg, ver) {
  dest <- file.path(tempdir(), sprintf("classify_%s_%s", pkg, ver))
  on.exit(unlink(dest, recursive = TRUE, force = TRUE), add = TRUE)
  tryCatch(
    {
      message(sprintf(
        "[classify] cloning %s@%s from github.com/cran ...",
        pkg,
        ver
      ))
      system2(
        "git",
        c(
          "clone",
          "--depth",
          "1",
          "--branch",
          ver,
          sprintf("https://github.com/cran/%s", pkg),
          dest
        )
      )
      message(sprintf("[classify] running ABI classifier on %s ...", pkg))
      isTRUE(as.logical(bincraft::needs_per_minor_recompile(dest)))
    },
    error = function(e) {
      message(sprintf(
        "classify failed for %s %s: %s; treating as r-minor-sensitive",
        pkg,
        ver,
        conditionMessage(e)
      ))
      TRUE
    }
  )
}

minor <- paste(
  R.version$major,
  strsplit(R.version$minor, ".", fixed = TRUE)[[1L]][1L],
  sep = "."
)
touched_generic <- FALSE
touched_minor <- FALSE

for (ver in versions) {
  sensitive <- classify(package, ver)
  if (sensitive_only && !sensitive) {
    message(sprintf(
      "Skipping %s %s under R %s (not r-minor-sensitive)",
      package,
      ver,
      minor
    ))
    next
  }
  cat(sprintf(
    "Building %s %s (r_minor_sensitive=%s, R %s)\n",
    package,
    ver,
    sensitive,
    minor
  ))
  bincraft::build_binary_package(
    package,
    tag = ver,
    is_r_minor_sensitive = sensitive,
    force = TRUE,
    upload = TRUE,
    archive = TRUE,
    patches = "local/patches",
    store_build_metadata = TRUE,
    s3_endpoint = s3$s3_endpoint,
    s3_region = s3$s3_region,
    s3_bucket = s3$s3_bucket,
    s3_access_key_id = s3$s3_access_key_id,
    s3_secret_access_key = s3$s3_secret_access_key,
    metadata_db_host = "r-binaries.devxy.io",
    metadata_db_name = "build_metadata",
    metadata_db_table = "single_builds",
    metadata_db_user = "rpkgs",
    metadata_db_password = Sys.getenv("PGPASS"),
    metadata_db_sslmode = "require",
    metadata_db_port = 15432
  )
  if (sensitive) touched_minor <- TRUE else touched_generic <- TRUE
}

# Signal the container wrapper whether per-minor passes are warranted (a single
# package's sensitivity is the same across R minors, so a non-sensitive package
# need not touch any other minor's library).
if (touched_minor) {
  file.create(".r_minor_sensitive")
}

# Refresh the PACKAGES index for each slot we wrote to, so the (re)built binary
# is immediately resolvable by clients.
codename <- bincraft::set_codename(NULL)
# cranlike keeps a working PACKAGES.db in the CWD; clear any copy left by a
# previous pass so each per-slot index is built fresh. Otherwise the 2nd index
# update in the same container fails with "table packages already exists".
clean_index_workdir <- function() {
  unlink(c("PACKAGES", "PACKAGES.gz", "PACKAGES.rds", "PACKAGES.db"))
}
if (touched_generic) {
  cat("Refreshing generic index\n")
  clean_index_workdir()
  bincraft::upload_package_index(
    codename = codename,
    s3_endpoint = s3$s3_endpoint,
    s3_region = s3$s3_region,
    s3_bucket = s3$s3_bucket,
    s3_access_key_id = s3$s3_access_key_id,
    s3_secret_access_key = s3$s3_secret_access_key
  )
}
if (touched_minor) {
  cat(sprintf("Refreshing per-minor index %s\n", minor))
  clean_index_workdir()
  bincraft::upload_package_index(
    codename = codename,
    r_minor = minor,
    s3_endpoint = s3$s3_endpoint,
    s3_region = s3$s3_region,
    s3_bucket = s3$s3_bucket,
    s3_access_key_id = s3$s3_access_key_id,
    s3_secret_access_key = s3$s3_secret_access_key
  )
}