From 0ae88bcf0233641142a854f364e75e4ec0de1e2f Mon Sep 17 00:00:00 2001 From: Alex Farach Date: Fri, 10 Jul 2026 03:30:48 -0400 Subject: [PATCH 1/5] Finish cache snapshot contract Co-authored-by: Copilot App <223556219+Copilot@users.noreply.github.com> --- NEWS.md | 2 +- R/cache.R | 117 +++++++++++++++--- R/panel.R | 123 +++++++++++++------ man/onet_archive_download.Rd | 3 + tests/testthat/test-panel.R | 134 +++++++++++++++++++-- tests/testthat/test-request-construction.R | 115 ++++++++++++++++++ 6 files changed, 428 insertions(+), 66 deletions(-) diff --git a/NEWS.md b/NEWS.md index bb4d2da..632a115 100644 --- a/NEWS.md +++ b/NEWS.md @@ -21,7 +21,7 @@ * Cached API responses are written atomically and corrupt RDS files now fail with a specific cache-clear instruction instead of falling through to network access. * Cached archive and adapter files without provenance receipts now fail closed when a URL, version, `as_of`, or expected digest is requested. Unconstrained internal reuse warns and records a `legacy_unverified` receipt, while `force = TRUE` replaces the legacy bytes without exposing URL credentials. -* Cached archive and adapter readers now copy verified bytes to a private snapshot while holding the cache lock, so a concurrent refresh cannot separate parsed data from its source receipt. OAuth authorization `code` parameters are redacted with other URL credentials. +* Cached archive readers now acquire matching bytes and receipts and create a verified private snapshot under one cache lock, so a concurrent forced refresh cannot change the archive being parsed. URL credential redaction now uses explicit normalized parameter names, preserving benign parameters such as `author`, `monkey`, and `keyboard`. * Clean-install validation now builds a source tarball, installs it into temporary libraries outside the repository, exercises every public export with deterministic offline fixtures, and runs twice in pull-request CI. * O*NET archive and external-adapter downloads now support optional `expected_sha256` and `as_of` verification, write atomic source receipts with URL, commit when inferable, retrieval time, digest, size, and version metadata, and reject changed or mismatched cached sources. * Pull requests now require installed-package tests with network access blocked plus a complete pkgdown reference check and site build; deployment remains limited to pushes on `main`. diff --git a/R/cache.R b/R/cache.R index add6663..e070d7e 100644 --- a/R/cache.R +++ b/R/cache.R @@ -187,11 +187,69 @@ onet_receipt_value <- function(x) { as.character(x) } +onet_normalize_url_parameter_name <- function(name) { + name <- utils::URLdecode(name) + name <- gsub( + "([[:upper:]]+)([[:upper:]][[:lower:]])", + "\\1_\\2", + name, + perl = TRUE + ) + name <- gsub( + "([[:lower:][:digit:]])([[:upper:]])", + "\\1_\\2", + name, + perl = TRUE + ) + tolower(gsub("[.-]+", "_", name)) +} + onet_url_parameter_is_sensitive <- function(name) { - name <- tolower(utils::URLdecode(name)) - name == "code" || grepl( - "auth|credential|key|passwd|password|secret|sig|signature|token", - name + name <- onet_normalize_url_parameter_name(name) + name %in% c( + "code", + "access_token", + "id_token", + "refresh_token", + "token", + "api_key", + "apikey", + "x_api_key", + "subscription_key", + "ocp_apim_subscription_key", + "key", + "client_secret", + "consumer_secret", + "secret", + "password", + "passwd", + "pwd", + "signature", + "sig", + "credential", + "credentials", + "authorization", + "auth", + "oauth_token", + "oauth_verifier", + "auth_token", + "bearer_token", + "security_token", + "session_token", + "private_key", + "client_assertion", + "aws_access_key_id", + "aws_secret_access_key", + "aws_session_token", + "x_amz_credential", + "x_amz_signature", + "x_amz_security_token", + "x_goog_credential", + "x_goog_signature", + "x_goog_security_token", + "google_access_id", + "shared_access_signature", + "sas_token" ) } @@ -356,6 +414,19 @@ onet_atomic_commit_source <- function( dest, receipt, return_snapshot = FALSE) { + onet_with_cache_lock(dest, onet_atomic_commit_source_unlocked( + tmp = tmp, + dest = dest, + receipt = receipt, + return_snapshot = return_snapshot + )) +} + +onet_atomic_commit_source_unlocked <- function( + tmp, + dest, + receipt, + return_snapshot = FALSE) { receipt_dest <- onet_receipt_path(dest) receipt_tmp <- tempfile( paste0(".", basename(receipt_dest), "-write-"), @@ -378,7 +449,7 @@ onet_atomic_commit_source <- function( }, add = TRUE) } - result <- onet_with_cache_lock(dest, { + commit <- function() { old_paths <- c(dest, receipt_dest) backups <- rep(NA_character_, length(old_paths)) installed <- character() @@ -441,7 +512,8 @@ onet_atomic_commit_source <- function( } else { invisible(dest) } - }) + } + result <- commit() snapshot_success <- isTRUE(return_snapshot) result } @@ -524,6 +596,21 @@ onet_cached_source_snapshot <- function( expected_sha256 = NULL, version = NULL, as_of = NULL) { + onet_with_cache_lock(path, onet_cached_source_snapshot_unlocked( + path = path, + source_url = source_url, + expected_sha256 = expected_sha256, + version = version, + as_of = as_of + )) +} + +onet_cached_source_snapshot_unlocked <- function( + path, + source_url = NULL, + expected_sha256 = NULL, + version = NULL, + as_of = NULL) { extension <- tools::file_ext(path) snapshot <- tempfile( "onet-cache-snapshot-", @@ -536,16 +623,14 @@ onet_cached_source_snapshot <- function( } }, add = TRUE) - result <- onet_with_cache_lock(path, { - receipt <- onet_cached_source_receipt_unlocked( - path = path, - source_url = source_url, - expected_sha256 = expected_sha256, - version = version, - as_of = as_of - ) - onet_copy_verified_snapshot(path, receipt, snapshot) - }) + receipt <- onet_cached_source_receipt_unlocked( + path = path, + source_url = source_url, + expected_sha256 = expected_sha256, + version = version, + as_of = as_of + ) + result <- onet_copy_verified_snapshot(path, receipt, snapshot) success <- TRUE result } diff --git a/R/panel.R b/R/panel.R index 3d5aa3f..749059b 100644 --- a/R/panel.R +++ b/R/panel.R @@ -106,6 +106,9 @@ archive_version_from_link <- function(link) { #' supply `expected_sha256` when an independently verified digest is available. #' A cached archive without a receipt cannot satisfy the requested URL or #' version provenance. Use `force = TRUE` to replace legacy cached bytes. +#' The returned path is the shared cache location and can be replaced by a later +#' forced download. [onet_archive_read()] parses a private verified snapshot +#' rather than this mutable path. #' @export #' #' @examples @@ -119,6 +122,23 @@ onet_archive_download <- function( force = FALSE, expected_sha256 = NULL, as_of = NULL) { + acquired <- onet_archive_acquire( + version = version, + dir = dir, + force = force, + expected_sha256 = expected_sha256, + as_of = as_of + ) + on.exit(unlink(acquired$snapshot, force = TRUE), add = TRUE) + acquired$cache_path +} + +onet_archive_acquire <- function( + version, + dir = onet_cache_dir(), + force = FALSE, + expected_sha256 = NULL, + as_of = NULL) { validate_single_string(version, "version") validate_single_string(dir, "dir") if (!is.logical(force) || length(force) != 1 || is.na(force)) { @@ -138,27 +158,56 @@ onet_archive_download <- function( dest_name <- basename(sub("[?#].*$", "", release$text_url[[1]])) dest <- file.path(archive_dir, dest_name) - if (file.exists(dest) && file.info(dest)$size > 0 && !isTRUE(force)) { - snapshot <- onet_cached_source_snapshot( - path = dest, - source_url = release$text_url[[1]], - expected_sha256 = expected_sha256, - version = version, - as_of = as_of - ) - on.exit(unlink(snapshot, force = TRUE), add = TRUE) - validate_archive_zip(snapshot) - return(dest) - } + onet_with_cache_lock( + dest, + { + if (file.exists(dest) && file.info(dest)$size > 0 && !isTRUE(force)) { + snapshot <- onet_cached_source_snapshot_unlocked( + path = dest, + source_url = release$text_url[[1]], + expected_sha256 = expected_sha256, + version = version, + as_of = as_of + ) + snapshot <- onet_validate_archive_snapshot(snapshot) + receipt <- attr(snapshot, "source_receipt", exact = TRUE) + } else { + tmp <- tempfile("onet-archive-", tmpdir = archive_dir, fileext = ".zip") + on.exit(unlink(tmp, force = TRUE), add = TRUE) + onet_archive_download_file(release$text_url[[1]], tmp) + receipt <- onet_source_receipt( + path = tmp, + source_url = release$text_url[[1]], + expected_sha256 = expected_sha256, + version = version, + as_of = as_of + ) + validate_archive_zip(tmp) + snapshot <- onet_atomic_commit_source_unlocked( + tmp, + dest, + receipt, + return_snapshot = TRUE + ) + snapshot <- onet_validate_archive_snapshot(snapshot) + } + list( + snapshot = snapshot, + receipt = receipt, + cache_path = dest + ) + }, + timeout = max(300, getOption("timeout", 60)) + ) +} - tmp <- tempfile("onet-archive-", tmpdir = archive_dir, fileext = ".zip") - on.exit(unlink(tmp, force = TRUE), add = TRUE) +onet_archive_download_file <- function(url, dest) { download_warned <- FALSE status <- tryCatch( withCallingHandlers( utils::download.file( - url = release$text_url[[1]], - destfile = tmp, + url = url, + destfile = dest, mode = "wb", quiet = TRUE ), @@ -168,7 +217,7 @@ onet_archive_download <- function( } ), error = function(cnd) { - safe_url <- onet_redact_url_credentials(release$text_url[[1]]) + safe_url <- onet_redact_url_credentials(url) cli::cli_abort( c( "Failed to download O*NET archive.", @@ -178,10 +227,10 @@ onet_archive_download <- function( } ) if (download_warned && identical(status, 0L)) { - onet_warn_download_completed(release$text_url[[1]], "O*NET archive") + onet_warn_download_completed(url, "O*NET archive") } if (!identical(status, 0L)) { - safe_url <- onet_redact_url_credentials(release$text_url[[1]]) + safe_url <- onet_redact_url_credentials(url) cli::cli_abort( c( "Failed to download O*NET archive.", @@ -189,18 +238,19 @@ onet_archive_download <- function( ) ) } + invisible(dest) +} - receipt <- onet_source_receipt( - path = tmp, - source_url = release$text_url[[1]], - expected_sha256 = expected_sha256, - version = version, - as_of = as_of - ) - validate_archive_zip(tmp) - onet_atomic_commit_source(tmp, dest, receipt) - - dest +onet_validate_archive_snapshot <- function(snapshot) { + success <- FALSE + on.exit({ + if (!success) { + unlink(snapshot, force = TRUE) + } + }, add = TRUE) + validate_archive_zip(snapshot) + success <- TRUE + snapshot } #' Read an O*NET Archive Table @@ -233,16 +283,9 @@ onet_archive_read <- function(version, table, path = NULL, release_date = NULL) } archive <- if (is.null(path)) { - cache_path <- onet_archive_download(version) - release <- onet_releases() - release <- release[release$version == version, , drop = FALSE] - snapshot <- onet_cached_source_snapshot( - path = cache_path, - source_url = release$text_url[[1]], - version = version - ) - on.exit(unlink(snapshot, force = TRUE), add = TRUE) - snapshot + acquired <- onet_archive_acquire(version) + on.exit(unlink(acquired$snapshot, force = TRUE), add = TRUE) + acquired$snapshot } else { path } diff --git a/man/onet_archive_download.Rd b/man/onet_archive_download.Rd index f80cb0f..f8fbd12 100644 --- a/man/onet_archive_download.Rd +++ b/man/onet_archive_download.Rd @@ -41,6 +41,9 @@ optional \code{as_of} metadata. The archive URLs are not assumed to be immutable supply \code{expected_sha256} when an independently verified digest is available. A cached archive without a receipt cannot satisfy the requested URL or version provenance. Use \code{force = TRUE} to replace legacy cached bytes. +The returned path is the shared cache location and can be replaced by a later +forced download. \code{\link[=onet_archive_read]{onet_archive_read()}} parses a private verified snapshot +rather than this mutable path. } \examples{ if (interactive()) { diff --git a/tests/testthat/test-panel.R b/tests/testthat/test-panel.R index 46abc41..a292aec 100644 --- a/tests/testthat/test-panel.R +++ b/tests/testthat/test-panel.R @@ -323,22 +323,83 @@ test_that("archive force redownload replaces a receiptless legacy archive", { expect_equal(receipt$provenance_status, "recorded") }) +test_that("archive force acquisition returns matching private bytes and receipt", { + source <- tiny_archive_zip(first_value = 7.12) + source_url <- paste0( + "file:///", + sub("^/", "", normalizePath(source, winslash = "/")) + ) + cache_dir <- withr::local_tempdir() + archive_dir <- file.path(cache_dir, "archives") + dir.create(archive_dir) + dest <- file.path(archive_dir, basename(source)) + writeBin(charToRaw("legacy bytes"), dest) + original_copy <- onet2r:::onet_copy_cache_snapshot + original_lock <- onet2r:::onet_with_cache_lock + copied_under_lock <- FALSE + lock_timeout <- NULL + + local_mocked_bindings( + onet_releases = function() { + tibble::tibble(version = "30.3", text_url = source_url) + }, + onet_copy_cache_snapshot = function(from, to) { + copied_under_lock <<- dir.exists(paste0(dest, ".lock")) + original_copy(from, to) + }, + onet_with_cache_lock = function(path, code, timeout = 10) { + lock_timeout <<- timeout + original_lock(path, force(code), timeout = timeout) + }, + .package = "onet2r" + ) + + acquired <- onet2r:::onet_archive_acquire( + "30.3", + dir = cache_dir, + force = TRUE, + as_of = "2026-05" + ) + on.exit(unlink(acquired$snapshot, force = TRUE), add = TRUE) + + expect_equal(copied_under_lock, TRUE) + expect_gte(lock_timeout, 300) + expect_equal(acquired$cache_path, dest) + expect_equal( + onet2r:::onet_sha256(acquired$snapshot), + acquired$receipt$actual_sha256 + ) + expect_equal( + attr(acquired$snapshot, "source_receipt", exact = TRUE), + acquired$receipt + ) + expect_equal(acquired$receipt$as_of, "2026-05") +}) + test_that("onet_archive_read normalizes descriptor archive tables", { zipfile <- tiny_archive_zip() url <- "https://www.onetcenter.org/dl_files/database/db_30_3_text.zip" - saveRDS( - onet2r:::onet_source_receipt( - zipfile, - source_url = url, - version = "30.3" - ), - paste0(zipfile, ".receipt.rds") + receipt <- onet2r:::onet_source_receipt( + zipfile, + source_url = url, + version = "30.3" ) + snapshot <- tempfile(fileext = ".zip") + file.copy(zipfile, snapshot) local_mocked_bindings( - onet_archive_download = function(version, dir = onet_cache_dir(), force = FALSE) { + onet_archive_acquire = function( + version, + dir = onet_cache_dir(), + force = FALSE, + expected_sha256 = NULL, + as_of = NULL) { expect_equal(version, "30.3") - zipfile + list( + snapshot = structure(snapshot, source_receipt = receipt), + receipt = receipt, + cache_path = zipfile + ) }, onet_releases = function() { tibble::tibble( @@ -393,7 +454,11 @@ test_that("archive reads consume a verified snapshot during cache replacement", ) saveRDS(receipt_a, paste0(dest, ".receipt.rds")) original_member <- onet2r:::onet_archive_member + original_copy <- onet2r:::onet_copy_cache_snapshot snapshot_path <- NULL + snapshot_receipt <- NULL + snapshot_digest <- NULL + snapshot_copied_under_lock <- FALSE replaced <- FALSE local_mocked_bindings( @@ -406,8 +471,14 @@ test_that("archive reads consume a verified snapshot during cache replacement", text_url = url ) }, + onet_copy_cache_snapshot = function(from, to) { + snapshot_copied_under_lock <<- dir.exists(paste0(dest, ".lock")) + original_copy(from, to) + }, onet_archive_member = function(archive, table) { snapshot_path <<- archive + snapshot_receipt <<- attr(archive, "source_receipt", exact = TRUE) + snapshot_digest <<- onet2r:::onet_sha256(archive) if (!replaced) { replacement <- tempfile("archive-b-", tmpdir = archive_dir, fileext = ".zip") file.copy(source_b, replacement) @@ -427,7 +498,14 @@ test_that("archive reads consume a verified snapshot during cache replacement", result <- onet_archive_read("30.3", "Abilities") expect_equal(result$data_value[[1]], 4.12) + expect_equal(snapshot_copied_under_lock, TRUE) + expect_equal(snapshot_digest, receipt_a$actual_sha256) + expect_equal(snapshot_receipt$actual_sha256, receipt_a$actual_sha256) expect_equal(onet2r:::onet_sha256(dest), onet2r:::onet_sha256(source_b)) + expect_equal( + readRDS(paste0(dest, ".receipt.rds"))$actual_sha256, + onet2r:::onet_sha256(source_b) + ) expect_equal(file.exists(snapshot_path), FALSE) }) @@ -471,6 +549,44 @@ test_that("archive snapshots are removed when archive parsing errors", { "injected archive parse failure" ) expect_equal(file.exists(snapshot_path), FALSE) + expect_equal(dir.exists(paste0(dest, ".lock")), FALSE) +}) + +test_that("failed archive acquisition removes snapshots and cache locks", { + source <- tiny_archive_zip() + cache_dir <- withr::local_tempdir() + archive_dir <- file.path(cache_dir, "archives") + dir.create(archive_dir) + url <- "https://www.onetcenter.org/dl_files/database/db_30_3_text.zip" + dest <- file.path(archive_dir, basename(url)) + file.copy(source, dest) + saveRDS( + onet2r:::onet_source_receipt( + dest, + source_url = url, + version = "30.3" + ), + paste0(dest, ".receipt.rds") + ) + snapshot_path <- NULL + + local_mocked_bindings( + onet_releases = function() { + tibble::tibble(version = "30.3", text_url = url) + }, + validate_archive_zip = function(path) { + snapshot_path <<- path + stop("injected archive validation failure") + }, + .package = "onet2r" + ) + + expect_error( + onet2r:::onet_archive_acquire("30.3", dir = cache_dir), + "injected archive validation failure" + ) + expect_equal(file.exists(snapshot_path), FALSE) + expect_equal(dir.exists(paste0(dest, ".lock")), FALSE) }) test_that("archive reader resolves spaced table names", { diff --git a/tests/testthat/test-request-construction.R b/tests/testthat/test-request-construction.R index e18a21b..1fcce98 100644 --- a/tests/testthat/test-request-construction.R +++ b/tests/testthat/test-request-construction.R @@ -525,6 +525,121 @@ test_that("OAuth authorization codes are redacted without hiding benign paramete ) }) +test_that("sensitive URL parameter matching is explicit and normalized", { + sensitive <- c( + "code", "access_token", "accessToken", "ID-TOKEN", "idToken", + "refresh.token", "refreshToken", "token", "api_key", "apiKey", "apikey", + "key", "client_secret", "clientSecret", "password", "passwd", + "signature", "sig", "credential", "authorization", "auth", + "x-amz-credential", "xAmzCredential", "X-Amz-Signature", + "x-amz-security-token", + "oauth_token", "auth-token", "bearer.token", "session_token", + "aws_access_key_id", "aws_secret_access_key" + ) + benign <- c( + "author", "monkey", "hockey", "keyboard", "donkey", "tokenizer", + "signature_method", "credential_type", "authorization_mode", + "state", "mode", "variant" + ) + + expect_equal( + unname(vapply( + sensitive, + onet2r:::onet_url_parameter_is_sensitive, + logical(1) + )), + rep(TRUE, length(sensitive)) + ) + expect_equal( + unname(vapply( + benign, + onet2r:::onet_url_parameter_is_sensitive, + logical(1) + )), + rep(FALSE, length(benign)) + ) + expect_equal( + onet2r:::onet_url_parameter_is_sensitive("access%5Ftoken"), + TRUE + ) +}) + +test_that("URL redaction preserves benign parameters in all reporting paths", { + url <- paste0( + "https://example.invalid/source.csv?", + "author=alice&monkey=capuchin&keyboard=qwerty&api%5Fkey=query-secret&", + "clientSecret=camel-secret", + "#route?state=visible&AUTH=fragment-secret&hockey=ice" + ) + safe_url <- paste0( + "https://example.invalid/source.csv?", + "author=alice&monkey=capuchin&keyboard=qwerty&api_key=[REDACTED]&", + "clientSecret=[REDACTED]", + "#route?state=visible&AUTH=[REDACTED]&hockey=ice" + ) + path <- tempfile(fileext = ".csv") + on.exit(unlink(path), add = TRUE) + writeLines("source", path) + + expect_equal(onet2r:::onet_redact_url_credentials(url), safe_url) + receipt <- onet2r:::onet_source_receipt(path, source_url = url) + expect_equal(receipt$source_url, safe_url) + expect_no_match( + receipt$source_url, + "query-secret|camel-secret|fragment-secret" + ) + expect_match( + receipt$source_url, + "author=alice&monkey=capuchin&keyboard=qwerty", + fixed = TRUE + ) + + warning_message <- NULL + withCallingHandlers( + onet2r:::onet_warn_download_completed(url, "fixture"), + warning = function(cnd) { + warning_message <<- conditionMessage(cnd) + invokeRestart("muffleWarning") + } + ) + expect_no_match( + warning_message, + "query-secret|camel-secret|fragment-secret" + ) + expect_match(warning_message, "author=alice", fixed = TRUE) + expect_match(warning_message, "hockey=ice", fixed = TRUE) + + malformed <- paste0( + "http://[bad]?author=alice&monkey=capuchin&", + "X-Amz-Security-Token=error-secret#route?", + "hockey=ice&signature=fragment-error-secret" + ) + expect_equal( + onet2r:::onet_redact_url_credentials(malformed), + paste0( + "http://[bad]?author=alice&monkey=capuchin&", + "X-Amz-Security-Token=[REDACTED]#route?", + "hockey=ice&signature=[REDACTED]" + ) + ) + + cache_dir <- withr::local_tempdir() + condition <- tryCatch( + onet2r:::download_import_file( + paste0( + "bad://example.invalid/source.csv?", + "author=alice&signature=error-secret" + ), + cache_dir = cache_dir, + force = TRUE + ), + error = identity + ) + message <- conditionMessage(condition) + expect_no_match(message, "error-secret") + expect_match(message, "author=alice", fixed = TRUE) +}) + test_that("failed cache snapshot creation removes the private copy", { cache_dir <- withr::local_tempdir() path <- file.path(cache_dir, "source.csv") From 3867a94f0d623d61f5684e6c0f1efcb8a0657db3 Mon Sep 17 00:00:00 2001 From: Alex Farach Date: Fri, 10 Jul 2026 03:39:25 -0400 Subject: [PATCH 2/5] Cover common credential key aliases Co-authored-by: Copilot App <223556219+Copilot@users.noreply.github.com> --- R/cache.R | 3 +++ tests/testthat/test-request-construction.R | 11 ++++++----- 2 files changed, 9 insertions(+), 5 deletions(-) diff --git a/R/cache.R b/R/cache.R index 150365a..0996862 100644 --- a/R/cache.R +++ b/R/cache.R @@ -218,6 +218,9 @@ onet_url_parameter_is_sensitive <- function(name) { "subscription_key", "ocp_apim_subscription_key", "key", + "access_key", + "secret_key", + "consumer_key", "client_secret", "consumer_secret", "secret", diff --git a/tests/testthat/test-request-construction.R b/tests/testthat/test-request-construction.R index 1fcce98..0db1c27 100644 --- a/tests/testthat/test-request-construction.R +++ b/tests/testthat/test-request-construction.R @@ -529,7 +529,8 @@ test_that("sensitive URL parameter matching is explicit and normalized", { sensitive <- c( "code", "access_token", "accessToken", "ID-TOKEN", "idToken", "refresh.token", "refreshToken", "token", "api_key", "apiKey", "apikey", - "key", "client_secret", "clientSecret", "password", "passwd", + "key", "access_key", "secretKey", "consumer-key", "client_secret", + "clientSecret", "password", "passwd", "signature", "sig", "credential", "authorization", "auth", "x-amz-credential", "xAmzCredential", "X-Amz-Signature", "x-amz-security-token", @@ -568,13 +569,13 @@ test_that("URL redaction preserves benign parameters in all reporting paths", { url <- paste0( "https://example.invalid/source.csv?", "author=alice&monkey=capuchin&keyboard=qwerty&api%5Fkey=query-secret&", - "clientSecret=camel-secret", + "clientSecret=camel-secret&secretKey=key-secret", "#route?state=visible&AUTH=fragment-secret&hockey=ice" ) safe_url <- paste0( "https://example.invalid/source.csv?", "author=alice&monkey=capuchin&keyboard=qwerty&api_key=[REDACTED]&", - "clientSecret=[REDACTED]", + "clientSecret=[REDACTED]&secretKey=[REDACTED]", "#route?state=visible&AUTH=[REDACTED]&hockey=ice" ) path <- tempfile(fileext = ".csv") @@ -586,7 +587,7 @@ test_that("URL redaction preserves benign parameters in all reporting paths", { expect_equal(receipt$source_url, safe_url) expect_no_match( receipt$source_url, - "query-secret|camel-secret|fragment-secret" + "query-secret|camel-secret|key-secret|fragment-secret" ) expect_match( receipt$source_url, @@ -604,7 +605,7 @@ test_that("URL redaction preserves benign parameters in all reporting paths", { ) expect_no_match( warning_message, - "query-secret|camel-secret|fragment-secret" + "query-secret|camel-secret|key-secret|fragment-secret" ) expect_match(warning_message, "author=alice", fixed = TRUE) expect_match(warning_message, "hockey=ice", fixed = TRUE) From d2d72b93ddf8993a8584c2b0e6e79fc26f789ce4 Mon Sep 17 00:00:00 2001 From: Alex Farach Date: Fri, 10 Jul 2026 03:53:45 -0400 Subject: [PATCH 3/5] Redact collapsed credential aliases Co-authored-by: Copilot App <223556219+Copilot@users.noreply.github.com> --- R/cache.R | 5 ++++- tests/testthat/test-request-construction.R | 7 ++++--- 2 files changed, 8 insertions(+), 4 deletions(-) diff --git a/R/cache.R b/R/cache.R index 0996862..66bb695 100644 --- a/R/cache.R +++ b/R/cache.R @@ -206,7 +206,7 @@ onet_normalize_url_parameter_name <- function(name) { onet_url_parameter_is_sensitive <- function(name) { name <- onet_normalize_url_parameter_name(name) - name %in% c( + sensitive_names <- c( "code", "access_token", "id_token", @@ -254,6 +254,9 @@ onet_url_parameter_is_sensitive <- function(name) { "shared_access_signature", "sas_token" ) + name %in% sensitive_names || + gsub("_", "", name, fixed = TRUE) %in% + gsub("_", "", sensitive_names, fixed = TRUE) } onet_redact_url_parameters <- function(parameters) { diff --git a/tests/testthat/test-request-construction.R b/tests/testthat/test-request-construction.R index 0db1c27..4c1ae88 100644 --- a/tests/testthat/test-request-construction.R +++ b/tests/testthat/test-request-construction.R @@ -529,8 +529,9 @@ test_that("sensitive URL parameter matching is explicit and normalized", { sensitive <- c( "code", "access_token", "accessToken", "ID-TOKEN", "idToken", "refresh.token", "refreshToken", "token", "api_key", "apiKey", "apikey", - "key", "access_key", "secretKey", "consumer-key", "client_secret", - "clientSecret", "password", "passwd", + "key", "access_key", "accesskey", "secretKey", "secretkey", + "consumer-key", "consumerkey", "client_secret", "clientSecret", + "clientsecret", "password", "passwd", "signature", "sig", "credential", "authorization", "auth", "x-amz-credential", "xAmzCredential", "X-Amz-Signature", "x-amz-security-token", @@ -538,7 +539,7 @@ test_that("sensitive URL parameter matching is explicit and normalized", { "aws_access_key_id", "aws_secret_access_key" ) benign <- c( - "author", "monkey", "hockey", "keyboard", "donkey", "tokenizer", + "author", "monkey", "hockey", "keyboard", "key_board", "donkey", "tokenizer", "signature_method", "credential_type", "authorization_mode", "state", "mode", "variant" ) From 91fdaacc9ce216b3ff43c9cf6bc2890f676717f4 Mon Sep 17 00:00:00 2001 From: Alex Farach Date: Fri, 10 Jul 2026 04:14:05 -0400 Subject: [PATCH 4/5] Preserve shared archive path behavior Co-authored-by: Copilot App <223556219+Copilot@users.noreply.github.com> --- R/panel.R | 74 ++++++++++++++++++++++++++----------- tests/testthat/test-panel.R | 19 ++++++++-- 2 files changed, 68 insertions(+), 25 deletions(-) diff --git a/R/panel.R b/R/panel.R index 749059b..2b666ad 100644 --- a/R/panel.R +++ b/R/panel.R @@ -127,10 +127,10 @@ onet_archive_download <- function( dir = dir, force = force, expected_sha256 = expected_sha256, - as_of = as_of + as_of = as_of, + return_snapshot = FALSE ) - on.exit(unlink(acquired$snapshot, force = TRUE), add = TRUE) - acquired$cache_path + acquired } onet_archive_acquire <- function( @@ -138,12 +138,20 @@ onet_archive_acquire <- function( dir = onet_cache_dir(), force = FALSE, expected_sha256 = NULL, - as_of = NULL) { + as_of = NULL, + return_snapshot = FALSE) { validate_single_string(version, "version") validate_single_string(dir, "dir") if (!is.logical(force) || length(force) != 1 || is.na(force)) { cli::cli_abort("{.arg force} must be `TRUE` or `FALSE`.") } + if ( + !is.logical(return_snapshot) || + length(return_snapshot) != 1 || + is.na(return_snapshot) + ) { + cli::cli_abort("{.arg return_snapshot} must be `TRUE` or `FALSE`.") + } expected_sha256 <- onet_normalize_sha256(expected_sha256) as_of <- onet_normalize_as_of(as_of) @@ -162,15 +170,32 @@ onet_archive_acquire <- function( dest, { if (file.exists(dest) && file.info(dest)$size > 0 && !isTRUE(force)) { - snapshot <- onet_cached_source_snapshot_unlocked( - path = dest, - source_url = release$text_url[[1]], - expected_sha256 = expected_sha256, - version = version, - as_of = as_of - ) - snapshot <- onet_validate_archive_snapshot(snapshot) - receipt <- attr(snapshot, "source_receipt", exact = TRUE) + if (isTRUE(return_snapshot)) { + snapshot <- onet_cached_source_snapshot_unlocked( + path = dest, + source_url = release$text_url[[1]], + expected_sha256 = expected_sha256, + version = version, + as_of = as_of + ) + snapshot <- onet_validate_archive_snapshot(snapshot) + receipt <- attr(snapshot, "source_receipt", exact = TRUE) + result <- list( + snapshot = snapshot, + receipt = receipt, + cache_path = dest + ) + } else { + onet_cached_source_receipt_unlocked( + path = dest, + source_url = release$text_url[[1]], + expected_sha256 = expected_sha256, + version = version, + as_of = as_of + ) + validate_archive_zip(dest) + result <- dest + } } else { tmp <- tempfile("onet-archive-", tmpdir = archive_dir, fileext = ".zip") on.exit(unlink(tmp, force = TRUE), add = TRUE) @@ -183,19 +208,24 @@ onet_archive_acquire <- function( as_of = as_of ) validate_archive_zip(tmp) - snapshot <- onet_atomic_commit_source_unlocked( + committed <- onet_atomic_commit_source_unlocked( tmp, dest, receipt, - return_snapshot = TRUE + return_snapshot = return_snapshot ) - snapshot <- onet_validate_archive_snapshot(snapshot) + if (isTRUE(return_snapshot)) { + snapshot <- onet_validate_archive_snapshot(committed) + result <- list( + snapshot = snapshot, + receipt = receipt, + cache_path = dest + ) + } else { + result <- committed + } } - list( - snapshot = snapshot, - receipt = receipt, - cache_path = dest - ) + result }, timeout = max(300, getOption("timeout", 60)) ) @@ -283,7 +313,7 @@ onet_archive_read <- function(version, table, path = NULL, release_date = NULL) } archive <- if (is.null(path)) { - acquired <- onet_archive_acquire(version) + acquired <- onet_archive_acquire(version, return_snapshot = TRUE) on.exit(unlink(acquired$snapshot, force = TRUE), add = TRUE) acquired$snapshot } else { diff --git a/tests/testthat/test-panel.R b/tests/testthat/test-panel.R index 281f5b7..ac41919 100644 --- a/tests/testthat/test-panel.R +++ b/tests/testthat/test-panel.R @@ -142,6 +142,9 @@ test_that("archive cache verifies digests and records a receipt", { text_url = url ) }, + onet_copy_cache_snapshot = function(...) { + stop("public archive download created a private snapshot") + }, .package = "onet2r" ) @@ -305,6 +308,9 @@ test_that("archive force redownload replaces a receiptless legacy archive", { onet_releases = function() { tibble::tibble(version = "30.3", text_url = source_url) }, + onet_copy_cache_snapshot = function(...) { + stop("public archive download created a private snapshot") + }, .package = "onet2r" ) @@ -362,7 +368,8 @@ test_that("archive force acquisition returns matching private bytes and receipt" "30.3", dir = cache_dir, force = TRUE, - as_of = "2026-05" + as_of = "2026-05", + return_snapshot = TRUE ) on.exit(unlink(acquired$snapshot, force = TRUE), add = TRUE) @@ -397,8 +404,10 @@ test_that("onet_archive_read normalizes descriptor archive tables", { dir = onet_cache_dir(), force = FALSE, expected_sha256 = NULL, - as_of = NULL) { + as_of = NULL, + return_snapshot = FALSE) { expect_equal(version, "30.3") + expect_equal(return_snapshot, TRUE) list( snapshot = structure(snapshot, source_receipt = receipt), receipt = receipt, @@ -592,7 +601,11 @@ test_that("failed archive acquisition removes snapshots and cache locks", { ) expect_error( - onet2r:::onet_archive_acquire("30.3", dir = cache_dir), + onet2r:::onet_archive_acquire( + "30.3", + dir = cache_dir, + return_snapshot = TRUE + ), "injected archive validation failure" ) expect_equal(file.exists(snapshot_path), FALSE) From 6da4e6fd972a086c7b02abdb65c4b4b14f7fef81 Mon Sep 17 00:00:00 2001 From: Alex Farach Date: Fri, 10 Jul 2026 04:20:19 -0400 Subject: [PATCH 5/5] Keep shared archive validation non-destructive Co-authored-by: Copilot App <223556219+Copilot@users.noreply.github.com> --- R/panel.R | 8 +++++--- tests/testthat/test-panel.R | 5 +++++ 2 files changed, 10 insertions(+), 3 deletions(-) diff --git a/R/panel.R b/R/panel.R index 2b666ad..6395eef 100644 --- a/R/panel.R +++ b/R/panel.R @@ -193,7 +193,7 @@ onet_archive_acquire <- function( version = version, as_of = as_of ) - validate_archive_zip(dest) + validate_archive_zip(dest, remove_invalid = FALSE) result <- dest } } else { @@ -810,11 +810,13 @@ onet_archive_member <- function(archive, table) { match[[1]] } -validate_archive_zip <- function(path) { +validate_archive_zip <- function(path, remove_invalid = TRUE) { tryCatch( utils::unzip(path, list = TRUE), error = function(cnd) { - unlink(path, force = TRUE) + if (isTRUE(remove_invalid)) { + unlink(path, force = TRUE) + } cli::cli_abort("Downloaded archive is not a readable ZIP file.", parent = cnd) } ) diff --git a/tests/testthat/test-panel.R b/tests/testthat/test-panel.R index ac41919..e8b8c6c 100644 --- a/tests/testthat/test-panel.R +++ b/tests/testthat/test-panel.R @@ -134,6 +134,7 @@ test_that("archive cache verifies digests and records a receipt", { as_of = "2026-05" ) saveRDS(receipt, paste0(dest, ".receipt.rds")) + original_validate <- onet2r:::validate_archive_zip local_mocked_bindings( onet_releases = function() { @@ -145,6 +146,10 @@ test_that("archive cache verifies digests and records a receipt", { onet_copy_cache_snapshot = function(...) { stop("public archive download created a private snapshot") }, + validate_archive_zip = function(path, remove_invalid = TRUE) { + expect_equal(remove_invalid, FALSE) + original_validate(path, remove_invalid = remove_invalid) + }, .package = "onet2r" )