🛡️ Sentinel: [HIGH] Fix 무한 루프(DoS) 취약점

.github/workflows/r.yml

@@ -30,13 +30,13 @@ jobs:
         uses: actions/checkout@de0fac2e4500dabe0009e67214ff5f5447ce83dd
 
       - name: Set up R
-        uses: r-lib/actions/setup-r@d3c5be51b12e724e68f33216ca3c148b66d5f0b6
+        uses: r-lib/actions/setup-r@6f6e5bc62fba3a704f74e7ad7ef7676c5c6a2590
         with:
           r-version: release
           use-public-rspm: true
 
       - name: Set up R package dependencies
-        uses: r-lib/actions/setup-r-dependencies@d3c5be51b12e724e68f33216ca3c148b66d5f0b6
+        uses: r-lib/actions/setup-r-dependencies@6f6e5bc62fba3a704f74e7ad7ef7676c5c6a2590
         with:
           extra-packages: any::rcmdcheck
           needs: check

.jules/sentinel.md

@@ -9,3 +9,7 @@
 5. DoS 완화를 위해 `return(1L)` 같은 기본 승인값을 넣을 때는 추정 기준척도, anchor/common item, true parameter 재현 계약을 우회하지 않는지 먼저 검증합니다.
 6. Fail-secure 에러 메시지는 테스트의 일부로 취급합니다. 보안 테스트는 실제 구현 메시지와 맞아야 하며, 오래된 `"Interactive prompt is not available"` 같은 별도 문구를 새로 만들지 않습니다.
 7. Prompt DoS 회귀 테스트는 모델 추정 실패에 기대지 말고, common-item confirmation guard처럼 취약한 입력 경계에서 바로 발생하는 fail-secure 에러를 검증합니다.
+## 2024-06-30 - [Infinite Loop DoS Risk in Model Estimation]
+**Vulnerability:** Unconstrained `while (!exists('model'))` loops used to retry model estimation upon failure could result in infinite loops and Denial of Service (DoS) if the failure is deterministic.
+**Learning:** Legacy R code often relies on continuous retries. In automated environments, these unconstrained loops will hang indefinitely.
+**Prevention:** Always replace unconstrained `while` loops intended for retries with bounded `for` loops (e.g., maximum 3 attempts) or timeout limits.

R/aFIPC.R

@@ -184,14 +184,15 @@ autoFIPC <-
 
       if (tryFitwholeOldItems == T) {
         if (
-          !oldFormModel@OptimInfo$secondordertest &&
+          (!exists('oldFormModel', envir = environment(), inherits = FALSE) ||
+           !oldFormModel@OptimInfo$secondordertest) &&
             !itemtype == 'ideal'
         ) {
           message(
             'Estimation failed. estimating new parameters with no prior distribution using quasi-Monte Carlo EM estimation. please be patient.'
           )
 
-          try(rm(oldFormModel))
+          try(rm(list = 'oldFormModel', envir = environment(), inherits = FALSE), silent = TRUE)
           try(
             oldFormModel <-
               mirt::mirt(
@@ -208,15 +209,16 @@ autoFIPC <-
         }
 
         if (
-          !oldFormModel@OptimInfo$secondordertest &&
+          (!exists('oldFormModel', envir = environment(), inherits = FALSE) ||
+           !oldFormModel@OptimInfo$secondordertest) &&
             !itemtype == 'ideal'
         ) {
           message(
             'Estimation failed. estimating new parameters with no prior distribution using  Cai\'s (2010) Metropolis-Hastings Robbins-Monro (MHRM) algorithm. please be patient.'
           )
 
-          try(rm(oldFormModel))
-          while (!exists('oldFormModel')) {
+          try(rm(list = 'oldFormModel', envir = environment(), inherits = FALSE), silent = TRUE)
+          for (attempt in seq_len(3)) {
             try(
               oldFormModel <-
                 mirt::mirt(
@@ -230,11 +232,16 @@ autoFIPC <-
                   GenRandomPars = F
                 )
             )
+            if (exists('oldFormModel', envir = environment(), inherits = FALSE)) break
+          }
+          if (!exists('oldFormModel', envir = environment(), inherits = FALSE)) {
+            stop("Estimation failed repeatedly for oldFormModel. Exiting.")
           }
         }
       }
 
       if (
+        exists('oldFormModel', envir = environment(), inherits = FALSE) &&
         !oldFormModel@OptimInfo$secondordertest &&
           !itemtype == 'ideal'
       ) {
@@ -396,14 +403,15 @@ autoFIPC <-
 
       if (tryFitwholeNewItems) {
         if (
-          !newFormModel@OptimInfo$secondordertest &&
+          (!exists('newFormModel', envir = environment(), inherits = FALSE) ||
+           !newFormModel@OptimInfo$secondordertest) &&
             !itemtype == 'ideal'
         ) {
           message(
             'Estimation failed. estimating new parameters with no prior distribution using quasi-Monte Carlo EM estimation. please be patient.'
           )
 
-          try(rm(newFormModel))
+          try(rm(list = 'newFormModel', envir = environment(), inherits = FALSE), silent = TRUE)
           try(
             newFormModel <-
               mirt::mirt(
@@ -420,15 +428,16 @@ autoFIPC <-
         }
 
         if (
-          !newFormModel@OptimInfo$secondordertest &&
+          (!exists('newFormModel', envir = environment(), inherits = FALSE) ||
+           !newFormModel@OptimInfo$secondordertest) &&
             !itemtype == 'ideal'
         ) {
           message(
             'Estimation failed. estimating new parameters with no prior distribution using  Cai\'s (2010) Metropolis-Hastings Robbins-Monro (MHRM) algorithm. please be patient.'
           )
 
-          try(rm(newFormModel))
-          while (!exists('newFormModel')) {
+          try(rm(list = 'newFormModel', envir = environment(), inherits = FALSE), silent = TRUE)
+          for (attempt in seq_len(3)) {
             try(
               newFormModel <-
                 mirt::mirt(
@@ -442,11 +451,16 @@ autoFIPC <-
                   GenRandomPars = F
                 )
             )
+            if (exists('newFormModel', envir = environment(), inherits = FALSE)) break
+          }
+          if (!exists('newFormModel', envir = environment(), inherits = FALSE)) {
+            stop("Estimation failed repeatedly for newFormModel. Exiting.")
           }
         }
       }
 
       if (
+        exists('newFormModel', envir = environment(), inherits = FALSE) &&
         !newFormModel@OptimInfo$secondordertest &&
           !itemtype == 'ideal'
       ) {

tests/testthat/test-model-retries.R

@@ -0,0 +1,31 @@
+test_that("model estimation fails cleanly after max retries", {
+  skip_if_not_installed("mirt")
+
+  set.seed(20260630)
+  old_item_names <- paste0("old_item_", 1:6)
+  new_item_names <- paste0("new_item_", 1:6)
+  old_common_items <- old_item_names[1:4]
+  new_common_items <- new_item_names[1:4]
+
+  # Forcing an error in mirt by passing non-sensical data shapes
+  old_data <- data.frame(a = c("A", "B"), b = c("C", "D"))
+  new_data <- data.frame(c = c("E", "F"), d = c("G", "H"))
+  names(old_data) <- old_item_names[1:2]
+  names(new_data) <- new_item_names[1:2]
+
+  expect_error(
+    aFIPC::autoFIPC(
+      newformXData = new_data,
+      oldformYData = old_data,
+      newformCommonItemNames = new_common_items[1:2],
+      oldformCommonItemNames = old_common_items[1:2],
+      itemtype = "2PL",
+      checkIPD = FALSE,
+      tryEM = FALSE,
+      freeMEAN = FALSE,
+      forceNormalZeroOne = TRUE,
+      confirmCommonItems = TRUE
+    ),
+    "Estimation failed repeatedly"
+  )
+})