Fail closed on match-limit exhaustion (P1 #28)
ober
1a36b4ce6ac3cc9bae0fa9be084bec418e867a09
--- a/src/jerboa-pcre2/ffi.ss +++ b/src/jerboa-pcre2/ffi.ss @@ -17,6 +17,7 @@ PCRE2_ERROR_NOMATCH PCRE2_ERROR_PARTIAL PCRE2_ERROR_NOMEMORY PCRE2_ERROR_NOSUBSTRING + PCRE2_ERROR_MATCHLIMIT PCRE2_ERROR_DEPTHLIMIT ;; Core functions ffi-pcre2-compile @@ -102,6 +103,8 @@ (def PCRE2_ERROR_PARTIAL -2) (def PCRE2_ERROR_NOMEMORY -48) (def PCRE2_ERROR_NOSUBSTRING -49) + (def PCRE2_ERROR_MATCHLIMIT -47) + (def PCRE2_ERROR_DEPTHLIMIT -53) ;; ---- Native loading ---- --- a/src/jerboa-pcre2/pcre2.ss +++ b/src/jerboa-pcre2/pcre2.ss @@ -23,6 +23,9 @@ ;; Matching pcre2-match pcre2-search pcre2-matches? + ;; Limit-exhaustion signal (fail-closed; distinguishable from no-match) + pcre2-limit-condition? pcre2-limit-error-code + ;; Match result access pcre-match-group pcre-match-named pcre-match-positions @@ -46,7 +49,9 @@ ;; Re-export constants for convenience PCRE2_CASELESS PCRE2_MULTILINE PCRE2_DOTALL PCRE2_EXTENDED PCRE2_UTF PCRE2_UCP PCRE2_ANCHORED PCRE2_ENDANCHORED - PCRE2_UNGREEDY PCRE2_LITERAL) + PCRE2_UNGREEDY PCRE2_LITERAL + PCRE2_ERROR_NOMATCH PCRE2_ERROR_MATCHLIMIT + PCRE2_ERROR_DEPTHLIMIT PCRE2_ERROR_NOMEMORY) (import (jerboa prelude) (jerboa-pcre2 ffi) @@ -167,6 +172,27 @@ (error 'pcre2-set-match-limits! "invalid PCRE2 match limits" rc)) (void))) + ;; Limit exhaustion is fail-closed. PCRE2_ERROR_MATCHLIMIT/DEPTHLIMIT/NOMEMORY + ;; raise this catchable condition so a defender that blocks input on the match + ;; result cannot be bypassed by exhausting the limit (which previously collapsed + ;; to #f, indistinguishable from a genuine no-match). PCRE2_ERROR_NOMATCH still + ;; returns #f. + (define-condition-type &pcre2-limit &error + make-pcre2-limit-condition + pcre2-limit-condition? + (limit-code pcre2-limit-error-code)) + + (def (pcre2-limit-rc? rc) + (or (= rc PCRE2_ERROR_MATCHLIMIT) + (= rc PCRE2_ERROR_DEPTHLIMIT) + (= rc PCRE2_ERROR_NOMEMORY))) + + (def (raise-match-limit-error who rc) + (raise (condition + (make-pcre2-limit-condition rc) + (make-who-condition who) + (make-message-condition (ffi-pcre2-get-error-message rc))))) + ;; ----------------------------------------------------------------------- ;; UTF-8 byte/char offset conversion ;; ----------------------------------------------------------------------- @@ -350,13 +376,19 @@ (dynamic-wind (lambda () (void)) (lambda () - (let ([rc (if (pcre-regex-jit? rx) - (ffi-pcre2-jit-match code bv (bytevector-length bv) - byte-start options md) - (ffi-pcre2-match code bv (bytevector-length bv) - byte-start options md))]) - (if (< rc 0) - #f + (let ([rc (if (pcre-regex-jit? rx) + (ffi-pcre2-jit-match code bv (bytevector-length bv) + byte-start options md) + (ffi-pcre2-match code bv (bytevector-length bv) + byte-start options md))]) + (cond + [(= rc PCRE2_ERROR_NOMATCH) #f] + [(pcre2-limit-rc? rc) + (raise-match-limit-error 'pcre2-do-match rc)] + [(< rc 0) + (error 'pcre2-do-match + (ffi-pcre2-get-error-message rc) rc)] + [else (let* ([ncap (+ (pcre-regex-capture-count rx) 1)] [sv (make-vector ncap #f)]) (let loop ([i 0]) @@ -369,7 +401,7 @@ (byte-offset->char-index bv bend))))) (loop (+ i 1)))) (make-pcre-match sv subject - (pcre-regex-name-table rx)))))) + (pcre-regex-name-table rx)))]))) (lambda () (ffi-pcre2-match-data-free md)))))))])) ;; ----------------------------------------------------------------------- --- a/support/hostile-regex-corpus.ss +++ b/support/hostile-regex-corpus.ss @@ -41,15 +41,41 @@ (record-pass name) (record-fail name "expected-match")))))) -(define (expect-no-match-under-limit name pattern subject match-limit depth-limit) +;; Fail-closed signal for catastrophic patterns (P1 #28): under a low limit a +;; backtracking-heavy pattern must raise the pcre2-limit condition rather than +;; return a match or be silently collapsed to a no-match (#f). The raised +;; condition is what lets a defender distinguish limit exhaustion from no-match. +(define (expect-limit-exhaustion name pattern subject match-limit depth-limit) (guard-case name (lambda () (pcre2-set-match-limits! match-limit depth-limit) - (let ([result (pcre2-search pattern subject)]) + (let ([outcome + (guard (e [(pcre2-limit-condition? e) 'limit]) + (let ([result (pcre2-search pattern subject)]) + (if result 'match 'no-match)))]) (reset-limits!) - (if result - (record-fail name "unexpected-match") - (record-pass name)))))) + (case outcome + [(limit) (record-pass name)] + [(no-match) (record-fail name "expected-limit-exhaustion")] + [else (record-fail name "unexpected-match")]))))) + +;; Fail-closed smoke: under a low limit the pattern must not certify a match. +;; PCRE2 may either hit the limit (raise the pcre2-limit condition) or fast-path +;; a genuine no-match (e.g. the minimum-length optimization); both are fail-closed +;; and only a returned match fails. Shapes guaranteed catastrophic are held to the +;; stricter expect-limit-exhaustion above. +(define (expect-fail-closed-under-limit name pattern subject match-limit depth-limit) + (guard-case name + (lambda () + (pcre2-set-match-limits! match-limit depth-limit) + (let ([outcome + (guard (e [(pcre2-limit-condition? e) 'limit]) + (let ([result (pcre2-search pattern subject)]) + (if result 'match 'no-match)))]) + (reset-limits!) + (case outcome + [(limit no-match) (record-pass name)] + [else (record-fail name "unexpected-match")]))))) (define (a-run n suffix) (string-append (make-string n #\a) suffix)) @@ -76,35 +102,35 @@ "^[a-z]+$" "jerboa") -(expect-no-match-under-limit +(expect-limit-exhaustion "nested-plus-rejects-under-low-limit" "(a+)+$" (a-run 256 "b") 128 128) -(expect-no-match-under-limit +(expect-limit-exhaustion "alternation-prefix-rejects-under-low-limit" "^(a|aa)+$" (a-run 192 "b") 128 128) -(expect-no-match-under-limit +(expect-limit-exhaustion "nested-class-repeat-rejects-under-low-limit" "^([[:alpha:]]+)*$" (a-run 192 "!") 128 128) -(expect-no-match-under-limit +(expect-fail-closed-under-limit "bounded-optional-repeat-rejects-under-low-limit" "^(a?){80}a{80}$" (make-string 79 #\a) 256 128) -(expect-no-match-under-limit +(expect-fail-closed-under-limit "quoted-hostile-pattern-is-literal" (pcre2-quote "(a+)+$") (a-run 64 "b") @@ -134,7 +160,7 @@ (define (run-generated-hostile-case i) (set! generated-hostile-cases (+ generated-hostile-cases 1)) - (expect-no-match-under-limit + (expect-fail-closed-under-limit (string-append "generated-hostile-" (number->string i)) (generated-hostile-pattern i) (generated-hostile-subject i) @@ -168,6 +194,7 @@ (printf "generated_hostile_cases=~a\n" generated-hostile-cases) (printf "generated_literal_cases=~a\n" generated-literal-cases) (printf "match_limit_status=covered\n") +(printf "limit_exhaustion_signal=pcre2-limit-condition\n") (printf "quote_literal_status=covered\n") (printf "status=~a\n" (if (zero? *fail*) "pass" "fail")) (exit (if (zero? *fail*) 0 1)) --- a/tests/pcre2-test.ss +++ b/tests/pcre2-test.ss @@ -467,10 +467,55 @@ (pcre2-set-match-limits! 10000000 1000000) (check #t => #t)) - (test-case "low match limit fails safely" + ;; P1 #28 regression: match-limit exhaustion must FAIL CLOSED. It raises a + ;; catchable pcre2-limit condition that is distinguishable from a genuine + ;; no-match (#f), so a defender that blocks input on the match result cannot + ;; be bypassed by exhausting the limit. + (test-case "match-limit exhaustion raises a limit condition, not #f" (pcre2-set-match-limits! 1 100) - (check (pcre2-search "(a+)+$" "aaaaaaaaaaaaab") => #f) - (pcre2-set-match-limits! 10000000 1000000))) + (let ([outcome (guard (e [(pcre2-limit-condition? e) 'limit]) + (let ([m (pcre2-search "(a+)+$" "aaaaaaaaaaaaab")]) + (if m 'match 'no-match)))]) + (pcre2-set-match-limits! 10000000 1000000) + (check outcome => 'limit))) + + (test-case "limit condition carries a PCRE2 limit error code" + (pcre2-set-match-limits! 1 100) + (let ([code (guard (e [(pcre2-limit-condition? e) (pcre2-limit-error-code e)]) + (pcre2-search "(a+)+$" "aaaaaaaaaaaaab") + #f)]) + (pcre2-set-match-limits! 10000000 1000000) + (check (or (= code PCRE2_ERROR_MATCHLIMIT) + (= code PCRE2_ERROR_DEPTHLIMIT)) => #t))) + + (test-case "pcre2-matches? fails closed on limit exhaustion" + (pcre2-set-match-limits! 1 100) + (let ([outcome (guard (e [(pcre2-limit-condition? e) 'limit]) + (if (pcre2-matches? "(a+)+$" "aaaaaaaaaaaaab") 'match 'safe))]) + (pcre2-set-match-limits! 10000000 1000000) + (check outcome => 'limit))) + + (test-case "pcre2-match fails closed on limit exhaustion" + (pcre2-set-match-limits! 1 100) + (let ([outcome (guard (e [(pcre2-limit-condition? e) 'limit]) + (if (pcre2-match "(a+)+$" "aaaaaaaaaaaaab") 'match 'no-match))]) + (pcre2-set-match-limits! 10000000 1000000) + (check outcome => 'limit))) + + (test-case "genuine no-match still returns #f under a low limit" + (pcre2-set-match-limits! 1 100) + (let ([m (pcre2-search "xyz" "aaaaaaaaaaaaab")]) + (pcre2-set-match-limits! 10000000 1000000) + (check m => #f))) + + (test-case "limit condition is distinct from a plain error" + (pcre2-set-match-limits! 1 100) + (let ([kind (guard (e [(pcre2-limit-condition? e) 'limit] + [else 'other]) + (pcre2-search "(a+)+$" "aaaaaaaaaaaaab") + 'returned)]) + (pcre2-set-match-limits! 10000000 1000000) + (check kind => 'limit)))) ;; ----------------------------------------------------------------- (test-group "edge cases"