diff --git a/NEWS.md b/NEWS.md index 9fd3b84..c58b0db 100644 --- a/NEWS.md +++ b/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 diff --git a/R/dock_from_desc.R b/R/dock_from_desc.R index 809d17e..bcefe62 100644 --- a/R/dock_from_desc.R +++ b/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") diff --git a/R/utils.R b/R/utils.R index 272b8bc..9addb44 100644 --- a/R/utils.R +++ b/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 diff --git a/man/dockerfiles.Rd b/man/dockerfiles.Rd index 88c192b..8c6276c 100644 --- a/man/dockerfiles.Rd +++ b/man/dockerfiles.Rd @@ -14,7 +14,8 @@ dock_from_desc( 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 ) } \arguments{ @@ -50,6 +51,17 @@ PAT will be visible in the image metadata), or \code{"secret"} RUN; the PAT is never persisted in the image; requires BuildKit, so pass with \verb{DOCKER_BUILDKIT=1 docker build --secret id=github_pat,env=GITHUB_PAT ...}).} + +\item{strict_install}{boolean. When \code{TRUE} (the default), every +install RUN in the generated Dockerfile is prefixed with +\code{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 \code{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; \code{NA}, character, numeric, +\code{NULL} and length-2+ vectors are rejected with an error.} } \value{ Dockerfile diff --git a/tests/testthat/test-dock_from_desc.R b/tests/testthat/test-dock_from_desc.R index 66a3e48..38ad237 100644 --- a/tests/testthat/test-dock_from_desc.R +++ b/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__"))