fix(abi): enumerate the flat slot from S3, not through the edge

Reading PACKAGES.gz over HTTPS from inside R sends an R User-Agent, which the
edge routes to a per-minor index. The script then enumerated union records
carrying `Path: <minor>`, whose objects do not exist at the flat path, so every
download 404'd: the first run skipped 292 of 300.

The bucket cannot be routed and is authoritative about which objects are
actually in the flat slot, so list and fetch from there.

local/backfill-flat-safety.R

@@ -48,29 +48,56 @@ cat(sprintf(
   length(bincraft:::cross_minor_volatile_symbols(sets))
 ))
 
-read_index <- function(index_url) {
+# The flat slot is listed from S3, not from PACKAGES.gz over HTTPS. Reading the
-  con <- gzcon(url(index_url, open = "rb"))
+# index from inside R sends an R User-Agent, which the edge routes to a
-  on.exit(close(con), add = TRUE)
+# per-minor index; that enumerates union records carrying `Path: <minor>`, whose
-  read.dcf(con, fields = c("Package", "Version", "Built", "NeedsCompilation"))
+# objects do not exist at the flat path. Every download then 404s: a first run
-}
+# skipped 292 of 300 that way. The bucket cannot be routed and is authoritative.
-
+s3fs::s3_file_system(
-flat <- read_index(sprintf(
+  aws_access_key_id = Sys.getenv("B2_S3_ACCESS_KEY"),
-  "https://cran.rpkgs.com/%s/%s/latest/src/contrib/PACKAGES.gz",
+  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
-))
+)
-# Source fallbacks carry no binary, so there is nothing to inspect.
+objects <- s3fs::s3_dir_ls(contrib, recurse = TRUE)
-flat <- flat[!is.na(flat[, "Built"]), , drop = FALSE]
+relative <- sub(sprintf("^(s3://)?%s/", contrib), "", objects)
-compiled <- flat[
+# Flat objects only: no `<minor>/` prefix and nothing under Archive/.
-  !is.na(flat[, "NeedsCompilation"]) & flat[, "NeedsCompilation"] == "yes",
+flat_files <- relative[
-  ,
+  grepl("\\.tar\\.gz$", relative) & !grepl("/", relative, fixed = TRUE)
-  drop = FALSE
 ]
+flat_pkg <- sub("_.*$", "", flat_files)
+flat_ver <- sub("\\.tar\\.gz$", "", sub("^[^_]*_", "", flat_files))
+
+# Only compiled packages can fail at dyn.load(), so the rest are not worth
+# downloading. CRAN's own index says which; it is not behind our edge.
+cran <- read.dcf(
+  gzcon(url(
+    "https://cloud.r-project.org/src/contrib/PACKAGES.gz",
+    open = "rb"
+  )),
+  fields = c("Package", "NeedsCompilation")
+)
+compiled_names <- cran[
+  !is.na(cran[, "NeedsCompilation"]) & cran[, "NeedsCompilation"] == "yes",
+  "Package"
+]
+keep <- flat_pkg %in% compiled_names
+compiled <- data.frame(
+  Package = flat_pkg[keep],
+  Version = flat_ver[keep],
+  stringsAsFactors = FALSE
+)
 cat(sprintf(
-  "%s/%s: %d flat binaries, %d compiled and worth inspecting\n",
+  "%s/%s: %d flat objects, %d compiled and worth inspecting\n",
   arch,
   codename,
-  nrow(flat),
+  length(flat_files),
   nrow(compiled)
 ))
 if (!is.na(limit) && limit > 0L && limit < nrow(compiled)) {
@@ -78,11 +105,8 @@ if (!is.na(limit) && limit > 0L && limit < nrow(compiled)) {
   cat(sprintf("Limited to the first %d\n", limit))
 }
 
-base <- sprintf(
+# Fetch from the bucket as well: the edge does not rewrite tarball requests,
-  "https://cran.rpkgs.com/%s/%s/latest/src/contrib",
+# but it does cache them, and the object is what the verdict is about.
-  arch,
-  codename
-)
 safe <- 0L
 unsafe <- 0L
 skipped <- 0L
@@ -92,13 +116,12 @@ for (i in seq_len(nrow(compiled))) {
   tarball <- file.path(tempdir(), sprintf("%s_%s.tar.gz", pkg, ver))
   ok <- tryCatch(
     {
-      utils::download.file(
+      s3fs::s3_file_download(
-        sprintf("%s/%s_%s.tar.gz", base, pkg, ver),
+        sprintf("%s/%s_%s.tar.gz", contrib, pkg, ver),
         tarball,
-        quiet = TRUE,
+        overwrite = TRUE
-        mode = "wb"
       )
-      TRUE
+      file.exists(tarball)
     },
     error = function(e) FALSE,
     warning = function(w) FALSE