🛡️ Sentinel: [CRITICAL] 무한 루프 DoS 취약점 수정 (추정 실패 시 무한 재시도 방지)

.jules/sentinel.md

@@ -9,3 +9,10 @@
 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 - 추정 실패 시 무한 재시도로 인한 리소스 고갈(DoS) 취약점
+**Vulnerability:** 데이터 처리 과정 중 모델 추정이 실패했을 때(예: `mirt` 패키지의 MHRM 알고리즘을 이용한 oldFormModel, newFormModel 추정), 변수가 성공적으로 생성될 때까지 `while(!exists('oldFormModel'))`과 같은 탈출 조건(exit condition)이 없는 무한 루프가 코드 내에 존재했습니다.
+**Learning:** 실패 시 무한 루프는 자동화된 환경(CI/CD, 묶음 처리 서버 등)에서 작업이 절대 끝나지 않고 CPU와 메모리 등 시스템 리소스를 계속 점유하게 만들어 서비스 거부(DoS) 상태를 유발합니다. 외부 라이브러리(패키지) 호출 실패를 무한정 재시도하는 것은 매우 위험합니다.
+**Prevention:**
+1. 어떠한 형태의 재시도 루프든 간에 반드시 최대 재시도 횟수(`max_retries`) 제한을 두어 무한 루프에 빠지지 않도록 방어적인 코드를 작성해야 합니다.
+2. 최대 재시도 횟수에 도달했을 때에는 `stop()` 함수 등을 사용해 명시적인 예외를 발생시키고 안전하게 실패하도록(fail-secure) 처리해야 합니다.

R/aFIPC.R

@@ -1,3 +1,21 @@
+.fit_mhrm_with_retries <- function(model_name, max_retries, fit) {
+  for (attempt in seq_len(max_retries)) {
+    result <- try(fit(), silent = TRUE)
+    if (!inherits(result, "try-error")) {
+      return(result)
+    }
+  }
+
+  stop(
+    "Estimation failed for ",
+    model_name,
+    " after ",
+    max_retries,
+    " MHRM retries. Please check test quality.",
+    call. = FALSE
+  )
+}
+
 #' automated fixed item parameter linking
 #'
 #' @import mirt
@@ -184,8 +202,9 @@ autoFIPC <-
 
       if (tryFitwholeOldItems == T) {
         if (
+          exists("oldFormModel") &&
           !oldFormModel@OptimInfo$secondordertest &&
-            !itemtype == 'ideal'
+            itemtype != 'ideal'
         ) {
           message(
             'Estimation failed. estimating new parameters with no prior distribution using quasi-Monte Carlo EM estimation. please be patient.'
@@ -208,17 +227,20 @@ autoFIPC <-
         }
 
         if (
+          exists("oldFormModel") &&
           !oldFormModel@OptimInfo$secondordertest &&
-            !itemtype == 'ideal'
+            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(
-              oldFormModel <-
+          max_retries <- 3L
+          oldFormModel <-
+            .fit_mhrm_with_retries(
+              "oldFormModel",
+              max_retries,
+              function() {
                 mirt::mirt(
                   data = oldformYDataK,
                   1,
@@ -229,14 +251,15 @@ autoFIPC <-
                   technical = list(NCYCLES = 1e+5, MHRM_SE_draws = 200000),
                   GenRandomPars = F
                 )
+              }
             )
-          }
         }
       }
 
       if (
+        exists("oldFormModel") &&
         !oldFormModel@OptimInfo$secondordertest &&
-          !itemtype == 'ideal'
+          itemtype != 'ideal'
       ) {
         message(
           'Estimation failed. trying to remove weird items by itemfit statistics'
@@ -253,8 +276,9 @@ autoFIPC <-
       }
 
       if (
+        exists("oldFormModel") &&
         !oldFormModel@OptimInfo$secondordertest &&
-          !itemtype == 'ideal'
+          itemtype != 'ideal'
       ) {
         message(
           'Estimation failed. trying to remove weird items by itemfit statistics by normal MMLE/EM'
@@ -272,8 +296,9 @@ autoFIPC <-
       }
 
       if (
+        exists("oldFormModel") &&
         !oldFormModel@OptimInfo$secondordertest &&
-          !itemtype == 'ideal'
+          itemtype != 'ideal'
       ) {
         message(
           'Estimation failed. trying to remove weird items by itemfit statistics by MMLE/QMCEM'
@@ -291,8 +316,9 @@ autoFIPC <-
       }
 
       if (
+        exists("oldFormModel") &&
         !oldFormModel@OptimInfo$secondordertest &&
-          !itemtype == 'ideal'
+          itemtype != 'ideal'
       ) {
         message(
           'Estimation failed. trying to remove weird items by itemfit statistics by MMLE/MHRM'
@@ -310,8 +336,8 @@ autoFIPC <-
       }
 
       if (
-        !oldFormModel@OptimInfo$secondordertest &&
-          !itemtype == 'ideal'
+        (!exists("oldFormModel") || !oldFormModel@OptimInfo$secondordertest) &&
+          itemtype != 'ideal'
       ) {
         stop('Estimation failed. Please check test quality.')
       }
@@ -396,8 +422,9 @@ autoFIPC <-
 
       if (tryFitwholeNewItems) {
         if (
+          exists("newFormModel") &&
           !newFormModel@OptimInfo$secondordertest &&
-            !itemtype == 'ideal'
+            itemtype != 'ideal'
         ) {
           message(
             'Estimation failed. estimating new parameters with no prior distribution using quasi-Monte Carlo EM estimation. please be patient.'
@@ -420,17 +447,20 @@ autoFIPC <-
         }
 
         if (
+          exists("newFormModel") &&
           !newFormModel@OptimInfo$secondordertest &&
-            !itemtype == 'ideal'
+            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(
-              newFormModel <-
+          max_retries <- 3L
+          newFormModel <-
+            .fit_mhrm_with_retries(
+              "newFormModel",
+              max_retries,
+              function() {
                 mirt::mirt(
                   data = newformXDataK,
                   1,
@@ -441,14 +471,15 @@ autoFIPC <-
                   technical = list(NCYCLES = 1e+5, MHRM_SE_draws = 200000),
                   GenRandomPars = F
                 )
+              }
             )
-          }
         }
       }
 
       if (
+        exists("newFormModel") &&
         !newFormModel@OptimInfo$secondordertest &&
-          !itemtype == 'ideal'
+          itemtype != 'ideal'
       ) {
         message(
           'Estimation failed. trying to remove weird items by itemfit statistics'
@@ -465,8 +496,9 @@ autoFIPC <-
       }
 
       if (
+        exists("newFormModel") &&
         !newFormModel@OptimInfo$secondordertest &&
-          !itemtype == 'ideal'
+          itemtype != 'ideal'
       ) {
         message(
           'Estimation failed. trying to remove weird items by itemfit statistics again by normal MMLE/EM'
@@ -484,8 +516,9 @@ autoFIPC <-
       }
 
       if (
+        exists("newFormModel") &&
         !newFormModel@OptimInfo$secondordertest &&
-          !itemtype == 'ideal'
+          itemtype != 'ideal'
       ) {
         message(
           'Estimation failed. trying to remove weird items by itemfit statistics again by MMLE/QMCEM'
@@ -503,8 +536,9 @@ autoFIPC <-
       }
 
       if (
+        exists("newFormModel") &&
         !newFormModel@OptimInfo$secondordertest &&
-          !itemtype == 'ideal'
+          itemtype != 'ideal'
       ) {
         message(
           'Estimation failed. trying to remove weird items by itemfit statistics again by MMLE/MHRM'
@@ -522,8 +556,8 @@ autoFIPC <-
       }
 
       if (
-        !newFormModel@OptimInfo$secondordertest &&
-          !itemtype == 'ideal'
+        (!exists("newFormModel") || !newFormModel@OptimInfo$secondordertest) &&
+          itemtype != 'ideal'
       ) {
         stop('Estimation failed. Please check test quality.')
       }

tests/testthat/test-MHRM-failure-dos.R

@@ -0,0 +1,47 @@
+test_that("autoFIPC fails safely when oldFormModel estimation input is invalid", {
+  skip_if_not_installed("mirt")
+
+  old_data <- data.frame(item1 = rep(0, 100))
+  new_data <- data.frame(item1 = rep(0, 100))
+
+  expect_error(
+    aFIPC::autoFIPC(
+      oldformYData = old_data,
+      newformXData = new_data,
+      itemtype = '2PL',
+      oldformCommonItemNames = "item1",
+      newformCommonItemNames = "item1",
+      confirmCommonItems = TRUE
+    ),
+    "Estimation failed. Please check test quality."
+  )
+})
+
+test_that("MHRM retry helper fails after the retry limit", {
+  attempts <- 0L
+
+  expect_error(
+    aFIPC:::.fit_mhrm_with_retries("oldFormModel", 3L, function() {
+      attempts <<- attempts + 1L
+      stop("forced failure")
+    }),
+    "Estimation failed for oldFormModel after 3 MHRM retries"
+  )
+
+  expect_equal(attempts, 3L)
+})
+
+test_that("MHRM retry helper returns a successful retry result", {
+  attempts <- 0L
+
+  result <- aFIPC:::.fit_mhrm_with_retries("newFormModel", 3L, function() {
+    attempts <<- attempts + 1L
+    if (attempts < 2L) {
+      stop("forced failure")
+    }
+    "ok"
+  })
+
+  expect_equal(result, "ok")
+  expect_equal(attempts, 2L)
+})