build-cran-binaries/local/rebuild-missing.R

### Rebuild one shard of a slot's missing-binary list.
#
# Usage: Rscript local/rebuild-missing.R <split_into> <split_index> [budget_hours]
#
# The list itself comes from local/fetch-rebuild-packages-from-issue.R, which
# writes $REBUILD_PKG_LIST (default /tmp/rebuild_pkgs.txt).
#
# Two properties matter here and are the reason this is a script rather than an
# `R -q -e` argument in the pipeline:
#
#   * it is restartable. The outstanding set is re-derived from the bucket on
#     every start, so a shard that died resumes where it stopped without any
#     progress file, and without replaying thousands of per-package HEADs.
#   * it terminates. A wall-clock budget stops the loop cleanly instead of the
#     run having to be killed, which is what previously skipped the re-index and
#     CDN purge and left rebuilt binaries hidden behind stale edge copies.

options(error = function() {
  cat("ERROR:", geterrmessage(), "\n", file = stdout())
  traceback(2)
  q(status = 1)
})

library(bincraft, quietly = TRUE)

source(file.path("local", "rebuild-missing-helpers.R"))

args <- parse_rebuild_args(commandArgs(trailingOnly = TRUE))
if (is.na(args$split_into) || is.na(args$split_index)) {
  stop("usage: rebuild-missing.R <split_into> <split_index> [budget_hours]")
}

list_file <- Sys.getenv("REBUILD_PKG_LIST", "/tmp/rebuild_pkgs.txt")
pkgs <- if (file.exists(list_file)) readLines(list_file) else character(0)
pkgs <- pkgs[nzchar(pkgs)]
if (length(pkgs) == 0L) {
  cat("Nothing to rebuild\n")
  q("no")
}

excluded <- jsonlite::fromJSON("local/excluded-packages.json")[["package"]]
pkgs <- setdiff(pkgs, excluded)

mine <- shard_slice(pkgs, args$split_into, args$split_index)
cat(sprintf(
  "Shard %s/%s: %s of %s listed packages\n",
  args$split_index,
  args$split_into,
  length(mine),
  length(pkgs)
))

### Resume: ask the bucket what is still outstanding

codename <- bincraft::set_codename(NULL)
local_machine <- Sys.info()[["machine"]]
arch <- if (grepl("arm64|aarch64", local_machine)) "arm64" else "amd64"
slot_dir <- sprintf(
  "devxy-rpkgs-binaries/%s/%s/latest/src/contrib",
  arch,
  codename
)

s3fs::s3_file_system(
  aws_access_key_id = Sys.getenv("B2_S3_ACCESS_KEY"),
  aws_secret_access_key = Sys.getenv("B2_S3_SECRET_KEY"),
  endpoint = "https://s3.eu-central-003.backblazeb2.com",
  region_name = "eu-central-003",
  refresh = TRUE
)

# One paginated listing instead of a HEAD per package. Not recursed: the
# rebuild passes no `is_r_minor_sensitive`, so it only ever targets the flat
# path, and the resume filter matches that scope deliberately.
info <- tryCatch(s3fs::s3_dir_info(slot_dir), error = function(e) NULL)
etag_by_file <- if (is.null(info) || nrow(info) == 0L) {
  cat(sprintf(
    "WARNING: could not list %s; building the whole shard\n",
    slot_dir
  ))
  stats::setNames(character(), character())
} else {
  stats::setNames(
    gsub('^"|"$', "", as.character(info$etag)),
    basename(as.character(info$uri))
  )
}

cran <- tryCatch(
  {
    con <- gzcon(url(
      "https://cloud.r-project.org/src/contrib/PACKAGES.gz",
      open = "rb"
    ))
    on.exit(close(con), add = TRUE)
    read.dcf(con, fields = c("Package", "Version", "MD5sum"))
  },
  error = function(e) {
    cat(sprintf(
      "WARNING: could not read CRAN's index (%s)\n",
      conditionMessage(e)
    ))
    NULL
  }
)
cran_version <- stats::setNames(character(), character())
cran_md5 <- stats::setNames(character(), character())
if (!is.null(cran)) {
  cran_version <- stats::setNames(
    as.character(cran[, "Version"]),
    as.character(cran[, "Package"])
  )
  keep <- !is.na(cran[, "MD5sum"])
  cran_md5 <- stats::setNames(
    as.character(cran[keep, "MD5sum"]),
    paste(cran[keep, "Package"], cran[keep, "Version"], sep = "_")
  )
}

before <- length(mine)
mine <- outstanding_packages(mine, etag_by_file, cran_version, cran_md5)
cat(sprintf(
  "Resume: %s of %s already carry a binary; %s outstanding\n",
  before - length(mine),
  before,
  length(mine)
))

if (length(mine) == 0L) {
  cat("Nothing outstanding for this shard\n")
  q("no")
}

### Build

options(
  crayon.enabled = TRUE,
  Ncpus = as.integer(Sys.getenv("NCPUS", "2")),
  future.globals.onReference = NULL
)

started <- Sys.time()
n <- length(mine)
completed <- 0L
for (i in seq_along(mine)) {
  elapsed <- as.numeric(difftime(Sys.time(), started, units = "hours"))
  if (elapsed > args$budget_hours) {
    cat(sprintf(
      "Budget of %sh reached after %d/%d packages; stopping cleanly. The next run resumes from the bucket.\n",
      args$budget_hours,
      completed,
      n
    ))
    break
  }

  x <- mine[i]
  cat(sprintf("[%d/%d] %s\n", i, n, x))
  tryCatch(
    bincraft::build_binary_package(
      x,
      tag_limit = 1L,
      patches = "local/patches",
      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"),
      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,
      archive = TRUE,
      upload = TRUE,
      store_build_metadata = TRUE
    ),
    error = function(e) {
      cat(sprintf("ERROR building %s - %s\n", x, conditionMessage(e)))
    }
  )
  completed <- completed + 1L
}

cat(sprintf(
  "Shard %s/%s finished: %d/%d packages processed in %.1fh\n",
  args$split_index,
  args$split_into,
  completed,
  n,
  as.numeric(difftime(Sys.time(), started, units = "hours"))
))