Fix for new chromedriver location (extended)

DESCRIPTION

@@ -27,11 +27,12 @@ Imports:
     assertthat,
     processx,
     yaml,
-    semver(>= 0.2.0),
-    utils
+    semver (>= 0.2.0),
+    utils,
+    jsonlite
 URL: https://docs.ropensci.org/wdman/, https://github.com/ropensci/wdman
 URLNote: https://github.com/ropensci/wdman
 BugReports: https://github.com/ropensci/wdman/issues
-RoxygenNote: 7.2.1
+RoxygenNote: 7.2.3
 VignetteBuilder: knitr
 Config/testthat/edition: 3

NAMESPACE

@@ -4,9 +4,12 @@ export(chrome)
 export(gecko)
 export(iedriver)
 export(phantomjs)
+export(predl_chrome_for_testing)
 export(selenium)
+export(unziptar_chromedriver)
 importFrom(assertthat,assert_that)
 importFrom(binman,app_dir)
+importFrom(binman,assign_directory)
 importFrom(binman,list_versions)
 importFrom(binman,process_yaml)
 importFrom(binman,rm_platform)

R/chrome.R

@@ -36,7 +36,14 @@ chrome <- function(port = 4567L, version = "latest", path = "wd/hub",
   assert_that(is_string(version))
   assert_that(is_string(path))
   assert_that(is_logical(verbose))
-  chromecheck <- chrome_check(verbose, check = check)
+
+  if (version != "latest" && numeric_version(version) < "115.0.5790.170") {
+    chrome_old <- TRUE
+  } else {
+    chrome_old <- FALSE
+  }
+
+  chromecheck <- chrome_check(verbose, check = check, chrome_old = chrome_old)
   chromeplat <- chromecheck[["platform"]]
   chromeversion <- chrome_ver(chromeplat, version)
   eopts <- list(...)
@@ -97,21 +104,34 @@ chrome <- function(port = 4567L, version = "latest", path = "wd/hub",
   )
 }
 
-chrome_check <- function(verbose, check = TRUE) {
-  chromeyml <- system.file("yaml", "chromedriver.yml", package = "wdman")
+chrome_check <- function(verbose, check = TRUE, chrome_old = FALSE) {
+  if (chrome_old) {
+    chromeyml <- system.file("yaml", "chromedriver.yml", package = "wdman")
+    predl_function <- "binman::predl_google_storage"
+  } else {
+    chromeyml <- system.file("yaml", "chromedriver_testing.yml", package = "wdman")
+    predl_function <- "wdman::predl_chrome_for_testing"
+  }
+
   cyml <- yaml::yaml.load_file(chromeyml)
-  platvec <- c("predlfunction", "binman::predl_google_storage", "platform")
-  cyml[[platvec]] <-
+  platvec <- c("predlfunction", predl_function, "platform")
+  cyml_platvec <-
     switch(Sys.info()["sysname"],
       Linux = grep(os_arch("linux"), cyml[[platvec]], value = TRUE),
-      Windows = grep("win", cyml[[platvec]], value = TRUE),
+      Windows = grep(os_arch("win"), cyml[[platvec]], value = TRUE),
       Darwin = grep(mac_machine(), cyml[[platvec]], value = TRUE),
       stop("Unknown OS")
     )
 
+  if (length(cyml_platvec) == 0) {
+    cyml_platvec <- grep("win", cyml[[platvec]], value = TRUE)
+  }
+
+  cyml[[platvec]] <- cyml_platvec
+
   # Need regex that can tell mac64 and mac64_m1 apart
   if (cyml[[platvec]] %in% c("mac64", "mac64_m1")) {
-    platregexvec <- c("predlfunction", "binman::predl_google_storage", "platformregex")
+    platregexvec <- c("predlfunction", predl_function, "platformregex")
     cyml[[platregexvec]] <- paste0(cyml[[platvec]], "\\.")
   }
 

R/predl_chrome_for_testing.R

@@ -0,0 +1,90 @@
+#' Pre-download function for Chrome for Testing site
+#'
+#' Prepare to download Chromedriver from the Chrome for Testing site.
+#'
+#' @param url URL containing the JSON used to locate files.
+#' @param platform One of `c("linux64", "mac-arm64", "mac-x64",
+#'                           "win32", "win64")`.
+#'
+#' @return
+#' A named list of dataframes. The name indicates the platform. The
+#' dataframe should contain the version, url, and file to be processed.
+#' Used as input for [binman::download_files()] or equivalent.
+#'
+#' @examples
+#' \dontrun{
+#' # predl_chrome_for_testing() is used by chrome()
+#' chrome <- chrome()
+#' chrome$stop()
+#' }
+#'
+#' @importFrom binman assign_directory
+#'
+#' @export
+predl_chrome_for_testing <- function(url, platform) {
+  assert_that(is_URL_file(url))
+  assert_that(is_character(platform))
+  ver_data <- jsonlite::fromJSON(url)[[2]]
+  ver_data <- Filter(
+    function(x) !is.null(x$downloads[["chromedriver"]]),
+    ver_data
+  )
+  ver_data <- ver_data[order(as.numeric(names(ver_data)))]
+  unwrap <- function(entry) {
+    version <- entry$version
+    downloads <- entry$downloads[["chromedriver"]]
+    if (!is.null(downloads)) {
+      platform <- downloads$platform
+      url <- downloads$url
+      file <- basename(url)
+      data.frame(version, platform, url, file)
+    }
+  }
+  extracted <- do.call(rbind, lapply(ver_data, unwrap))
+  app_links <- tapply_identity(extracted, extracted$platform)
+  app_links <- app_links[platform]
+  assign_directory(app_links, "chromedriver")
+}
+
+# The same as tapply(x, y, identity), but works on older versions of R.
+tapply_identity <- function(x, y) {
+  res <- lapply(unique(y), function(z) x[y == z, ])
+
+  names(res) <- unique(y)
+
+  as.array(res)
+}
+
+#' Unzip/untar the chromedriver file
+#'
+#' Unzip or untar a downloaded chromedriver file, then extract it from
+#' its folder.
+#'
+#' @param dlfiles Passed into [binman::unziptar_dlfiles]: A data frame of
+#'   files.
+#' @param chmod If `TRUE`, the files are made executable.
+#'
+#' @returns The same as [binman::unziptar_dlfiles()]: a list of character
+#'   vectors representing the processed files.
+#'
+#' @examples
+#' \dontrun{
+#' # unziptar_chromedriver() is used by chrome()
+#' chrome <- chrome()
+#' chrome$stop()
+#' }
+#'
+#' @export
+unziptar_chromedriver <- function(dlfiles, chmod = TRUE) {
+  x <- binman::unziptar_dlfiles(dlfiles, chmod = chmod)
+
+  for (f in x$processed) {
+    dir <- tools::file_path_sans_ext(f)
+    file.copy(list.files(dir, full.names = TRUE), dirname(dir), copy.mode = TRUE)
+
+    if (chmod && .Platform$OS.type != "windows") {
+      Sys.chmod(list.files(dirname(dir), pattern = "^chromedriver$", full.names = TRUE), "0755")
+    }
+  }
+  x
+}

R/utils.R

@@ -75,12 +75,13 @@ read_pipes <- function(env, outfile, errfile, pipe = "both",
 unix_spawn_tofile <- function(command, args, outfile, errfile, ...) {
   tfile <- tempfile(fileext = ".sh")
   write("#!/bin/sh", tfile)
-  write(paste(c(
-    shQuote(command), args, ">",
-    shQuote(outfile), "2>", shQuote(errfile)
-  ), collapse = " "),
-  tfile,
-  append = TRUE
+  write(
+    paste(c(
+      shQuote(command), args, ">",
+      shQuote(outfile), "2>", shQuote(errfile)
+    ), collapse = " "),
+    tfile,
+    append = TRUE
   )
   Sys.chmod(tfile)
   processx::process$new(tfile, cleanup_tree = TRUE)
@@ -124,5 +125,5 @@ kill_process <- function(p) {
 
 # Figure out if installing on an Intel or M1 mac
 mac_machine <- function() {
-  ifelse(Sys.info()[["machine"]] == "arm64", "mac(64_|os-)", "mac(64|os)$")
+  ifelse(Sys.info()[["machine"]] == "arm64", "mac(-arm64|64_|os-)", "mac(64|os|-x64)$")
 }

inst/etc/checks.R

@@ -2,47 +2,92 @@ library(wdman)
 
 tries <- list()
 
-tries$chrome <- tryCatch({
-  print("chrome")
-  tmp <- chrome(verbose = TRUE)
-  print(tmp$log())
-  tmp$stop()
-  tmp
-}, error = function(e) {print(e$message); e})
-
-tries$gecko <- tryCatch({
-  print("gecko")
-  tmp <- gecko(verbose = TRUE)
-  print(tmp$log())
-  tmp$stop()
-  tmp
-}, error = function(e) {print(e$message); e})
-
-tries$phantomjs <- tryCatch({
-  print("phantomjs")
-  tmp <- phantomjs(verbose = TRUE)
-  print(tmp$log())
-  tmp$stop()
-  tmp
-}, error = function(e) {print(e$message); e})
+tries$chrome <- tryCatch(
+  {
+    print("chrome")
+    tmp <- chrome(verbose = TRUE)
+    print(tmp$log())
+    tmp$stop()
+    tmp
+  },
+  error = function(e) {
+    print(e$message)
+    e
+  }
+)
 
-if (Sys.info()[["sysname"]] == "Windows") {
-  tries$iedriver <- tryCatch({
-    print("iedriver")
-    tmp <- iedriver(verbose = TRUE)
+tries$chrome_old <- tryCatch(
+  {
+    # Version of chrome that is not on the Chrome for Testing site
+    print("chrome (old)")
+    tmp <- chrome(verbose = TRUE, version = "114.0.5735.90")
     print(tmp$log())
     tmp$stop()
     tmp
-  }, error = function(e) {print(e$message); e})
+  },
+  error = function(e) {
+    print(e$message)
+    e
+  }
+)
+
+tries$gecko <- tryCatch(
+  {
+    print("gecko")
+    tmp <- gecko(verbose = TRUE)
+    print(tmp$log())
+    tmp$stop()
+    tmp
+  },
+  error = function(e) {
+    print(e$message)
+    e
+  }
+)
+
+tries$phantomjs <- tryCatch(
+  {
+    print("phantomjs")
+    tmp <- phantomjs(verbose = TRUE)
+    print(tmp$log())
+    tmp$stop()
+    tmp
+  },
+  error = function(e) {
+    print(e$message)
+    e
+  }
+)
+
+if (Sys.info()[["sysname"]] == "Windows") {
+  tries$iedriver <- tryCatch(
+    {
+      print("iedriver")
+      tmp <- iedriver(verbose = TRUE)
+      print(tmp$log())
+      tmp$stop()
+      tmp
+    },
+    error = function(e) {
+      print(e$message)
+      e
+    }
+  )
 }
 
-tries$selenium <- tryCatch({
-  print("selenium")
-  tmp <- selenium(verbose = TRUE)
-  print(tmp$log())
-  tmp$stop()
-  tmp
-}, error = function(e) {print(e$message); e})
+tries$selenium <- tryCatch(
+  {
+    print("selenium")
+    tmp <- selenium(verbose = TRUE)
+    print(tmp$log())
+    tmp$stop()
+    tmp
+  },
+  error = function(e) {
+    print(e$message)
+    e
+  }
+)
 
 errors <- sapply(tries, function(x) is(x, "simpleError"))
 if (any(errors)) {

inst/yaml/chromedriver_testing.yml

@@ -0,0 +1,15 @@
+name: chromedriver
+predlfunction:
+  "wdman::predl_chrome_for_testing":
+    url: https://googlechromelabs.github.io/chrome-for-testing/latest-versions-per-milestone-with-downloads.json
+    platform:
+    - mac-arm64
+    - mac-x64
+    - linux64
+    - win32
+    - win64
+dlfunction:
+  "binman::download_files": []
+postdlfunction:
+  "wdman::unziptar_chromedriver":
+    chmod: TRUE