Rewrite HTTP options handling

Now all HTTP honors the pkgcache_* and pkg_* HTTP options.

Also, the default is now HTTP 1.1, everywhere. Until I figure out why
HTTP/2 crashes occasionally.

Closes #140.

Author: gaborcsardi

NEWS.md

@@ -1,5 +1,9 @@
 # pkgcache (development version)
 
+* All HTTP requests now honor the `pkgcache_http_version` option and
+  `PKGCACHE_HTTP_VERSION` environment variable. Closes
+  https://github.com/r-lib/pkgcache/issues/140.
+
 * New `PKG_USE_BIOCONDUCTOR` environment variable and new
   `pkg.use_bioconductor` option to opt out from automatic Bioconductor
   support.

R/aaa-async.R

@@ -3165,6 +3165,16 @@ http_delete <- function(
 
 http_delete <- mark_as_async(http_delete)
 
+default_http_version <- function() {
+  # We default to HTTP/1.1 on every platform, because HTTP/2 has caused a
+  # number of transport-level failures (connection resets, `GOAWAY` frames,
+  # etc.) with various libcurl and server combinations, see e.g.
+  # https://github.com/r-lib/pak/issues/358
+  # https://github.com/r-lib/actions/issues/483
+  # https://github.com/r-lib/actions/issues/1091
+  2L # HTTP/1.1
+}
+
 #' @importFrom utils modifyList
 
 get_default_curl_options <- function(options) {
@@ -3185,6 +3195,9 @@ get_default_curl_options <- function(options) {
       connecttimeout = as.integer(getopt("connecttimeout") %||% 300),
       low_speed_time = as.integer(getopt("low_speed_time") %||% 0),
       low_speed_limit = as.integer(getopt("low_speed_limit") %||% 0),
+      http_version = as.integer(
+        getopt("http_version") %||% default_http_version()
+      ),
       cainfo = getopt("cainfo")
     ))
   )

R/async-http.R

@@ -1,45 +1,64 @@
-default_http_version <- function() {
-  os <- Sys.info()["sysname"]
-  if (!is.na(os) && os %in% c("Darwin", "Linux")) {
-    # FIXME: when is it safe to remove this? Does it depend on the OS
-    # version? The libcurl version?
-    # UPDATE: HTTP/2 now also causes issues on Linux:
-    # https://github.com/r-lib/pak/issues/358
-    # https://github.com/r-lib/actions/issues/483
-    # So this will be here for now. :(
-    2 # HTTP 1.1
-  } else {
-    0 # whatever curl chooses
-  }
-}
+# The embedded async `http_get()` etc. only look at the `async_http_*` options
+# (via `get_default_curl_options()`). `set_pkgcache_curl_options()` reads the
+# pkgcache-level options and environment variables and sets the corresponding
+# curl options, so that pkgcache's HTTP requests honor them. For each curl
+# option it looks, in decreasing priority, at the `pkgcache_*` option, the
+# `PKGCACHE_*` environment variable, the `pkg_http_*` option and the
+# `PKG_HTTP_*` environment variable.
+#
+# It only sets an option when it is actually configured. An unset option must
+# not be turned into an explicit curl option, otherwise it would override the
+# `async_http_*` option and the async default further downstream in
+# `get_default_curl_options()`.
 
-#' @importFrom utils modifyList
-
-update_async_timeouts <- function(options) {
+set_pkgcache_curl_options <- function(options) {
+  nms <- c(
+    "timeout",
+    "connecttimeout",
+    "low_speed_time",
+    "low_speed_limit",
+    "http_version"
+  )
+  prefixes <- c("pkgcache_", "pkg_http_")
   getopt <- function(nm) {
-    if (!is.null(v <- options[[nm]])) {
-      return(v)
+    for (prefix in prefixes) {
+      anm <- paste0(prefix, nm)
+      if (!is.null(v <- getOption(anm))) {
+        return(v)
+      }
+      if (!is.na(v <- Sys.getenv(toupper(anm), NA_character_))) {
+        return(v)
+      }
+    }
+    NULL
+  }
+  for (nm in nms) {
+    # An option passed explicitly to the request always wins.
+    if (!is.null(options[[nm]])) {
+      next
     }
-    anm <- paste0("pkgcache_", nm)
-    if (!is.null(v <- getOption(anm))) {
-      return(v)
+    if (!is.null(v <- getopt(nm))) {
+      options[[nm]] <- as.integer(v)
     }
-    if (!is.na(v <- Sys.getenv(toupper(anm), NA_character_))) return(v)
   }
-  utils::modifyList(
-    options,
-    list(
-      timeout = as.integer(getopt("timeout") %||% 0),
-      connecttimeout = as.integer(getopt("connecttimeout") %||% 300),
-      low_speed_time = as.integer(getopt("low_speed_time") %||% 0),
-      low_speed_limit = as.integer(getopt("low_speed_limit") %||% 0),
-      http_version = as.integer(
-        getopt("http_version") %||% default_http_version()
-      )
-    )
-  )
+  options
 }
 
+# Wrap an embedded async HTTP function so that it applies the pkgcache-level
+# HTTP options and environment variables (see `set_pkgcache_curl_options()`)
+# to every request.
+wrap_pkgcache_http <- function(fun) {
+  force(fun)
+  mark_as_async(function(url, ..., options = list()) {
+    fun(url, ..., options = set_pkgcache_curl_options(options))
+  })
+}
+
+http_get <- wrap_pkgcache_http(http_get)
+http_head <- wrap_pkgcache_http(http_head)
+http_post <- wrap_pkgcache_http(http_post)
+http_delete <- wrap_pkgcache_http(http_delete)
+
 add_auth_header <- function(url, headers) {
   c(headers, repo_auth_headers(url)$headers)
 }
@@ -127,7 +146,6 @@ download_file <- function(
   )
   force(list(...))
 
-  options <- update_async_timeouts(options)
   destfile <- normalizePath(destfile, mustWork = FALSE)
   tmp_destfile <- normalizePath(tmp_destfile, mustWork = FALSE)
   mkdirp(dirname(tmp_destfile))
@@ -259,7 +277,6 @@ download_if_newer <- function(
   )
   force(list(...))
 
-  options <- update_async_timeouts(options)
   etag_old <- get_etag_header_from_file(destfile, etag_file)
   headers <- c(headers, etag_old)
   headers <- add_auth_header(url, headers)
@@ -390,7 +407,6 @@ download_one_of <- function(
   )
   force(list(...))
 
-  options <- update_async_timeouts(options)
   tmps <- paste0(destfile, ".tmp.", seq_along(urls))
   dls <- mapply(
     download_if_newer,
@@ -428,7 +444,6 @@ download_files <- function(
     )
   }
 
-  options <- update_async_timeouts(options)
   bar <- create_progress_bar(data)
   prog_cb <- function(upd) update_progress_bar_progress(bar, upd)
 

README.md

@@ -198,6 +198,12 @@ configure Bioconductor support.
   and
   [`LOW_SPEED_TIME`](https://curl.se/libcurl/c/CURLOPT_LOW_SPEED_TIME.html)
   curl options.
+- `pkgcache_http_version` selects the HTTP version to use for HTTP requests.
+  It corresponds to the [`HTTP_VERSION` libcurl
+  option](https://curl.se/libcurl/c/CURLOPT_HTTP_VERSION.html), so e.g.
+  `2` forces HTTP/1.1 and `0` lets libcurl choose. It defaults to HTTP/1.1,
+  because HTTP/2 has caused transport-level failures with some client and
+  server combinations.
 
 ## Package environment variables
 
@@ -239,6 +245,13 @@ configure Bioconductor support.
   curl options. The `pkgcache_low_speed_time` and
   `pkgcache_low_speed_limit` options have priority over these
   environment variables, if they are set.
+- `PKGCACHE_HTTP_VERSION` selects the HTTP version to use for HTTP requests.
+  It corresponds to the [`HTTP_VERSION` libcurl
+  option](https://curl.se/libcurl/c/CURLOPT_HTTP_VERSION.html), so e.g.
+  `2` forces HTTP/1.1 and `0` lets libcurl choose. It defaults to HTTP/1.1,
+  because HTTP/2 has caused transport-level failures with some client and
+  server combinations. The `pkgcache_http_version` option has priority over
+  this, if set.
 - `R_PKG_CACHE_DIR` is used for the cache directory, if set. (Otherwise
   `tools::R_user_dir("pkgcache", "cache")` is used, see also
   `meta_cache_summary()` and `pkg_cache_summary()`).

man/pkgcache-package.Rd

@@ -235,6 +235,34 @@ test_that("more sophisticated timeouts", {
   expect_true(toc - tic < as.difftime(5, units = "secs"))
 })
 
+test_that("http_version is set from options and env vars", {
+  # explicit option wins
+  expect_equal(
+    get_default_curl_options(list(http_version = 3))$http_version,
+    3L
+  )
+
+  # async_http_http_version option
+  withr::local_options(async_http_http_version = 3)
+  expect_equal(get_default_curl_options(list())$http_version, 3L)
+
+  # ASYNC_HTTP_HTTP_VERSION env var (option has priority)
+  withr::local_options(async_http_http_version = NULL)
+  withr::local_envvar(ASYNC_HTTP_HTTP_VERSION = "3")
+  expect_equal(get_default_curl_options(list())$http_version, 3L)
+
+  # default is used when nothing is set
+  withr::local_envvar(ASYNC_HTTP_HTTP_VERSION = NA_character_)
+  expect_equal(
+    get_default_curl_options(list())$http_version,
+    default_http_version()
+  )
+})
+
+test_that("default_http_version", {
+  expect_equal(default_http_version(), 2L)
+})
+
 test_that("errors contain the response", {
   do <- function() {
     http_get(http$url("/status/418"))$then(http_stop_for_status)