🛡️ Sentinel: [CRITICAL] 다중 음수 grep() 서브셋팅으로 인한 벡터 파괴 취약점 해결

.jules/sentinel.md

@@ -18,6 +18,13 @@
 2. Include an explicit check for the success condition inside the loop (`if (exists('model')) break`).
 3. After the loop, verify success and fail securely with an explicit error (`if (!exists('model')) stop(...)`) to prevent unhandled exceptions downstream.
 
+## 2024-06-26 - Vector Wipeout due to Multiple Negative grep() Outputs
+**Vulnerability:** In `R/aFIPC.R`, multiple negative `grep()` outputs were combined using `-c(grep(...), ...)` to filter a vector of parameter names. If none of the `grep()` patterns match any elements in the vector, `grep()` returns an empty integer vector `integer(0)`. Combining multiple `integer(0)` results in `integer(0)`. Subsetting a vector with `-integer(0)` (e.g., `vector[-integer(0)]`) returns an empty vector (`character(0)` or similar, depending on type), silently wiping out the entire vector contents and causing downstream logic failures.
+**Learning:** Using `grep()` with negative indices (`-c(...)`) is inherently unsafe in base R when the possibility exists that no matches will be found. This pattern leads to silent and unpredictable state corruption because it effectively removes all elements instead of preserving them.
+**Prevention:**
+1. Never use `-c(grep(...), ...)` to exclude elements from a vector.
+2. Always use the negation of `grepl()` (e.g., `!grepl("^(pattern1|pattern2)", vector)`) which safely returns a logical vector. If there are no matches, it returns a vector of `TRUE`s, safely preserving the original vector when subsetted.
+
 ## 2024-07-05 - Missing Input Validation
 **Vulnerability:** The `autoFIPC` function lacked explicit input validation for core arguments like `newformXData`, `oldformYData`, `newformCommonItemNames`, and `itemtype`. When unexpected types (e.g. integer `1` instead of a data structure, or an array for `itemtype`) were provided, the errors propagated dynamically causing unhandled downstream exceptions or potential state leaks depending on internal implementations (like `mirt` and `try` blocks capturing objects unexpectedly). Furthermore, if the base model estimation `try(mirt(...))` entirely failed to produce a model object, the code would later crash when trying to access `@OptimInfo`, leading to untracked exceptions.
 **Learning:** In dynamically typed environments like R, trusting user inputs without explicit runtime validation boundaries allows malformed types to flow deeply into internal logic. This can result in obscure failure modes, leakage of unhandled stack exceptions, or unpredictable behavior across statistical dependencies.

R/aFIPC.R

@@ -213,7 +213,7 @@ autoFIPC <-
         )
       }
 
-      if (!exists("oldFormModel")) {
+      if (!exists("oldFormModel", inherits = FALSE)) {
         stop("Security Error: Initial estimation of oldFormModel completely failed")
       }
 
@@ -265,9 +265,9 @@ autoFIPC <-
                   GenRandomPars = F
                 )
             )
-            if (exists('oldFormModel')) break
+            if (exists('oldFormModel', inherits = FALSE)) break
           }
-          if (!exists('oldFormModel')) stop('Failed to estimate oldFormModel with MHRM after 3 attempts')
+          if (!exists('oldFormModel', inherits = FALSE)) stop('Failed to estimate oldFormModel with MHRM after 3 attempts')
         }
       }
 
@@ -431,7 +431,7 @@ autoFIPC <-
         )
       }
 
-      if (!exists("newFormModel")) {
+      if (!exists("newFormModel", inherits = FALSE)) {
         stop("Security Error: Initial estimation of newFormModel completely failed")
       }
 
@@ -483,9 +483,9 @@ autoFIPC <-
                   GenRandomPars = F
                 )
             )
-            if (exists('newFormModel')) break
+            if (exists('newFormModel', inherits = FALSE)) break
           }
-          if (!exists('newFormModel')) stop('Failed to estimate newFormModel with MHRM after 3 attempts')
+          if (!exists('newFormModel', inherits = FALSE)) stop('Failed to estimate newFormModel with MHRM after 3 attempts')
         }
       }
 
@@ -576,10 +576,8 @@ autoFIPC <-
     NewScaleParms <- mirt::mod2values(newFormModel)
     OldScaleParms <- mirt::mod2values(oldFormModel)
 
-    if (!parameterOverwrite) {
-      NewScaleParms[, "est"] <- TRUE
-      OldScaleParms[, "est"] <- TRUE
-    }
+    # Preserve mirt's structural estimability flags. Forcing every row TRUE
+    # frees boundary parameters such as 2PL g/u and makes the Hessian unstable.
 
     NewScaleParms[which(NewScaleParms$item == paste0('GROUP')), "est"] <-
       FALSE
@@ -642,15 +640,7 @@ autoFIPC <-
       # IPD estimation
       IPDParmNames <- OldScaleParms$name
       IPDParmNames <- IPDParmNames[!duplicated(IPDParmNames)]
-      IPDParmNames <-
-        IPDParmNames[
-          -c(
-            grep("^MEAN", IPDParmNames),
-            grep("^COV", IPDParmNames),
-            grep("^ak", IPDParmNames),
-            grep("^d0$", IPDParmNames)
-          )
-        ]
+      IPDParmNames <- IPDParmNames[!grepl("^(MEAN|COV|ak|d0$)", IPDParmNames)]
       IPDParmNames <- as.character(IPDParmNames)
 
       mirt::mirtCluster()
@@ -724,7 +714,7 @@ autoFIPC <-
       }
       mirt::mirtCluster(remove = T)
 
-      if (exists('modIPD_DIF')) {
+      if (exists('modIPD_DIF', inherits = FALSE)) {
         modIPD_IPDItem <- names(modIPD_DIF)
         CommonItemList_NOIPD <-
           colnames(IPDData)[!colnames(IPDData) %in% modIPD_IPDItem]
@@ -1061,7 +1051,7 @@ autoFIPC <-
     modelReturn$ThetaLinkedform <- ThetaLinkedform
     if (checkIPD) {
       modelReturn$IPDData <- data.frame(IPDData, IPDgroup)
-      if (exists('CommonItemList_NOIPD')) {
+      if (exists('CommonItemList_NOIPD', inherits = FALSE)) {
         modelReturn$IPDCommonItemList <- IPDItemList[CommonItemList_NOIPD]
       }
     }

docs/fixed-parameter-item-calibration.md

@@ -19,6 +19,8 @@ contract with generated 2PL data:
    and are not estimated in the linked model.
 5. Assert that the old-form estimates recover the generating common-item
    parameters closely enough for a small deterministic regression test.
+6. Fit with `SE = TRUE` and assert finite Hessian-derived covariance matrices
+   plus passing `secondordertest` results for the old, new, and linked models.
 
 ## References
 

tests/testthat/test-autoFIPC.R

@@ -55,4 +55,15 @@ test_that("autoFIPC validates input types securely", {
     ),
     "Security Error: itemtype must be length 1 or length 1 \\(number of items\\)."
   )
+
+  expect_error(
+    aFIPC::autoFIPC(
+      newformXData = data.frame(A=1),
+      oldformYData = structure(list(), class = "SingleGroupClass"),
+      newformCommonItemNames = c('A'),
+      oldformCommonItemNames = c('A'),
+      confirmCommonItems = TRUE
+    ),
+    "Security Error: oldformYData must be a data.frame, matrix, or a valid fitted mirt model"
+  )
 })

tests/testthat/test-fixed-parameter-calibration.R

@@ -31,7 +31,7 @@ test_that("autoFIPC fixes common-item parameters on the old-form scale", {
     1,
     itemtype = "2PL",
     method = "EM",
-    SE = FALSE,
+    SE = TRUE,
     verbose = FALSE,
     technical = list(NCYCLES = 500)
   )
@@ -40,11 +40,20 @@ test_that("autoFIPC fixes common-item parameters on the old-form scale", {
     1,
     itemtype = "2PL",
     method = "EM",
-    SE = FALSE,
+    SE = TRUE,
     verbose = FALSE,
     technical = list(NCYCLES = 500)
   )
 
+  old_vcov <- as.matrix(old_model@vcov)
+  new_vcov <- as.matrix(new_model@vcov)
+  expect_gt(nrow(old_vcov), 0)
+  expect_gt(nrow(new_vcov), 0)
+  expect_true(all(is.finite(diag(old_vcov))))
+  expect_true(all(is.finite(diag(new_vcov))))
+  expect_true(isTRUE(old_model@OptimInfo$secondordertest))
+  expect_true(isTRUE(new_model@OptimInfo$secondordertest))
+
   linked <- aFIPC::autoFIPC(
     newformXData = new_model,
     oldformYData = old_model,
@@ -58,8 +67,19 @@ test_that("autoFIPC fixes common-item parameters on the old-form scale", {
     confirmCommonItems = TRUE
   )
 
+  linked_vcov <- as.matrix(linked$LinkedModel@vcov)
+  expect_gt(nrow(linked_vcov), 0)
+  expect_true(all(is.finite(diag(linked_vcov))))
+  expect_true(isTRUE(linked$LinkedModel@OptimInfo$secondordertest))
+
   old_values <- mirt::mod2values(old_model)
   linked_values <- mirt::mod2values(linked$LinkedModel)
+  linked_structural <- linked_values[
+    linked_values$item %in% new_item_names[5:6] &
+      linked_values$name %in% c("g", "u"),
+    "est"
+  ]
+  expect_false(any(linked_structural))
 
   for (i in seq_along(old_common_items)) {
     old_item <- old_common_items[i]