🛡️ Sentinel: [MEDIUM] Add input validation to prevent internal error leakage

..Rcheck/00check.log

@@ -0,0 +1,13 @@
+* using log directory ‘/app/..Rcheck’
+* using R version 4.3.3 (2024-02-29)
+* using platform: x86_64-pc-linux-gnu (64-bit)
+* R was compiled by
+    gcc (Ubuntu 13.2.0-23ubuntu3) 13.2.0
+    GNU Fortran (Ubuntu 13.2.0-23ubuntu3) 13.2.0
+* running under: Ubuntu 24.04.4 LTS
+* using session charset: UTF-8
+* checking for file ‘./DESCRIPTION’ ... ERROR
+Required fields missing or empty:
+  ‘Author’ ‘Maintainer’
+* DONE
+Status: 1 ERROR

.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-08-03 - Prevent Information Disclosure from unvalidated exported function arguments
+**Vulnerability:** Unvalidated arguments passed to exported functions (`conf.level`, `nested`, `adj`) bypass top-level `stop(..., call. = FALSE)` safeguards. When invalid types are used, they trigger raw R errors deep inside internal logic, leaking internal execution contexts and stack traces.
+**Learning:** In R codebases, unvalidated arguments passed to exported functions can bypass top-level `stop(..., call. = FALSE)` safeguards and trigger raw R errors deep inside internal logic, leaking internal execution contexts.
+**Prevention:** Always strictly validate the type, length, and bounds of user inputs at the very beginning of exported functions to fail securely.

R/icci.R

@@ -65,6 +65,10 @@
 #' @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 scalar between 0 and 1", call. = FALSE)
+  }
+
   ## check objects, issue warnings/errors, get classes/calls
   obinfo <- check.obj(object1, object2)
   callA <- obinfo$callA; classA <- obinfo$classA

R/vuongtest.R

@@ -98,6 +98,13 @@
 #' @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 logical scalar (TRUE or FALSE)", call. = FALSE)
+  }
+  if (!is.character(adj) || length(adj) != 1 || !(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)
   callA <- obinfo$callA; classA <- obinfo$classA

tests/testthat/test_icci_args.R

@@ -0,0 +1,22 @@
+test_that("icci sanitizes unvalidated conf.level errors", {
+  dat <- data.frame(y = c(1, 2, 3, 4), x = c(1, 2, 3, 4))
+  model_a <- lm(y ~ x, data = dat)
+  model_b <- lm(y ~ 1, data = dat)
+
+  err1 <- tryCatch(icci(model_a, model_b, conf.level = "a"), error = identity)
+  expect_s3_class(err1, "error")
+  expect_identical(conditionMessage(err1), "conf.level must be a numeric scalar between 0 and 1")
+  expect_null(conditionCall(err1))
+
+  err2 <- tryCatch(icci(model_a, model_b, conf.level = c(0.95, 0.99)), error = identity)
+  expect_s3_class(err2, "error")
+  expect_identical(conditionMessage(err2), "conf.level must be a numeric scalar between 0 and 1")
+
+  err3 <- tryCatch(icci(model_a, model_b, conf.level = NA_real_), error = identity)
+  expect_s3_class(err3, "error")
+  expect_identical(conditionMessage(err3), "conf.level must be a numeric scalar between 0 and 1")
+
+  err4 <- tryCatch(icci(model_a, model_b, conf.level = Inf), error = identity)
+  expect_s3_class(err4, "error")
+  expect_identical(conditionMessage(err4), "conf.level must be a numeric scalar between 0 and 1")
+})

tests/testthat/test_vuongtest_args.R

@@ -0,0 +1,27 @@
+test_that("vuongtest sanitizes unvalidated arguments errors", {
+  dat <- data.frame(y = c(1, 2, 3, 4), x = c(1, 2, 3, 4))
+  model_a <- lm(y ~ x, data = dat)
+  model_b <- lm(y ~ 1, data = dat)
+
+  err1 <- tryCatch(vuongtest(model_a, model_b, nested = "yes"), error = identity)
+  expect_s3_class(err1, "error")
+  expect_identical(conditionMessage(err1), "nested must be a logical scalar (TRUE or FALSE)")
+  expect_null(conditionCall(err1))
+
+  err2 <- tryCatch(vuongtest(model_a, model_b, nested = c(TRUE, FALSE)), error = identity)
+  expect_s3_class(err2, "error")
+  expect_identical(conditionMessage(err2), "nested must be a logical scalar (TRUE or FALSE)")
+
+  err3 <- tryCatch(vuongtest(model_a, model_b, adj = c("none", "aic")), error = identity)
+  expect_s3_class(err3, "error")
+  expect_identical(conditionMessage(err3), "adj must be one of 'none', 'aic', or 'bic'")
+  expect_null(conditionCall(err3))
+
+  err4 <- tryCatch(vuongtest(model_a, model_b, adj = "what"), error = identity)
+  expect_s3_class(err4, "error")
+  expect_identical(conditionMessage(err4), "adj must be one of 'none', 'aic', or 'bic'")
+
+  err5 <- tryCatch(vuongtest(model_a, model_b, adj = factor("none")), error = identity)
+  expect_s3_class(err5, "error")
+  expect_identical(conditionMessage(err5), "adj must be one of 'none', 'aic', or 'bic'")
+})