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.
This commit is contained in:
parent
63149e246a
commit
cdfdcd035d
7 changed files with 726 additions and 51 deletions
|
|
@ -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
|
||||
)
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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
|
||||
}
|
||||
|
|
|
|||
162
local/seed-helpers.R
Normal file
162
local/seed-helpers.R
Normal file
|
|
@ -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 `<pkg>_<ver>.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 `<pkg>_<ver>`. 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)
|
||||
}
|
||||
323
local/seed-pure-r.R
Normal file
323
local/seed-pure-r.R
Normal file
|
|
@ -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 = ", ")
|
||||
)
|
||||
|
|
@ -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))
|
||||
})
|
||||
|
|
|
|||
126
local/tests/test-seed-helpers.R
Normal file
126
local/tests/test-seed-helpers.R
Normal file
|
|
@ -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")
|
||||
))
|
||||
})
|
||||
Loading…
Reference in a new issue