diff --git a/.jules/sentinel.md b/.jules/sentinel.md index bc5c6e1..886613b 100644 --- a/.jules/sentinel.md +++ b/.jules/sentinel.md @@ -12,3 +12,7 @@ **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-09-03 - [Input Validation and Secure Failures] +**Vulnerability:** Unvalidated inputs passed to exported functions can bypass top-level `stop()` safeguards, triggering raw errors deep inside internal execution contexts and exposing internal states. +**Learning:** In R, evaluating malformed parameters (like NAs or missing logicals) inside `if` statements can crash the application or leak system state (e.g., "missing value where TRUE/FALSE needed"). +**Prevention:** Always place strict type, length, and `is.na()` checks at the absolute beginning of exported functions, using `||` for safe short-circuiting, to fail securely and deliberately. diff --git a/NEWS b/NEWS index f387a71..02200d2 100644 --- a/NEWS +++ b/NEWS @@ -2,6 +2,9 @@ Changes in Version 0.5-9 o bug fixes: lavaan parameter counts with equality constraints, mirt DiscreteClass (credit to Seongho Bae) + o validate public vuongtest() and icci() arguments before model evaluation, + with stable errors for invalid nested/adj/conf.level values and callbacks + Changes in Version 0.5-8 o add support for objects of DiscreteClass from mirt package (credit to Phil Chalmers) diff --git a/R/icci.R b/R/icci.R index f22278a..2fd5fde 100644 --- a/R/icci.R +++ b/R/icci.R @@ -65,6 +65,13 @@ #' @export icci <- function(object1, object2, conf.level=.95, ll1=llcont, ll2=llcont) { + if (length(conf.level) != 1 || is.na(conf.level) || !is.numeric(conf.level) || conf.level <= 0 || conf.level >= 1) { + stop("conf.level must be a single numeric value strictly between 0 and 1", call. = FALSE) + } + if (!is.function(ll1) || !is.function(ll2)) { + stop("ll1 and ll2 must be functions", call. = FALSE) + } + ## check objects, issue warnings/errors, get classes/calls obinfo <- check.obj(object1, object2) callA <- obinfo$callA; classA <- obinfo$classA diff --git a/R/vuongtest.R b/R/vuongtest.R index 2bdfbf6..f115135 100644 --- a/R/vuongtest.R +++ b/R/vuongtest.R @@ -98,6 +98,22 @@ #' @export vuongtest <- function(object1, object2, nested=FALSE, adj="none", ll1=llcont, ll2=llcont, score1=NULL, score2=NULL, vc1=vcov, vc2=vcov) { + if (length(nested) != 1 || is.na(nested) || !is.logical(nested)) { + stop("nested must be a single logical value", call. = FALSE) + } + if (length(adj) != 1 || is.na(adj) || !is.character(adj) || !(adj %in% c("none", "aic", "bic"))) { + stop('adj must be one of "none", "aic", or "bic"', call. = FALSE) + } + if (!is.function(ll1) || !is.function(ll2)) { + stop("ll1 and ll2 must be functions", call. = FALSE) + } + if ((!is.null(score1) && !is.function(score1)) || (!is.null(score2) && !is.function(score2))) { + stop("score1 and score2 must be functions or NULL", call. = FALSE) + } + if (!is.function(vc1) || !is.function(vc2)) { + stop("vc1 and vc2 must be functions", call. = FALSE) + } + ## check objects, issue warnings/errors, get classes/calls obinfo <- check.obj(object1, object2) callA <- obinfo$callA; classA <- obinfo$classA diff --git a/tests/testthat/test_public_argument_validation.R b/tests/testthat/test_public_argument_validation.R new file mode 100644 index 0000000..611e351 --- /dev/null +++ b/tests/testthat/test_public_argument_validation.R @@ -0,0 +1,45 @@ +test_that("vuongtest rejects malformed public arguments before object inspection", { + invalid_cases <- list( + list(args = list(nested = NA), message = "nested must be a single logical value"), + list(args = list(nested = c(TRUE, FALSE)), message = "nested must be a single logical value"), + list(args = list(adj = NA_character_), message = 'adj must be one of "none", "aic", or "bic"'), + list(args = list(adj = "unknown"), message = 'adj must be one of "none", "aic", or "bic"'), + list(args = list(ll1 = "llcont"), message = "ll1 and ll2 must be functions"), + list(args = list(score1 = "score"), message = "score1 and score2 must be functions or NULL"), + list(args = list(vc1 = "vcov"), message = "vc1 and vc2 must be functions") + ) + + for (case in invalid_cases) { + err <- tryCatch( + do.call(vuongtest, c(list(object1 = NULL, object2 = NULL), case$args)), + error = identity + ) + + expect_s3_class(err, "error") + expect_identical(conditionMessage(err), case$message) + expect_null(conditionCall(err)) + } +}) + + +test_that("icci rejects malformed public arguments before object inspection", { + invalid_cases <- list( + list(args = list(conf.level = NA_real_), message = "conf.level must be a single numeric value strictly between 0 and 1"), + list(args = list(conf.level = c(0.9, 0.95)), message = "conf.level must be a single numeric value strictly between 0 and 1"), + list(args = list(conf.level = 0), message = "conf.level must be a single numeric value strictly between 0 and 1"), + list(args = list(conf.level = 1), message = "conf.level must be a single numeric value strictly between 0 and 1"), + list(args = list(conf.level = "0.95"), message = "conf.level must be a single numeric value strictly between 0 and 1"), + list(args = list(ll2 = "llcont"), message = "ll1 and ll2 must be functions") + ) + + for (case in invalid_cases) { + err <- tryCatch( + do.call(icci, c(list(object1 = NULL, object2 = NULL), case$args)), + error = identity + ) + + expect_s3_class(err, "error") + expect_identical(conditionMessage(err), case$message) + expect_null(conditionCall(err)) + } +})