devxy/build-cran-binaries
Watch
1
0
Fork
You've already forked build-cran-binaries
 0
Code Issues 10 Pull requests Releases Activity

feat(local): auto-propose registry patches and track the feedback loop (#117)

Browse source 
Implements steps 3 + 4 of #115, building on the classifier merged in #116. Now that bincraft **v4.4.3** applies registry `patch`/`makevars`/`configure_args` to the *target* package build (previously deps-only), a trial patched build is a meaningful acceptance gate, so the "propose" half is viable.

## Step 3 — propose, do not apply

- **`local/propose-patches.R`** — for each classified, safe fix affecting a package with no current registry entry, emits a pre-filled `registry.json` entry and validates the candidate set against a *temporary* merged registry (the real one is never touched unless asked).
  - default: print candidates + validation, **take no action**
  - `--write`: append entries to `registry.json` + the proposals ledger (you commit + open the PR)
  - `--open-issue`: post/update a Forgejo tracking issue (reuses the weekly-audit `httr2` + `FORGEJO_TOKEN` pattern)
- **`local/trial-build-patch.R`** — isolated bincraft build of one package with the registry applied (no upload/archive/metadata; `patchhash` keeps it out of the real cache). Exit 0/1, so it gates a CI step or manual pre-merge check.

The human gate stays: nothing merges. Acceptance = `validate-patches.R` passes (checked automatically) **and** the trial build succeeds. Novel source diffs and unknown signatures are never proposed (they carry `auto = FALSE`).

## Step 4 — feedback loop

- **`local/proposal-tracking.R`** (read-only) — signature hit rate (builds/pkgs/addressed/open per signature), proposed-vs-merged (a proposal counts merged once its package is in the registry), and retirement candidates (registry entries whose package no longer fails, i.e. likely fixed upstream).
- **`local/proposal-tracking-lib.R`** — the pure metric/ledger helpers.

## Supporting changes

- Refactored the classify helpers to expose a pure `build_triage_report()` + a list-returning entry builder; `failing-builds-report.R` now renders from the shared function (no behaviour change).
- `validate-patches.R` gains optional `PATCH_DIR`/`REGISTRY_FILE` overrides (backward-compatible) so a candidate registry can be validated in isolation.
- Documented the propose/trial-build/tracking workflow in `local/patches/README.md`.

## Verification

- 71 unit tests pass (incl. new `test-proposal-tracking-lib.R`) under the Dockerized R 4.5.3 build env.
- All pre-commit hooks pass (`air-format`, `validate-patches`, prettier, etc.).
- Smoke-tested all three entrypoints end-to-end with a stubbed DB: dry-run, `--write` (produces a registry that passes the canonical validator + a valid ledger, then reverted), and the tracker.

Closes #115

Reviewed-on: #117
This commit is contained in:
Patrick Schratz 2026-07-14 15:03:24 +00:00 • committed by Patrick Schratz
commit 1c297c01bf
9 changed files with 990 additions and 119 deletions
Download patch file Download diff file Expand all files Collapse all files

116
local/failing-builds-classify.R
View file

@ -175,10 +175,10 @@ classify_error <- function(error_text, signatures = build_signatures()) {
)
}
# Render a suggested registry.json entry (as a pretty JSON string) for a
# classified group, filling package/versions/platforms from the observed
# failures. Only meaningful when the signature carries a `registry` template.
propose_registry_entry <- function(
# Build a suggested registry.json entry (as an R list) for a classified group,
# filling package/versions/platforms from the observed failures. Only
# meaningful when the signature carries a `registry` template.
propose_registry_entry_list <- function(
signature,
package,
platforms,
@ -192,7 +192,7 @@ propose_registry_entry <- function(
package = package,
versions = versions,
# I() keeps this a JSON array even when a single platform is affected.
platforms = I(as.character(platforms))
platforms = I(sort(unique(as.character(platforms))))
)
for (k in c("env", "configure_args", "makevars", "patch")) {
if (!is.null(tmpl[[k]])) {
@ -200,5 +200,111 @@ propose_registry_entry <- function(
}
}
entry$reason <- tmpl$reason
entry
}
# Same, rendered as a pretty JSON string.
propose_registry_entry <- function(
signature,
package,
platforms,
versions = "*"
) {
entry <- propose_registry_entry_list(signature, package, platforms, versions)
if (is.null(entry)) {
return(NULL)
}
jsonlite::toJSON(entry, auto_unbox = TRUE, pretty = TRUE, null = "null")
}
# Resolve the representative signature for a group by its id, re-attaching the
# `matched` flag the report/proposer rely on. Unknown ids -> unclassified.
resolve_signature <- function(sig_id, signatures = build_signatures()) {
hit <- Filter(function(s) s$id == sig_id, signatures)
if (length(hit) > 0L) {
s <- hit[[1L]]
s$matched <- TRUE
s
} else {
classify_error("", signatures) # unclassified fallback (matched = FALSE)
}
}
# ---------------------------------------------------------------------------
# Triage report (shared by the report printer and the patch proposer)
# ---------------------------------------------------------------------------
# `failures` is a data.frame with at least: name, platform, arch, error_text.
# `registered_pkgs` is the set of packages that already carry a registry entry.
# Returns a list of group records (one per root-cause bucket), ordered by
# number of affected builds descending. Pure: no IO, no printing.
build_triage_report <- function(
failures,
registered_pkgs = character(0L),
signatures = build_signatures()
) {
if (nrow(failures) == 0L) {
return(list())
}
idx <- seq_len(nrow(failures))
failures$fingerprint <- vapply(
idx,
function(i) fingerprint_error(failures$error_text[[i]], failures$name[[i]]),
character(1L)
)
failures$sig_id <- vapply(
idx,
function(i) classify_error(failures$error_text[[i]], signatures)$id,
character(1L)
)
# Group by root cause: classified failures collapse by signature id (same fix
# candidate is one bucket regardless of log noise); unclassified failures fall
# back to the fingerprint so distinct unknowns stay separate for discovery.
failures$group_key <- ifelse(
failures$sig_id == "unclassified",
failures$fingerprint,
failures$sig_id
)
groups <- split(failures, failures$group_key)
groups <- groups[order(-vapply(groups, nrow, integer(1L)))]
lapply(unname(groups), function(g) {
sig_id <- names(sort(table(g$sig_id), decreasing = TRUE))[[1L]]
sig <- resolve_signature(sig_id, signatures)
fp_tab <- sort(table(g$fingerprint), decreasing = TRUE)
pkgs <- sort(unique(g$name))
plats <- sort(unique(g$platform))
arches <- sort(unique(g$arch))
unregistered <- setdiff(pkgs, registered_pkgs)
auto_proposable <- isTRUE(sig$auto) && sig$matched
proposed <- list()
if (auto_proposable) {
for (p in unregistered) {
proposed[[p]] <- propose_registry_entry_list(
sig,
p,
g$platform[g$name == p]
)
}
}
list(
signature = sig$id,
label = sig$label,
matched = sig$matched,
auto_proposable = auto_proposable,
tier = sig$tier,
confidence = sig$confidence,
suggested_fix = sig$fix,
fingerprint = names(fp_tab)[[1L]],
fingerprint_variants = length(fp_tab),
build_count = nrow(g),
packages = pkgs,
packages_without_entry = unregistered,
platforms = plats,
arches = arches,
proposed_entries = if (length(proposed) > 0L) proposed else NULL
)
})
}

127
local/failing-builds-report.R
View file

@ -127,99 +127,53 @@ if (file.exists(registry_file)) {
}
# ---------------------------------------------------------------------------
# Fingerprint + classify every failure, then group
# Classify + group (shared logic), then render
# ---------------------------------------------------------------------------
signatures <- build_signatures()
failures$fingerprint <- vapply(
seq_len(nrow(failures)),
function(i) fingerprint_error(failures$error_text[[i]], failures$name[[i]]),
character(1L)
)
failures$sig_id <- vapply(
seq_len(nrow(failures)),
function(i) classify_error(failures$error_text[[i]], signatures)$id,
character(1L)
)
report <- build_triage_report(failures, registered_pkgs)
report <- Filter(function(r) r$build_count >= min_count, report)
# Group by root cause: classified failures collapse by signature id (so the
# same fix candidate is one bucket regardless of surrounding log noise);
# unclassified failures fall back to the fingerprint so distinct unknowns stay
# separate for discovery.
failures$group_key <- ifelse(
failures$sig_id == "unclassified",
failures$fingerprint,
failures$sig_id
)
groups <- split(failures, failures$group_key)
# Order groups by number of affected builds, descending.
groups <- groups[order(-vapply(groups, nrow, integer(1L)))]
report <- list()
cat(sprintf(
"\n%d distinct failure fingerprint(s); showing groups with >= %d build(s).\n",
length(groups),
"\n%d distinct failure group(s); showing groups with >= %d build(s).\n",
length(report),
min_count
))
cat(strrep("=", 78L), "\n", sep = "")
for (g in groups) {
n <- nrow(g)
if (n < min_count) {
next
}
# Representative classification: most common signature id in the group.
sig_id <- names(sort(table(g$sig_id), decreasing = TRUE))[[1L]]
sig <- Filter(function(s) s$id == sig_id, signatures)
if (length(sig) > 0L) {
sig <- sig[[1L]]
sig$matched <- TRUE
} else {
sig <- classify_error("", signatures) # unclassified fallback (matched = FALSE)
}
fp_tab <- sort(table(g$fingerprint), decreasing = TRUE)
rep_fp <- names(fp_tab)[[1L]]
fp_variants <- length(fp_tab)
pkgs <- sort(unique(g$name))
plats <- sort(unique(g$platform))
arches <- sort(unique(g$arch))
unregistered <- setdiff(pkgs, registered_pkgs)
status <- if (!sig$matched) {
for (r in report) {
status <- if (!r$matched) {
"HUMAN TRIAGE (unknown signature)"
} else if (!sig$auto) {
sprintf("HUMAN TRIAGE (classified: %s; novel source diff)", sig$id)
} else if (!r$auto_proposable) {
sprintf("HUMAN TRIAGE (classified: %s; novel source diff)", r$signature)
} else {
sprintf("AUTO-PROPOSABLE (%s, %s confidence)", sig$id, sig$confidence)
sprintf("AUTO-PROPOSABLE (%s, %s confidence)", r$signature, r$confidence)
}
cat(sprintf(
"\n[%d builds | %d pkgs | %s] %s\n",
n,
length(pkgs),
toString(plats),
r$build_count,
length(r$packages),
toString(r$platforms),
status
))
cat(sprintf(
" fingerprint: %s%s\n",
rep_fp,
if (fp_variants > 1L) {
sprintf(" (+%d fingerprint variant(s))", fp_variants - 1L)
r$fingerprint,
if (r$fingerprint_variants > 1L) {
sprintf(" (+%d fingerprint variant(s))", r$fingerprint_variants - 1L)
} else {
""
}
))
if (sig$matched) {
cat(sprintf(" signature : %s\n", sig$label))
cat(sprintf(" suggested : [%s] %s\n", sig$tier, sig$fix))
if (r$matched) {
cat(sprintf(" signature : %s\n", r$label))
cat(sprintf(" suggested : [%s] %s\n", r$tier, r$suggested_fix))
}
cat(sprintf(" arch : %s\n", toString(arches)))
cat(sprintf(" arch : %s\n", toString(r$arches)))
cat(sprintf(
" packages : %s\n",
paste(
vapply(
pkgs,
r$packages,
function(p) {
if (p %in% registered_pkgs) paste0(p, " (has entry)") else p
},
@ -229,39 +183,20 @@ for (g in groups) {
)
))
proposals <- list()
if (sig$matched && sig$auto && length(unregistered) > 0L) {
if (!is.null(r$proposed_entries)) {
cat(" proposed registry entries (validate + trial-build before merge):\n")
for (p in unregistered) {
p_plats <- sort(unique(g$platform[g$name == p]))
entry <- propose_registry_entry(sig, p, p_plats)
proposals[[p]] <- entry
cat(paste0(" ", gsub("\n", "\n ", entry)), "\n", sep = "")
for (entry in r$proposed_entries) {
j <- jsonlite::toJSON(
entry,
auto_unbox = TRUE,
pretty = TRUE,
null = "null"
)
cat(paste0(" ", gsub("\n", "\n ", j)), "\n", sep = "")
}
} else if (sig$matched && sig$auto && length(unregistered) == 0L) {
} else if (r$auto_proposable) {
cat(" (all affected packages already have a registry entry)\n")
}
report[[length(report) + 1L]] <- list(
fingerprint = rep_fp,
fingerprint_variants = fp_variants,
build_count = n,
packages = pkgs,
packages_without_entry = unregistered,
platforms = plats,
arches = arches,
signature = sig$id,
matched = sig$matched,
auto_proposable = isTRUE(sig$auto) && sig$matched,
tier = sig$tier,
confidence = sig$confidence,
suggested_fix = sig$fix,
proposed_entries = if (length(proposals) > 0L) {
lapply(proposals, jsonlite::fromJSON)
} else {
NULL
}
)
}
# ---------------------------------------------------------------------------

34
local/patches/README.md
View file

@ -59,3 +59,37 @@ For auto-proposable groups it prints a ready-to-review registry entry; still run
Novel source diffs and unknown signatures stay human-reviewed by design.
Add a new signature by appending a rule to `build_signatures()` in `local/failing-builds-classify.R`; the pure helpers are covered by `local/tests/test-failing-builds-classify.R`.
### Proposing entries (step 3: propose, do not apply)
`local/propose-patches.R` takes the auto-proposable candidates one step further: for each classified, safe fix affecting a package with no current entry, it emits a pre-filled `registry.json` entry and validates the candidate set against a temporary merged registry (the real registry is never touched unless you ask).
The human gate stays: it never merges.
```bash
# Default: print candidates + validation, take no action.
PGPASS=... Rscript local/propose-patches.R
# Append the candidates to registry.json + the proposals ledger (you commit + open the PR).
PGPASS=... Rscript local/propose-patches.R --write
# Or post/update a Forgejo tracking issue instead (needs FORGEJO_TOKEN).
PGPASS=... FORGEJO_TOKEN=... Rscript local/propose-patches.R --open-issue
```
The acceptance criteria before merging a proposal are: `validate-patches.R` passes (checked automatically), and an isolated trial build succeeds.
Run the trial build inside the failing platform's build-env image; it uploads/archives nothing and writes no metadata:
```bash
Rscript local/trial-build-patch.R <package>
```
`--write` and `--open-issue` also append to `local/patches/proposals-log.json`, a ledger of what was proposed.
### Feedback loop (step 4)
`local/proposal-tracking.R` reports the signature hit rate, proposed-vs-merged status (a proposal counts as merged once its package appears in the registry), and retirement candidates (registry entries whose package no longer appears in any current failure, so the upstream cause was likely fixed).
It is read-only.
```bash
PGPASS=... Rscript local/proposal-tracking.R --json metrics.json
```
The pure metric/ledger helpers live in `local/proposal-tracking-lib.R` and are covered by `local/tests/test-proposal-tracking-lib.R`.

103
local/proposal-tracking-lib.R Normal file
View file

@ -0,0 +1,103 @@
# Pure, IO-free helpers for the proposal feedback loop (issue #115, step 4):
# a small ledger of what the classifier proposed, plus metrics derived from the
# live triage report and the registry (signature hit rate, proposed-vs-merged,
# retirement candidates).
#
# Kept free of DB/HTTP/clock so it can be sourced by the proposer, the tracker
# entrypoint, and the unit tests. Timestamps are passed in by callers.
# Stable identity of a ledger record: one proposal per (package, signature).
ledger_key <- function(record) {
paste0(
if (is.null(record$package)) "?" else record$package,
"|",
if (is.null(record$signature)) "?" else record$signature
)
}
# Merge freshly-generated proposals into an existing ledger without clobbering
# history: a record whose (package, signature) already exists is left as-is
# (its status/PR/issue are preserved); genuinely new proposals are appended.
# Returns the combined list. Pure: callers stamp `proposed_at` before passing.
merge_ledger <- function(existing, new_records) {
if (is.null(existing)) {
existing <- list()
}
seen <- vapply(existing, ledger_key, character(1L))
out <- existing
for (rec in new_records) {
if (!(ledger_key(rec) %in% seen)) {
out[[length(out) + 1L]] <- rec
seen <- c(seen, ledger_key(rec))
}
}
out
}
# Per-signature hit rate from a triage report (list of group records from
# build_triage_report) crossed with the set of already-registered packages.
# For each *matched* signature: how many failing builds/packages it explains,
# and how many of those packages are already addressed by a registry entry.
signature_hit_rate <- function(report, registered_pkgs = character(0L)) {
matched <- Filter(function(g) isTRUE(g$matched), report)
by_sig <- split(
matched,
vapply(matched, function(g) g$signature, character(1L))
)
lapply(names(by_sig), function(sig) {
grps <- by_sig[[sig]]
pkgs <- unique(unlist(lapply(grps, function(g) g$packages)))
addressed <- intersect(pkgs, registered_pkgs)
list(
signature = sig,
builds = sum(vapply(grps, function(g) g$build_count, integer(1L))),
packages = length(pkgs),
addressed = length(addressed),
open = length(setdiff(pkgs, registered_pkgs)),
auto_proposable = any(vapply(
grps,
function(g) isTRUE(g$auto_proposable),
logical(1L)
))
)
})
}
# Proposed-vs-merged: a ledger record counts as "merged" once its package
# appears in the registry. Returns per-record status plus a rollup.
proposed_vs_merged <- function(ledger, registered_pkgs = character(0L)) {
if (is.null(ledger)) {
ledger <- list()
}
rows <- lapply(ledger, function(rec) {
merged <- !is.null(rec$package) && rec$package %in% registered_pkgs
list(
package = rec$package,
signature = rec$signature,
status = if (merged) "merged" else (rec$status %||% "proposed"),
merged = merged
)
})
list(
records = rows,
total = length(rows),
merged = sum(vapply(rows, function(r) isTRUE(r$merged), logical(1L)))
)
}
# Registry entries whose package no longer appears in any current failure are
# retirement candidates: the upstream cause was likely fixed, so the entry can
# be reviewed for removal. `failing_pkgs` is the set of currently-failing
# package names (from the live report).
retirement_candidates <- function(registry_entries, failing_pkgs) {
if (is.null(registry_entries)) {
registry_entries <- list()
}
keep <- Filter(
function(e) !is.null(e$package) && !(e$package %in% failing_pkgs),
registry_entries
)
vapply(keep, function(e) as.character(e$package), character(1L))
}
`%||%` <- function(a, b) if (is.null(a)) b else a

135
local/proposal-tracking.R Normal file
View file

@ -0,0 +1,135 @@
#!/usr/bin/env Rscript
# Feedback loop for the failure classifier (issue #115, step 4): report the
# signature hit rate, proposed-vs-merged status, and registry entries that look
# retirable, so the rule set can improve and stale entries can be pruned.
# Read-only: queries `single_builds` and reads the registry + proposals ledger.
#
# Usage:
# PGPASS=... Rscript local/proposal-tracking.R [--json PATH]
options(error = function() {
cat("ERROR:", geterrmessage(), "\n", file = stdout())
q(status = 1)
})
suppressPackageStartupMessages({
library(DBI, quietly = TRUE)
library(RPostgres, quietly = TRUE)
library(jsonlite, quietly = TRUE)
})
script_path <- local({
a <- commandArgs(trailingOnly = FALSE)
f <- sub("^--file=", "", a[grepl("^--file=", a)])
if (length(f) == 1L && nzchar(f)) normalizePath(f) else NA_character_
})
script_dir <- if (is.na(script_path)) "local" else dirname(script_path)
source(file.path(script_dir, "failing-builds-classify.R"))
source(file.path(script_dir, "proposal-tracking-lib.R"))
args <- commandArgs(trailingOnly = TRUE)
json_out <- local({
i <- match("--json", args)
if (!is.na(i) && i < length(args)) args[[i + 1L]] else NA_character_
})
if (nchar(Sys.getenv("PGPASS")) == 0L) {
stop("PGPASS env var is not set; a DB password is required.")
}
registry_file <- file.path(script_dir, "patches", "registry.json")
ledger_file <- file.path(script_dir, "patches", "proposals-log.json")
con <- DBI::dbConnect(
RPostgres::Postgres(),
dbname = "build_metadata",
host = "r-binaries.devxy.io",
port = 15432,
user = "rpkgs",
password = Sys.getenv("PGPASS"),
sslmode = "require"
)
on.exit(DBI::dbDisconnect(con), add = TRUE)
failures <- DBI::dbGetQuery(
con,
paste0(
"SELECT name, tag, platform, arch, r_version, timestamp, error_text ",
"FROM single_builds WHERE error_occurred = TRUE AND removed = FALSE"
)
)
existing_entries <- if (file.exists(registry_file)) {
jsonlite::fromJSON(registry_file, simplifyVector = FALSE)
} else {
list()
}
registered_pkgs <- unique(vapply(
existing_entries,
function(e) as.character(e$package %||% ""),
character(1L)
))
ledger <- if (file.exists(ledger_file)) {
jsonlite::fromJSON(ledger_file, simplifyVector = FALSE)
} else {
list()
}
report <- build_triage_report(failures, registered_pkgs)
failing_pkgs <- unique(unlist(lapply(report, function(g) g$packages)))
hit <- signature_hit_rate(report, registered_pkgs)
pvm <- proposed_vs_merged(ledger, registered_pkgs)
retire <- retirement_candidates(existing_entries, failing_pkgs)
cat(sprintf(
"Feedback loop over %d failing builds, %d registry entries, %d ledger records.\n",
nrow(failures),
length(existing_entries),
length(ledger)
))
cat("\nSignature hit rate:\n")
cat(strrep("-", 60L), "\n", sep = "")
for (h in hit) {
cat(sprintf(
" %-26s %3d builds | %2d pkgs | %2d addressed | %2d open%s\n",
h$signature,
h$builds,
h$packages,
h$addressed,
h$open,
if (isTRUE(h$auto_proposable)) " [auto]" else ""
))
}
cat(sprintf("\nProposed vs merged: %d / %d merged.\n", pvm$merged, pvm$total))
for (r in pvm$records) {
cat(sprintf(" %-24s %-26s %s\n", r$package, r$signature, r$status))
}
cat(sprintf(
"\nRetirement candidates (%d): registry entries with no current failure.\n",
length(retire)
))
if (length(retire) > 0L) {
cat(paste0(" - ", retire, "\n"), sep = "")
} else {
cat(" (none)\n")
}
if (!is.na(json_out)) {
jsonlite::write_json(
list(
signature_hit_rate = hit,
proposed_vs_merged = pvm,
retirement_candidates = retire
),
json_out,
auto_unbox = TRUE,
pretty = TRUE,
null = "null"
)
cat(sprintf("\nWrote metrics to %s\n", json_out))
}

362
local/propose-patches.R Normal file
View file

@ -0,0 +1,362 @@
#!/usr/bin/env Rscript
# Propose registry patches for classified, auto-proposable build failures
# (issue #115, step 3: "propose, do not apply"). Queries `single_builds`,
# classifies failures, and for each *known, safe* fix lever affecting a package
# with no current registry entry, emits a pre-filled `registry.json` entry.
#
# The human gate stays: this never merges. Acceptance before merge is
# 1. `local/validate-patches.R` passes (checked here against a candidate
# registry), and
# 2. an isolated trial build succeeds -- run `local/trial-build-patch.R <pkg>`
# (this script prints the exact command per candidate).
# Novel source diffs and unknown signatures are never proposed (they carry
# `auto = FALSE` in the signature table).
#
# Usage:
# PGPASS=... Rscript local/propose-patches.R [--platform P] [--arch A] [--min N]
# (default) print candidates + validation, take no action
# --write append candidates to local/patches/registry.json and
# the proposals ledger (commit + open a PR yourself)
# --open-issue post/update a Forgejo tracking issue (needs FORGEJO_TOKEN)
# --json PATH also write the machine-readable candidate list to PATH
options(error = function() {
cat("ERROR:", geterrmessage(), "\n", file = stdout())
q(status = 1)
})
suppressPackageStartupMessages({
library(DBI, quietly = TRUE)
library(RPostgres, quietly = TRUE)
library(jsonlite, quietly = TRUE)
})
script_path <- local({
a <- commandArgs(trailingOnly = FALSE)
f <- sub("^--file=", "", a[grepl("^--file=", a)])
if (length(f) == 1L && nzchar(f)) normalizePath(f) else NA_character_
})
script_dir <- if (is.na(script_path)) "local" else dirname(script_path)
source(file.path(script_dir, "failing-builds-classify.R"))
source(file.path(script_dir, "proposal-tracking-lib.R"))
# ---------------------------------------------------------------------------
# Arguments
# ---------------------------------------------------------------------------
args <- commandArgs(trailingOnly = TRUE)
opt_val <- function(flag, default = NA_character_) {
i <- match(flag, args)
if (!is.na(i) && i < length(args)) args[[i + 1L]] else default
}
platform <- opt_val("--platform", Sys.getenv("PLATFORM", ""))
arch <- opt_val("--arch", Sys.getenv("ARCH", ""))
json_out <- opt_val("--json")
min_count <- suppressWarnings(as.integer(opt_val("--min", "1")))
if (is.na(min_count)) {
min_count <- 1L
}
do_write <- "--write" %in% args
do_issue <- "--open-issue" %in% args
if (nchar(Sys.getenv("PGPASS")) == 0L) {
stop("PGPASS env var is not set; a DB password is required.")
}
registry_file <- file.path(script_dir, "patches", "registry.json")
ledger_file <- file.path(script_dir, "patches", "proposals-log.json")
# ---------------------------------------------------------------------------
# Query failing builds (same shape as failing-builds-report.R)
# ---------------------------------------------------------------------------
con <- DBI::dbConnect(
RPostgres::Postgres(),
dbname = "build_metadata",
host = "r-binaries.devxy.io",
port = 15432,
user = "rpkgs",
password = Sys.getenv("PGPASS"),
sslmode = "require"
)
on.exit(DBI::dbDisconnect(con), add = TRUE)
where <- "error_occurred = TRUE AND removed = FALSE"
params <- list()
if (nzchar(platform)) {
where <- paste0(where, " AND platform = $", length(params) + 1L)
params <- c(params, platform)
}
if (nzchar(arch)) {
where <- paste0(where, " AND arch = $", length(params) + 1L)
params <- c(params, arch)
}
failures <- DBI::dbGetQuery(
con,
paste0(
"SELECT name, tag, platform, arch, r_version, timestamp, error_text ",
"FROM single_builds WHERE ",
where
),
params = if (length(params) > 0L) params else NULL
)
cat(sprintf("Queried single_builds: %d failing builds\n", nrow(failures)))
# ---------------------------------------------------------------------------
# Existing registry + classification
# ---------------------------------------------------------------------------
existing_entries <- if (file.exists(registry_file)) {
jsonlite::fromJSON(registry_file, simplifyVector = FALSE)
} else {
list()
}
registered_pkgs <- unique(vapply(
existing_entries,
function(e) as.character(e$package %||% ""),
character(1L)
))
report <- build_triage_report(failures, registered_pkgs)
report <- Filter(function(r) r$build_count >= min_count, report)
# Flatten auto-proposable groups into candidate records.
candidates <- list()
for (r in report) {
if (is.null(r$proposed_entries)) {
next
}
for (pkg in names(r$proposed_entries)) {
candidates[[length(candidates) + 1L]] <- list(
package = pkg,
signature = r$signature,
confidence = r$confidence,
tier = r$tier,
entry = r$proposed_entries[[pkg]]
)
}
}
if (length(candidates) == 0L) {
cat(
"No auto-proposable candidates (nothing classified, safe, and unregistered).\n"
)
q(status = 0)
}
cat(sprintf(
"\n%d candidate registry %s:\n",
length(candidates),
if (length(candidates) == 1L) "entry" else "entries"
))
cat(strrep("=", 78L), "\n", sep = "")
for (c in candidates) {
j <- jsonlite::toJSON(
c$entry,
auto_unbox = TRUE,
pretty = TRUE,
null = "null"
)
cat(sprintf(
"\n# %s [signature: %s, %s confidence]\n",
c$package,
c$signature,
c$confidence
))
cat(j, "\n", sep = "")
cat(sprintf(
" acceptance gate: PGPASS=... Rscript local/trial-build-patch.R %s\n",
c$package
))
}
# ---------------------------------------------------------------------------
# Validate the candidate set against a temporary merged registry (never
# touches the real registry unless --write succeeds).
# ---------------------------------------------------------------------------
rscript <- file.path(R.home("bin"), "Rscript")
candidate_entries <- lapply(candidates, function(c) c$entry)
merged <- c(existing_entries, candidate_entries)
validate_registry <- function(entries) {
tmp <- tempfile(fileext = ".json")
on.exit(unlink(tmp), add = TRUE)
jsonlite::write_json(
entries,
tmp,
auto_unbox = TRUE,
pretty = TRUE,
null = "null"
)
status <- system2(
rscript,
file.path(script_dir, "validate-patches.R"),
env = c(
paste0("PATCH_DIR=", file.path(script_dir, "patches")),
paste0("REGISTRY_FILE=", tmp)
),
stdout = TRUE,
stderr = TRUE
)
cat(paste0(" ", status, "\n"), sep = "")
identical(attr(status, "status"), NULL) # NULL status attr == exit 0
}
cat("\n", strrep("=", 78L), "\n", sep = "")
cat("Validating candidate registry:\n")
ok <- validate_registry(merged)
if (!ok) {
stop("Candidate registry failed validation; not writing or proposing.")
}
if (!is.na(json_out)) {
jsonlite::write_json(
candidates,
json_out,
auto_unbox = TRUE,
pretty = TRUE,
null = "null"
)
cat(sprintf("Wrote candidate list to %s\n", json_out))
}
# ---------------------------------------------------------------------------
# Actions (default: none)
# ---------------------------------------------------------------------------
now <- format(Sys.time(), "%Y-%m-%d %H:%M:%S")
new_ledger_records <- lapply(candidates, function(c) {
list(
package = c$package,
signature = c$signature,
tier = c$tier,
confidence = c$confidence,
versions = c$entry$versions,
platforms = as.character(c$entry$platforms),
proposed_at = now,
status = "proposed"
)
})
load_ledger <- function() {
if (file.exists(ledger_file)) {
jsonlite::fromJSON(ledger_file, simplifyVector = FALSE)
} else {
list()
}
}
save_ledger <- function(led) {
jsonlite::write_json(
led,
ledger_file,
auto_unbox = TRUE,
pretty = TRUE,
null = "null"
)
}
if (do_write) {
jsonlite::write_json(
merged,
registry_file,
auto_unbox = TRUE,
pretty = TRUE,
null = "null"
)
save_ledger(merge_ledger(load_ledger(), new_ledger_records))
cat(sprintf(
"\nWrote %d entries to %s and updated %s.\n",
length(candidate_entries),
registry_file,
ledger_file
))
cat(
"Next: run the acceptance-gate trial build(s), then commit and open a PR.\n"
)
} else if (do_issue) {
forgejo_token <- Sys.getenv("FORGEJO_TOKEN")
if (nchar(forgejo_token) == 0L) {
stop("--open-issue requires FORGEJO_TOKEN.")
}
suppressPackageStartupMessages(library(httr2, quietly = TRUE))
forgejo_base <- "https://git.devxy.io/api/v1"
repo <- "devxy/build-cran-binaries"
issue_title <- "Auto-proposed registry patches (classifier #115)"
body_lines <- c(
sprintf("_Generated %s from `single_builds` failures._", now),
"",
"The failure classifier proposes these registry entries for packages with no current entry.",
"Each is a known, safe fix lever; **review, trial-build, and open a PR** -- nothing is applied automatically.",
""
)
for (c in candidates) {
j <- jsonlite::toJSON(
c$entry,
auto_unbox = TRUE,
pretty = TRUE,
null = "null"
)
body_lines <- c(
body_lines,
sprintf(
"### %s (%s, %s confidence)",
c$package,
c$signature,
c$confidence
),
"",
"```json",
as.character(j),
"```",
sprintf(
"Acceptance gate: `PGPASS=... Rscript local/trial-build-patch.R %s`",
c$package
),
""
)
}
new_body <- paste(body_lines, collapse = "\n")
search_url <- sprintf(
"%s/repos/%s/issues?type=issues&state=open&q=%s&limit=50",
forgejo_base,
repo,
utils::URLencode(issue_title, reserved = TRUE)
)
existing <- httr2::request(search_url) |>
httr2::req_headers(Authorization = paste("token", forgejo_token)) |>
httr2::req_perform() |>
httr2::resp_body_json(simplifyVector = FALSE)
match_idx <- which(vapply(
existing,
function(x) identical(x$title, issue_title),
logical(1L)
))
if (length(match_idx) > 0L) {
num <- existing[[match_idx[1]]]$number
httr2::request(sprintf("%s/repos/%s/issues/%d", forgejo_base, repo, num)) |>
httr2::req_headers(
Authorization = paste("token", forgejo_token),
`Content-Type` = "application/json"
) |>
httr2::req_body_json(list(body = new_body)) |>
httr2::req_method("PATCH") |>
httr2::req_perform()
cat(sprintf("Updated tracking issue #%d.\n", num))
} else {
created <- httr2::request(sprintf(
"%s/repos/%s/issues",
forgejo_base,
repo
)) |>
httr2::req_headers(
Authorization = paste("token", forgejo_token),
`Content-Type` = "application/json"
) |>
httr2::req_body_json(list(title = issue_title, body = new_body)) |>
httr2::req_perform() |>
httr2::resp_body_json()
cat(sprintf("Opened tracking issue #%d.\n", created$number))
}
save_ledger(merge_ledger(load_ledger(), new_ledger_records))
} else {
cat(
"\nDry run: no changes made. Re-run with --write or --open-issue to act.\n"
)
}

105
local/tests/test-proposal-tracking-lib.R Normal file
View file

@ -0,0 +1,105 @@
source(file.path("..", "proposal-tracking-lib.R"))
source(file.path("..", "failing-builds-classify.R"))
mk_failures <- function() {
data.frame(
name = c("StanHeaders", "rstan", "RcppParallel", "somepkg"),
platform = c("alpine-321", "alpine-321", "alpine-320", "redhat-9"),
arch = c("amd64", "arm64", "amd64", "amd64"),
error_text = c(
"fatal error: tbb/tbb_stddef.h: No such file or directory",
"In file: tbb/tbb_stddef.h: No such file or directory",
"Error: USE_TBB=Linux is not supported; bundled TBB on musl",
"some unmatched failure"
),
stringsAsFactors = FALSE
)
}
test_that("merge_ledger appends new proposals and preserves existing history", {
existing <- list(list(
package = "fs",
signature = "system-libuv-link-leak",
status = "merged"
))
new <- list(
list(
package = "fs",
signature = "system-libuv-link-leak",
status = "proposed"
),
list(
package = "StanHeaders",
signature = "tbb-stddef-removed",
status = "proposed"
)
)
merged <- merge_ledger(existing, new)
expect_length(merged, 2L) # fs is deduped, StanHeaders added
fs <- Filter(function(r) r$package == "fs", merged)[[1L]]
expect_identical(fs$status, "merged") # existing status preserved, not clobbered
})
test_that("merge_ledger handles an empty/NULL starting ledger", {
new <- list(list(package = "x", signature = "s"))
expect_length(merge_ledger(NULL, new), 1L)
expect_length(merge_ledger(list(), new), 1L)
})
test_that("signature_hit_rate splits addressed vs open per signature", {
report <- build_triage_report(mk_failures(), registered_pkgs = "RcppParallel")
hit <- signature_hit_rate(report, registered_pkgs = "RcppParallel")
tbb <- Filter(function(h) h$signature == "tbb-stddef-removed", hit)[[1L]]
expect_identical(tbb$packages, 2L) # StanHeaders + rstan
expect_identical(tbb$addressed, 0L)
expect_identical(tbb$open, 2L)
expect_true(tbb$auto_proposable)
rcpp <- Filter(function(h) h$signature == "rcppparallel-bundled-tbb", hit)[[
1L
]]
expect_identical(rcpp$addressed, 1L) # already registered
expect_identical(rcpp$open, 0L)
# Unclassified failures never appear as a signature.
expect_false(
"unclassified" %in% vapply(hit, function(h) h$signature, character(1L))
)
})
test_that("proposed_vs_merged marks a package merged once it is registered", {
ledger <- list(
list(
package = "StanHeaders",
signature = "tbb-stddef-removed",
status = "proposed"
),
list(
package = "rstan",
signature = "tbb-stddef-removed",
status = "proposed"
)
)
pvm <- proposed_vs_merged(ledger, registered_pkgs = "StanHeaders")
expect_identical(pvm$total, 2L)
expect_identical(pvm$merged, 1L)
stan <- Filter(function(r) r$package == "StanHeaders", pvm$records)[[1L]]
expect_identical(stan$status, "merged")
})
test_that("retirement_candidates flags entries whose package no longer fails", {
entries <- list(
list(package = "RcppParallel"),
list(package = "oldpkg")
)
# RcppParallel still fails; oldpkg does not -> only oldpkg is retirable.
out <- retirement_candidates(
entries,
failing_pkgs = c("RcppParallel", "StanHeaders")
)
expect_identical(out, "oldpkg")
expect_length(
retirement_candidates(entries, failing_pkgs = c("RcppParallel", "oldpkg")),
0L
)
})

65
local/trial-build-patch.R Normal file
View file

@ -0,0 +1,65 @@
#!/usr/bin/env Rscript
# Acceptance gate for a proposed registry patch (issue #115, step 3): build one
# package in isolation with the current `local/patches` registry applied, and
# report whether it succeeds. Nothing is uploaded, archived, or written to the
# metadata DB -- `patchhash` keeps the trial binary out of the real cache.
#
# Must run inside a build-env image (the same image the failing platform uses),
# because it invokes the real compiler toolchain via bincraft.
#
# Usage:
# Rscript local/trial-build-patch.R <package> [tag]
#
# Exit status: 0 if the patched build succeeds, 1 otherwise -- so it can gate a
# CI step or a manual pre-merge check.
args <- commandArgs(trailingOnly = TRUE)
if (length(args) < 1L) {
stop("usage: Rscript local/trial-build-patch.R <package> [tag]")
}
package <- args[[1L]]
tag <- if (length(args) >= 2L) args[[2L]] else NULL
script_path <- local({
a <- commandArgs(trailingOnly = FALSE)
f <- sub("^--file=", "", a[grepl("^--file=", a)])
if (length(f) == 1L && nzchar(f)) normalizePath(f) else NA_character_
})
patches_dir <- file.path(
if (is.na(script_path)) "local" else dirname(script_path),
"patches"
)
suppressPackageStartupMessages(library(bincraft, quietly = TRUE))
cat(sprintf(
"Trial build: %s%s with registry %s (no upload/archive/metadata)\n",
package,
if (is.null(tag)) "" else sprintf(" @ %s", tag),
patches_dir
))
ok <- tryCatch(
{
bincraft::build_binary_package(
package,
tag_limit = 1L,
patches = patches_dir,
archive = FALSE,
upload = FALSE,
store_build_metadata = FALSE
)
TRUE
},
error = function(e) {
cat(sprintf("Trial build FAILED: %s\n", conditionMessage(e)))
FALSE
}
)
if (ok) {
cat(sprintf("Trial build OK: %s builds with the proposed patch.\n", package))
q(status = 0)
}
q(status = 1)

62
local/validate-patches.R
View file

@ -1,9 +1,17 @@
#!/usr/bin/env Rscript
# Validate local/patches/registry.json: schema, referenced patch files, and
# ambiguous overlaps. Exits 1 on any problem. Used by pre-commit and CI.
#
# Defaults to local/patches/registry.json. To validate a candidate registry
# without touching the real one (e.g. from the patch proposer), set:
# PATCH_DIR directory patch-file paths resolve against (default local/patches)
# REGISTRY_FILE registry.json to validate (default <PATCH_DIR>/registry.json)
dir <- "local/patches"
registry_file <- file.path(dir, "registry.json")
dir <- Sys.getenv("PATCH_DIR", unset = "local/patches")
registry_file <- Sys.getenv(
"REGISTRY_FILE",
unset = file.path(dir, "registry.json")
)
if (!file.exists(registry_file)) {
cat("No registry.json found; nothing to validate.\n")
quit(status = 0L)
@ -19,33 +27,47 @@ for (i in seq_along(reg)) {
e <- reg[[i]]
missing <- setdiff(required, names(e))
if (length(missing) > 0L) {
errs <- c(errs, sprintf(
"entry %d (%s): missing %s", i,
if (is.null(e$package)) "?" else e$package, toString(missing)
))
errs <- c(
errs,
sprintf(
"entry %d (%s): missing %s",
i,
if (is.null(e$package)) "?" else e$package,
toString(missing)
)
)
}
if (!is.null(e$patch)) {
p <- file.path(dir, e$patch)
if (!file.exists(p)) {
errs <- c(errs, sprintf("entry %d (%s): patch file '%s' missing",
i, e$package, p))
errs <- c(
errs,
sprintf("entry %d (%s): patch file '%s' missing", i, e$package, p)
)
}
}
}
# Ambiguous overlap: two entries for the same package with identical platforms
# and versions.
keys <- vapply(reg, function(e) {
sprintf(
"%s|%s|%s",
or_q(e$package),
paste(sort(as.character(unlist(e$platforms))), collapse = ","),
or_q(e$versions)
)
}, character(1L))
keys <- vapply(
reg,
function(e) {
sprintf(
"%s|%s|%s",
or_q(e$package),
paste(sort(as.character(unlist(e$platforms))), collapse = ","),
or_q(e$versions)
)
},
character(1L)
)
dups <- keys[duplicated(keys)]
if (length(dups) > 0L) {
errs <- c(errs, sprintf("ambiguous duplicate entries: %s", toString(unique(dups))))
errs <- c(
errs,
sprintf("ambiguous duplicate entries: %s", toString(unique(dups)))
)
}
if (length(errs) > 0L) {
@ -53,4 +75,8 @@ if (length(errs) > 0L) {
cat(paste0(" - ", errs, "\n"))
quit(status = 1L)
}
cat(sprintf("Patch registry OK (%d %s).\n", length(reg), if (length(reg) == 1L) "entry" else "entries"))
cat(sprintf(
"Patch registry OK (%d %s).\n",
length(reg),
if (length(reg) == 1L) "entry" else "entries"
))