feat(dock_from_desc): add strict_install parameter (default TRUE)

NEWS.md

@@ -30,6 +30,17 @@
   cache location at image build time with
   `--build-arg RENV_PATHS_CACHE=...` without regenerating the
   Dockerfile.
+- `dock_from_desc()` gains a `strict_install` parameter (default
+  `TRUE`). When `TRUE`, every install RUN in the generated Dockerfile
+  is prefixed with `options(warn = 2);` so any R warning during
+  install (missing CRAN package, partial download, archived package,
+  404 on a remote) becomes a hard error and aborts the docker build.
+  This is a behaviour change for users regenerating their Dockerfile:
+  install RUNs now refuse to silently swallow warnings. Pass
+  `strict_install = FALSE` if your build environment routinely
+  emits benign warnings (locale defaulting, NTP time-verification,
+  ABI-version notices) that you do not want to fail the build.
+  Closes #9.
 
 ## Bug fixes
 

R/dock_from_desc.R

@@ -63,6 +63,16 @@ quote_not_na <- function(x){
 #'   RUN; the PAT is never persisted in the image; requires BuildKit, so
 #'   pass with
 #'   `DOCKER_BUILDKIT=1 docker build --secret id=github_pat,env=GITHUB_PAT ...`).
+#' @param strict_install boolean. When `TRUE` (the default), every
+#'   install RUN in the generated Dockerfile is prefixed with
+#'   `options(warn = 2);` so that any R warning during install
+#'   (missing CRAN package, partial download, archived package,
+#'   404 on a remote) becomes a hard error and aborts the docker
+#'   build. Set to `FALSE` if your build environment routinely emits
+#'   benign warnings (locale defaulting, NTP time-verification,
+#'   ABI-version notices) that you do not want to fail the build.
+#'   Must be a single scalar logical; `NA`, character, numeric,
+#'   `NULL` and length-2+ vectors are rejected with an error.
 #'
 #' @export
 #' @rdname dockerfiles
@@ -89,9 +99,20 @@ dock_from_desc <- function(
   update_tar_gz = TRUE,
   build_from_source = TRUE,
   extra_sysreqs = NULL,
-  github_pat = c("none", "build_arg", "secret")
+  github_pat = c("none", "build_arg", "secret"),
+  strict_install = TRUE
 ) {
   github_pat <- match.arg(github_pat)
+  if (
+    !is.logical(strict_install) ||
+      length(strict_install) != 1L ||
+      is.na(strict_install)
+  ) {
+    stop(
+      "`strict_install` must be a single `TRUE` or `FALSE`, got: ",
+      deparse(strict_install)
+    )
+  }
   path <- fs::path_abs(path)
 
   packages <- desc_get_deps(path)$package
@@ -207,17 +228,28 @@ dock_from_desc <- function(
 
 
 
-  dock$RUN("R -e 'install.packages(\"remotes\")'")
+  strict_prefix <- .r_strict_prefix(strict_install)
+
+  dock$RUN(
+    sprintf(
+      "R -e '%sinstall.packages(\"remotes\")'",
+      strict_prefix
+    )
+  )
 
   if (length(packages_on_cran) > 0) {
     ping <- mapply(
-      function(dock, ver, nm) {
-        res <- dock$RUN(sprintf("Rscript -e 'remotes::install_version(\"%s\",upgrade=\"never\", version = %s)'",
-                                nm, ver))
+      function(dock, ver, nm, strict_prefix) {
+        res <- dock$RUN(sprintf(
+          "Rscript -e '%sremotes::install_version(\"%s\",upgrade=\"never\", version = %s)'",
+          strict_prefix,
+          nm,
+          ver
+        ))
       },
       ver = quote_not_na(packages_on_cran),
       nm = names(packages_on_cran),
-      MoreArgs = list(dock = dock)
+      MoreArgs = list(dock = dock, strict_prefix = strict_prefix)
     )
   }
 
@@ -243,17 +275,18 @@ dock_from_desc <- function(
 
 
     pong <- mapply(
-      function(dock, ver, nm) {
+      function(dock, ver, strict_prefix) {
         res <- dock$RUN(
           sprintf(
-            "%sRscript -e 'remotes::install_github(\"%s\")'",
+            "%sRscript -e '%sremotes::install_github(\"%s\")'",
             .github_pat_run_prefix(github_pat),
+            strict_prefix,
             ver
           )
         )
       },
       ver = nn,
-      MoreArgs = list(dock = dock)
+      MoreArgs = list(dock = dock, strict_prefix = strict_prefix)
     )
   }
 
@@ -313,7 +346,9 @@ dock_from_desc <- function(
     dock$RUN(
       paste0(
         .github_pat_run_prefix(github_pat),
-        "R -e 'remotes::install_local(\"/app.tar.gz\",upgrade=\"never\")'"
+        "R -e '",
+        strict_prefix,
+        "remotes::install_local(\"/app.tar.gz\",upgrade=\"never\")'"
       )
     )
     dock$RUN("rm /app.tar.gz")
@@ -324,7 +359,9 @@ dock_from_desc <- function(
     dock$RUN(
       paste0(
         .github_pat_run_prefix(github_pat),
-        "R -e 'remotes::install_local(upgrade=\"never\")'"
+        "R -e '",
+        strict_prefix,
+        "remotes::install_local(upgrade=\"never\")'"
       )
     )
     dock$RUN("rm -rf /build_zone")

R/utils.R

@@ -72,6 +72,24 @@ cat_info <- function(...) {
   }
 }
 
+#' Strict-install prefix for an R / Rscript invocation in a Dockerfile RUN.
+#'
+#' When `strict_install = TRUE`, returns `"options(warn = 2); "` so
+#' that warnings emitted during the install (e.g. a missing CRAN
+#' package, a 404 on a remote, a partial install) become hard
+#' errors and the docker build aborts. Otherwise an empty string,
+#' which preserves the legacy behavior where install warnings did
+#' not fail the build.
+#' @noRd
+.r_strict_prefix <- function(strict_install) {
+  # Caller must pass a single TRUE / FALSE; `dock_from_desc()` validates.
+  if (strict_install) {
+    "options(warn = 2); "
+  } else {
+    ""
+  }
+}
+
 #' Emit a one-shot reminder describing how the PAT must be supplied at
 #' `docker build` time. No-op when mode is `"none"`.
 #' @noRd

tests/testthat/test-dock_from_desc.R

@@ -120,6 +120,93 @@ withr::with_dir(
 
     })
 
+    test_that("dock_from_desc(strict_install = TRUE) prepends options(warn = 2) to every install RUN", {
+      skip_if(is_rdevel, "skip on R-devel")
+      out <- dock_from_desc(
+        file.path(".", "DESCRIPTION__"),
+        sysreqs = FALSE,
+        strict_install = TRUE
+      )
+      install_lines <- grep(
+        "(R|Rscript) -e '.*install",
+        out$Dockerfile,
+        value = TRUE
+      )
+      expect_gt(length(install_lines), 0L)
+      for (line in install_lines) {
+        expect_match(
+          line,
+          "options\\(warn = 2\\);",
+          info = sprintf(
+            "install RUN must carry options(warn = 2): %s",
+            line
+          )
+        )
+      }
+    })
+
+    test_that("dock_from_desc(strict_install = FALSE) does not prepend options(warn = 2)", {
+      skip_if(is_rdevel, "skip on R-devel")
+      out <- dock_from_desc(
+        file.path(".", "DESCRIPTION__"),
+        sysreqs = FALSE,
+        strict_install = FALSE
+      )
+      df <- paste(out$Dockerfile, collapse = "\n")
+      expect_false(grepl("options\\(warn = 2\\)", df))
+    })
+
+    test_that("dock_from_desc default is strict_install = TRUE so install warnings fail the build", {
+      fmls <- formals(dock_from_desc)
+      expect_true("strict_install" %in% names(fmls))
+      expect_true(fmls$strict_install)
+    })
+
+    test_that("dock_from_desc rejects non-scalar / NA / non-logical strict_install", {
+      skip_if(is_rdevel, "skip on R-devel")
+
+      expect_error(
+        dock_from_desc(
+          file.path(".", "DESCRIPTION__"),
+          sysreqs = FALSE,
+          strict_install = NA
+        ),
+        "single `TRUE` or `FALSE`"
+      )
+      expect_error(
+        dock_from_desc(
+          file.path(".", "DESCRIPTION__"),
+          sysreqs = FALSE,
+          strict_install = c(TRUE, FALSE)
+        ),
+        "single `TRUE` or `FALSE`"
+      )
+      expect_error(
+        dock_from_desc(
+          file.path(".", "DESCRIPTION__"),
+          sysreqs = FALSE,
+          strict_install = "TRUE"
+        ),
+        "single `TRUE` or `FALSE`"
+      )
+      expect_error(
+        dock_from_desc(
+          file.path(".", "DESCRIPTION__"),
+          sysreqs = FALSE,
+          strict_install = 1
+        ),
+        "single `TRUE` or `FALSE`"
+      )
+      expect_error(
+        dock_from_desc(
+          file.path(".", "DESCRIPTION__"),
+          sysreqs = FALSE,
+          strict_install = NULL
+        ),
+        "single `TRUE` or `FALSE`"
+      )
+    })
+
     test_that("dock_from_desc emits no GITHUB_PAT plumbing by default", {
       skip_if(is_rdevel, "skip on R-devel")
       my_dock <- dock_from_desc(file.path(".", "DESCRIPTION__"))