build-cran-binaries/local/check-slots.R

### Fail when a pipeline targets a slot that is not in `local.rpkgs_slots`.
#
#   Rscript local/check-slots.R
#
# That list feeds `UNION_SLOTS`, which `edge/rpkgs-router.ts` gates per-R-minor
# routing on. An unrouted slot serves the flat index to every client, so its
# binaries fail at dyn.load() under every R minor but one.
#
# One-directional: a published slot missing from some pipeline is only
# reported, since several pipelines cover a subset on purpose.

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

# Parses the distro list out of the setproduct's second array.
published_codenames <- function(path = "cdn.tf") {
  if (!file.exists(path)) {
    stop(
      sprintf("%s not found; run this from the repository root.", path),
      call. = FALSE
    )
  }
  lines <- readLines(path, warn = FALSE)
  start <- grep("rpkgs_slots\\s*=", lines)
  if (length(start) != 1L) {
    stop(
      "Could not find exactly one `rpkgs_slots` local in cdn.tf.",
      call. = FALSE
    )
  }
  block <- paste(lines[start:min(start + 10L, length(lines))], collapse = "\n")
  arrays <- regmatches(block, gregexpr("\\[[^]]*\\]", block))[[1L]]
  if (length(arrays) < 2L) {
    stop(
      "`rpkgs_slots` no longer has the two-array setproduct shape this parses.",
      call. = FALSE
    )
  }
  codenames <- gsub(
    '"',
    "",
    regmatches(arrays[[2L]], gregexpr('"[^"]+"', arrays[[2L]]))[[1L]]
  )
  if (length(codenames) == 0L) {
    stop("Parsed an empty distro list from cdn.tf.", call. = FALSE)
  }
  codenames
}

UBUNTU_CODENAMES <- c(
  resolute = "ubuntu-2604",
  noble = "ubuntu-2404",
  jammy = "ubuntu-2204"
)

as_pipeline_os <- function(codename) {
  ifelse(
    codename %in% names(UBUNTU_CODENAMES),
    UBUNTU_CODENAMES[codename],
    ifelse(
      grepl("^rhel[0-9]+$", codename),
      sub("^rhel", "redhat-", codename),
      ifelse(
        grepl("^alpine[0-9]+$", codename),
        sub("^alpine([0-9])([0-9]+)$", "alpine-\\1\\2", codename),
        NA_character_
      )
    )
  )
}

# Structural lines only, so a codename in a comment is not a finding.
slots_in_pipeline <- function(path) {
  lines <- readLines(path, warn = FALSE)
  row <- regmatches(
    lines,
    regexec("^\\s*-?\\s*(OS|CODENAME|OS_ID):\\s*(\\S+)\\s*$", lines)
  )
  opt <- regmatches(
    lines,
    regexec("^\\s*-\\s*([a-z0-9]+-[a-z0-9]+)-(amd64|arm64)\\s*$", lines)
  )
  hits <- c(
    vapply(
      row,
      function(m) if (length(m) == 3L) m[[3L]] else NA_character_,
      ""
    ),
    vapply(opt, function(m) if (length(m) == 4L) m[[2L]] else NA_character_, "")
  )
  hits <- hits[!is.na(hits)]
  # `OS: alpine` (build-all-versions' bare image name) is not a slot.
  unique(hits[grepl("^(alpine|redhat|ubuntu)-?[0-9]", hits)])
}

codenames <- published_codenames()
published_os <- unname(as_pipeline_os(codenames))
if (anyNA(published_os)) {
  stop(
    sprintf(
      "Unrecognised codename(s) in cdn.tf: %s",
      paste(codenames[is.na(published_os)], collapse = ", ")
    ),
    call. = FALSE
  )
}
# Files spell a slot either way, so accept both.
published <- unique(c(published_os, codenames))

cat(sprintf(
  "Published slots (cdn.tf): %s\n\n",
  paste(sort(published_os), collapse = ", ")
))

files <- sort(list.files(".crow", pattern = "\\.yaml$", full.names = TRUE))
findings <- list()
for (f in files) {
  stale <- setdiff(slots_in_pipeline(f), published)
  if (length(stale) > 0L) {
    findings[[f]] <- stale
    cat(sprintf(
      "%-45s targets unpublished: %s\n",
      f,
      paste(sort(stale), collapse = ", ")
    ))
  }
}

uncovered <- setdiff(
  published_os,
  unique(unlist(lapply(files, slots_in_pipeline)))
)
if (length(uncovered) > 0L) {
  cat(sprintf(
    "\nNote: %s appear(s) in no pipeline at all.\n",
    paste(sort(uncovered), collapse = ", ")
  ))
}

if (length(findings) == 0L) {
  cat("All pipeline slots are published and routed.\n")
  quit(status = 0)
}

cat(sprintf(
  "\n%d file(s) target an unrouted slot. Retire it with:\n  just retire-slot <codename>\n",
  length(findings)
))
quit(status = 1)