feat(security): validate user-supplied strings flowing into shell context

Closes the post-#106 security audit follow-up. Adds 9 .validate_*
helpers in R/utils.R (@nord) that reject inputs which would
otherwise be interpolated raw into the generated Dockerfile's shell
commands. Each helper raises stop() with a clear message naming the
offending parameter.

Validators added:

- .validate_FROM (image reference: `^[a-zA-Z0-9][a-zA-Z0-9._/-]*(:tag)?(@sha256:hex)?$`)
- .validate_AS (build-stage name: `^[a-zA-Z0-9][a-zA-Z0-9._-]*$`)
- .validate_repos (https URLs + simple-identifier names; closes the
  `dput()`-backtick injection vector on names)
- .validate_extra_sysreqs (Debian package name: `^[a-z0-9][a-z0-9.+-]+$`)
- .validate_renv_version (semver-like, NULL allowed)
- .validate_lockfile (basename: alphanumerics + `._-`)
- .validate_renv_paths_cache (absolute path, no metacharacters)
- .validate_r_version (defensive depth on lockfile-derived value)
- .validate_scalar_logical (factored out from strict_install; used
  for use_pak too, closing a real injection vector via
  `echo "options(renv.config.pak.enabled = %s, ...)"`)

dock_from_desc() and dock_from_renv() call the relevant validators
at function entry, just after match.arg(github_pat).

The pr-reviewer agent flagged two additional vectors I missed in
the first pass: use_pak (B1, blocked) and names(repos) (B2, blocked
via the dput() backtick path). Both are closed by this commit.

Tests: 9 new expect_error() blocks across test-dock_from_desc.R
and test-dock_from_renv.R, each TDD red-against-buggy. One
existing test patched: renv_version = "banana" -> "1.2.3" since
the new validator rejects non-semver strings (the test was
exercising the install_version code path, which "1.2.3" still
covers).

devtools::test() -> [ FAIL 0 | WARN 3 | SKIP 0 | PASS 302 ].
R CMD check --as-cran: 0 errors / 0 warnings / 1 note (the
"unable to verify current time" host note, unrelated).

Out of scope for this PR (per the threat model agreed with the
maintainer):
- R6 helpers in R/add.R (dock$RUN, dock$COPY, ...) are
  author-controlled API; if the author writes a malicious RUN it
  is self-foot-shooting, not injection.
- distro is deprecated and ignored at runtime.
- github_pat is match.arg'd against a fixed enum.

NEWS.md gains a `## Security` section above `## New features`.

Author: VincentGuyader

NEWS.md

@@ -24,6 +24,20 @@
   behaviour. debian/ubuntu only; for alpine-based images you must
   pass `user = NULL` and create the user yourself. Closes #100.
 
+## Security
+
+- `dock_from_desc()` and `dock_from_renv()` now validate every
+  user-supplied parameter that flows into a Dockerfile shell context
+  (`FROM`, `AS`, `repos` values and names, `extra_sysreqs`,
+  `renv_version`, `renv_paths_cache`, `lockfile` basename, `use_pak`,
+  `strict_install`, plus `r_version` read from the lockfile). Inputs
+  that contain shell metacharacters, newlines, or do not match the
+  documented format raise an explicit error at function entry,
+  rather than silently producing a malformed Dockerfile or one that
+  executes attacker-controlled commands at `docker build` time.
+  This closes the post-#106 audit follow-up for all five sites
+  surfaced by Copilot review.
+
 ## New features
 
 - `dock$ARG()` and the internal `add_arg()` helper gain a `default`

R/dock_from_desc.R

@@ -42,17 +42,29 @@ quote_not_na <- function(x){
 #
 #' @param path path to the DESCRIPTION file to use as an input.
 #' @param FROM The FROM of the Dockerfile. Default is
-#'     FROM rocker/r-ver:`R.Version()$major`.`R.Version()$minor`.
-#' @param AS The AS of the Dockerfile. Default it NULL.
+#'   `paste0("rocker/r-ver:", R.Version()$major, ".", R.Version()$minor)`.
+#'   Validated as a Docker image reference (alphanumerics, dot, slash,
+#'   dash, underscore, optional `:tag` and / or `@sha256:<hex>`); other
+#'   values raise an error to prevent shell-metacharacter injection
+#'   into the generated FROM directive.
+#' @param AS The AS of the Dockerfile. Default it NULL. When non-NULL,
+#'   validated as a simple build-stage name (`^[a-zA-Z0-9][a-zA-Z0-9._-]*$`).
 #' @param sysreqs boolean. If TRUE, the Dockerfile will contain sysreq installation.
-#' @param repos character. The URL(s) of the repositories to use for `options("repos")`.
+#' @param repos character. The URL(s) of the repositories to use for
+#'   `options("repos")`. Each value must look like an http(s) URL (no
+#'   quotes, spaces or newlines); each name (when set) must be a simple
+#'   identifier (`^[A-Za-z][A-Za-z0-9._-]*$`). Other values raise an
+#'   error to prevent injection into the generated `echo "options(...)"`
+#'   shell command.
 #' @param expand boolean. If `TRUE` each system requirement will have its own `RUN` line.
 #' @param build_from_source boolean. If `TRUE` no tar.gz is created and
 #'     the Dockerfile directly mount the source folder.
 #' @param update_tar_gz boolean. If `TRUE` and `build_from_source` is also `TRUE`,
 #'     an updated tar.gz is created.
 #' @param extra_sysreqs character vector. Extra debian system requirements.
-#'    Will be installed with apt-get install.
+#'   Will be installed with apt-get install. Each entry must be a Debian
+#'   package name (`^[a-z0-9][a-z0-9.+-]+$`); other values raise an error
+#'   to prevent injection into the generated apt-get RUN.
 #' @param github_pat character. How to provide a GitHub PAT to
 #'   `remotes::install_github()` for private dependency repositories.
 #'   One of `"none"` (default; the generated Dockerfile does not
@@ -103,16 +115,11 @@ dock_from_desc <- function(
   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)
-    )
-  }
+  .validate_scalar_logical(strict_install, "strict_install")
+  .validate_FROM(FROM)
+  .validate_AS(AS)
+  .validate_repos(repos)
+  .validate_extra_sysreqs(extra_sysreqs)
   path <- fs::path_abs(path)
 
   packages <- desc_get_deps(path)$package

R/dock_from_renv.R

@@ -9,14 +9,26 @@ pkg_sysreqs_mem <- memoise::memoise(
 #' Create a Dockerfile from an `renv.lock` file
 #'
 #' @param lockfile Path to an `renv.lock` file to use as an input..
-#' @param FROM Docker image to start FROM Default is FROM rocker/r-base
-#' @param AS The AS of the Dockerfile. Default it `NULL`.
+#' @param FROM Docker image to start FROM. Default is `"rocker/r-base"`.
+#'   Validated as a Docker image reference (alphanumerics, dot, slash,
+#'   dash, underscore, optional `:tag` and / or `@sha256:<hex>`); other
+#'   values raise an error to prevent shell-metacharacter injection
+#'   into the generated FROM directive.
+#' @param AS The AS of the Dockerfile. Default it `NULL`. When non-NULL,
+#'   validated as a simple build-stage name (`^[a-zA-Z0-9][a-zA-Z0-9._-]*$`).
 #' @param distro - deprecated - only debian/ubuntu based images are supported
 #' @param sysreqs boolean. If `TRUE`, the Dockerfile will contain sysreq installation.
 #' @param expand boolean. If `TRUE` each system requirement will have its own `RUN` line.
-#' @param repos character. The URL(s) of the repositories to use for `options("repos")`.
+#' @param repos character. The URL(s) of the repositories to use for
+#'   `options("repos")`. Each value must look like an http(s) URL
+#'   (no quotes, spaces or newlines); each name (when set) must be a
+#'   simple identifier (`^[A-Za-z][A-Za-z0-9._-]*$`). Other values raise
+#'   an error to prevent injection into the generated `echo "options(...)"`
+#'   shell command.
 #' @param extra_sysreqs character vector. Extra debian system requirements.
-#'    Will be installed with apt-get install.
+#'   Will be installed with apt-get install. Each entry must be a Debian
+#'   package name (`^[a-z0-9][a-z0-9.+-]+$`); other values raise an error
+#'   to prevent injection into the generated apt-get RUN.
 #' @param renv_version character or `NULL`. The renv version to install.
 #'   The argument has three distinct modes, deliberately encoded with
 #'   the missing-vs-`NULL` distinction:
@@ -28,7 +40,12 @@ pkg_sysreqs_mem <- memoise::memoise(
 #'     version.
 #'   - a character string such as `"1.0.0"`: install that specific
 #'     version regardless of what the lockfile says.
-#' @param use_pak boolean. If `TRUE` use pak to deal with dependencies  during `renv::restore()`. FALSE by default
+#'
+#'   When supplied as a string, validated as a version-like token
+#'   (`^[0-9]+(\.[0-9]+){0,3}([-.][a-zA-Z0-9]+)?$`).
+#' @param use_pak boolean. If `TRUE` use pak to deal with dependencies
+#'   during `renv::restore()`. FALSE by default. Must be a single
+#'   `TRUE` or `FALSE` (no `NA`, no vector).
 #' @param user Name of the user the runtime container drops privilege
 #'   to before the `renv::restore()` step (and therefore at runtime).
 #'   Default is `"rstudio"` so the generated image runs as a non-root
@@ -139,6 +156,16 @@ dock_from_renv <- function(
   renv_paths_cache = NULL
 ) {
   github_pat <- match.arg(github_pat)
+  .validate_lockfile(lockfile)
+  .validate_FROM(FROM)
+  .validate_AS(AS)
+  .validate_repos(repos)
+  .validate_extra_sysreqs(extra_sysreqs)
+  .validate_scalar_logical(use_pak, "use_pak")
+  if (!missing(renv_version)) {
+    .validate_renv_version(renv_version)
+  }
+  .validate_renv_paths_cache(renv_paths_cache)
   if (!is.null(user)) {
     # `user` is interpolated into shell commands (id, useradd, chown, USER).
     # Reject anything that is not a strict POSIX username so a caller passing
@@ -173,6 +200,7 @@ dock_from_renv <- function(
 
   # start the dockerfile
   R_major_minor <- lock$R$Version
+  .validate_r_version(R_major_minor)
   dock <- Dockerfile$new(
     FROM = gen_base_image(
       r_version = R_major_minor,

R/utils.R

@@ -90,6 +90,219 @@ cat_info <- function(...) {
   }
 }
 
+#' Validate user-supplied strings that flow into a Dockerfile shell context.
+#'
+#' These helpers reject inputs that, if interpolated raw, would either
+#' break the generated Dockerfile / shell command or allow injection of
+#' arbitrary commands at `docker build` time. Each helper raises an
+#' error with a clear message naming the offending parameter. `NULL` is
+#' accepted where it has a documented meaning (e.g. `renv_paths_cache`,
+#' `renv_version`, `extra_sysreqs`, `repos`).
+#' @noRd
+.validate_FROM <- function(x) {
+  if (!is.character(x) || length(x) != 1L || is.na(x)) {
+    stop(
+      "`FROM` must be a single string, got: ",
+      deparse(x)
+    )
+  }
+  if (
+    !grepl(
+      "^[a-zA-Z0-9][a-zA-Z0-9._/-]*(:[a-zA-Z0-9._-]+)?(@sha256:[a-fA-F0-9]+)?$",
+      x
+    )
+  ) {
+    stop(
+      "`FROM` must be a valid Docker image reference ",
+      "(alphanumerics, dot, slash, dash, underscore; optional `:tag` ",
+      "and / or `@sha256:<hex>`; no newlines or shell metacharacters), got: ",
+      deparse(x)
+    )
+  }
+  invisible()
+}
+
+#' @noRd
+.validate_r_version <- function(x) {
+  if (!is.character(x) || length(x) != 1L || is.na(x)) {
+    stop(
+      "`r_version` (read from the lockfile) must be a single string, got: ",
+      deparse(x)
+    )
+  }
+  if (!grepl("^[0-9]+\\.[0-9]+(\\.[0-9]+)?$", x)) {
+    stop(
+      "`r_version` (read from the lockfile) must look like a numeric ",
+      "R version such as \"4.5\" or \"4.5.0\", got: ",
+      deparse(x)
+    )
+  }
+  invisible()
+}
+
+#' @noRd
+.validate_repos <- function(x) {
+  if (is.null(x)) {
+    return(invisible())
+  }
+  if (!is.character(x)) {
+    stop(
+      "`repos` must be a character vector, got: ",
+      deparse(x)
+    )
+  }
+  bad <- !grepl(
+    "^https?://[A-Za-z0-9._~:/?#@!$&()*+,;=%-]+$",
+    x
+  )
+  if (any(bad)) {
+    stop(
+      "`repos` entries must be http(s) URLs without quotes, ",
+      "spaces or newlines; invalid: ",
+      paste(vapply(x[bad], deparse, character(1)), collapse = ", ")
+    )
+  }
+  # Names are emitted via `dput(repos)`, which wraps R-syntax-unsafe
+  # names in backticks. Backticks inside a Dockerfile RUN's outer
+  # double-quoted shell context trigger command substitution. Tight
+  # regex on names to keep them simple identifiers.
+  nms <- names(x)
+  if (!is.null(nms)) {
+    bad_nms <- !grepl("^[A-Za-z][A-Za-z0-9._-]*$", nms)
+    if (any(bad_nms)) {
+      stop(
+        "`names(repos)` must be simple identifiers ",
+        "(`^[A-Za-z][A-Za-z0-9._-]*$`); invalid: ",
+        paste(vapply(nms[bad_nms], deparse, character(1)), collapse = ", ")
+      )
+    }
+  }
+  invisible()
+}
+
+#' @noRd
+.validate_AS <- function(x) {
+  if (is.null(x)) {
+    return(invisible())
+  }
+  if (!is.character(x) || length(x) != 1L || is.na(x)) {
+    stop(
+      "`AS` must be a single string or NULL, got: ",
+      deparse(x)
+    )
+  }
+  if (!grepl("^[a-zA-Z0-9][a-zA-Z0-9._-]*$", x)) {
+    stop(
+      "`AS` must be a simple build-stage name ",
+      "(`^[a-zA-Z0-9][a-zA-Z0-9._-]*$`), got: ",
+      deparse(x)
+    )
+  }
+  invisible()
+}
+
+#' @noRd
+.validate_scalar_logical <- function(x, name) {
+  if (
+    !is.logical(x) ||
+      length(x) != 1L ||
+      is.na(x)
+  ) {
+    stop(
+      sprintf("`%s` must be a single `TRUE` or `FALSE`, got: ", name),
+      deparse(x)
+    )
+  }
+  invisible()
+}
+
+#' @noRd
+.validate_extra_sysreqs <- function(x) {
+  if (is.null(x)) {
+    return(invisible())
+  }
+  if (!is.character(x)) {
+    stop(
+      "`extra_sysreqs` must be a character vector, got: ",
+      deparse(x)
+    )
+  }
+  bad <- !grepl("^[a-z0-9][a-z0-9.+-]+$", x)
+  if (any(bad)) {
+    stop(
+      "`extra_sysreqs` entries must be Debian package names ",
+      "matching `^[a-z0-9][a-z0-9.+-]+$`; invalid: ",
+      paste(vapply(x[bad], deparse, character(1)), collapse = ", ")
+    )
+  }
+  invisible()
+}
+
+#' @noRd
+.validate_renv_version <- function(x) {
+  if (is.null(x)) {
+    return(invisible())
+  }
+  if (!is.character(x) || length(x) != 1L || is.na(x)) {
+    stop(
+      "`renv_version` must be a single string or NULL, got: ",
+      deparse(x)
+    )
+  }
+  if (!grepl("^[0-9]+(\\.[0-9]+){0,3}([-.][a-zA-Z0-9]+)?$", x)) {
+    stop(
+      "`renv_version` must look like a version string such as ",
+      "\"1.0.0\" or \"0.16.0-beta\", got: ",
+      deparse(x)
+    )
+  }
+  invisible()
+}
+
+#' @noRd
+.validate_lockfile <- function(x) {
+  if (!is.character(x) || length(x) != 1L || is.na(x)) {
+    stop(
+      "`lockfile` must be a single path string, got: ",
+      deparse(x)
+    )
+  }
+  bn <- basename(x)
+  if (!grepl("^[A-Za-z0-9._-]+$", bn)) {
+    stop(
+      "`lockfile` basename must contain only alphanumerics, dots, ",
+      "underscores or hyphens (no spaces or shell metacharacters); ",
+      "the COPY directive in the generated Dockerfile would otherwise ",
+      "be malformed. Got basename: ",
+      deparse(bn)
+    )
+  }
+  invisible()
+}
+
+#' @noRd
+.validate_renv_paths_cache <- function(x) {
+  if (is.null(x)) {
+    return(invisible())
+  }
+  if (!is.character(x) || length(x) != 1L || is.na(x)) {
+    stop(
+      "`renv_paths_cache` must be a single path string or NULL, got: ",
+      deparse(x)
+    )
+  }
+  if (!grepl("^/[A-Za-z0-9._/-]*$", x)) {
+    stop(
+      "`renv_paths_cache` must be an absolute path containing only ",
+      "alphanumerics, dots, slashes, underscores or hyphens ",
+      "(`^/[A-Za-z0-9._/-]*$`); shell metacharacters or newlines ",
+      "would break the ARG directive. Got: ",
+      deparse(x)
+    )
+  }
+  invisible()
+}
+
 #' Emit a one-shot reminder describing how the PAT must be supplied at
 #' `docker build` time. No-op when mode is `"none"`.
 #' @noRd