build-cran-binaries/local/packages-to-build.R

options(error = function() {
  cat("ERROR:", geterrmessage(), "\n", file = stdout())
  traceback(2)
  q(status = 1)
})

library(bincraft, quietly = TRUE)
suppressPackageStartupMessages(library(dplyr))
library(DBI, quietly = TRUE)
library(purrr, quietly = TRUE)
library(progressr, quietly = TRUE)
suppressPackageStartupMessages(library(data.table))

# Sys.setenv("OS" = "alpine")
# Sys.setenv("OS_VERSION" = "3.22")
# Sys.setenv("ARCH" = "arm64")

arch = Sys.getenv("ARCH")
# target: alpine-322, ubuntu-2404, redhat-9, etc.
platform = paste(Sys.getenv("OS"), gsub("[.]", "", Sys.getenv("OS_VERSION")), sep = "-")
# Use bincraft's codename detection for S3 paths (e.g. "rhel10" not "redhat10")
codename = bincraft::set_codename(NULL)

con <- DBI::dbConnect(
  RPostgres::Postgres(),
  dbname = "build_metadata",
  host = "r-binaries.devxy.io",
  port = 15432,
  user = "rpkgs",
  password = Sys.getenv("PGPASS"),
  sslmode = "require"
)

cran_archive = tools::CRAN_archive_db()
cran_release = tools::CRAN_package_db()
# Subset cran_archive to only those packages
cran_archive_in_release <- cran_archive[names(cran_archive) %in% cran_release$Package]

archive_versions <- rbindlist(
  lapply(names(cran_archive), function(pkg) {
    df <- as.data.table(cran_archive_in_release[[pkg]])
    file_names <- rownames(cran_archive_in_release[[pkg]]) # Get row names from the original data.frame!
    versions <- sub(".*_(.*)\\.tar\\.gz$", "\\1", file_names)
    data.table(
      Package = pkg,
      Version = versions,
      mtime = df$mtime
    )
  }),
  fill = TRUE
)

# Select the 4 most recent archive versions by mtime for each package
# Combined with the 1 release version = 5 versions per package
archive_versions <- archive_versions[
  order(Package, -as.numeric(mtime))
][,
  head(.SD, 4),
  by = Package
][,
  .(Package, Version)
]

# Now get release versions (assuming cran_release has Package and Version columns)
release_versions <- data.table(
  Package = cran_release$Package,
  Version = as.character(cran_release$Version)
)

pkgs_to_build <- unique(rbind(archive_versions, release_versions, fill = TRUE))
setorder(pkgs_to_build, Package, Version)

### Get all packages in S3
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_pkgs = s3fs::s3_dir_ls(
  sprintf("devxy-rpkgs-binaries/%s/%s/latest/src/contrib", arch, codename),
  recurse = TRUE
)

# Save the raw S3 file listing for the build step to use as s3_package_cache
# This avoids loading s3fs/reticulate in the build container, saving memory for pak forks
saveRDS(basename(s3_pkgs), "/mnt/cache/packages/s3_cache.rds")

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

### Get all packages with build errors

sql_query <- paste0(
  # nolint
  "SELECT error_occurred FROM ",
  "single_builds",
  " WHERE name = $1 AND tag = $2 AND platform = $3 AND arch = $4"
)
# Function to query for a single package-version
query_error <- function(pkg, ver) {
  purrr::insistently(
    ~ DBI::dbGetQuery(
      con,
      sql_query,
      params = list(pkg, ver, platform, arch)
    ),
    rate = purrr::rate_backoff(
      pause_base = 1L,
      pause_cap = 60L,
      pause_min = 1L,
      max_times = 10L,
      jitter = FALSE
    ),
    quiet = FALSE
  )()
}

# Fetch all relevant columns from the database
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_pkgs <- as.data.table(errored_pkgs)
setkey(pkgs_to_build, Package, Version)
setnames(errored_pkgs, c("Package","Version"))
setkey(errored_pkgs, Package, Version)

### Final subsetting
pkgs_no_error <- pkgs_to_build[!errored_pkgs]
# Return the full (Package, Version) pairs that need building
pkgs <- pkgs_no_error[!s3_dt]
# Deduplicate
pkgs <- unique(pkgs)
setorder(pkgs, Package, Version)