build-cran-binaries/local/build-newer-r.R

source(file.path("local", "newer-r-helpers.R"))
source(file.path("local", "rebuild-missing-helpers.R"))
source(file.path("local", "r-minor-helpers.R"))

args <- commandArgs(trailingOnly = TRUE)
pos <- args[!startsWith(args, "--")]
if (!length(pos) %in% c(1L, 3L)) {
  stop("Usage: build-newer-r.R PRIMARY_R [SPLIT_INTO SPLIT_INDEX] [--dry-run]")
}
primary_r <- pos[1L]
target_r <- as.character(getRversion())
pkgs <- newer_r_candidates(tools::CRAN_package_db(), primary_r, target_r)
exclude <- jsonlite::fromJSON("local/excluded-packages.json")[["package"]]
pkgs <- pkgs[!pkgs$Package %in% exclude, , drop = FALSE]
if (length(pos) == 3L) {
  pkgs <- pkgs[
    shard_slice(seq_len(nrow(pkgs)), pos[2L], pos[3L]),
    ,
    drop = FALSE
  ]
}
message(sprintf(
  "R %s: %d package(s) unsupported by primary R %s",
  target_r,
  nrow(pkgs),
  primary_r
))
if ("--dry-run" %in% args) {
  print(pkgs, row.names = FALSE)
} else {
  # Most candidates were built on an earlier run. Asking bincraft about each one
  # costs a DB connection plus several S3 requests, about 4s a package, so the
  # loop spent well over an hour per run re-confirming existing binaries.
  # Decide those in bulk first; bincraft still checks whatever is left.
  local_machine <- Sys.info()[["machine"]]
  arch <- if (grepl("arm64|aarch64", local_machine)) "arm64" else "amd64"
  slot_dir <- sprintf(
    "devxy-rpkgs-binaries/%s/%s/latest/src/contrib",
    arch,
    bincraft::set_codename(NULL)
  )
  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
  )
  # NULL when the listing fails, so that route falls back to bincraft.
  list_etags <- function(dir) {
    info <- tryCatch(s3fs::s3_dir_info(dir), error = function(e) {
      message(sprintf("Could not list %s: %s", dir, conditionMessage(e)))
      NULL
    })
    if (is.null(info)) {
      return(NULL)
    }
    stats::setNames(
      gsub('^"|"$', "", as.character(info$etag)),
      basename(as.character(info$uri))
    )
  }
  # The verdicts bincraft::classify_r_minor_sensitive() would read from its
  # cache, fetched in one query rather than one connection per package.
  read_verdicts <- function(packages) {
    tryCatch(
      {
        con <- DBI::dbConnect(
          RPostgres::Postgres(),
          dbname = "build_metadata",
          host = "r-binaries.devxy.io",
          port = 15432,
          user = "rpkgs",
          password = Sys.getenv("PGPASS"),
          sslmode = "verify-full",
          sslrootcert = bincraft::postgres_sslrootcert("verify-full")
        )
        on.exit(DBI::dbDisconnect(con), add = TRUE)
        rows <- DBI::dbGetQuery(
          con,
          paste(
            "SELECT package, version, r_minor_sensitive FROM abi_classification",
            "WHERE classifier_sig = $1 AND package = ANY($2::text[])"
          ),
          params = list(
            bincraft:::abi_classifier_signature(),
            paste0("{", paste(packages, collapse = ","), "}")
          )
        )
        stats::setNames(
          as.logical(rows$r_minor_sensitive),
          paste(rows$package, rows$version, sep = "_")
        )
      },
      error = function(e) {
        message(sprintf("Could not read ABI verdicts: %s", conditionMessage(e)))
        logical()
      }
    )
  }
  sensitive <- read_verdicts(pkgs$Package)
  before <- nrow(pkgs)
  pkgs <- newer_r_outstanding(
    pkgs,
    sensitive,
    list_etags(slot_dir),
    list_etags(file.path(
      slot_dir,
      sub("^(\\d+\\.\\d+).*", "\\1", target_r)
    )),
    bincraft:::cran_source_md5()
  )
  message(sprintf(
    "%d of %d already carry a binary at their routed path; %d left for bincraft",
    before - nrow(pkgs),
    before,
    nrow(pkgs)
  ))

  options(crayon.enabled = TRUE, Ncpus = 4, future.globals.onReference = NULL)
  deadline <- build_deadline()
  for (i in seq_len(nrow(pkgs))) {
    if (deadline_reached(deadline)) {
      message(sprintf(
        "Build deadline reached after %d/%d package(s); stopping cleanly.",
        i - 1L,
        nrow(pkgs)
      ))
      break
    }
    message(sprintf(
      "[%d/%d] %s %s",
      i,
      nrow(pkgs),
      pkgs$Package[i],
      pkgs$Version[i]
    ))
    bincraft::build_binary_package(
      pkgs$Package[i],
      tag = pkgs$Version[i],
      # Keep bincraft's normal ABI routing: safe binaries can be shared;
      # sensitive ones use this interpreter's minor for presence and output.
      is_r_minor_sensitive = bincraft::classify_r_minor_sensitive(
        pkgs$Package[i],
        pkgs$Version[i],
        metadata_db_host = "r-binaries.devxy.io",
        metadata_db_name = "build_metadata",
        metadata_db_user = "rpkgs",
        metadata_db_password = Sys.getenv("PGPASS"),
        metadata_db_sslmode = "verify-full",
        metadata_db_port = 15432
      ),
      s3_endpoint = "https://s3.eu-central-003.backblazeb2.com",
      s3_region = "eu-central-003",
      s3_bucket = "devxy-rpkgs-binaries",
      s3_access_key_id = Sys.getenv("B2_S3_ACCESS_KEY"),
      s3_secret_access_key = Sys.getenv("B2_S3_SECRET_KEY"),
      metadata_db_host = "r-binaries.devxy.io",
      metadata_db_name = "build_metadata",
      metadata_db_table = "single_builds",
      metadata_db_user = "rpkgs",
      metadata_db_password = Sys.getenv("PGPASS"),
      metadata_db_sslmode = "verify-full",
      metadata_db_port = 15432,
      archive = TRUE,
      patches = "local/patches",
      upload = TRUE,
      store_build_metadata = TRUE
    )
  }
}