fix(abi): prune flat-slot binaries of ABI-risky packages

upload_single_binary() writes an ABI-risky package only to the per-minor slot,
so a risky package should have no flat binary at all. Packages built before they
were classified risky still do, and the flat slot is what every client that
cannot be routed by R minor receives.

Such a binary was built under whichever R was primary at the time, so it fails
at load under any minor that has since dropped a symbol it uses. base64enc was
built under R 4.4.3, calls SETLENGTH, and R 4.6 no longer exports it:

  base64enc.so: undefined symbol: SETLENGTH

Deleting the flat object does not create a hole. The source fallback republishes
the CRAN source under the same key, so the package stays installable everywhere
and compiles against the client's own R, while routed clients keep getting the
per-minor binary.

This change will:

- add local/prune-stale-flat-binaries.R, dry run unless --apply, taking either
  an explicit package list or every package the classifier cache calls risky
- refuse to run on an empty risky set, which is indistinguishable from an
  unreachable cache and would report success having pruned nothing
- keep any object whose package CRAN no longer ships, since there would be no
  source to fall back to
- re-index and purge in the same run, because a published index naming deleted
  files serves 404s rather than the source fallback

local/prune-stale-flat-binaries.R

@@ -0,0 +1,136 @@
+### Remove flat-slot binaries of packages that are ABI-risky.
+#
+# Usage:
+#   Rscript local/prune-stale-flat-binaries.R <arch> <codename> [--apply] [pkg ...]
+#
+# `upload_single_binary()` writes an ABI-risky package only to the per-minor
+# slot, never to the flat one, so a risky package should have no flat binary at
+# all. Packages built before they were classified risky still do, and the flat
+# slot is what every client that cannot be routed by R minor receives. That
+# binary was built under whichever R was primary at the time, so it fails at
+# load under any minor that dropped a symbol it uses:
+#
+#   base64enc.so: undefined symbol: SETLENGTH
+#
+# Deleting the flat object does not create a hole: bincraft's source fallback
+# publishes the CRAN source under the same key, so the package stays installable
+# everywhere and compiles against the client's own R. Clients that are routed
+# keep getting the per-minor binary.
+#
+# Dry run by default. Nothing is deleted without --apply.
+
+options(error = function() {
+  cat("ERROR:", geterrmessage(), "\n", file = stdout())
+  traceback(2)
+  q(status = 1)
+})
+
+library(bincraft, quietly = TRUE)
+
+args <- commandArgs(trailingOnly = TRUE)
+apply_changes <- "--apply" %in% args
+args <- args[args != "--apply"]
+if (length(args) < 2L) {
+  stop(
+    "usage: prune-stale-flat-binaries.R <arch> <codename> [--apply] [pkg ...]",
+    call. = FALSE
+  )
+}
+arch <- args[[1L]]
+codename <- args[[2L]]
+explicit <- args[-c(1L, 2L)]
+
+bucket <- "devxy-rpkgs-binaries"
+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("%s/%s/%s/latest/src/contrib", bucket, arch, codename)
+objects <- s3fs::s3_dir_ls(contrib, recurse = TRUE)
+relative <- sub(sprintf("^(s3://)?%s/", contrib), "", objects)
+
+is_tarball <- grepl("\\.tar\\.gz$", relative)
+# Flat objects only: no `<minor>/` prefix and not under Archive/.
+is_flat <- is_tarball & !grepl("/", relative, fixed = TRUE)
+flat_files <- relative[is_flat]
+flat_pkg <- sub("_.*$", "", flat_files)
+
+if (length(explicit) > 0L) {
+  risky <- explicit
+  cat(sprintf("Restricted to %d named package(s)\n", length(risky)))
+} else {
+  risky <- bincraft:::abi_cache_risky_packages()
+  cat(sprintf("Classifier cache reports %d risky package(s)\n", length(risky)))
+  if (length(risky) == 0L) {
+    stop(
+      "The classifier cache returned nothing. Refusing to proceed: an empty risky set here is indistinguishable from an unreachable cache, and would silently prune nothing while reporting success.", # nolint
+      call. = FALSE
+    )
+  }
+}
+
+doomed <- flat_files[flat_pkg %in% risky]
+cat(sprintf(
+  "%s/%s: %d flat binaries, %d belong to ABI-risky packages\n",
+  arch,
+  codename,
+  length(flat_files),
+  length(doomed)
+))
+
+# Never remove the last artifact of a package. The source fallback republishes
+# the CRAN source under this key, but only for packages CRAN still ships, so
+# confirm the source exists before deleting the binary.
+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 = "Package")[, "Package"]
+  },
+  error = function(e) character(0)
+)
+if (length(cran) == 0L) {
+  stop("Could not read CRAN's index; refusing to prune blind.", call. = FALSE)
+}
+
+orphaned <- doomed[!(sub("_.*$", "", doomed) %in% cran)]
+if (length(orphaned) > 0L) {
+  cat(sprintf(
+    "Keeping %d object(s) whose package is no longer on CRAN, so there is no source to fall back to: %s\n",
+    length(orphaned),
+    paste(utils::head(orphaned, 5L), collapse = ", ")
+  ))
+  doomed <- setdiff(doomed, orphaned)
+}
+
+if (length(doomed) == 0L) {
+  cat("Nothing to prune.\n")
+  quit(status = 0)
+}
+
+for (f in doomed) {
+  cat(sprintf("  %s %s\n", if (apply_changes) "DELETE" else "would delete", f))
+}
+
+if (!apply_changes) {
+  cat(sprintf(
+    "\nDry run: %d object(s) left in place. Re-run with --apply to delete.\n",
+    length(doomed)
+  ))
+  quit(status = 0)
+}
+
+for (f in doomed) {
+  s3fs::s3_file_delete(file.path(contrib, f))
+}
+cat(sprintf(
+  "Deleted %d flat binary object(s). Re-index the slot so the source fallback republishes them.\n",
+  length(doomed)
+))