devxy/build-cran-binaries
Watch
1
0
Fork
You've already forked build-cran-binaries
 0
Code Issues 10 Pull requests Releases Activity
build-cran-binaries/local/weekly-missing-binaries-audit.R

351 lines
12 KiB
R
Raw Permalink Blame History

options(error = function() {
cat("ERROR:", geterrmessage(), "\n", file = stdout())
traceback(2)
q(status = 1)
})
suppressPackageStartupMessages(library(data.table))
library(DBI, quietly = TRUE)
library(RPostgres, quietly = TRUE)
library(s3fs, quietly = TRUE)
library(jsonlite, quietly = TRUE)
library(httr2, quietly = TRUE)
# ---------------------------------------------------------------------------
# Environment / config
# ---------------------------------------------------------------------------
platform <- Sys.getenv("PLATFORM")
arch <- Sys.getenv("ARCH")
if (nchar(platform) == 0) stop("PLATFORM env var is not set")
if (nchar(arch) == 0) stop("ARCH env var is not set")
# e.g. "ubuntu-2204" -> "ubuntu2204"
s3_codename <- gsub("-", "", platform)
# Derive OS family for the Forgejo issue title
os_family <- if (grepl("^ubuntu", platform)) {
"Ubuntu"
} else if (grepl("^alpine", platform)) {
"Alpine"
} else if (grepl("^redhat", platform)) {
"Red Hat"
} else {
platform
}
cat(sprintf("Platform: %s | Arch: %s | S3 codename: %s | OS family: %s\n",
platform, arch, s3_codename, os_family))
# ---------------------------------------------------------------------------
# 1. CRAN release packages
# ---------------------------------------------------------------------------
cat("Fetching CRAN package database...\n")
cran_release <- tools::CRAN_package_db()
cran_dt <- data.table(
Package = as.character(cran_release$Package),
Version = as.character(cran_release$Version)
)
# ---------------------------------------------------------------------------
# 2. S3 tarballs
# ---------------------------------------------------------------------------
cat("Connecting to S3...\n")
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
)
s3_path <- sprintf("devxy-rpkgs-binaries/%s/%s/latest/src/contrib", arch, s3_codename)
cat(sprintf("Listing S3 path: %s\n", s3_path))
s3_pkgs <- tryCatch(
s3fs::s3_dir_ls(s3_path, recurse = FALSE),
error = function(e) {
cat(sprintf("WARNING: Could not list S3 path %s: %s\n", s3_path, conditionMessage(e)))
character(0)
}
)
file_names <- basename(s3_pkgs)
matches <- regexec("^([A-Za-z0-9.]+)_([0-9][^/]*)\\.tar\\.gz$", file_names)
parts <- regmatches(file_names, matches)
parts <- parts[sapply(parts, length) == 3]
s3_dt <- data.table(
Package = sapply(parts, `[`, 2),
Version = sapply(parts, `[`, 3)
)
cat(sprintf("S3 contains %d tarballs for %s/%s\n", nrow(s3_dt), arch, s3_codename))
# ---------------------------------------------------------------------------
# 3. Find missing packages (CRAN release version not in S3)
# ---------------------------------------------------------------------------
setkey(cran_dt, Package, Version)
setkey(s3_dt, Package, Version)
missing_dt <- cran_dt[!s3_dt]
cat(sprintf("%d CRAN release packages missing from S3\n", nrow(missing_dt)))
# ---------------------------------------------------------------------------
# 4. Remove excluded packages
# ---------------------------------------------------------------------------
script_dir <- tryCatch(
dirname(normalizePath(
if (exists("ofile", envir = sys.frame(1), inherits = FALSE)) sys.frame(1)$ofile
else commandArgs(trailingOnly = FALSE)[grepl("--file=", commandArgs(trailingOnly = FALSE))] |>
sub("--file=", "", x = _),
mustWork = FALSE
)),
error = function(e) "local"
)
excluded_path <- file.path(script_dir, "excluded-packages.json")
excluded_pkgs <- data.table(package = character(0), reason = character(0))
if (file.exists(excluded_path)) {
excluded_raw <- jsonlite::fromJSON(excluded_path)
excluded_pkgs <- as.data.table(excluded_raw)
cat(sprintf("Loaded %d excluded packages from %s\n", nrow(excluded_pkgs), excluded_path))
missing_dt <- missing_dt[!Package %in% excluded_pkgs$package]
cat(sprintf("%d packages remain after removing exclusions\n", nrow(missing_dt)))
} else {
cat(sprintf("No excluded-packages.json found at %s -- skipping exclusion step\n", excluded_path))
}
# ---------------------------------------------------------------------------
# 5. Query PostgreSQL for known build failures
# ---------------------------------------------------------------------------
cat("Connecting to PostgreSQL...\n")
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)
errored_pkgs <- DBI::dbGetQuery(
con,
sprintf(
"SELECT name, tag FROM single_builds WHERE error_occurred = TRUE AND platform = '%s' AND arch = '%s'",
platform, arch
)
)
errored_dt <- as.data.table(errored_pkgs)
if (nrow(errored_dt) > 0) {
setnames(errored_dt, c("Package", "Version"))
setkey(errored_dt, Package, Version)
}
cat(sprintf("Found %d known build failures for %s/%s\n", nrow(errored_dt), platform, arch))
# ---------------------------------------------------------------------------
# 6. Split into rebuildable vs known failures
# ---------------------------------------------------------------------------
if (nrow(errored_dt) > 0) {
known_failures_dt <- missing_dt[errored_dt, nomatch = 0]
rebuildable_dt <- missing_dt[!errored_dt]
} else {
known_failures_dt <- missing_dt[0]
rebuildable_dt <- missing_dt
}
cat(sprintf("Rebuildable: %d | Known failures: %d\n",
nrow(rebuildable_dt), nrow(known_failures_dt)))
# ---------------------------------------------------------------------------
# 7. Write rebuildable package names to cache RDS
# ---------------------------------------------------------------------------
cache_dir <- "/mnt/cache/packages"
cache_file <- file.path(cache_dir, sprintf("weekly_rebuild_%s_%s.rds", platform, arch))
if (dir.exists(cache_dir)) {
saveRDS(rebuildable_dt$Package, cache_file)
cat(sprintf("Wrote %d rebuildable packages to %s\n", nrow(rebuildable_dt), cache_file))
} else {
cat(sprintf("Cache dir %s does not exist -- skipping RDS write\n", cache_dir))
}
# ---------------------------------------------------------------------------
# 8. Update Forgejo issue
# ---------------------------------------------------------------------------
forgejo_token <- Sys.getenv("FORGEJO_TOKEN")
if (nchar(forgejo_token) == 0) {
cat("FORGEJO_TOKEN not set -- skipping issue update\n")
} else {
issue_title <- sprintf("Missing package binaries for latest version (%s)", os_family)
n_missing <- nrow(missing_dt)
n_rebuild <- nrow(rebuildable_dt)
arch_lines <- sprintf("### %s (%d missing, %d to rebuild)", arch, n_missing, n_rebuild)
if (nrow(rebuildable_dt) > 0) {
arch_lines <- c(arch_lines,
paste0("- ", rebuildable_dt$Package, " (", rebuildable_dt$Version, ")")
)
} else {
arch_lines <- c(arch_lines, "_None_")
}
if (nrow(known_failures_dt) > 0) {
arch_lines <- c(arch_lines,
"",
"#### Known build failures",
paste0("- ", known_failures_dt$Package, " (", known_failures_dt$Version, ")")
)
}
build_excluded_footer <- function() {
if (nrow(excluded_pkgs) == 0) return(character(0))
entries <- paste(
paste0(excluded_pkgs$package, " (", excluded_pkgs$reason, ")"),
collapse = ", "
)
c("---", "", "## Excluded packages", entries)
}
forgejo_base <- "https://git.devxy.io/api/v1"
repo <- "devxy/build-cran-binaries"
search_url <- sprintf(
"%s/repos/%s/issues?type=issues&state=open&q=%s&limit=50",
forgejo_base, repo,
utils::URLencode(issue_title, reserved = TRUE)
)
search_resp <- httr2::request(search_url) |>
httr2::req_headers(Authorization = paste("token", forgejo_token)) |>
httr2::req_perform()
existing_issues <- httr2::resp_body_json(search_resp, simplifyVector = FALSE)
match_idx <- which(sapply(existing_issues, function(x) x$title) == issue_title)
today_str <- format(Sys.Date(), "%Y-%m-%d")
if (length(match_idx) > 0) {
# ---- Update existing issue ----
issue_number <- existing_issues[[match_idx[1]]]$number
old_body <- existing_issues[[match_idx[1]]]$body
if (is.null(old_body)) old_body <- ""
lines <- strsplit(old_body, "\n", fixed = TRUE)[[1]]
# Update timestamp
ts_idx <- which(grepl("^_Last updated:", lines))
if (length(ts_idx) > 0) {
lines[ts_idx[1]] <- sprintf("_Last updated: %s_", today_str)
} else {
lines <- c(sprintf("_Last updated: %s_", today_str), "", lines)
}
plat_header <- sprintf("## %s", platform)
arch_header <- sprintf("### %s", arch)
plat_idx <- which(lines == plat_header)
if (length(plat_idx) == 0) {
# Platform section missing -- insert before --- footer
footer_idx <- which(lines == "---")
insert_at <- if (length(footer_idx) > 0) footer_idx[length(footer_idx)] else length(lines) + 1
new_plat_block <- c(sprintf("## %s", platform), "", arch_lines, "")
lines <- c(
lines[seq_len(insert_at - 1)],
new_plat_block,
lines[seq(insert_at, length(lines))]
)
} else {
pi <- plat_idx[1]
# End of platform section: next ## or --- at a higher level, or EOF
next_section <- which(grepl("^## |^---", lines) & seq_along(lines) > pi)
plat_end <- if (length(next_section) > 0) next_section[1] - 1 else length(lines)
plat_lines <- lines[seq(pi, plat_end)]
arch_local_idx <- which(plat_lines == arch_header)
if (length(arch_local_idx) == 0) {
# Append arch subsection at end of platform block
lines <- c(
lines[seq_len(plat_end)],
"",
arch_lines,
lines[seq(plat_end + 1, length(lines))]
)
} else {
ai <- pi + arch_local_idx[1] - 1 # absolute line index
# End of arch subsection
next_arch <- which(grepl("^### |^## |^---", lines) & seq_along(lines) > ai)
arch_end <- if (length(next_arch) > 0) next_arch[1] - 1 else plat_end
lines <- c(
lines[seq_len(ai - 1)],
arch_lines,
lines[seq(arch_end + 1, length(lines))]
)
}
}
# Rebuild excluded footer
excl_hdr_idx <- which(lines == "## Excluded packages")
if (length(excl_hdr_idx) > 0) {
pre_dash <- which(lines == "---" & seq_along(lines) < excl_hdr_idx[1])
remove_from <- if (length(pre_dash) > 0) pre_dash[length(pre_dash)] else excl_hdr_idx[1]
lines <- lines[seq_len(remove_from - 1)]
}
footer <- build_excluded_footer()
if (length(footer) > 0) {
lines <- c(lines, "", footer)
}
new_body <- paste(lines, collapse = "\n")
patch_url <- sprintf("%s/repos/%s/issues/%d", forgejo_base, repo, issue_number)
httr2::request(patch_url) |>
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 Forgejo issue #%d: %s\n", issue_number, issue_title))
} else {
# ---- Create new issue ----
body_lines <- c(
sprintf("_Last updated: %s_", today_str),
"",
sprintf("## %s", platform),
"",
arch_lines
)
footer <- build_excluded_footer()
if (length(footer) > 0) {
body_lines <- c(body_lines, "", footer)
}
post_url <- sprintf("%s/repos/%s/issues", forgejo_base, repo)
create_resp <- httr2::request(post_url) |>
httr2::req_headers(
Authorization = paste("token", forgejo_token),
`Content-Type` = "application/json"
) |>
httr2::req_body_json(list(
title = issue_title,
body = paste(body_lines, collapse = "\n")
)) |>
httr2::req_perform()
new_issue <- httr2::resp_body_json(create_resp)
cat(sprintf("Created Forgejo issue #%d: %s\n", new_issue$number, issue_title))
}
}
cat("Done.\n")
Reference in a new issue View git blame Copy permalink