build-cran-binaries/local/backfill-abi-classification.R

### Classify every compiled package in a slot's flat index, into the ABI cache.
#
# Usage: Rscript local/backfill-abi-classification.R <arch> <codename> [limit]
#
# The per-minor scheme only ever classified packages that passed through the
# build pipeline after it existed. Everything built before that, and not updated
# on CRAN since, has no verdict at all -- and bincraft's risky set is what
# decides whether a flat binary may be carried into a per-minor index. With no
# verdict the answer defaults to "carry it", which is how a base64enc built
# under R 4.4.3 reached R 4.6 clients and died at dyn.load() on SETLENGTH.
#
# The verdict is a property of the source, so it is independent of OS, arch and
# R minor: one slot's backfill populates the cache for every slot. The slot
# argument only selects which flat index to enumerate.
#
# Only packages with NeedsCompilation=yes are classified. A package with no
# compiled code has no symbols to bind and cannot fail this way, so downloading
# its source to prove that would be wasted work.
#
# Resumable: `classify_r_minor_sensitive()` returns cached verdicts without
# touching the network, so a re-run costs one query per package and only the
# unclassified remainder is downloaded.

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

library(bincraft, quietly = TRUE)

args <- commandArgs(trailingOnly = TRUE)
if (length(args) < 2L) {
  stop(
    "usage: backfill-abi-classification.R <arch> <codename> [limit]",
    call. = FALSE
  )
}
arch <- args[[1L]]
codename <- args[[2L]]
limit <- if (length(args) >= 3L) as.integer(args[[3L]]) else NA_integer_

db <- list(
  metadata_db_type = "postgres",
  metadata_db_host = "r-binaries.devxy.io",
  metadata_db_name = "build_metadata",
  metadata_db_port = 15432L,
  metadata_db_user = "rpkgs",
  metadata_db_password = Sys.getenv("PGPASS"),
  metadata_db_sslmode = "verify-full"
)

read_index <- function(index_url) {
  con <- gzcon(url(index_url, open = "rb"))
  on.exit(close(con), add = TRUE)
  read.dcf(con, fields = c("Package", "Version", "Built"))
}

flat <- read_index(sprintf(
  "https://cran.rpkgs.com/%s/%s/latest/src/contrib/PACKAGES.gz",
  arch,
  codename
))
# Source fallbacks have no binary to be unsafe, so skip them.
flat <- flat[!is.na(flat[, "Built"]), , drop = FALSE]

cran <- read.dcf(
  gzcon(url(
    "https://cloud.r-project.org/src/contrib/PACKAGES.gz",
    open = "rb"
  )),
  fields = c("Package", "NeedsCompilation")
)
compiled <- cran[
  !is.na(cran[, "NeedsCompilation"]) & cran[, "NeedsCompilation"] == "yes",
  "Package"
]

todo <- flat[flat[, "Package"] %in% compiled, , drop = FALSE]
cat(sprintf(
  "%s/%s: %d binaries in the flat index, %d compiled and due classification\n",
  arch,
  codename,
  nrow(flat),
  nrow(todo)
))
if (!is.na(limit) && limit > 0L && limit < nrow(todo)) {
  todo <- todo[seq_len(limit), , drop = FALSE]
  cat(sprintf("Limited to the first %d\n", limit))
}

sensitive <- 0L
failed <- 0L
for (i in seq_len(nrow(todo))) {
  pkg <- todo[i, "Package"]
  ver <- todo[i, "Version"]
  verdict <- tryCatch(
    do.call(
      bincraft::classify_r_minor_sensitive,
      c(list(package_name = pkg, tag = ver), db)
    ),
    error = function(e) {
      cat(sprintf("  %s %s: %s\n", pkg, ver, conditionMessage(e)))
      NA
    }
  )
  if (is.na(verdict)) {
    failed <- failed + 1L
  } else if (isTRUE(verdict)) {
    sensitive <- sensitive + 1L
  }
  if (i %% 250L == 0L) {
    cat(sprintf(
      "  classified %d/%d (%d r-minor-sensitive, %d failed)\n",
      i,
      nrow(todo),
      sensitive,
      failed
    ))
    utils::flush.console()
  }
}

cat(sprintf(
  "Done: %d classified, %d r-minor-sensitive, %d failed\n",
  nrow(todo),
  sensitive,
  failed
))