superseded: option-validation edge contract inherited by #126

.jules/sentinel.md

@@ -12,3 +12,8 @@
 **Vulnerability:** Raw `stop()` and `warning()` calls without `call. = FALSE` in `llcont.R` and `vuongtest.R` exposed execution stack/call details when raised.
 **Learning:** While some instances of `stop()` inside `tryCatch()` were previously fixed to hide the call stack, other standalone exceptions and warnings still leaked call context. Security must be consistently applied across the entire codebase.
 **Prevention:** Always set `call. = FALSE` when using `stop()` or `warning()` to enforce a secure-by-default boundary and prevent internal execution paths from being disclosed to the end user.
+
+## 2024-07-28 - Add Input Validation for Exported Functions
+**Vulnerability:** Exported functions like `icci` and `vuongtest` lacked input validation for arguments like `conf.level`, `nested`, and `adj`. Passing invalid arguments (e.g. non-numeric bounds or wrong types) allowed errors to propagate into arithmetic or logical evaluations, ultimately triggering unhandled internal exceptions that exposed raw contexts and structural assumptions (e.g. `$ operator is invalid for atomic vectors`).
+**Learning:** Security boundaries must exist at the entry points (the exported API). Unvalidated inputs that fall through to internal logic can induce failures that disclose details of the underlying implementation.
+**Prevention:** Strictly validate the type, length, and range of all inputs in exported functions before any other operations, and fail securely with a generic error using `stop(..., call. = FALSE)`.

R/icci.R

@@ -64,6 +64,9 @@
 #' @importFrom stats AIC var qnorm
 #' @export
 icci <- function(object1, object2, conf.level=.95, ll1=llcont, ll2=llcont) {
+  if (!is.numeric(conf.level) || length(conf.level) != 1 || is.na(conf.level) || conf.level <= 0 || conf.level >= 1) {
+    stop("conf.level must be a numeric value between 0 and 1", call. = FALSE)
+  }
 
   ## check objects, issue warnings/errors, get classes/calls
   obinfo <- check.obj(object1, object2)

R/vuongtest.R

@@ -97,6 +97,12 @@
 #' @importFrom methods slotNames
 #' @export
 vuongtest <- function(object1, object2, nested=FALSE, adj="none", ll1=llcont, ll2=llcont, score1=NULL, score2=NULL, vc1=vcov, vc2=vcov) {
+  if (!is.logical(nested) || length(nested) != 1 || is.na(nested)) {
+    stop("nested must be a single logical value", call. = FALSE)
+  }
+  if (!is.character(adj) || length(adj) != 1 || is.na(adj) || !(adj %in% c("none", "aic", "bic"))) {
+    stop("adj must be one of \"none\", \"aic\", or \"bic\"", call. = FALSE)
+  }
 
   ## check objects, issue warnings/errors, get classes/calls
   obinfo <- check.obj(object1, object2)

tests/testthat/test_vuongtest_errors.R

@@ -57,3 +57,19 @@ test_that("vuongtest sanitizes singular covariance errors", {
     )
   )
 })
+
+test_that("vuongtest rejects unsupported adjustment names before model processing", {
+  for (adj in c("AIC", "", "aic ")) {
+    err <- tryCatch(
+      vuongtest(NULL, NULL, adj = adj),
+      error = identity
+    )
+
+    expect_s3_class(err, "error")
+    expect_identical(
+      conditionMessage(err),
+      'adj must be one of "none", "aic", or "bic"'
+    )
+    expect_null(conditionCall(err))
+  }
+})