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/2] 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/2] 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)