From cdfdcd035d72c4bfbfe074d2a243010be865e18c Mon Sep 17 00:00:00 2001 From: pat-s Date: Sat, 24 Oct 2026 01:58:25 +0000 Subject: [PATCH] perf: seed pure-R binaries into a new slot, interleave shards, and stop builds before the timeout - Add local/seed-pure-r.R, opt-in via SEED_FROM on install-deps: copy pure-R binaries server-side from a slot of the same OS family and arch, after verifying each is a binary, has no compiled code, was built by the primary R minor, and passes bincraft's cross-minor ABI check; write the single_builds and abi_flat_safety rows an upload would. - Interleave build-all shards with shard_slice() instead of contiguous alphabetical blocks, which ranged from 0.1h to 28h per shard. - Share one BUILD_DEADLINE (BUILD_BUDGET_HOURS, default 44h) across every build pass of a build-all-versions step so long runs stop cleanly and still archive and index what they built. - Derive the single_builds platform with codename_platform() instead of a hard-coded list. --- .crow/build-all-versions-install-deps.yaml | 8 + .crow/build-all-versions.yaml | 7 + local/build-all.R | 94 +++--- local/build-newer-r.R | 10 + local/r-minor-helpers.R | 30 ++ local/seed-helpers.R | 162 +++++++++++ local/seed-pure-r.R | 323 +++++++++++++++++++++ local/tests/test-r-minor-helpers.R | 17 ++ local/tests/test-seed-helpers.R | 126 ++++++++ 9 files changed, 726 insertions(+), 51 deletions(-) create mode 100644 local/seed-helpers.R create mode 100644 local/seed-pure-r.R create mode 100644 local/tests/test-seed-helpers.R diff --git a/.crow/build-all-versions-install-deps.yaml b/.crow/build-all-versions-install-deps.yaml index e3f652e..c092c7a 100644 --- a/.crow/build-all-versions-install-deps.yaml +++ b/.crow/build-all-versions-install-deps.yaml @@ -36,6 +36,13 @@ variables: - 4.5.3 - 4.4.3 default: 4.5.3 + SEED_FROM: + # Only for bootstrapping a new slot. Copies the pure-R binaries of these + # slots (same OS family and arch, same primary R minor; see + # local/seed-pure-r.R) before the build list is computed, so build-all only + # compiles what actually needs compiling. Space-separated, first wins. + description: 'Existing slots to copy pure-R binaries from, e.g. "alpine324 alpine323". Empty: no seeding.' + default: '' when: - event: manual @@ -88,6 +95,7 @@ steps: - /opt/R/$R_VERSION/bin/Rscript local/install-bincraft.R - UVR_R_BIN=/opt/R/$R_VERSION/bin/R local/uvr-install.sh RPostgres s3fs data.table future jsonlite purrr - /opt/R/$R_VERSION/bin/R -q -e 'packageVersion("bincraft")' + - if [ -n "${SEED_FROM}" ]; then /opt/R/$R_VERSION/bin/Rscript local/seed-pure-r.R ${SEED_FROM}; fi - /opt/R/$R_VERSION/bin/R -q -e "source('local/packages-to-build.R'); saveRDS(pkgs, '/mnt/cache/packages/pkgs_to_build.rds'); saveRDS(pkgs[r_minor_sensitive == TRUE], '/mnt/cache/packages/r_minor_sensitive_pkgs.rds'); sprintf('Precomputed %s package versions (%s r-minor-sensitive)', nrow(pkgs), nrow(pkgs[r_minor_sensitive == TRUE]))" backend_options: docker: diff --git a/.crow/build-all-versions.yaml b/.crow/build-all-versions.yaml index 8e3e830..ae5cd89 100644 --- a/.crow/build-all-versions.yaml +++ b/.crow/build-all-versions.yaml @@ -136,11 +136,18 @@ steps: R_LIBS_USER: /mnt/cache/R-pkgs CCACHE_DIR: /mnt/cache/ccache NCPUS: 2 + # Whole hours the build passes below may use, measured from the step's + # start. The repo timeout is 50h; the remainder is left for archiving the + # missed packages, so a long run ends cleanly instead of being killed. + BUILD_BUDGET_HOURS: 44 volumes: - ${ARCH}-binaries-r-dep-cache-${OS}-${OS_VERSION//./}:/mnt/cache commands: - git clone -q https://pat-s:$$REPO_RO_TOKEN@git.devxy.io/devxy/build-cran-binaries.git . - . local/compiler-cache.sh + # One deadline shared by every build pass in this step, read by + # local/build-all.R and local/build-newer-r.R before each package. + - export BUILD_DEADLINE=$(( $(date +%s) + BUILD_BUDGET_HOURS * 3600 )) - mkdir -p /mnt/cache/uvr/cache /mnt/cache/uvr/packages /mnt/cache/R-pkgs /mnt/cache/ccache /mnt/cache/packages # The primary pass must not rely on build-all-versions-install-deps having # run on *this* agent: depends_on only orders the steps, but the cache diff --git a/local/build-all.R b/local/build-all.R index bd1aefb..04d382f 100644 --- a/local/build-all.R +++ b/local/build-all.R @@ -1,6 +1,7 @@ sink(stdout(), type = "message") options(crayon.enabled = TRUE, future.globals.onReference = NULL) source(file.path("local", "r-minor-helpers.R")) +source(file.path("local", "rebuild-missing-helpers.R")) args <- commandArgs(trailingOnly = TRUE) parsed <- parse_build_args(args) @@ -104,9 +105,10 @@ sprintf( sensitive_only ) -# Split into chunks for this worker -chunks <- split(pkgs, cut(seq_len(nrow(pkgs)), split_into, labels = FALSE)) -chunk <- chunks[[split_index]] +# Interleave rather than cut the alphabetical list into contiguous blocks: build +# cost clusters by name (Rcpp*, rstan*), and contiguous quarters of the last +# full rebuild ran anywhere from 0.1h to 28h. +chunk <- pkgs[shard_slice(seq_len(nrow(pkgs)), split_into, split_index), ] sprintf("# of package versions for this job: %s", nrow(chunk)) # Exclude known problematic packages (single source of truth) @@ -126,23 +128,7 @@ chunk <- chunk[!chunk$Package %in% exclude, ] # environment, so Sys.getenv() would return "" and this pre-filter would query # platform "-" and skip nothing. codename <- bincraft::set_codename(NULL) -platform <- switch( - codename, - jammy = "ubuntu-2204", - noble = "ubuntu-2404", - resolute = "ubuntu-2604", - rhel10 = "redhat-10", - rhel9 = "redhat-9", - rhel8 = "redhat-8", - alpine320 = "alpine-320", - alpine321 = "alpine-321", - alpine322 = "alpine-322", - alpine323 = "alpine-323", - alpine324 = "alpine-324", - alpine325 = "alpine-325", - alpine326 = "alpine-326", - NA_character_ -) +platform <- codename_platform(codename) local_machine <- Sys.info()[["machine"]] arch <- if (grepl("arm64|aarch64", local_machine)) "arm64" else "amd64" con <- DBI::dbConnect( @@ -232,35 +218,41 @@ sprintf( length(s3_cache_paths) ) +deadline <- build_deadline() n <- nrow(chunk) -mapply( - function(pkg, ver, sens, i) { - cat(sprintf("[%d/%d] %s_%s (r_minor_sensitive=%s)\n", i, n, pkg, ver, sens)) - bincraft::build_binary_package( - pkg, - tag = ver, - is_r_minor_sensitive = isTRUE(sens), - s3_endpoint = "https://s3.eu-central-003.backblazeb2.com", - s3_region = "eu-central-003", - s3_bucket = "devxy-rpkgs-binaries", - s3_access_key_id = Sys.getenv("B2_S3_ACCESS_KEY"), - s3_secret_access_key = Sys.getenv("B2_S3_SECRET_KEY"), - s3_package_cache = s3_cache, - metadata_db_host = "r-binaries.devxy.io", - metadata_db_name = "build_metadata", - metadata_db_table = "single_builds", - metadata_db_user = "rpkgs", - metadata_db_password = Sys.getenv("PGPASS"), - metadata_db_sslmode = "verify-full", - metadata_db_port = 15432, - archive = TRUE, - patches = "local/patches", - upload = TRUE, - store_build_metadata = TRUE - ) - }, - chunk$Package, - chunk$Version, - chunk$r_minor_sensitive, - seq_len(n) -) +for (i in seq_len(n)) { + if (deadline_reached(deadline)) { + cat(sprintf( + "Build deadline reached after %d/%d package versions; stopping cleanly. The next run resumes from the metadata DB.\n", + i - 1L, + n + )) + break + } + pkg <- chunk$Package[i] + ver <- chunk$Version[i] + sens <- chunk$r_minor_sensitive[i] + cat(sprintf("[%d/%d] %s_%s (r_minor_sensitive=%s)\n", i, n, pkg, ver, sens)) + bincraft::build_binary_package( + pkg, + tag = ver, + is_r_minor_sensitive = isTRUE(sens), + s3_endpoint = "https://s3.eu-central-003.backblazeb2.com", + s3_region = "eu-central-003", + s3_bucket = "devxy-rpkgs-binaries", + s3_access_key_id = Sys.getenv("B2_S3_ACCESS_KEY"), + s3_secret_access_key = Sys.getenv("B2_S3_SECRET_KEY"), + s3_package_cache = s3_cache, + metadata_db_host = "r-binaries.devxy.io", + metadata_db_name = "build_metadata", + metadata_db_table = "single_builds", + metadata_db_user = "rpkgs", + metadata_db_password = Sys.getenv("PGPASS"), + metadata_db_sslmode = "verify-full", + metadata_db_port = 15432, + archive = TRUE, + patches = "local/patches", + upload = TRUE, + store_build_metadata = TRUE + ) +} diff --git a/local/build-newer-r.R b/local/build-newer-r.R index a66e5ee..05ffba0 100644 --- a/local/build-newer-r.R +++ b/local/build-newer-r.R @@ -1,5 +1,6 @@ source(file.path("local", "newer-r-helpers.R")) source(file.path("local", "rebuild-missing-helpers.R")) +source(file.path("local", "r-minor-helpers.R")) args <- commandArgs(trailingOnly = TRUE) pos <- args[!startsWith(args, "--")] @@ -117,7 +118,16 @@ if ("--dry-run" %in% args) { )) options(crayon.enabled = TRUE, Ncpus = 4, future.globals.onReference = NULL) + deadline <- build_deadline() for (i in seq_len(nrow(pkgs))) { + if (deadline_reached(deadline)) { + message(sprintf( + "Build deadline reached after %d/%d package(s); stopping cleanly.", + i - 1L, + nrow(pkgs) + )) + break + } message(sprintf( "[%d/%d] %s %s", i, diff --git a/local/r-minor-helpers.R b/local/r-minor-helpers.R index 65aafdf..b031265 100644 --- a/local/r-minor-helpers.R +++ b/local/r-minor-helpers.R @@ -31,3 +31,33 @@ parse_build_args <- function(args) { ncpus = as.integer(pos[3L]) ) } + +# The `single_builds` platform name for a bincraft codename, e.g. alpine324 -> +# "alpine-324", rhel9 -> "redhat-9". NA for a codename this repo does not build. +codename_platform <- function(codename) { + ubuntu <- c(jammy = "2204", noble = "2404", resolute = "2604") + if (codename %in% names(ubuntu)) { + return(paste0("ubuntu-", ubuntu[[codename]])) + } + if (grepl("^rhel[0-9]+$", codename)) { + return(sub("^rhel", "redhat-", codename)) + } + if (grepl("^alpine[0-9]+$", codename)) { + return(sub("^alpine", "alpine-", codename)) + } + NA_character_ +} + +# The wall-clock deadline a build loop must stop at, from BUILD_DEADLINE (epoch +# seconds). The pipeline sets it once per step, so every pass in the step shares +# one budget and the steps after the builds (archiving, the index upload) still +# get to run before Crow's timeout kills the step. Unset or unparsable means no +# deadline. +build_deadline <- function(value = Sys.getenv("BUILD_DEADLINE", unset = "")) { + deadline <- suppressWarnings(as.numeric(value)) + if (length(deadline) != 1L || is.na(deadline)) Inf else deadline +} + +deadline_reached <- function(deadline, now = as.numeric(Sys.time())) { + now >= deadline +} diff --git a/local/seed-helpers.R b/local/seed-helpers.R new file mode 100644 index 0000000..a3d8e57 --- /dev/null +++ b/local/seed-helpers.R @@ -0,0 +1,162 @@ +# Pure helpers for local/seed-pure-r.R, kept separate so local/tests can source +# them without touching S3 or the metadata DB. + +# "alpine" for alpine324, "rhel" for rhel9. Seeding only ever crosses versions +# within one family: a pure-R binary has no compiled code, but install-time R +# code can still capture the build system's paths and tools. +codename_family <- function(codename) { + sub("[0-9]+$", "", codename) +} + +per_minor_key <- function(keys) { + grepl("^[0-9]+\\.[0-9]+/", keys) +} + +# Split `_.tar.gz` file names; NA where a name does not parse. +split_tarball_name <- function(files) { + m <- regmatches(files, regexec("^([A-Za-z0-9.]+)_([^_]+)\\.tar\\.gz$", files)) + part <- function(i) { + vapply(m, function(x) if (length(x) == 3L) x[[i]] else NA_character_, "") + } + list(package = part(2L), version = part(3L)) +} + +# Donor objects worth downloading and verifying for the target slot. +# +# `donor_keys`/`donor_etags` describe the donor slot, keys relative to its +# contrib dir (`curl_5.0.tar.gz`, `Archive/curl/curl_4.3.tar.gz`). +# `target_keys` are the target slot's keys, same form. +# `release_pkgs` packages on CRAN now; the build scope. +# `compiled_pkgs` packages whose current CRAN release needs compilation. Their +# archive versions are skipped as well: a seed only saves time, so guessing +# wrong in this direction costs a build, never a broken binary. +# `cran_md5` CRAN's MD5 per `_`. An ETag equal to it is CRAN's source +# tarball served as a fallback, never a binary worth copying. +# +# Anything already present in the target, under any non-per-minor key, is left +# alone: that is either a build or an earlier seed. +seed_candidates <- function( + donor_keys, + donor_etags, + target_keys, + release_pkgs, + compiled_pkgs, + cran_md5, + exclude = character() +) { + files <- basename(donor_keys) + parsed <- split_tarball_name(files) + md5 <- if (length(cran_md5) == 0L) { + rep(NA_character_, length(files)) + } else { + unname(cran_md5[paste(parsed$package, parsed$version, sep = "_")]) + } + is_source <- !is.na(md5) & !is.na(donor_etags) & donor_etags == md5 + present <- basename(target_keys[!per_minor_key(target_keys)]) + + keep <- !is.na(parsed$package) & + !per_minor_key(donor_keys) & + parsed$package %in% release_pkgs & + !parsed$package %in% compiled_pkgs & + !parsed$package %in% exclude & + !files %in% present & + !is_source + out <- data.frame( + key = donor_keys, + package = parsed$package, + version = parsed$version, + stringsAsFactors = FALSE + )[keep, , drop = FALSE] + # The same version can sit both flat and under Archive/ while the donor waits + # for process_unarchived_pkgs(); copy it once, flat first. + out <- out[order(grepl("^Archive/", out$key)), , drop = FALSE] + out <- out[!duplicated(basename(out$key)), , drop = FALSE] + rownames(out) <- NULL + out +} + +# `Built: R 4.5.3; ; 2026-09-01 10:00:00 UTC; unix` -> R version and platform. +# The platform is empty exactly when the package has no compiled code. +parse_built <- function(built) { + parts <- trimws(strsplit(built, ";", fixed = TRUE)[[1L]]) + list( + r_version = sub("^R\\s+", "", parts[1L]), + platform = if (length(parts) >= 2L) parts[2L] else NA_character_ + ) +} + +# Whether one downloaded donor tarball may be published in the target slot. +# +# Every check has to pass; anything unreadable is a refusal, never a guess, +# because a refusal only means the package gets built the normal way. +# * it is a binary: DESCRIPTION carries a `Built` field (a CRAN source +# fallback does not); +# * it has no compiled code: empty `Built` platform and no libs/ directory; +# * it was built by the target's primary R minor, the one whose binaries the +# flat slot holds; +# * `abi_verdict` (bincraft's upload-time symbol inspection) calls it portable +# across every installed minor, exactly the decision a fresh upload would +# make before writing to the flat slot. +seed_verdict <- function(tarball, package, version, target_minor, abi_verdict) { + reject <- function(reason) { + list(seed = FALSE, reason = reason, unsupported = character()) + } + read_members <- function() { + tryCatch( + utils::untar(tarball, list = TRUE), + error = function(e) NULL, + warning = function(w) NULL + ) + } + members <- read_members() + if (is.null(members)) { + return(reject("unreadable")) + } + desc <- paste0(package, "/DESCRIPTION") + if (!desc %in% members) { + return(reject("unreadable")) + } + if (any(startsWith(members, paste0(package, "/libs/")))) { + return(reject("compiled")) + } + + dir <- tempfile("seed_desc_") + on.exit(unlink(dir, recursive = TRUE, force = TRUE), add = TRUE) + fields <- tryCatch( + { + utils::untar(tarball, files = desc, exdir = dir) + read.dcf( + file.path(dir, desc), + fields = c("Package", "Version", "Built") + ) + }, + error = function(e) NULL, + warning = function(w) NULL + ) + if (is.null(fields) || nrow(fields) != 1L) { + return(reject("unreadable")) + } + if ( + !identical(unname(fields[1L, "Package"]), package) || + !identical(unname(fields[1L, "Version"]), version) + ) { + return(reject("mismatch")) + } + if (is.na(fields[1L, "Built"])) { + return(reject("source")) + } + built <- parse_built(fields[1L, "Built"]) + if (is.na(built$platform) || nzchar(built$platform)) { + return(reject("compiled")) + } + built_minor <- sub("^(\\d+\\.\\d+).*$", "\\1", built$r_version) + if (!identical(built_minor, target_minor)) { + return(reject("r-minor")) + } + + verdict <- abi_verdict(tarball) + if (!isTRUE(verdict$inspected) || !identical(verdict$sensitive, FALSE)) { + return(reject("abi")) + } + list(seed = TRUE, reason = "seeded", unsupported = verdict$unsupported) +} diff --git a/local/seed-pure-r.R b/local/seed-pure-r.R new file mode 100644 index 0000000..4268224 --- /dev/null +++ b/local/seed-pure-r.R @@ -0,0 +1,323 @@ +# Seed a new slot with the pure-R binaries of an existing one. +# +# Usage: Rscript local/seed-pure-r.R DONOR [DONOR...] [--workers=N] [--dry-run] +# e.g. Rscript local/seed-pure-r.R alpine324 alpine323 +# +# Three quarters of the versions a full rebuild targets have no compiled code. +# Building one costs about 20s, nearly all of it dependency installs and +# bookkeeping, and the result is the same R objects every other slot already +# serves: R6 2.6.1 deparses identically on amd64/alpine323, amd64/alpine324 and +# arm64/rhel9. Copying those from a slot of the same OS family and arch saves +# roughly 340 shard-hours per arch and leaves build-all with the compiled rest. +# +# Each candidate is downloaded and checked before it is copied server-side (see +# seed_verdict()): a binary, no compiled code, built by this image's primary R +# minor, and portable across every installed minor by bincraft's own symbol +# inspection. A seeded object then gets the two metadata rows an upload would +# have written: a successful `single_builds` row, so build-all skips it, and an +# `abi_flat_safety` row, without which the per-minor indexes drop it. +# +# Donors are tried in order; the first one with a valid binary wins. Re-running +# is safe: whatever the target already holds is skipped, and the metadata rows +# of earlier copies are re-written idempotently. + +source(file.path("local", "seed-helpers.R")) +source(file.path("local", "r-minor-helpers.R")) + +args <- commandArgs(trailingOnly = TRUE) +donors <- args[!startsWith(args, "--")] +if (length(donors) == 0L) { + stop("Usage: seed-pure-r.R DONOR [DONOR...] [--workers=N] [--dry-run]") +} +dry_run <- "--dry-run" %in% args +workers_arg <- sub("^--workers=", "", grep("^--workers=", args, value = TRUE)) +workers <- if (length(workers_arg)) as.integer(workers_arg[1L]) else 8L +batch_size <- 400L + +local_machine <- Sys.info()[["machine"]] +arch <- if (grepl("arm64|aarch64", local_machine)) "arm64" else "amd64" +target <- bincraft::set_codename(NULL) +platform <- codename_platform(target) +target_minor <- paste( + R.version$major, + strsplit(R.version$minor, ".", fixed = TRUE)[[1L]][1L], + sep = "." +) +for (donor in donors) { + if (identical(donor, target)) { + stop(sprintf("Donor %s is the target slot itself", donor)) + } + if (!identical(codename_family(donor), codename_family(target))) { + stop(sprintf( + "Donor %s is not an %s slot; seeding only copies within one OS family", + donor, + codename_family(target) + )) + } +} +if (is.na(platform)) { + stop(sprintf("No single_builds platform name for codename %s", target)) +} + +# Computed once: bincraft would otherwise run nm over every libR per tarball. +symbol_sets <- bincraft:::installed_r_symbol_sets() +if (is.null(symbol_sets)) { + stop( + "Fewer than two R minors under /opt/R; ABI portability cannot be ", + "verified, so nothing is seeded" + ) +} +message(sprintf( + "Seeding %s/%s (R %s) from %s; ABI checked against R %s", + arch, + target, + target_minor, + paste(donors, collapse = ", "), + paste(names(symbol_sets), collapse = ", ") +)) + +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 +) +slot_dir <- function(codename) { + sprintf("devxy-rpkgs-binaries/%s/%s/latest/src/contrib", arch, codename) +} +# Keys relative to the contrib dir with unquoted ETags. A listing failure is +# fatal: an empty target listing would mean re-copying everything. +list_slot <- function(codename) { + info <- s3fs::s3_dir_info(slot_dir(codename), recurse = TRUE) + uri <- as.character(info$uri) + is_tarball <- grepl("\\.tar\\.gz$", uri) + data.frame( + key = sub( + sprintf("^(s3://)?%s/", slot_dir(codename)), + "", + uri[is_tarball] + ), + etag = gsub('^"|"$', "", as.character(info$etag[is_tarball])), + stringsAsFactors = FALSE + ) +} + +cran <- tools::CRAN_package_db() +compiled_pkgs <- cran$Package[tolower(cran$NeedsCompilation) %in% "yes"] +cran_md5 <- bincraft:::cran_source_md5() +exclude <- jsonlite::fromJSON("local/excluded-packages.json")[["package"]] + +db_connect <- function() { + DBI::dbConnect( + RPostgres::Postgres(), + dbname = "build_metadata", + host = "r-binaries.devxy.io", + port = 15432, + user = "rpkgs", + password = Sys.getenv("PGPASS"), + sslmode = "verify-full", + sslrootcert = bincraft::postgres_sslrootcert("verify-full") + ) +} + +# The rows an upload would have written for these objects. Idempotent, so a +# re-run can repair rows a failed write left out. Pure-R objects reference no R +# symbols, hence an empty `unsupported`. +record_seeded <- function(packages, versions) { + if (length(packages) == 0L) { + return(invisible(TRUE)) + } + ok <- tryCatch( + { + con <- db_connect() + on.exit(DBI::dbDisconnect(con), add = TRUE) + bincraft:::ensure_flat_safety_table(con, "abi_flat_safety") + DBI::dbWithTransaction(con, { + DBI::dbWriteTable( + con, + "seed_rows", + data.frame( + name = packages, + tag = versions, + stringsAsFactors = FALSE + ), + temporary = TRUE, + overwrite = TRUE + ) + DBI::dbExecute( + con, + paste( + "INSERT INTO single_builds (name, tag, platform, arch,", + "error_occurred, error_text, size, timestamp, duration, removed,", + "r_version)", + "SELECT s.name, s.tag, $1, $2, FALSE, NULL, NULL, now(), NULL,", + "FALSE, $3 FROM seed_rows s WHERE NOT EXISTS (SELECT 1 FROM", + "single_builds b WHERE b.name = s.name AND b.tag = s.tag", + "AND b.platform = $1 AND b.arch = $2 AND b.r_version = $3)" + ), + params = list(platform, arch, target_minor) + ) + DBI::dbExecute( + con, + paste( + "INSERT INTO abi_flat_safety (package, version, codename, arch,", + "safe, unsupported) SELECT s.name, s.tag, $1, $2, TRUE, ''", + "FROM seed_rows s ON CONFLICT (package, version, codename, arch)", + "DO UPDATE SET safe = EXCLUDED.safe,", + "unsupported = EXCLUDED.unsupported, checked_at = now()" + ), + params = list(target, arch) + ) + }) + TRUE + }, + error = function(e) { + message(sprintf( + "WARNING: could not record %d seeded object(s): %s. Re-run to repair.", + length(packages), + conditionMessage(e) + )) + FALSE + } + ) + invisible(ok) +} + +target_listing <- list_slot(target) +message(sprintf("Target %s holds %d tarball(s)", target, nrow(target_listing))) + +future::plan(future::multisession, workers = workers) +tally <- integer() +count <- function(reasons) { + for (r in reasons) { + tally[[r]] <<- (if (is.na(tally[r])) 0L else tally[[r]]) + 1L + } +} + +for (donor in donors) { + donor_listing <- list_slot(donor) + + # Byte-identical copies an earlier run made: make sure their rows exist. + same <- merge(donor_listing, target_listing, by = c("key", "etag")) + same <- same[!per_minor_key(same$key), , drop = FALSE] + parsed <- split_tarball_name(basename(same$key)) + ours <- !is.na(parsed$package) & !parsed$package %in% compiled_pkgs + if (any(ours) && !dry_run) { + record_seeded(parsed$package[ours], parsed$version[ours]) + } + + candidates <- seed_candidates( + donor_listing$key, + donor_listing$etag, + target_listing$key, + cran$Package, + compiled_pkgs, + cran_md5, + exclude + ) + message(sprintf( + "%s: %d tarball(s), %d candidate(s) after the metadata filters", + donor, + nrow(donor_listing), + nrow(candidates) + )) + if (dry_run || nrow(candidates) == 0L) { + next + } + + batches <- split( + seq_len(nrow(candidates)), + ceiling(seq_len(nrow(candidates)) / batch_size) + ) + for (b in seq_along(batches)) { + batch <- candidates[batches[[b]], , drop = FALSE] + dl_dir <- tempfile("seed_") + dir.create(dl_dir) + local_files <- file.path(dl_dir, basename(batch$key)) + downloaded <- tryCatch( + { + s3fs::s3_file_download( + file.path(slot_dir(donor), batch$key), + local_files, + overwrite = TRUE + ) + TRUE + }, + error = function(e) { + message(sprintf( + "Batch %d: download failed (%s); leaving it to build-all", + b, + conditionMessage(e) + )) + FALSE + } + ) + if (!downloaded) { + count(rep("download-failed", nrow(batch))) + unlink(dl_dir, recursive = TRUE) + next + } + + verdicts <- future.apply::future_lapply( + seq_len(nrow(batch)), + function(i) { + seed_verdict( + local_files[i], + batch$package[i], + batch$version[i], + target_minor, + function(t) bincraft:::tarball_abi_verdict(t, symbol_sets) + ) + }, + future.seed = NULL + ) + unlink(dl_dir, recursive = TRUE) + seed <- vapply(verdicts, function(v) isTRUE(v$seed), logical(1L)) + count(vapply(verdicts, function(v) v$reason, "")) + + if (any(seed)) { + copied <- tryCatch( + { + s3fs::s3_file_copy( + paste0("s3://", file.path(slot_dir(donor), batch$key[seed])), + paste0("s3://", file.path(slot_dir(target), batch$key[seed])), + overwrite = TRUE + ) + TRUE + }, + error = function(e) { + message(sprintf( + "Batch %d: copy failed (%s); leaving it to build-all", + b, + conditionMessage(e) + )) + FALSE + } + ) + if (copied) { + record_seeded(batch$package[seed], batch$version[seed]) + target_listing <- rbind( + target_listing, + data.frame(key = batch$key[seed], etag = NA_character_) + ) + } else { + count(rep("copy-failed", sum(seed))) + tally[["seeded"]] <- tally[["seeded"]] - sum(seed) + } + } + message(sprintf( + "%s batch %d/%d: %d of %d seeded", + donor, + b, + length(batches), + sum(seed), + nrow(batch) + )) + } +} + +message( + "Seed summary: ", + paste(sprintf("%s=%d", names(tally), tally), collapse = ", ") +) diff --git a/local/tests/test-r-minor-helpers.R b/local/tests/test-r-minor-helpers.R index ac7b0a6..2beb6c1 100644 --- a/local/tests/test-r-minor-helpers.R +++ b/local/tests/test-r-minor-helpers.R @@ -26,3 +26,20 @@ test_that("compiled but no risky LinkingTo is ambiguous (needs source)", { ) expect_identical(classify_from_metadata("yes", NA, c("Rcpp")), "ambiguous") }) + +test_that("codename_platform names the single_builds platform", { + expect_identical(codename_platform("alpine325"), "alpine-325") + expect_identical(codename_platform("rhel9"), "redhat-9") + expect_identical(codename_platform("noble"), "ubuntu-2404") + expect_identical(codename_platform("resolute"), "ubuntu-2604") + expect_identical(codename_platform("bogus"), NA_character_) +}) + +test_that("build_deadline reads BUILD_DEADLINE and defaults to none", { + expect_identical(build_deadline(""), Inf) + expect_identical(build_deadline("not a number"), Inf) + expect_identical(build_deadline("1700000000"), 1700000000) + expect_false(deadline_reached(Inf)) + expect_true(deadline_reached(100, now = 100)) + expect_false(deadline_reached(100, now = 99)) +}) diff --git a/local/tests/test-seed-helpers.R b/local/tests/test-seed-helpers.R new file mode 100644 index 0000000..87fdd6a --- /dev/null +++ b/local/tests/test-seed-helpers.R @@ -0,0 +1,126 @@ +source(file.path("..", "seed-helpers.R")) + +# A minimal tarball laid out like R CMD INSTALL --build output. +make_tarball <- function( + package = "R6", + version = "2.6.1", + built = "R 4.5.3; ; 2026-09-01 10:00:00 UTC; unix", + libs = FALSE +) { + root <- tempfile("pkg_") + dir.create(file.path(root, package, "R"), recursive = TRUE) + fields <- c(Package = package, Version = version) + if (!is.na(built)) { + fields <- c(fields, Built = built) + } + write.dcf(t(fields), file.path(root, package, "DESCRIPTION")) + writeLines("", file.path(root, package, "R", package)) + if (libs) { + dir.create(file.path(root, package, "libs")) + writeLines("", file.path(root, package, "libs", paste0(package, ".so"))) + } + tarball <- tempfile(fileext = ".tar.gz") + old <- setwd(root) + on.exit(setwd(old), add = TRUE) + utils::tar(tarball, package, compression = "gzip", tar = "internal") + tarball +} + +portable <- function(t) { + list(inspected = TRUE, sensitive = FALSE, unsupported = character()) +} + +test_that("seed_verdict accepts a pure-R binary from the target minor", { + v <- seed_verdict(make_tarball(), "R6", "2.6.1", "4.5", portable) + expect_true(v$seed) + expect_identical(v$reason, "seeded") +}) + +test_that("seed_verdict refuses what a fresh build would not publish flat", { + verdict <- function(tarball, minor = "4.5", abi = portable) { + seed_verdict(tarball, "R6", "2.6.1", minor, abi)$reason + } + expect_identical(verdict(make_tarball(built = NA)), "source") + expect_identical( + verdict(make_tarball( + built = "R 4.5.3; x86_64-pc-linux-musl; 2026-09-01; unix" + )), + "compiled" + ) + expect_identical(verdict(make_tarball(libs = TRUE)), "compiled") + expect_identical(verdict(make_tarball(), minor = "4.6"), "r-minor") + expect_identical(verdict(make_tarball(version = "2.6.0")), "mismatch") + # Unknown is a refusal, as is a verdict that some minor cannot load it. + expect_identical( + verdict(make_tarball(), abi = function(t) list(inspected = FALSE)), + "abi" + ) + expect_identical( + verdict( + make_tarball(), + abi = function(t) list(inspected = TRUE, sensitive = TRUE) + ), + "abi" + ) + junk <- tempfile(fileext = ".tar.gz") + writeLines("not a tarball", junk) + expect_identical(verdict(junk), "unreadable") +}) + +test_that("seed_candidates keeps only uncopied pure-R binaries in scope", { + donor <- c( + "R6_2.6.1.tar.gz", + "Archive/R6/R6_2.5.1.tar.gz", + "curl_7.0.0.tar.gz", + "4.6/R6_2.6.1.tar.gz", + "glue_1.8.0.tar.gz", + "gone_1.0.tar.gz", + "done_1.0.tar.gz", + "skipme_1.0.tar.gz", + "PACKAGES.tar.gz" + ) + etags <- c("a", "b", "c", "d", "c0ffee", "e", "f", "g", "h") + out <- seed_candidates( + donor, + etags, + target_keys = c("done_1.0.tar.gz", "4.6/R6_2.5.1.tar.gz"), + release_pkgs = c("R6", "curl", "glue", "done", "skipme"), + compiled_pkgs = "curl", + cran_md5 = c(glue_1.8.0 = "c0ffee", R6_2.6.1 = "zzz"), + exclude = "skipme" + ) + expect_identical(out$key, c("R6_2.6.1.tar.gz", "Archive/R6/R6_2.5.1.tar.gz")) + expect_identical(out$package, c("R6", "R6")) + expect_identical(out$version, c("2.6.1", "2.5.1")) +}) + +test_that("seed_candidates copies a version listed twice once, flat first", { + out <- seed_candidates( + c("Archive/R6/R6_2.6.1.tar.gz", "R6_2.6.1.tar.gz"), + c("a", "a"), + character(), + "R6", + character(), + character() + ) + expect_identical(out$key, "R6_2.6.1.tar.gz") +}) + +test_that("parse_built separates the R version from the platform", { + b <- parse_built("R 4.5.3; ; 2026-09-01 10:00:00 UTC; unix") + expect_identical(b$r_version, "4.5.3") + expect_identical(b$platform, "") + expect_identical( + parse_built("R 4.4.3; aarch64-alpine-linux-musl; 2026; unix")$platform, + "aarch64-alpine-linux-musl" + ) +}) + +test_that("codename_family groups versions of one distribution", { + expect_identical(codename_family("alpine325"), "alpine") + expect_identical(codename_family("alpine324"), codename_family("alpine325")) + expect_false(identical( + codename_family("rhel9"), + codename_family("alpine324") + )) +})