diff --git a/local/weekly-missing-binaries-audit.R b/local/weekly-missing-binaries-audit.R new file mode 100644 index 0000000..9c2b4ae --- /dev/null +++ b/local/weekly-missing-binaries-audit.R @@ -0,0 +1,351 @@ +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")