diff --git a/local/backfill-flat-safety.R b/local/backfill-flat-safety.R index fe23735..a8a8bbe 100644 --- a/local/backfill-flat-safety.R +++ b/local/backfill-flat-safety.R @@ -48,29 +48,56 @@ cat(sprintf( length(bincraft:::cross_minor_volatile_symbols(sets)) )) -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", "NeedsCompilation")) -} - -flat <- read_index(sprintf( - "https://cran.rpkgs.com/%s/%s/latest/src/contrib/PACKAGES.gz", +# The flat slot is listed from S3, not from PACKAGES.gz over HTTPS. Reading the +# index from inside R sends an R User-Agent, which the edge routes to a +# per-minor index; that enumerates union records carrying `Path: `, whose +# 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( + 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 -)) -# Source fallbacks carry no binary, so there is nothing to inspect. -flat <- flat[!is.na(flat[, "Built"]), , drop = FALSE] -compiled <- flat[ - !is.na(flat[, "NeedsCompilation"]) & flat[, "NeedsCompilation"] == "yes", - , - drop = FALSE +) +objects <- s3fs::s3_dir_ls(contrib, recurse = TRUE) +relative <- sub(sprintf("^(s3://)?%s/", contrib), "", objects) +# Flat objects only: no `/` prefix and nothing under Archive/. +flat_files <- relative[ + grepl("\\.tar\\.gz$", relative) & !grepl("/", relative, fixed = TRUE) ] +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( - "https://cran.rpkgs.com/%s/%s/latest/src/contrib", - arch, - codename -) +# Fetch from the bucket as well: the edge does not rewrite tarball requests, +# but it does cache them, and the object is what the verdict is about. 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( - sprintf("%s/%s_%s.tar.gz", base, pkg, ver), + s3fs::s3_file_download( + sprintf("%s/%s_%s.tar.gz", contrib, pkg, ver), tarball, - quiet = TRUE, - mode = "wb" + overwrite = TRUE ) - TRUE + file.exists(tarball) }, error = function(e) FALSE, warning = function(w) FALSE