Hipercow Linux Support

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: hipercow
 Title: High Performance Computing
-Version: 1.0.55
+Version: 1.0.56
 Authors@R: c(person("Rich", "FitzJohn", role = c("aut", "cre"),
                     email = "rich.fitzjohn@gmail.com"),
              person("Wes", "Hinsley", role = "aut"),

R/drivers.R

@@ -2,5 +2,6 @@ hipercow_drivers <- function() {
   list(
     "windows"      = c("hipercow.windows", "hipercow_driver_windows"),
     "dide-windows" = c("hipercow.windows", "hipercow_driver_windows"),
+    "dide-linux"   = c("hipercow.windows", "hipercow_driver_linux"),
     "example"      = c("hipercow", "example_driver"))
 }

drivers/windows/DESCRIPTION

@@ -1,6 +1,6 @@
 Package: hipercow.windows
 Title: DIDE HPC Support for Windows
-Version: 1.0.55
+Version: 1.0.56
 Authors@R: c(person("Rich", "FitzJohn", role = c("aut", "cre"),
                     email = "rich.fitzjohn@gmail.com"),
              person("Wes", "Hinsley", role = "aut"),
@@ -29,9 +29,11 @@ Imports:
     keyring,
     logwatch,
     openssl,
+    pkgdepends,
     rematch,
     rstudioapi,
     rlang,
+    utils,
     xml2
 Suggests:
     mockery,

drivers/windows/NAMESPACE

@@ -7,3 +7,4 @@ S3method(format,dide_shares)
 S3method(print,dide_clusterload)
 S3method(print,password)
 S3method(print,windows_path)
+importFrom(utils,read.csv)

drivers/windows/R/batch.R

@@ -1,19 +1,48 @@
 write_batch_task_run <- function(task_id, config, path_root) {
+
+  run_on_linux <- config$platform == "linux"
+  template_file <- if (run_on_linux) "task_run.sh" else "task_run.bat"
+  out_script <- if (run_on_linux) SH_RUN else BATCH_RUN
+  write_os_lines <- if (run_on_linux) write_linux_lines else writeLines
+
   data <- template_data_task_run(task_id, config, path_root)
-  str <- glue_whisker(read_template("task_run.bat"), data)
-  path <- path_to_task_file(path_root, task_id, BATCH_RUN)
-  writeLines(str, path)
+  str <- glue_whisker(read_template(template_file), data)
+  path <- path_to_task_file(path_root, task_id, out_script)
+  write_os_lines(str, path)
+
+  if (run_on_linux) {
+    path_dat <- prepare_path(path, config$shares)
+    linux_path <- path_on_linux(path_dat)
+    wrap_path <- path_to_task_file(path_root, task_id, SH_WRAP_RUN)
+    write_linux_lines(
+      sprintf("python -u /opt/hpcnodemanager/kwrap.py %s", linux_path),
+        wrap_path)
+  }
   path
 }
 
 
 write_batch_provision_script <- function(id, config, path_root) {
+  run_on_linux <- config$platform == "linux"
+  template_file <- if (run_on_linux) "provision.sh" else "provision.bat"
+  write_os_lines <- if (run_on_linux) write_linux_lines else writeLines
+
   data <- template_data_provision_script(id, config, path_root)
-  str <- glue_whisker(read_template("provision.bat"), data)
+  str <- glue_whisker(read_template(template_file), data)
   path_job <- file.path(path_root, "hipercow", "provision", id)
-  path <- file.path(path_job, "provision.bat")
+  path <- file.path(path_job, template_file)
   fs::dir_create(path_job)
-  writeLines(str, path)
+  write_os_lines(str, path)
+
+  if (run_on_linux) {
+    path_dat <- prepare_path(path, config$shares)
+    linux_path <- path_on_linux(path_dat)
+    wrap_path <- file.path(dirname(path), "wrap_provision.sh")
+    write_linux_lines(c(
+      "touch /wpia-hn/Hipercow/bootstrap-linux",
+      sprintf("python -u /opt/hpcnodemanager/kwrap.py %s", linux_path)),
+    wrap_path)
+  }
   path
 }
 
@@ -30,13 +59,14 @@ template_data_task_run <- function(task_id, config, path_root) {
   data$task_id_2 <- substr(task_id, 3, nchar(task_id))
 
   data$hipercow_library <- paste(
-    remote_path(file.path(path_root, config$path_lib), config$shares),
+    remote_path(file.path(path_root, config$path_lib), config$shares,
+                platform == "linux"),
     path_bootstrap(config),
     sep = path_delimiter(config$platform))
 
   data$renviron_path <-
     remote_path(path_to_task_file(path_root, task_id, "Renviron"),
-                config$shares)
+                config$shares, platform == "linux")
 
   data
 }
@@ -60,12 +90,17 @@ template_data_common <- function(config, path_root) {
     "ECHO Removing mapping {{drive}}\nnet use {{drive}} /delete /y",
     network_shares_data)
 
+  r_version <- config$r_version
+  if (config$platform != "linux") {
+    r_version <- version_string(config$r_version)
+  }
+
   list(
     hostname = hipercow:::hostname(),
     date = as.character(Sys.time()),
     hipercow_version = hipercow_version(),
     hipercow_windows_version = hipercow_windows_version(),
-    r_version = version_string(config$r_version),
+    r_version = r_version,
     network_shares_create = paste(network_shares_create, collapse = "\n"),
     network_shares_delete = paste(network_shares_delete, collapse = "\n"),
     hipercow_root_drive = hipercow_root$drive_remote,
@@ -80,10 +115,11 @@ path_bootstrap <- function(config) {
   version <- version_string(config$r_version, ".")
   if (platform == "windows") {
     ## TODO: update to I:/bootstrap(-dev)?/(windows|linux)/<version>
+    ## - Bit of a pain to migrate as I:/bootstrap is active.
+    ## - Can we tolerate I:/bootstrap, I:/bootstrap-dev  and
+    ##   /wpia-hn/Hipercow/bootstrap-linux /wpia-hn/Hipercow/bootstrap-dev-linux
     sprintf("I:/%s/%s", base, version)
   } else {
-    ## TODO: A mount does not yet exist yet - this is where the
-    ## projects share will likely be mounted.
-    sprintf("/wpia-hn/hipercow/%s/linux/%s", base, version)
+    sprintf("/wpia-hn/Hipercow/%s-linux/%s", base, version)
   }
 }

drivers/windows/R/bootstrap.R

@@ -1,31 +1,68 @@
-bootstrap_update <- function(development = NULL, root = NULL) {
+bootstrap_update <- function(development = NULL, root = NULL,
+                             platform = "windows") {
   path_script <- "hipercow/bootstrap-windows.R"
   path_root <- hipercow:::hipercow_root(root)$path$root
   path_script_abs <- file.path(path_root, path_script)
   dir.create(dirname(path_script_abs), FALSE, TRUE)
   bootstrap <- read_template("bootstrap.R")
+  prefix <- if (platform == "windows") "I:" else "/wpia-hn/Hipercow"
+  suffix <- if (platform == "windows") "" else "-linux"
+
+  bootstrap_repos <- c("https://mrc-ide.r-universe.dev",
+                       "https://cloud.r-project.org")
+  bootstrap_repos <- sprintf('c("%s")',
+                             paste0(bootstrap_repos, collapse = "\", \""))
+
+  bootstrap_pkgs <- c("hipercow", "remotes", "pkgdepends", "renv", "rrq")
+  deps <- pkgdepends::pkg_deps$new(bootstrap_pkgs)
+  deps$resolve()
+  bootstrap_pkgs <- deps$get_resolution()$package
+  bootstrap_pkgs <- sprintf('c("%s")',
+                            paste0(bootstrap_pkgs, collapse = "\", \""))
+
   if (is.null(development)) {
-    data <- list(bootstrap_path = "bootstrap",
-                 development_ref = "NULL")
+    data <- list(bootstrap_path = sprintf("%s/bootstrap%s", prefix, suffix),
+                 development_ref = "NULL",
+                 bootstrap_repos = bootstrap_repos,
+                 bootstrap_pkgs = bootstrap_pkgs)
+
   } else {
-    data <- list(bootstrap_path = "bootstrap-dev",
-                 development_ref = dquote(development))
+    data <- list(bootstrap_path = sprintf("%s/bootstrap-dev%s", prefix, suffix),
+                 development_ref = dquote(development),
+                 bootstrap_repos = bootstrap_repos,
+                 bootstrap_pkgs = bootstrap_pkgs)
   }
+
   writelines_if_different(glue_whisker(bootstrap, data),
                           path_script_abs)
+
   hipercow::hipercow_provision("script", script = path_script, root = root)
 }
 
 
 bootstrap_update_all <- function(development = NULL, root = NULL,
-                                 versions = r_versions("windows")) {
-  versions <- recent_versions(as.numeric_version(versions))
-  for (i in seq_along(versions)) {
-    version <- versions[[i]]
-    cli::cli_alert_info("Setting up bootstrap for R {version}")
-    hipercow::hipercow_init(root %||% ".", driver = "dide-windows",
-                            r_version = version)
-    bootstrap_update(development = development, root = root)
+                                 versions = NULL,
+                                 platforms = c("windows", "linux")) {
+  for (platform in platforms) {
+    os_versions <- r_versions(platform)
+    if (!is.null(versions)) {
+      os_versions <- intersect(os_versions, versions)
+    }
+    if (length(os_versions) == 0) {
+      cli::cli_abort(c("No matching R version(s) available on {platform}",
+                       i = "You requested {versions}",
+                       i = "Available: {r_versions(platform)}"))
+    }
+    os_versions <- recent_versions(as.numeric_version(os_versions))
+    for (i in seq_along(os_versions)) {
+      version <- os_versions[[i]]
+      cli::cli_alert_info("Setting up bootstrap for R {version} on {platform}")
+      hipercow::hipercow_init(root %||% ".",
+                              driver = sprintf("dide-%s", platform),
+                              r_version = version)
+      bootstrap_update(development = development, root = root,
+                       platform = platform)
+    }
   }
 }
 

drivers/windows/R/cluster.R

@@ -34,17 +34,16 @@ r_versions_fetch <- function() {
 }
 
 
-cluster_resources <- function(cluster, driver) {
+cluster_resources <- function(platform) {
   if (is.null(cache$cluster_resources)) {
     cache$cluster_resources <-
-      cluster_resources_fetch(cluster, driver)
+      cluster_resources_fetch()
   }
-  cache$cluster_resources
+  cache$cluster_resources[[platform]]
 }
 
 
-cluster_resources_fetch <- function(cluster, driver) {
+cluster_resources_fetch <- function() {
   credentials <- list(username = "public")
-  web_client$new(credentials, login = FALSE)$cluster_resources(
-    "wpia-hn", "hipercow.windows")
+  web_client$new(credentials, login = FALSE)$cluster_resources()
 }

drivers/windows/R/config.R

@@ -1,3 +1,8 @@
+linux_configure <- function(shares = NULL, r_version = NULL,
+                            platform = "linux") {
+  windows_configure(shares, r_version, platform)
+}
+
 windows_configure <- function(shares = NULL, r_version = NULL,
                               platform = "windows") {
   platform <- match_value(platform, c("windows", "linux"))

drivers/windows/R/constants.R

@@ -1,5 +1,7 @@
 # nolint start
 BATCH_RUN <- "run.bat"
+SH_WRAP_RUN <- "wrap_run.sh"
+SH_RUN <- "run.sh"
 DIDE_ID <- "dide_id"
 TASK_LOG <- "log"
 # nolint end

drivers/windows/R/driver-linux.R

@@ -0,0 +1,46 @@
+hipercow_driver_linux <- function() {
+  linux_driver <- hipercow_driver_windows()
+  linux_driver$configure <- linux_configure
+  linux_driver$submit <- linux_submit
+  linux_driver$check_hello <- linux_check_hello
+  linux_driver
+}
+
+linux_submit <- function(id, resources, config, path_root) {
+
+  # Convert win root to linux mount - eg
+  # Q:/testcow to /didehomes/wrh1/testcow
+
+  linux_root <- path_on_linux(prepare_path(path_root, config$shares))
+
+  # Create run.sh and wrap_run.sh in the write place - this returns the
+  # windows-style path to that, so we can write DIDE_ID below.
+
+  win_path_to_sh <- write_batch_task_run(id, config, path_root)
+
+  # For the API submit call, we want /workdir:/didenames/wrh1/testcow
+  # and the job to be relative to that - ./hipercow/tasks/etc
+
+  path_sh_dat <- prepare_path(win_path_to_sh, config$shares)
+  linux_rel_to_root <- gsub(paste0("^", linux_root), ".",
+                            path_on_linux(path_sh_dat))
+  client <- get_web_client()
+  dide_id <- client$submit(linux_rel_to_root, id, resources,
+                           workdir = linux_root)
+
+  # Job submitted - write the DIDE ID.
+
+  path_dide_id <- file.path(dirname(win_path_to_sh), DIDE_ID)
+  writeLines(dide_id, path_dide_id)
+}
+
+linux_check_hello <- function(config, path_root) {
+  if (!windows_check(path_root)) {
+    cli::cli_abort(paste("Failed checks for using linux on windows cluster;",
+                         "please see above"))
+  }
+  resources <- hipercow::hipercow_resources_validate(NULL, "dide-linux",
+                                                     path_root)
+  resources$queue <- cluster_resources("linux")$build_queue
+  resources
+}

drivers/windows/R/driver.R → drivers/windows/R/driver-windows.R

@@ -7,7 +7,7 @@ hipercow_driver_windows <- function() {
     log = windows_log,
     result = windows_result,
     cancel = windows_cancel,
-    provision_run = windows_provision_run,
+    provision_run = dide_provision_run,
     provision_list = windows_provision_list,
     provision_compare = windows_provision_compare,
     keypair = windows_keypair,
@@ -19,7 +19,6 @@ hipercow_driver_windows <- function() {
 
 windows_submit <- function(id, resources, config, path_root) {
   path_batch <- write_batch_task_run(id, config, path_root)
-
   path_batch_dat <- prepare_path(path_batch, config$shares)
   path_batch_unc <- windows_path_slashes(
     file.path(path_batch_dat$path_remote, path_batch_dat$rel))
@@ -91,7 +90,7 @@ windows_check_hello <- function(config, path_root) {
   }
   resources <- hipercow::hipercow_resources_validate(NULL, "dide-windows",
                                                      path_root)
-  resources$queue <- cluster_resources()$build_queue
+  resources$queue <- cluster_resources("windows")$build_queue
   resources
 }
 

drivers/windows/R/mounts.R

@@ -1,3 +1,5 @@
+##' @importFrom utils read.csv
+
 dide_cluster_paths <- function(shares, path_root, platform = "windows") {
   path_root <- clean_path_local(path_root)
   ## TODO: clean the shares - we can only map for the home directory
@@ -178,3 +180,46 @@ dide_locally_resolve_unc_path <- function(path, mounts = detect_mounts(),
   }
   unname(drop(mounts[i, "local"]))
 }
+
+path_on_linux <- function(path_dat) {
+  remap <- function(path_dat, server, dest) {
+    path_to_folder <- sprintf("\\\\\\\\%s\\\\", server)
+    if (grepl(path_to_folder, path_dat$path_remote)) {
+      inner_folder <- gsub(path_to_folder, "", path_dat$path_remote)
+      return(sprintf("/%s/%s/%s", dest, inner_folder, path_dat$rel))
+    }
+    FALSE
+  }
+
+  remap2 <- function(path_dat, server, folder, dest) {
+    path_to_folder <- sprintf("\\\\\\\\%s\\\\%s\\\\", server, folder)
+    if (grepl(path_to_folder, path_dat$path_remote)) {
+      inner_folder <- gsub(path_to_folder, "", path_dat$path_remote)
+      return(sprintf("/%s/%s/%s", dest, inner_folder, path_dat$rel))
+    }
+    FALSE
+  }
+
+  try_san04 <- remap2(path_dat, "wpia-san04.dide.ic.ac.uk",
+                                "homes", "didehomes")
+  if (!isFALSE(try_san04)) return(try_san04)
+
+  try_qdrive <- remap2(path_dat, "qdrive.dide.ic.ac.uk", "homes", "didehomes")
+  if (!isFALSE(try_qdrive)) return(try_qdrive)
+
+  try_wpiahn <- remap(path_dat, "wpia-hn.dide.ic.ac.uk", "wpia-hn")
+  if (!isFALSE(try_wpiahn)) return(try_wpiahn)
+
+  try_wpiahn <- remap(path_dat, "wpia-hn.hpc.dide.ic.ac.uk", "wpia-hn")
+  if (!isFALSE(try_wpiahn)) return(try_wpiahn)
+
+  try_wpiahn2 <- remap(path_dat, "wpia-hn2.dide.ic.ac.uk", "wpia-hn2")
+  if (!isFALSE(try_wpiahn2)) return(try_wpiahn2)
+
+  try_wpiahn2 <- remap(path_dat, "wpia-hn2.hpc.dide.ic.ac.uk", "wpia-hn2")
+  if (!isFALSE(try_wpiahn2)) return(try_wpiahn2)
+
+  cli::cli_abort(c(
+    "Error mapping linux path",
+    i = "Couldn't work out linux mount for {path_dat$path_remote}"))
+}