diff --git a/.Rbuildignore b/.Rbuildignore index 8989c62f..c02a908c 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -24,3 +24,4 @@ ^\.jules(/.*)?$ ^\.trivyignore\.yaml$ ^trivy\.yaml$ +^\.semgrepignore$ diff --git a/.jules/sentinel.md b/.jules/sentinel.md index a8207a48..753d0a98 100644 --- a/.jules/sentinel.md +++ b/.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"`만 정확히 허용하고, 그 밖의 값은 제한된 재시도 뒤 통제된 오류로 종료합니다. diff --git a/R/aFIPC.R b/R/aFIPC.R index 62546519..7c98b7d8 100644 --- a/R/aFIPC.R +++ b/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) { diff --git a/tests/testthat/test-sentinel-validation.R b/tests/testthat/test-sentinel-validation.R index 900f0ee3..5c6df805 100644 --- a/tests/testthat/test-sentinel-validation.R +++ b/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) +})