build-cran-binaries/local/list-unsafe-flat-objects.R

### Print the flat-slot objects recorded as unable to load under some R minor.
#
# Usage: Rscript local/list-unsafe-flat-objects.R <arch> <codename>
#
# Prints one `<package> <version>` per line, for a caller that rebuilds each
# under every installed R minor.
#
# The verdicts come from `abi_flat_safety`, written by the flat-safety backfill
# from the binaries themselves: an object is unsafe when it references a symbol
# some supported minor does not export. That is the authoritative list of what
# needs a per-minor build, and it replaces the ad-hoc symbol scans that produced
# earlier repair lists.

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

args <- commandArgs(trailingOnly = TRUE)
if (length(args) < 2L) {
  stop("usage: list-unsafe-flat-objects.R <arch> <codename>", call. = FALSE)
}
arch <- args[[1L]]
codename <- args[[2L]]

con <- DBI::dbConnect(
  RPostgres::Postgres(),
  dbname = "build_metadata",
  host = "r-binaries.devxy.io",
  port = 15432L,
  user = "rpkgs",
  password = Sys.getenv("PGPASS"),
  sslmode = "require"
)
on.exit(try(DBI::dbDisconnect(con), silent = TRUE), add = TRUE)

rows <- DBI::dbGetQuery(
  con,
  paste0(
    "SELECT package, version, unsupported FROM abi_flat_safety ",
    "WHERE NOT safe AND codename = $1 AND arch = $2 ",
    "ORDER BY package, version"
  ),
  params = list(codename, arch)
)

# Drop what is already repaired. The verdict describes the *flat* object, and a
# per-minor build does not change it, so a resumed run would otherwise rebuild
# everything it did last time: ~2500 objects of duplicated compute after the
# first fleet run was interrupted.
#
# An object is repaired once a per-minor build exists for every minor that
# cannot load the flat one. The bucket is the source of truth for that, and it
# cannot be routed.
if (nrow(rows) > 0L) {
  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
  )
  contrib <- sprintf(
    "devxy-rpkgs-binaries/%s/%s/latest/src/contrib",
    arch,
    codename
  )
  objects <- tryCatch(
    s3fs::s3_dir_ls(contrib, recurse = TRUE),
    error = function(e) character(0)
  )
  if (length(objects) == 0L) {
    stop(
      sprintf(
        "Could not list %s; refusing to guess what is already repaired.",
        contrib
      ),
      call. = FALSE
    )
  }
  present <- sub(sprintf("^(s3://)?%s/", contrib), "", objects)

  # No recorded minors means unsafe without a reason, so require a build under
  # every minor the image carries rather than assume one is enough.
  installed <- sub(
    "^([0-9]+[.][0-9]+).*$",
    "\\1",
    basename(list.dirs("/opt/R", recursive = FALSE))
  )
  installed <- unique(installed[grepl("^[0-9]+[.][0-9]+$", installed)])

  repaired <- vapply(
    seq_len(nrow(rows)),
    function(i) {
      u <- rows$unsupported[[i]]
      minors <- if (is.na(u) || !nzchar(u)) {
        installed
      } else {
        trimws(strsplit(u, ",", fixed = TRUE)[[1L]])
      }
      if (length(minors) == 0L) {
        return(FALSE)
      }
      wanted <- sprintf(
        "%s/%s_%s.tar.gz",
        minors,
        rows$package[[i]],
        rows$version[[i]]
      )
      all(wanted %in% present)
    },
    logical(1L)
  )
  if (any(repaired)) {
    message(sprintf(
      "%s/%s: %d of %d already have per-minor builds for every minor that needs one; skipping those.",
      arch,
      codename,
      sum(repaired),
      nrow(rows)
    ))
  }
  rows <- rows[!repaired, , drop = FALSE]
}

# An empty result is ambiguous: either nothing is unsafe, or the backfill never
# ran for this slot. Say which, rather than let the caller read silence as done.
if (nrow(rows) == 0L) {
  total <- DBI::dbGetQuery(
    con,
    "SELECT count(*) AS n FROM abi_flat_safety WHERE codename = $1 AND arch = $2",
    params = list(codename, arch)
  )$n[[1L]]
  if (total == 0L) {
    stop(
      sprintf(
        "No verdicts recorded for %s/%s at all. Run the flat-safety backfill first; an empty repair list here would look like success.", # nolint
        arch,
        codename
      ),
      call. = FALSE
    )
  }
  message(sprintf(
    "%s/%s: %d objects recorded, none unsafe. Nothing to repair.",
    arch,
    codename,
    total
  ))
  quit(status = 0)
}

message(sprintf(
  "%s/%s: %d objects need a per-minor build",
  arch,
  codename,
  nrow(rows)
))
cat(sprintf("%s %s", rows$package, rows$version), sep = "\n")