From 404c775ed2861cc9a27febab9e0b655b1dca8528 Mon Sep 17 00:00:00 2001 From: Andrew Gene Brown Date: Mon, 15 Sep 2025 15:09:09 -0700 Subject: [PATCH 1/9] feat: check_win: add `webform` argument to POST to web form instead of passive FTP --- R/check-win.R | 80 +++++++++++++++++++++++++++++++++++++++--------- man/check_win.Rd | 5 +++ 2 files changed, 71 insertions(+), 14 deletions(-) diff --git a/R/check-win.R b/R/check-win.R index fd735cc7e..63ba7f9bf 100644 --- a/R/check-win.R +++ b/R/check-win.R @@ -13,6 +13,7 @@ #' @param email An alternative email address to use. If `NULL`, the default is #' to use the package maintainer's email. #' @param quiet If `TRUE`, suppresses output. +#' @param webform If `TRUE`, uses web form instead of passive FTP upload. #' @param ... Additional arguments passed to [pkgbuild::build()]. #' @family build functions #' @name check_win @@ -20,39 +21,40 @@ NULL #' @describeIn check_win Check package on the development version of R. #' @export -check_win_devel <- function(pkg = ".", args = NULL, manual = TRUE, email = NULL, quiet = FALSE, ...) { +check_win_devel <- function(pkg = ".", args = NULL, manual = TRUE, email = NULL, quiet = FALSE, webform = FALSE, ...) { check_dots_used(action = getOption("devtools.ellipsis_action", rlang::warn)) check_win( pkg = pkg, version = "R-devel", args = args, manual = manual, - email = email, quiet = quiet, ... + email = email, quiet = quiet, webform = webform, ... ) } #' @describeIn check_win Check package on the released version of R. #' @export -check_win_release <- function(pkg = ".", args = NULL, manual = TRUE, email = NULL, quiet = FALSE, ...) { +check_win_release <- function(pkg = ".", args = NULL, manual = TRUE, email = NULL, quiet = FALSE, webform = FALSE, ...) { check_dots_used(action = getOption("devtools.ellipsis_action", rlang::warn)) check_win( pkg = pkg, version = "R-release", args = args, manual = manual, - email = email, quiet = quiet, ... + email = email, quiet = quiet, webform = webform, ... ) } #' @describeIn check_win Check package on the previous major release version of R. #' @export -check_win_oldrelease <- function(pkg = ".", args = NULL, manual = TRUE, email = NULL, quiet = FALSE, ...) { +check_win_oldrelease <- function(pkg = ".", args = NULL, manual = TRUE, email = NULL, quiet = FALSE, webform = FALSE, ...) { check_dots_used(action = getOption("devtools.ellipsis_action", rlang::warn)) check_win( pkg = pkg, version = "R-oldrelease", args = args, manual = manual, - email = email, quiet = quiet, ... + email = email, quiet = quiet, webform = webform, ... ) } check_win <- function(pkg = ".", version = c("R-devel", "R-release", "R-oldrelease"), - args = NULL, manual = TRUE, email = NULL, quiet = FALSE, ...) { + args = NULL, manual = TRUE, email = NULL, quiet = FALSE, + webform = FALSE, ...) { pkg <- as.package(pkg) if (!is.null(email)) { @@ -81,16 +83,16 @@ check_win <- function(pkg = ".", version = c("R-devel", "R-release", "R-oldrelea } built_path <- pkgbuild::build(pkg$path, tempdir(), - args = args, - manual = manual, quiet = quiet, ... + args = args, + manual = manual, quiet = quiet, ... ) on.exit(file_delete(built_path), add = TRUE) - url <- paste0( - "ftp://win-builder.r-project.org/", version, "/", - path_file(built_path) - ) - lapply(url, upload_ftp, file = built_path) + if (webform) { + submit_winbuilder_webform(built_path, version) + } else { + submit_winbuilder_ftp(built_path, version) + } if (!quiet) { time <- strftime(Sys.time() + 30 * 60, "%I:%M %p") @@ -105,6 +107,15 @@ check_win <- function(pkg = ".", version = c("R-devel", "R-release", "R-oldrelea invisible() } +submit_winbuilder_ftp <- function(path, version) { + url <- paste0("ftp://win-builder.r-project.org/", version, "/", path_file(path)) + lapply(url, upload_ftp, file = path) +} + +submit_winbuilder_webform <- function(path, version) { + lapply(version, upload_webform, file = path) +} + change_maintainer_email <- function(path, email, call = parent.frame()) { desc <- desc::desc(file = path) @@ -147,3 +158,44 @@ upload_ftp <- function(file, url, verbose = FALSE) { }, verbose = verbose) curl::curl_fetch_memory(url, handle = h) } + +extract_hidden_fields <- function(html_text) { + extract_value <- function(name) { + pattern <- sprintf('name="%s"[^>]*value="([^"]+)"', name) + match <- regexec(pattern, html_text) + result <- regmatches(html_text, match) + if (length(result[[1]]) >= 2) result[[1]][2] else NA_character_ + } + + list( + `__VIEWSTATE` = extract_value("__VIEWSTATE"), + `__VIEWSTATEGENERATOR` = extract_value("__VIEWSTATEGENERATOR"), + `__EVENTVALIDATION` = extract_value("__EVENTVALIDATION") + ) +} + +upload_webform <- function(file, version) { + + upload_url <- "https://win-builder.r-project.org/upload.aspx" + form_page <- httr::GET(upload_url) + html_text <- httr::content(form_page, as = "text") + + field_map <- list( + "R-release" = list(file = "FileUpload1", button = "Button1"), + "R-devel" = list(file = "FileUpload2", button = "Button2"), + "R-oldrelease" = list(file = "FileUpload3", button = "Button3") + ) + + fields <- field_map[[version]] + + body <- extract_hidden_fields(html_text) + body[[fields$file]] <- httr::upload_file(file) + body[[fields$button]] <- "Upload File" + + r <- httr::POST( + url = upload_url, + body = body, + encode = "multipart" + ) + httr::stop_for_status(r) +} diff --git a/man/check_win.Rd b/man/check_win.Rd index 60461fab6..2540b349a 100644 --- a/man/check_win.Rd +++ b/man/check_win.Rd @@ -13,6 +13,7 @@ check_win_devel( manual = TRUE, email = NULL, quiet = FALSE, + webform = FALSE, ... ) @@ -22,6 +23,7 @@ check_win_release( manual = TRUE, email = NULL, quiet = FALSE, + webform = FALSE, ... ) @@ -31,6 +33,7 @@ check_win_oldrelease( manual = TRUE, email = NULL, quiet = FALSE, + webform = FALSE, ... ) } @@ -49,6 +52,8 @@ to use the package maintainer's email.} \item{quiet}{If \code{TRUE}, suppresses output.} +\item{webform}{If \code{TRUE}, uses web form instead of passive FTP upload.} + \item{...}{Additional arguments passed to \code{\link[pkgbuild:build]{pkgbuild::build()}}.} } \description{ From 124c3bbb00fae90aec6bd7156a4be589cf639687 Mon Sep 17 00:00:00 2001 From: Andrew Gene Brown Date: Mon, 15 Sep 2025 19:45:52 -0700 Subject: [PATCH 2/9] Use httr conditionally --- R/check-win.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/check-win.R b/R/check-win.R index 63ba7f9bf..5c9ff8a4e 100644 --- a/R/check-win.R +++ b/R/check-win.R @@ -175,6 +175,7 @@ extract_hidden_fields <- function(html_text) { } upload_webform <- function(file, version) { + rlang::check_installed("httr") upload_url <- "https://win-builder.r-project.org/upload.aspx" form_page <- httr::GET(upload_url) From 306fb7f9aa402b9db03fa57b5be26ee770ca6569 Mon Sep 17 00:00:00 2001 From: Jenny Bryan Date: Mon, 2 Mar 2026 13:42:36 -0800 Subject: [PATCH 3/9] Style with air --- R/check-win.R | 80 ++++++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 67 insertions(+), 13 deletions(-) diff --git a/R/check-win.R b/R/check-win.R index bb3352c32..d853c2290 100644 --- a/R/check-win.R +++ b/R/check-win.R @@ -21,40 +21,89 @@ NULL #' @describeIn check_win Check package on the development version of R. #' @export -check_win_devel <- function(pkg = ".", args = NULL, manual = TRUE, email = NULL, quiet = FALSE, webform = FALSE, ...) { +check_win_devel <- function( + pkg = ".", + args = NULL, + manual = TRUE, + email = NULL, + quiet = FALSE, + webform = FALSE, + ... +) { check_dots_used(action = getOption("devtools.ellipsis_action", rlang::warn)) check_win( - pkg = pkg, version = "R-devel", args = args, manual = manual, - email = email, quiet = quiet, webform = webform, ... + pkg = pkg, + version = "R-devel", + args = args, + manual = manual, + email = email, + quiet = quiet, + webform = webform, + ... ) } #' @describeIn check_win Check package on the released version of R. #' @export -check_win_release <- function(pkg = ".", args = NULL, manual = TRUE, email = NULL, quiet = FALSE, webform = FALSE, ...) { +check_win_release <- function( + pkg = ".", + args = NULL, + manual = TRUE, + email = NULL, + quiet = FALSE, + webform = FALSE, + ... +) { check_dots_used(action = getOption("devtools.ellipsis_action", rlang::warn)) check_win( - pkg = pkg, version = "R-release", args = args, manual = manual, - email = email, quiet = quiet, webform = webform, ... + pkg = pkg, + version = "R-release", + args = args, + manual = manual, + email = email, + quiet = quiet, + webform = webform, + ... ) } #' @describeIn check_win Check package on the previous major release version of R. #' @export -check_win_oldrelease <- function(pkg = ".", args = NULL, manual = TRUE, email = NULL, quiet = FALSE, webform = FALSE, ...) { +check_win_oldrelease <- function( + pkg = ".", + args = NULL, + manual = TRUE, + email = NULL, + quiet = FALSE, + webform = FALSE, + ... +) { check_dots_used(action = getOption("devtools.ellipsis_action", rlang::warn)) check_win( - pkg = pkg, version = "R-oldrelease", args = args, manual = manual, - email = email, quiet = quiet, webform = webform, ... + pkg = pkg, + version = "R-oldrelease", + args = args, + manual = manual, + email = email, + quiet = quiet, + webform = webform, + ... ) } -check_win <- function(pkg = ".", version = c("R-devel", "R-release", "R-oldrelease"), - args = NULL, manual = TRUE, email = NULL, quiet = FALSE, - webform = FALSE, ...) { +check_win <- function( + pkg = ".", + version = c("R-devel", "R-release", "R-oldrelease"), + args = NULL, + manual = TRUE, + email = NULL, + quiet = FALSE, + webform = FALSE, + ... +) { pkg <- as.package(pkg) if (!is.null(email)) { @@ -110,7 +159,12 @@ check_win <- function(pkg = ".", version = c("R-devel", "R-release", "R-oldrelea } submit_winbuilder_ftp <- function(path, version) { - url <- paste0("ftp://win-builder.r-project.org/", version, "/", path_file(path)) + url <- paste0( + "ftp://win-builder.r-project.org/", + version, + "/", + path_file(path) + ) lapply(url, upload_ftp, file = path) } From 31713d936d157849762d3e4f4ec5a6135776cea4 Mon Sep 17 00:00:00 2001 From: Jenny Bryan Date: Mon, 2 Mar 2026 14:58:10 -0800 Subject: [PATCH 4/9] Use httr2 --- R/check-win.R | 22 ++++++++++------------ 1 file changed, 10 insertions(+), 12 deletions(-) diff --git a/R/check-win.R b/R/check-win.R index d853c2290..e9dd1a120 100644 --- a/R/check-win.R +++ b/R/check-win.R @@ -253,11 +253,12 @@ extract_hidden_fields <- function(html_text) { } upload_webform <- function(file, version) { - rlang::check_installed("httr") + check_installed("httr2") upload_url <- "https://win-builder.r-project.org/upload.aspx" - form_page <- httr::GET(upload_url) - html_text <- httr::content(form_page, as = "text") + req <- httr2::request(upload_url) + resp <- httr2::req_perform(req) + html_text <- httr2::resp_body_string(resp) field_map <- list( "R-release" = list(file = "FileUpload1", button = "Button1"), @@ -267,14 +268,11 @@ upload_webform <- function(file, version) { fields <- field_map[[version]] - body <- extract_hidden_fields(html_text) - body[[fields$file]] <- httr::upload_file(file) - body[[fields$button]] <- "Upload File" + hidden <- extract_hidden_fields(html_text) + hidden[[fields$file]] <- curl::form_file(file) + hidden[[fields$button]] <- "Upload File" - r <- httr::POST( - url = upload_url, - body = body, - encode = "multipart" - ) - httr::stop_for_status(r) + req <- httr2::request(upload_url) + req <- httr2::req_body_multipart(req, !!!hidden) + httr2::req_perform(req) } From 4e3faebe6575e3d61a98f3962370411996878f84 Mon Sep 17 00:00:00 2001 From: Jenny Bryan Date: Mon, 2 Mar 2026 15:00:05 -0800 Subject: [PATCH 5/9] Use `walk()` --- R/check-win.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/check-win.R b/R/check-win.R index e9dd1a120..85dd3dfee 100644 --- a/R/check-win.R +++ b/R/check-win.R @@ -165,11 +165,11 @@ submit_winbuilder_ftp <- function(path, version) { "/", path_file(path) ) - lapply(url, upload_ftp, file = path) + walk(url, upload_ftp, file = path) } submit_winbuilder_webform <- function(path, version) { - lapply(version, upload_webform, file = path) + walk(version, upload_webform, file = path) } confirm_maintainer_email <- function(email, call = parent.frame()) { From da6979441acaac19c0fa639ded27b36788285b9c Mon Sep 17 00:00:00 2001 From: Jenny Bryan Date: Mon, 2 Mar 2026 15:44:36 -0800 Subject: [PATCH 6/9] Use xml2 devtools has an indirect dependency on xml2 already: pak::pkg_deps_explain("devtools", "xml2") #> devtools -> pkgdown -> xml2 #> devtools -> roxygen2 -> xml2 #> devtools -> urlchecker -> xml2 --- DESCRIPTION | 3 ++- R/check-win.R | 61 +++++++++++++++++++++++++++++---------------------- 2 files changed, 37 insertions(+), 27 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 7d24be224..38ade75f1 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -54,7 +54,8 @@ Suggests: remotes (>= 2.5.0), rmarkdown (>= 2.14), rstudioapi (>= 0.13), - spelling (>= 2.2) + spelling (>= 2.2), + xml2 VignetteBuilder: knitr, quarto Config/Needs/website: tidyverse/tidytemplate Config/testthat/edition: 3 diff --git a/R/check-win.R b/R/check-win.R index 85dd3dfee..1421d05f6 100644 --- a/R/check-win.R +++ b/R/check-win.R @@ -237,42 +237,51 @@ upload_ftp <- function(file, url, verbose = FALSE) { curl::curl_fetch_memory(url, handle = h) } -extract_hidden_fields <- function(html_text) { - extract_value <- function(name) { - pattern <- sprintf('name="%s"[^>]*value="([^"]+)"', name) - match <- regexec(pattern, html_text) - result <- regmatches(html_text, match) - if (length(result[[1]]) >= 2) result[[1]][2] else NA_character_ +parse_winbuilder_form <- function(url, version) { + req <- httr2::request(url) + resp <- httr2::req_perform(req) + html <- xml2::read_html(httr2::resp_body_string(resp)) + + # Extract hidden fields shared by the whole form + hidden_nodes <- xml2::xml_find_all(html, ".//input[@type='hidden']") + hidden <- as.list(xml2::xml_attr(hidden_nodes, "value")) + names(hidden) <- xml2::xml_attr(hidden_nodes, "name") + + # Find the

heading for the requested version, then grab the file + # input and submit button from the
that follows it + headings <- xml2::xml_find_all(html, ".//h2") + heading_texts <- xml2::xml_text(headings) + idx <- match(version, heading_texts) + if (is.na(idx)) { + cli::cli_abort( + "Could not find {.val {version}} section in the WinBuilder form." + ) } - list( - `__VIEWSTATE` = extract_value("__VIEWSTATE"), - `__VIEWSTATEGENERATOR` = extract_value("__VIEWSTATEGENERATOR"), - `__EVENTVALIDATION` = extract_value("__EVENTVALIDATION") + section <- xml2::xml_find_first(headings[[idx]], "following-sibling::div") + file_field <- xml2::xml_attr( + xml2::xml_find_first(section, ".//input[@type='file']"), + "name" ) + button_field <- xml2::xml_attr( + xml2::xml_find_first(section, ".//input[@type='submit']"), + "name" + ) + + list(hidden = hidden, file_field = file_field, button_field = button_field) } upload_webform <- function(file, version) { - check_installed("httr2") + check_installed(c("httr2", "xml2")) upload_url <- "https://win-builder.r-project.org/upload.aspx" - req <- httr2::request(upload_url) - resp <- httr2::req_perform(req) - html_text <- httr2::resp_body_string(resp) - - field_map <- list( - "R-release" = list(file = "FileUpload1", button = "Button1"), - "R-devel" = list(file = "FileUpload2", button = "Button2"), - "R-oldrelease" = list(file = "FileUpload3", button = "Button3") - ) - - fields <- field_map[[version]] + form <- parse_winbuilder_form(upload_url, version) - hidden <- extract_hidden_fields(html_text) - hidden[[fields$file]] <- curl::form_file(file) - hidden[[fields$button]] <- "Upload File" + body <- form$hidden + body[[form$file_field]] <- curl::form_file(file) + body[[form$button_field]] <- "Upload File" req <- httr2::request(upload_url) - req <- httr2::req_body_multipart(req, !!!hidden) + req <- httr2::req_body_multipart(req, !!!body) httr2::req_perform(req) } From 1a0d45a0231400623eea80e84dc176d761b515b2 Mon Sep 17 00:00:00 2001 From: Jenny Bryan Date: Mon, 2 Mar 2026 15:49:22 -0800 Subject: [PATCH 7/9] Add a test --- tests/testthat/test-check-win.R | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/tests/testthat/test-check-win.R b/tests/testthat/test-check-win.R index b918c3755..8fa1c0db3 100644 --- a/tests/testthat/test-check-win.R +++ b/tests/testthat/test-check-win.R @@ -1,3 +1,22 @@ +test_that("parse_winbuilder_form() can extract form fields from live page", { + skip_on_cran() + skip_if_not_installed("httr2") + skip_if_not_installed("xml2") + + url <- "https://win-builder.r-project.org/upload.aspx" + + for (version in c("R-devel", "R-release", "R-oldrelease")) { + form <- parse_winbuilder_form(url, version) + + expect_named(form, c("hidden", "file_field", "button_field")) + expect_true("__VIEWSTATE" %in% names(form$hidden)) + expect_true("__VIEWSTATEGENERATOR" %in% names(form$hidden)) + expect_true("__EVENTVALIDATION" %in% names(form$hidden)) + expect_type(form$file_field, "character") + expect_type(form$button_field, "character") + } +}) + test_that("change_maintainer_email checks fields", { path <- withr::local_tempfile() From 6a85ccb7632e6e1846ee27d70816ca141f855066 Mon Sep 17 00:00:00 2001 From: Jenny Bryan Date: Mon, 2 Mar 2026 16:38:57 -0800 Subject: [PATCH 8/9] The whole rlang namespace is imported --- R/check-win.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/check-win.R b/R/check-win.R index 1421d05f6..8ee41b867 100644 --- a/R/check-win.R +++ b/R/check-win.R @@ -30,7 +30,7 @@ check_win_devel <- function( webform = FALSE, ... ) { - check_dots_used(action = getOption("devtools.ellipsis_action", rlang::warn)) + check_dots_used(action = getOption("devtools.ellipsis_action", warn)) check_win( pkg = pkg, @@ -55,7 +55,7 @@ check_win_release <- function( webform = FALSE, ... ) { - check_dots_used(action = getOption("devtools.ellipsis_action", rlang::warn)) + check_dots_used(action = getOption("devtools.ellipsis_action", warn)) check_win( pkg = pkg, @@ -80,7 +80,7 @@ check_win_oldrelease <- function( webform = FALSE, ... ) { - check_dots_used(action = getOption("devtools.ellipsis_action", rlang::warn)) + check_dots_used(action = getOption("devtools.ellipsis_action", warn)) check_win( pkg = pkg, From 945161f5c5893ddb77ad3368a65b12cfe45c1cad Mon Sep 17 00:00:00 2001 From: Jenny Bryan Date: Mon, 2 Mar 2026 16:44:01 -0800 Subject: [PATCH 9/9] Add a NEWS bullet --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index d26cb782d..7c85702e2 100644 --- a/NEWS.md +++ b/NEWS.md @@ -18,6 +18,7 @@ Other improvements * `build_site()` now just calls `pkgdown::build_site()`, meaning that you will get more (informative) output by default (#2578). * `check_doc_fields()` is a new function that checks for missing `\value` and `\examples` fields in Rd files, which are commonly flagged by CRAN (#2525). * `check_mac_devel()` is a new function to check a package using the macOS builder at https://mac.r-project.org/macbuilder/submit.html (@nfrerebeau, #2507) +* `check_win()` and friends gain a `webform` argument that uses a webform instead of passive FTP upload (@brownag, #2619). * `dev_sitrep()` now works correctly inside Positron (#2618), uses pak instead of remotes to check for dependencies that are missing/behind/ahead (#2663), and uses cli for user-facing messages. * `is_loading()` is now re-exported from pkgload (#2556). * `load_all()` now errors if called recursively, i.e. if you accidentally include a `load_all()` call in one of your R source files (#2617).