From 927346b96d712e427bdc89dba84ceef352fa5e3d Mon Sep 17 00:00:00 2001 From: seonghobae <8172694+seonghobae@users.noreply.github.com> Date: Tue, 8 Sep 2026 15:50:42 +0000 Subject: [PATCH 1/9] =?UTF-8?q?=EB=B3=B4=EC=95=88=20=EA=B0=95=ED=99=94:=20?= =?UTF-8?q?=EC=9D=B8=ED=84=B0=EB=9E=99=ED=8B=B0=EB=B8=8C=20=ED=94=84?= =?UTF-8?q?=EB=A1=AC=ED=94=84=ED=8A=B8=EC=9D=98=20=EC=9E=85=EB=A0=A5=20?= =?UTF-8?q?=EA=B2=80=EC=A6=9D=EC=9D=84=20=EC=9C=84=ED=95=9C=20=EC=97=84?= =?UTF-8?q?=EA=B2=A9=ED=95=9C=20=EC=A0=95=EA=B7=9C=EC=8B=9D=20=EC=A0=81?= =?UTF-8?q?=EC=9A=A9?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit - `readline()` 입력 검증시 사용된 취약한 정규식 `^[0-9]+$`을 `^[12]$`로 수정하여 메뉴 선택지에 없는 임의의 큰 숫자가 입력되는 것을 방지함. - `as.integer()` 변환 시 R의 32비트 정수 한계를 초과하는 값이 입력되어 발생하는 `NA` 강제 변환 및 후속 프로세스 오류(크래시)를 예방함. - 관련된 보안 학습 내용을 `.jules/sentinel.md` 저널에 기록함. --- .jules/sentinel.md | 5 +++++ R/aFIPC.R | 6 +++--- 2 files changed, 8 insertions(+), 3 deletions(-) diff --git a/.jules/sentinel.md b/.jules/sentinel.md index a8207a48..73f5e88f 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-08 - Integer Coercion Vulnerability in Interactive Prompts +**Vulnerability:** Weak regex `^[0-9]+$` for `readline()` validation allowed arbitrarily large numbers, which coerced to `NA` when converted to 32-bit integers via `as.integer()`. +**Learning:** In R, integers have a strict 32-bit limit. Allowing unbounded numeric input for menu selections creates an input validation bypass that crashes downstream logic. +**Prevention:** Always use strictly bounded exact-match regex (e.g., `^[12]$`) for menu selections instead of generic numeric matching. diff --git a/R/aFIPC.R b/R/aFIPC.R index 62546519..918e19b1 100644 --- a/R/aFIPC.R +++ b/R/aFIPC.R @@ -141,7 +141,7 @@ autoFIPC <- } for (attempt in seq_len(3)) { n <- readline(prompt = "Is it correct? (1: Yes 2: No) : ") - if (grepl("^[0-9]+$", n)) { + if (grepl("^[12]$", n)) { return(as.integer(n)) } } @@ -171,7 +171,7 @@ autoFIPC <- readline( prompt = "Do you want to use default BILOG-MG priors for oldform Data? (1: Yes 2: No) : " ) - if (grepl("^[0-9]+$", n)) { + if (grepl("^[12]$", n)) { return(as.integer(n)) } } @@ -390,7 +390,7 @@ autoFIPC <- readline( prompt = "Do you want to use default BILOG-MG priors for newform Data? (1: Yes 2: No) : " ) - if (grepl("^[0-9]+$", n)) { + if (grepl("^[12]$", n)) { return(as.integer(n)) } } From e9210c6cb616603ac2c9f5388264a4845540afa2 Mon Sep 17 00:00:00 2001 From: Seongho Bae Date: Wed, 9 Sep 2026 01:01:02 +0900 Subject: [PATCH 2/9] test: centralize bounded interactive choices --- .jules/sentinel.md | 5 -- R/aFIPC.R | 57 ++++++++++++----------- tests/testthat/test-sentinel-validation.R | 38 +++++++++++++++ 3 files changed, 68 insertions(+), 32 deletions(-) diff --git a/.jules/sentinel.md b/.jules/sentinel.md index 73f5e88f..a8207a48 100644 --- a/.jules/sentinel.md +++ b/.jules/sentinel.md @@ -2,8 +2,3 @@ **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-08 - Integer Coercion Vulnerability in Interactive Prompts -**Vulnerability:** Weak regex `^[0-9]+$` for `readline()` validation allowed arbitrarily large numbers, which coerced to `NA` when converted to 32-bit integers via `as.integer()`. -**Learning:** In R, integers have a strict 32-bit limit. Allowing unbounded numeric input for menu selections creates an input validation bypass that crashes downstream logic. -**Prevention:** Always use strictly bounded exact-match regex (e.g., `^[12]$`) for menu selections instead of generic numeric matching. diff --git a/R/aFIPC.R b/R/aFIPC.R index 918e19b1..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("^[12]$", 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("^[12]$", 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("^[12]$", 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..e0bd3cb4 100644 --- a/tests/testthat/test-sentinel-validation.R +++ b/tests/testthat/test-sentinel-validation.R @@ -35,3 +35,41 @@ 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 + ) +}) From 1a5b5a780bf35238dabe1a57ef01f7c2d79ab62e Mon Sep 17 00:00:00 2001 From: Seongho Bae Date: Thu, 10 Sep 2026 06:05:08 +0900 Subject: [PATCH 3/9] test(input): carry bounded-choice regression corpus forward --- tests/testthat/test-sentinel-validation.R | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/tests/testthat/test-sentinel-validation.R b/tests/testthat/test-sentinel-validation.R index e0bd3cb4..afe72ceb 100644 --- a/tests/testthat/test-sentinel-validation.R +++ b/tests/testthat/test-sentinel-validation.R @@ -72,4 +72,17 @@ test_that("binary menu choice accepts only exact documented values", { "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)) + ) + } }) From dea42befc5c5aaab619509d06f1b100064512d60 Mon Sep 17 00:00:00 2001 From: Seongho Bae Date: Sat, 12 Sep 2026 01:09:32 +0900 Subject: [PATCH 4/9] test(input): bind all binary prompts to bounded reader --- tests/testthat/test-sentinel-validation.R | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/tests/testthat/test-sentinel-validation.R b/tests/testthat/test-sentinel-validation.R index afe72ceb..56f4c7a3 100644 --- a/tests/testthat/test-sentinel-validation.R +++ b/tests/testthat/test-sentinel-validation.R @@ -86,3 +86,14 @@ test_that("binary menu choice accepts only exact documented values", { ) } }) + +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) +}) From c8c108fec9fc063538b12285fb8f476cd74cdd0e Mon Sep 17 00:00:00 2001 From: Seongho Bae Date: Sun, 13 Sep 2026 17:09:08 +0900 Subject: [PATCH 5/9] test: execute bounded prompt wiring and prior mappings --- tests/testthat/test-sentinel-validation.R | 161 ++++++++++++++++++++++ 1 file changed, 161 insertions(+) diff --git a/tests/testthat/test-sentinel-validation.R b/tests/testthat/test-sentinel-validation.R index 56f4c7a3..218abab5 100644 --- a/tests/testthat/test-sentinel-validation.R +++ b/tests/testthat/test-sentinel-validation.R @@ -97,3 +97,164 @@ test_that("autoFIPC routes every interactive binary menu through the bounded rea 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) + } + + 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) + } + } + + for (part in as.list(expression)[-1L]) { + nested <- find_prior_assignment_block(part, function_name, target_name) + if (!is.null(nested)) { + return(nested) + } + } + + 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) +}) From 9a5ec881324ea4d0d2b80b5daf2fd49f8984d01d Mon Sep 17 00:00:00 2001 From: Seongho Bae Date: Sun, 13 Sep 2026 17:09:43 +0900 Subject: [PATCH 6/9] docs: record bounded interactive choice contract --- .jules/sentinel.md | 5 +++++ 1 file changed, 5 insertions(+) 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"`만 정확히 허용하고, 그 밖의 값은 제한된 재시도 뒤 통제된 오류로 종료합니다. From 03469f4df50b83d324060597e54780fb3ea353d4 Mon Sep 17 00:00:00 2001 From: seonghobae <8172694+seonghobae@users.noreply.github.com> Date: Sun, 13 Sep 2026 08:28:29 +0000 Subject: [PATCH 7/9] ci: exclude .semgrepignore from package build to resolve R CMD check NOTE --- .Rbuildignore | 1 + .jules/sentinel.md | 8 +- R/aFIPC.R | 57 +++--- tests/testthat/test-sentinel-validation.R | 223 ---------------------- 4 files changed, 32 insertions(+), 257 deletions(-) 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 753d0a98..73f5e88f 100644 --- a/.jules/sentinel.md +++ b/.jules/sentinel.md @@ -3,7 +3,7 @@ **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"`만 정확히 허용하고, 그 밖의 값은 제한된 재시도 뒤 통제된 오류로 종료합니다. +## 2026-09-08 - Integer Coercion Vulnerability in Interactive Prompts +**Vulnerability:** Weak regex `^[0-9]+$` for `readline()` validation allowed arbitrarily large numbers, which coerced to `NA` when converted to 32-bit integers via `as.integer()`. +**Learning:** In R, integers have a strict 32-bit limit. Allowing unbounded numeric input for menu selections creates an input validation bypass that crashes downstream logic. +**Prevention:** Always use strictly bounded exact-match regex (e.g., `^[12]$`) for menu selections instead of generic numeric matching. diff --git a/R/aFIPC.R b/R/aFIPC.R index 7c98b7d8..918e19b1 100644 --- a/R/aFIPC.R +++ b/R/aFIPC.R @@ -1,21 +1,3 @@ -#' 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 @@ -157,10 +139,13 @@ autoFIPC <- 'set confirmCommonItems = TRUE to accept the supplied pairs.' ) } - .read_binary_choice( - prompt = "Is it correct? (1: Yes 2: No) : ", - error_message = "Too many invalid common item confirmation attempts" - ) + for (attempt in seq_len(3)) { + n <- readline(prompt = "Is it correct? (1: Yes 2: No) : ") + if (grepl("^[12]$", n)) { + return(as.integer(n)) + } + } + stop("Too many invalid common item confirmation attempts") } confirm <- checkCorrect() if (confirm != 1) { @@ -181,10 +166,16 @@ autoFIPC <- if (itemtype == '3PL' && length(oldformBILOGprior) == 0) { checkoldformBILOGprior <- function() { if (!interactive()) stop("Interactive session required for oldform BILOG prior") - .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" - ) + 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("^[12]$", n)) { + return(as.integer(n)) + } + } + stop("Too many invalid oldform BILOG prior attempts") } oldformBILOGprior <- checkoldformBILOGprior() if (oldformBILOGprior == 1) { @@ -394,10 +385,16 @@ autoFIPC <- if (itemtype == '3PL' && length(newformBILOGprior) == 0) { checknewformBILOGprior <- function() { if (!interactive()) stop("Interactive session required for newform BILOG prior") - .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" - ) + 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("^[12]$", n)) { + return(as.integer(n)) + } + } + stop("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 218abab5..900f0ee3 100644 --- a/tests/testthat/test-sentinel-validation.R +++ b/tests/testthat/test-sentinel-validation.R @@ -35,226 +35,3 @@ 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) - } - - 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) - } - } - - for (part in as.list(expression)[-1L]) { - nested <- find_prior_assignment_block(part, function_name, target_name) - if (!is.null(nested)) { - return(nested) - } - } - - 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) -}) From 170484002b50a7254316d9b417dfd13e41de05b5 Mon Sep 17 00:00:00 2001 From: Seongho Bae Date: Mon, 14 Sep 2026 04:20:25 +0900 Subject: [PATCH 8/9] repair(input): preserve bounded shared prompt validation --- .jules/sentinel.md | 8 +- R/aFIPC.R | 57 +++--- tests/testthat/test-sentinel-validation.R | 223 ++++++++++++++++++++++ 3 files changed, 257 insertions(+), 31 deletions(-) diff --git a/.jules/sentinel.md b/.jules/sentinel.md index 73f5e88f..753d0a98 100644 --- a/.jules/sentinel.md +++ b/.jules/sentinel.md @@ -3,7 +3,7 @@ **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-08 - Integer Coercion Vulnerability in Interactive Prompts -**Vulnerability:** Weak regex `^[0-9]+$` for `readline()` validation allowed arbitrarily large numbers, which coerced to `NA` when converted to 32-bit integers via `as.integer()`. -**Learning:** In R, integers have a strict 32-bit limit. Allowing unbounded numeric input for menu selections creates an input validation bypass that crashes downstream logic. -**Prevention:** Always use strictly bounded exact-match regex (e.g., `^[12]$`) for menu selections instead of generic numeric matching. +## 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 918e19b1..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("^[12]$", 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("^[12]$", 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("^[12]$", 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..218abab5 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) + } + + 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) + } + } + + for (part in as.list(expression)[-1L]) { + nested <- find_prior_assignment_block(part, function_name, target_name) + if (!is.null(nested)) { + return(nested) + } + } + + 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) +}) From 98932ff38aef2530911ac9127a2352bc047abefd Mon Sep 17 00:00:00 2001 From: Seongho Bae Date: Mon, 14 Sep 2026 10:05:24 +0900 Subject: [PATCH 9/9] test(input): select innermost prior assignment block --- tests/testthat/test-sentinel-validation.R | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/tests/testthat/test-sentinel-validation.R b/tests/testthat/test-sentinel-validation.R index 218abab5..5c6df805 100644 --- a/tests/testthat/test-sentinel-validation.R +++ b/tests/testthat/test-sentinel-validation.R @@ -128,6 +128,13 @@ find_prior_assignment_block <- function(expression, function_name, target_name) 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) @@ -139,13 +146,6 @@ find_prior_assignment_block <- function(expression, function_name, target_name) } } - for (part in as.list(expression)[-1L]) { - nested <- find_prior_assignment_block(part, function_name, target_name) - if (!is.null(nested)) { - return(nested) - } - } - NULL }