fix(input): centralize bounded interactive choices

.Rbuildignore

@@ -24,3 +24,4 @@
 ^\.jules(/.*)?$
 ^\.trivyignore\.yaml$
 ^trivy\.yaml$
+^\.semgrepignore$

.jules/sentinel.md

@@ -2,3 +2,8 @@
 **Vulnerability:** Unvalidated inputs passed to `if()` statements can cause process crashes (`condition has length > 1`) or unexpected coercion vulnerabilities.
 **Learning:** In R, optional boolean parameters that default to `NULL` should be validated using explicit runtime type validation (e.g., `if (!is.null(flag) && (!is.logical(flag) || length(flag) != 1 || is.na(flag)))`).
 **Prevention:** Always implement explicit runtime type validation for optional boolean parameters.
+
+## 2026-09-13 - 대화형 이진 선택 입력을 실제 허용 집합으로 제한
+**Finding:** 세 대화형 프롬프트가 `1`과 `2`만 의미 있게 사용하면서도 모든 숫자 문자열을 먼저 허용했습니다. 매우 큰 숫자는 `as.integer()`에서 `NA`가 되어 제어 흐름 오류를 만들 수 있고, `0`이나 `3`도 의미 없는 값으로 후속 분기에 들어갈 수 있었습니다.
+**Learning:** 선택형 입력은 숫자 여부를 넓게 확인한 뒤 변환하기보다 실제 도메인 허용값을 그대로 검증해야 합니다. 이 경로는 로컬 대화형 입력이므로 별도의 원격 신뢰 경계가 입증되지 않은 상태에서 보안 심각도를 부여하지 않습니다.
+**Prevention:** 공통 문항 확인과 old/new-form BILOG prior 프롬프트 모두 문자열 `"1"` 또는 `"2"`만 정확히 허용하고, 그 밖의 값은 제한된 재시도 뒤 통제된 오류로 종료합니다.

R/aFIPC.R

@@ -1,3 +1,21 @@
+#' Read a bounded binary menu choice
+#'
+#' @param prompt Prompt passed to the input reader.
+#' @param error_message Error raised after three invalid responses.
+#' @param read Input reader compatible with [readline()].
+#' @return Integer 1 or 2.
+#' @keywords internal
+#' @noRd
+.read_binary_choice <- function(prompt, error_message, read = readline) {
+  for (attempt in seq_len(3)) {
+    value <- read(prompt = prompt)
+    if (value %in% c("1", "2")) {
+      return(as.integer(value))
+    }
+  }
+  stop(error_message, call. = FALSE)
+}
+
 #' automated fixed item parameter linking
 #'
 #' @import mirt
@@ -139,13 +157,10 @@ autoFIPC <-
           'set confirmCommonItems = TRUE to accept the supplied pairs.'
         )
       }
-      for (attempt in seq_len(3)) {
-        n <- readline(prompt = "Is it correct? (1: Yes 2: No) : ")
-        if (grepl("^[0-9]+$", n)) {
-          return(as.integer(n))
-        }
-      }
-      stop("Too many invalid common item confirmation attempts")
+      .read_binary_choice(
+        prompt = "Is it correct? (1: Yes 2: No) : ",
+        error_message = "Too many invalid common item confirmation attempts"
+      )
     }
     confirm <- checkCorrect()
     if (confirm != 1) {
@@ -166,16 +181,10 @@ autoFIPC <-
       if (itemtype == '3PL' && length(oldformBILOGprior) == 0) {
         checkoldformBILOGprior <- function() {
           if (!interactive()) stop("Interactive session required for oldform BILOG prior")
-          for (attempt in seq_len(3)) {
-            n <-
-              readline(
-                prompt = "Do you want to use default BILOG-MG priors for oldform Data? (1: Yes 2: No) : "
-              )
-            if (grepl("^[0-9]+$", n)) {
-              return(as.integer(n))
-            }
-          }
-          stop("Too many invalid oldform BILOG prior attempts")
+          .read_binary_choice(
+            prompt = "Do you want to use default BILOG-MG priors for oldform Data? (1: Yes 2: No) : ",
+            error_message = "Too many invalid oldform BILOG prior attempts"
+          )
         }
         oldformBILOGprior <- checkoldformBILOGprior()
         if (oldformBILOGprior == 1) {
@@ -385,16 +394,10 @@ autoFIPC <-
       if (itemtype == '3PL' && length(newformBILOGprior) == 0) {
         checknewformBILOGprior <- function() {
           if (!interactive()) stop("Interactive session required for newform BILOG prior")
-          for (attempt in seq_len(3)) {
-            n <-
-              readline(
-                prompt = "Do you want to use default BILOG-MG priors for newform Data? (1: Yes 2: No) : "
-              )
-            if (grepl("^[0-9]+$", n)) {
-              return(as.integer(n))
-            }
-          }
-          stop("Too many invalid newform BILOG prior attempts")
+          .read_binary_choice(
+            prompt = "Do you want to use default BILOG-MG priors for newform Data? (1: Yes 2: No) : ",
+            error_message = "Too many invalid newform BILOG prior attempts"
+          )
         }
         newformBILOGprior <- checknewformBILOGprior()
         if (newformBILOGprior == 1) {

tests/testthat/test-sentinel-validation.R

@@ -35,3 +35,226 @@ test_that("autoFIPC validates boolean flags for newformBILOGprior, oldformBILOGp
     "Security Error: confirmCommonItems must be a single non-NA logical value or NULL"
   )
 })
+
+
+test_that("binary menu choice accepts only exact documented values", {
+  make_reader <- function(values) {
+    force(values)
+    function(prompt) {
+      value <- values[[1]]
+      values <<- values[-1]
+      value
+    }
+  }
+
+  expect_identical(
+    aFIPC:::.read_binary_choice("prompt", "invalid", make_reader("1")),
+    1L
+  )
+  expect_identical(
+    aFIPC:::.read_binary_choice("prompt", "invalid", make_reader("2")),
+    2L
+  )
+  expect_identical(
+    aFIPC:::.read_binary_choice(
+      "prompt",
+      "invalid",
+      make_reader(c("0", "3", "1"))
+    ),
+    1L
+  )
+  expect_error(
+    aFIPC:::.read_binary_choice(
+      "prompt",
+      "invalid",
+      make_reader(c("12", "2147483648", " 1"))
+    ),
+    "invalid",
+    fixed = TRUE
+  )
+
+  for (value in c("3", "10", "2147483648", "invalid", "")) {
+    expect_error(
+      aFIPC:::.read_binary_choice(
+        "prompt",
+        "invalid",
+        make_reader(rep(value, 3))
+      ),
+      "invalid",
+      fixed = TRUE,
+      info = paste("unexpectedly accepted binary menu value", dQuote(value))
+    )
+  }
+})
+
+test_that("autoFIPC routes every interactive binary menu through the bounded reader", {
+  source_text <- paste(deparse(body(aFIPC::autoFIPC)), collapse = "\n")
+  calls <- gregexpr(".read_binary_choice(", source_text, fixed = TRUE)[[1]]
+
+  expect_equal(sum(calls > 0), 3L)
+  expect_false(grepl('grepl("^[0-9]+$"', source_text, fixed = TRUE))
+  expect_match(source_text, "Too many invalid common item confirmation attempts", fixed = TRUE)
+  expect_match(source_text, "Too many invalid oldform BILOG prior attempts", fixed = TRUE)
+  expect_match(source_text, "Too many invalid newform BILOG prior attempts", fixed = TRUE)
+})
+
+find_nested_function_expression <- function(expression, function_name) {
+  if (!is.call(expression)) {
+    return(NULL)
+  }
+
+  if (
+    length(expression) >= 3L &&
+      identical(expression[[1L]], as.name("<-")) &&
+      identical(expression[[2L]], as.name(function_name)) &&
+      is.call(expression[[3L]]) &&
+      identical(expression[[3L]][[1L]], as.name("function"))
+  ) {
+    return(expression[[3L]])
+  }
+
+  for (part in as.list(expression)[-1L]) {
+    nested <- find_nested_function_expression(part, function_name)
+    if (!is.null(nested)) {
+      return(nested)
+    }
+  }
+
+  NULL
+}
+
+find_prior_assignment_block <- function(expression, function_name, target_name) {
+  if (!is.call(expression)) {
+    return(NULL)
+  }
+
+  for (part in as.list(expression)[-1L]) {
+    nested <- find_prior_assignment_block(part, function_name, target_name)
+    if (!is.null(nested)) {
+      return(nested)
+    }
+  }
+
+  if (identical(expression[[1L]], as.name("if"))) {
+    expression_text <- paste(deparse(expression), collapse = "\n")
+    assignment_text <- sprintf("%s <- %s()", target_name, function_name)
+    if (
+      grepl(function_name, expression_text, fixed = TRUE) &&
+        grepl(assignment_text, expression_text, fixed = TRUE)
+    ) {
+      return(expression)
+    }
+  }
+
+  NULL
+}
+
+wired_prompt <- function(function_name, choice, confirm_common_items = NULL) {
+  function_expression <- find_nested_function_expression(
+    body(aFIPC::autoFIPC),
+    function_name
+  )
+  if (is.null(function_expression)) {
+    stop(sprintf("Could not find nested prompt helper %s", function_name))
+  }
+
+  calls <- 0L
+  test_env <- new.env(parent = environment(aFIPC::autoFIPC))
+  test_env$confirmCommonItems <- confirm_common_items
+  test_env$interactive <- function() TRUE
+  test_env$.read_binary_choice <- function(prompt, error_message) {
+    calls <<- calls + 1L
+    choice
+  }
+
+  list(
+    run = eval(function_expression, envir = test_env),
+    calls = function() calls
+  )
+}
+
+wired_prior_assignment <- function(function_name, target_name, choice) {
+  assignment_block <- find_prior_assignment_block(
+    body(aFIPC::autoFIPC),
+    function_name,
+    target_name
+  )
+  if (is.null(assignment_block)) {
+    stop(sprintf("Could not find assignment block for %s", function_name))
+  }
+
+  calls <- 0L
+  test_env <- new.env(parent = environment(aFIPC::autoFIPC))
+  test_env$itemtype <- "3PL"
+  test_env[[target_name]] <- NULL
+  test_env$interactive <- function() TRUE
+  test_env$.read_binary_choice <- function(prompt, error_message) {
+    calls <<- calls + 1L
+    choice
+  }
+
+  eval(assignment_block, envir = test_env)
+
+  list(
+    value = test_env[[target_name]],
+    calls = calls
+  )
+}
+
+test_that("all three autoFIPC prompt helpers execute the shared bounded reader", {
+  helper_names <- c(
+    "checkCorrect",
+    "checkoldformBILOGprior",
+    "checknewformBILOGprior"
+  )
+
+  for (helper_name in helper_names) {
+    yes_runner <- wired_prompt(helper_name, 1L)
+    expect_identical(
+      yes_runner$run(),
+      1L,
+      info = sprintf("%s should return shared-reader choice 1", helper_name)
+    )
+    expect_identical(yes_runner$calls(), 1L)
+
+    no_runner <- wired_prompt(helper_name, 2L)
+    expect_identical(
+      no_runner$run(),
+      2L,
+      info = sprintf("%s should return shared-reader choice 2", helper_name)
+    )
+    expect_identical(no_runner$calls(), 1L)
+  }
+})
+
+test_that("old-form and new-form bounded choices map to logical prior flags", {
+  old_yes <- wired_prior_assignment(
+    "checkoldformBILOGprior",
+    "oldformBILOGprior",
+    1L
+  )
+  old_no <- wired_prior_assignment(
+    "checkoldformBILOGprior",
+    "oldformBILOGprior",
+    2L
+  )
+  new_yes <- wired_prior_assignment(
+    "checknewformBILOGprior",
+    "newformBILOGprior",
+    1L
+  )
+  new_no <- wired_prior_assignment(
+    "checknewformBILOGprior",
+    "newformBILOGprior",
+    2L
+  )
+
+  expect_identical(old_yes$value, TRUE)
+  expect_identical(old_no$value, FALSE)
+  expect_identical(new_yes$value, TRUE)
+  expect_identical(new_no$value, FALSE)
+  expect_identical(old_yes$calls, 1L)
+  expect_identical(old_no$calls, 1L)
+  expect_identical(new_yes$calls, 1L)
+  expect_identical(new_no$calls, 1L)
+})