Don't serialize redacted headers

NAMESPACE

@@ -4,19 +4,20 @@ S3method("$",httr2_headers)
 S3method("[",httr2_headers)
 S3method("[[",httr2_headers)
 S3method(close,httr2_response)
-S3method(format,httr2_redacted)
+S3method(format,httr2_redacted_sentinel)
 S3method(print,httr2_cmd)
 S3method(print,httr2_headers)
 S3method(print,httr2_json)
 S3method(print,httr2_oauth_client)
 S3method(print,httr2_obfuscated)
+S3method(print,httr2_redacted_sentinel)
 S3method(print,httr2_request)
 S3method(print,httr2_response)
 S3method(print,httr2_token)
 S3method(print,httr2_url)
 S3method(str,httr2_headers)
 S3method(str,httr2_obfuscated)
-S3method(str,httr2_redacted)
+S3method(str,httr2_redacted_sentinel)
 export("%>%")
 export(curl_help)
 export(curl_translate)

NEWS.md

@@ -1,5 +1,6 @@
 # httr2 (development version)
 
+* Redacted headers are no longer serialized to disk. This is important since it makes it harder to accidentally leak secrets to files on disk, but comes at a cost: you can longer perform such requests that have been saved and reloaded (#721).
 * New `req_get_method()` and `req_get_body()` allow you to do some limited prediction of what a request _will_ do when it's performed (#718).
 * Functions that capture interrutps (like `req_perform_parallel()` and friends) are now easier to escape if they're called inside a loop: you can press Ctrl + C twice to guarantee an exit (#1810).
 * New `last_request_json()` and `last_response_json()` to conveniently see JSON bodies (#734).

R/headers.R

@@ -1,13 +1,28 @@
-as_headers <- function(x, redact = character(), error_call = caller_env()) {
-  if (is.character(x) || is.raw(x)) {
+as_headers <- function(
+  x,
+  redact = character(),
+  lifespan,
+  error_call = caller_env()
+) {
+  if (is.list(x)) {
+    new_headers(
+      x,
+      redact = redact,
+      lifespan = lifespan,
+      error_call = error_call
+    )
+  } else if (is.character(x) || is.raw(x)) {
     parsed <- curl::parse_headers(x)
     valid <- parsed[grepl(":", parsed, fixed = TRUE)]
     halves <- parse_in_half(valid, ":")
 
     headers <- set_names(trimws(halves$right), halves$left)
-    new_headers(as.list(headers), redact = redact, error_call = error_call)
-  } else if (is.list(x)) {
-    new_headers(x, redact = redact, error_call = error_call)
+    new_headers(
+      as.list(headers),
+      redact = redact,
+      lifespan = lifespan,
+      error_call = error_call
+    )
   } else {
     cli::cli_abort(
       "{.arg headers} must be a list, character vector, or raw.",
@@ -16,15 +31,34 @@ as_headers <- function(x, redact = character(), error_call = caller_env()) {
   }
 }
 
-new_headers <- function(x, redact = character(), error_call = caller_env()) {
+new_headers <- function(
+  x,
+  redact = character(),
+  lifespan,
+  error_call = caller_env()
+) {
   if (!is_list(x)) {
     cli::cli_abort("{.arg x} must be a list.", call = error_call)
   }
   if (length(x) > 0 && !is_named(x)) {
     cli::cli_abort("All elements of {.arg x} must be named.", call = error_call)
   }
+  for (i in seq_along(x)) {
+    if (!is.atomic(x[[i]]) && !is_weakref(x[[i]])) {
+      cli::cli_abort(
+        c(
+          "Each element of {.arg x} must be an atomic vector or a weakref.",
+          i = "{.arg x[[{i}]]} is {obj_type_friendly(x[[i]])}."
+        ),
+        call = error_call
+      )
+    }
+  }
 
-  structure(x, redact = redact, class = "httr2_headers")
+  needs_redact <- !is_redacted(x) & (tolower(names(x)) %in% tolower(redact))
+  x[needs_redact] <- lapply(x[needs_redact], \(x) new_weakref(lifespan, x))
+
+  structure(x, class = "httr2_headers")
 }
 
 #' @export
@@ -36,64 +70,18 @@ print.httr2_headers <- function(x, ..., redact = TRUE) {
 
 show_headers <- function(x, redact = TRUE) {
   if (length(x) > 0) {
-    vals <- lapply(headers_redact(x, redact), format)
+    vals <- lapply(headers_flatten(x, redact), format)
     cli::cat_line(cli::style_bold(names(x)), ": ", vals)
   }
 }
 
 #' @export
 str.httr2_headers <- function(object, ..., no.list = FALSE) {
-  object <- unclass(headers_redact(object))
+  object <- unclass(headers_flatten(object))
   cat(" <httr2_headers>\n")
   utils::str(object, ..., no.list = TRUE)
 }
 
-headers_redact <- function(x, redact = TRUE) {
-  if (!redact) {
-    x
-  } else {
-    to_redact <- attr(x, "redact")
-    attr(x, "redact") <- NULL
-
-    list_redact(x, to_redact, case_sensitive = FALSE)
-  }
-}
-
-# https://datatracker.ietf.org/doc/html/rfc7230#section-3.2.2
-headers_flatten <- function(x) {
-  is_redacted <- map_lgl(x, is_redacted)
-  x[!is_redacted] <- lapply(x[!is_redacted], paste, collapse = ",")
-  x
-}
-
-list_redact <- function(x, names, case_sensitive = TRUE) {
-  if (case_sensitive) {
-    i <- match(names, names(x))
-  } else {
-    i <- match(tolower(names), tolower(names(x)))
-  }
-  x[i] <- list(redacted())
-  x
-}
-
-redacted <- function() {
-  structure(list(NULL), class = "httr2_redacted")
-}
-
-#' @export
-format.httr2_redacted <- function(x, ...) {
-  cli::col_grey("<REDACTED>")
-}
-#' @export
-str.httr2_redacted <- function(object, ...) {
-  cat(" ", cli::col_grey("<REDACTED>"), "\n", sep = "")
-}
-
-is_redacted <- function(x) {
-  inherits(x, "httr2_redacted")
-}
-
-
 #' @export
 `[.httr2_headers` <- function(x, i, ...) {
   if (is.character(i)) {
@@ -116,3 +104,32 @@ is_redacted <- function(x) {
   i <- match(tolower(name), tolower(names(x)))
   x[[i]]
 }
+
+is_redacted <- function(x) {
+  map_lgl(x, is_weakref)
+}
+which_redacted <- function(x) {
+  names(x)[is_redacted(x)]
+}
+
+# Flatten headers object into a list suitable either for display (if redacted)
+# or passing to curl (if not redacted).
+headers_flatten <- function(x, redact = TRUE) {
+  is_redacted <- is_redacted(x)
+
+  out <- vector("list", length(x))
+  names(out) <- names(x)
+
+  # https://datatracker.ietf.org/doc/html/rfc7230#section-3.2.2
+  out[!is_redacted] <- lapply(x[!is_redacted], paste, collapse = ",")
+
+  if (redact) {
+    out[is_redacted] <- list(redacted_sentinel())
+  } else {
+    out[is_redacted] <- lapply(x[is_redacted], wref_value)
+    # need to strip serialized weakrefs that now yield NULL
+    out <- compact(out)
+  }
+
+  out
+}

R/req-dry-run.R

@@ -63,18 +63,21 @@ req_dry_run <- function(
   handle <- req_handle(req)
   curl::handle_setopt(handle, url = req$url)
   resp <- curl::curl_echo(handle, progress = FALSE)
+  headers <- new_headers(
+    as.list(resp$headers),
+    redact = which_redacted(req$headers),
+    lifespan = current_env()
+  )
 
   if (!quiet) {
     cli::cat_line(resp$method, " ", resp$path, " HTTP/1.1")
 
-    headers <- new_headers(as.list(resp$headers), attr(req$headers, "redact"))
     if (testing_headers) {
       # curl::curl_echo() overrides
       headers$host <- NULL
       headers$`content-length` <- NULL
     }
-
-    show_headers(headers)
+    show_headers(headers, redact = redact_headers)
     cli::cat_line()
     show_body(resp$body, headers$`content-type`, pretty_json = pretty_json)
   }
@@ -83,7 +86,7 @@ req_dry_run <- function(
     method = resp$method,
     path = resp$path,
     body = resp$body,
-    headers = as.list(resp$headers)
+    headers = headers_flatten(headers, redact = redact_headers)
   ))
 }
 

R/req-headers.R

@@ -67,12 +67,8 @@ req_headers <- function(.req, ..., .redact = NULL) {
   check_header_values(...)
 
   headers <- modify_list(.req$headers, ..., .ignore_case = TRUE)
-
-  redact <- union(.redact, "Authorization")
-  redact <- redact[tolower(redact) %in% tolower(names(headers))]
-  redact <- sort(union(redact, attr(.req$headers, "redact")))
-
-  .req$headers <- new_headers(headers, redact)
+  redact <- c("Authorization", .redact, which_redacted(.req$headers))
+  .req$headers <- new_headers(headers, redact, lifespan = .req$state)
 
   .req
 }

R/req-perform.R

@@ -238,7 +238,10 @@ req_handle <- function(req) {
 
   handle <- curl::new_handle()
   curl::handle_setopt(handle, url = req$url)
-  curl::handle_setheaders(handle, .list = headers_flatten(req$headers))
+  curl::handle_setheaders(
+    handle,
+    .list = headers_flatten(req$headers, redact = FALSE)
+  )
   curl::handle_setopt(handle, .list = req$options)
   if (length(req$fields) > 0) {
     curl::handle_setform(handle, .list = req$fields)

R/req-verbose.R

@@ -58,7 +58,7 @@
     } else if (header_resp && type == 1) {
       verbose_header("<- ", msg)
     } else if (header_req && type == 2) {
-      to_redact <- attr(headers, "redact")
+      to_redact <- which_redacted(headers)
       verbose_header("-> ", msg, redact_headers, to_redact = to_redact)
     } else if (body_resp && type == 3) {
       # handled in handle_resp()
@@ -86,7 +86,8 @@
 
   for (line in lines) {
     if (grepl("^[-a-zA-z0-9]+:", line)) {
-      header <- headers_redact(as_headers(line, to_redact), redact)
+      headers <- as_headers(line, to_redact, lifespan = current_env())
+      header <- headers_flatten(headers, redact)
       cli::cat_line(
         prefix,
         cli::style_bold(names(header)),

R/req.R

@@ -27,10 +27,7 @@ print.httr2_request <- function(x, ..., redact_headers = TRUE) {
   method <- toupper(req_get_method(x))
   cli::cli_text("{.strong {method}} {x$url}")
 
-  bullets_with_header(
-    "Headers:",
-    headers_flatten(headers_redact(x$headers, redact_headers))
-  )
+  bullets_with_header("Headers:", headers_flatten(x$headers, redact_headers))
   cli::cli_text("{.strong Body}: {req_body_info(x)}")
   bullets_with_header("Options:", x$options)
   bullets_with_header("Policies:", x$policies)

R/utils-redacted.R

@@ -0,0 +1,25 @@
+redacted_sentinel <- function() {
+  structure(list(NULL), class = "httr2_redacted_sentinel")
+}
+#' @export
+print.httr2_redacted_sentinel <- function(x, ...) {
+  cat(format(x), "\n", sep = "")
+  invisible(x)
+}
+#' @export
+format.httr2_redacted_sentinel <- function(x, ...) {
+  unclass(cli::col_grey("<REDACTED>"))
+}
+#' @export
+str.httr2_redacted_sentinel <- function(object, ...) {
+  cat(" ", cli::col_grey("<REDACTED>"), "\n", sep = "")
+}
+
+list_redact <- function(x, names) {
+  x[names(x) %in% names] <- list(redacted_sentinel())
+  x
+}
+
+is_redacted_sentinel <- function(x) {
+  inherits(x, "httr2_redacted_sentinel")
+}

R/utils.R

@@ -16,7 +16,7 @@ bullets <- function(x) {
         format(x)
       }
     } else {
-      if (is_redacted(x)) {
+      if (is_redacted_sentinel(x)) {
         format(x)
       } else {
         paste0("<", class(x)[[1L]], ">")

tests/testthat/_snaps/headers.md

@@ -33,7 +33,7 @@
     Output
        <httr2_headers>
        $ x: <REDACTED>
-       $ y: num 2
+       $ y: chr "2"
 
 # new_headers checks inputs
 
@@ -47,4 +47,10 @@
     Condition
       Error:
       ! All elements of `x` must be named.
+    Code
+      new_headers(list(x = mean))
+    Condition
+      Error:
+      ! Each element of `x` must be an atomic vector or a weakref.
+      i `x[[1]]` is a function.
 

tests/testthat/_snaps/req-dry-run.md

@@ -47,10 +47,20 @@
 # authorization headers are redacted
 
     Code
-      req_dry_run(req)
+      out <- req_dry_run(req)
     Output
       GET / HTTP/1.1
       accept: */*
       authorization: <REDACTED>
 
 
+---
+
+    Code
+      out <- req_dry_run(req, redact_headers = FALSE)
+    Output
+      GET / HTTP/1.1
+      accept: */*
+      authorization: Basic dXNlcjpwYXNzd29yZA==
+
+

tests/testthat/_snaps/utils-redacted.md

@@ -0,0 +1,15 @@
+# sentinel displays nicely
+
+    Code
+      x
+    Output
+      <REDACTED>
+    Code
+      format(x)
+    Output
+      [1] "<REDACTED>"
+    Code
+      str(x)
+    Output
+       <REDACTED>
+

tests/testthat/helper.R

@@ -6,5 +6,5 @@ testthat::set_state_inspector(function() {
 })
 
 expect_redacted <- function(req, expected) {
-  expect_equal(attr(req$headers, "redact"), expected)
+  expect_equal(which_redacted(req$headers), expected)
 }