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")