security: fix re-split crash on empty match at end of subject
ober
de55fa7953da9e095b4dee4679d82addefbaa437
--- a/lib/std/pregexp.sls +++ b/lib/std/pregexp.sls @@ -680,14 +680,21 @@ => (lambda (y) (let ((jk (car y))) - (let ((j (car jk)) (k (cdr jk))) - (cond ((= j k) - (loop (+ k 1) - (cons (substring str i (+ j 1)) r) #t)) - ((and (= j i) picked-up-one-undelimited-char?) - (loop k r #f)) - (else - (loop k (cons (substring str i j) r) #f))))))) + (let ((j (car jk)) (k (cdr jk))) + (cond ((= j k) + ;; Empty-match delimiter: consume the char at j + ;; to guarantee progress. An empty match at the + ;; very end (j = n, e.g. pattern "$") has no char + ;; to consume; (+ j 1) would run past the string + ;; and crash substring. Emit the rest and stop. + (if (>= j n) + (loop n (cons (substring str i n) r) #f) + (loop (+ k 1) + (cons (substring str i (+ j 1)) r) #t))) + ((and (= j i) picked-up-one-undelimited-char?) + (loop k r #f)) + (else + (loop k (cons (substring str i j) r) #f))))))) (else (loop n (cons (substring str i n) r) #f))))))) (define pregexp-replace --- a/lib/std/regex.ss +++ b/lib/std/regex.ss @@ -611,14 +611,22 @@ [(>= i n) (reverse acc)] [(native-find-from r str i om bv bl) => (lambda (jk) - (let ([j (car jk)] [k (cdr jk)]) - (cond - [(= j k) - (loop (+ k 1) (cons (substring str i (+ j 1)) acc) #t)] - [(and (= j i) picked?) - (loop k acc #f)] - [else - (loop k (cons (substring str i j) acc) #f)])))] + (let ([j (car jk)] [k (cdr jk)]) + (cond + [(= j k) + ;; Empty-match delimiter. Normally we consume the + ;; char at j to guarantee progress. But an empty + ;; match at the very end (j = n, e.g. pattern "$") + ;; has no char to consume; (+ j 1) would run past + ;; the string and crash substring. Treat it as the + ;; final delimiter: emit the rest and stop. + (if (>= j n) + (loop n (cons (substring str i n) acc) #f) + (loop (+ k 1) (cons (substring str i (+ j 1)) acc) #t))] + [(and (= j i) picked?) + (loop k acc #f)] + [else + (loop k (cons (substring str i j) acc) #f)])))] [else (loop n (cons (substring str i n) acc) #f)])))] [else (pregexp-split (re-object-pat-string r) str)]))) --- a/tests/test-regex.ss +++ b/tests/test-regex.ss @@ -249,6 +249,41 @@ (test "non-ASCII: search with start offset" (let ([m (re-search "[0-9]" (string-append "1" e-acute "2") 1)]) (and m (re-match-full m))) "2") +;;; ========== re-split empty-match-at-end regression ========== +;;; +;;; A pattern whose leftmost match is an EMPTY match at the very end of the +;;; subject (e.g. "$", or "x*$") used to crash re-split: the empty-match branch +;;; consumed "the char at j" via (substring str i (+ j 1)), but at j = (string- +;;; length str) there is no such char and (+ j 1) ran past the end. Both the +;;; native linear path and the pregexp fallback are exercised here (the native +;;; path when a native handle exists, pregexp otherwise). +(define euro-str (string (integer->char #x20ac))) ;; 3-byte UTF-8 +(define cafe-str (string-append "caf" e-acute)) ;; "café" +(define mixed-str (string-append "a" e-acute euro-str emoji "b")) ;; "aé€😀b" + +(printf "~% -- re-split empty-match-at-end (no crash) --~%") + +(test "split: $ on ASCII" (re-split "$" "abc") '("abc")) +(test "split: $ on non-ASCII" (re-split "$" cafe-str) (list cafe-str)) +(test "split: $ on mixed multi" (re-split "$" mixed-str) (list mixed-str)) +(test "split: $ on empty string" (re-split "$" "") '()) +(test "split: x*$ on ASCII" (re-split "x*$" "abc") '("abc")) +(test "split: ^ still works" (re-split "^" "abc") '("a" "bc")) +(test "split: empty pat ASCII" (re-split "" "abc") '("a" "b" "c")) +(test "split: empty pat non-ASCII" (re-split "" cafe-str) '("c" "a" "f" "é")) +(test "split: trailing sep" (re-split "," "a,b,") '("a" "b")) + +;;; Empty-match advancement stays character-based for non-ASCII (no infinite +;;; loop, no mid-codepoint landing): re-replace-all/re-find-all on a pattern +;;; that matches empty at every position must terminate with the right count. +(test "non-ASCII: replace-all empty pattern terminates" + (re-replace-all "" cafe-str "-") "----") +(test "non-ASCII: find-all $ single end match" + (re-find-all "$" cafe-str) '("")) +(test "non-ASCII: fold $ reports char (not byte) offset" + (re-fold "$" (lambda (i m s a) (cons (re-match-start m) a)) '() cafe-str) + (list (string-length cafe-str))) + ;;; ========== Summary ========== (newline) (printf "Results: ~a passed, ~a failed~%" pass fail)