~ chicken-core (chicken-5) 0e97b648407d750f1e476e3c193e136126558346

commit 0e97b648407d750f1e476e3c193e136126558346
Author:     siiky <github-siiky@net-c.cat>
AuthorDate: Mon Mar 11 12:15:44 2024 +0100
Commit:     Mario Domenech Goulart <mario@parenteses.org>
CommitDate: Tue Mar 12 20:41:44 2024 +0100

    Add bounds-checks to substring=? and substring-ci=?
    
    Because the `start1`/`start2`/`n` parameters were not checked to be
    within bounds, it was possible to access arbitrary memory outside of
    the given strings. This could lead to wrong results (returning #t/#f
    when the opposite was true), or possibly crashing the program.
    
    Signed-off-by: felix <felix@call-with-current-continuation.org>
    Signed-off-by: Mario Domenech Goulart <mario@parenteses.org>

diff --git a/data-structures.scm b/data-structures.scm
index 8563fba2..642d2a59 100644
--- a/data-structures.scm
+++ b/data-structures.scm
@@ -155,11 +155,13 @@
 (define (##sys#substring=? s1 s2 start1 start2 n)
   (##sys#check-string s1 'substring=?)
   (##sys#check-string s2 'substring=?)
-  (let ((len (or n
-		 (fxmin (fx- (##sys#size s1) start1)
-			(fx- (##sys#size s2) start2) ) ) ) )
-    (##sys#check-fixnum start1 'substring=?)
-    (##sys#check-fixnum start2 'substring=?)
+  (##sys#check-range start1 0 (##sys#size s1) 'substring=?)
+  (##sys#check-range start2 0 (##sys#size s2) 'substring=?)
+  (let* ((maxlen (fxmin (fx- (##sys#size s1) start1)
+                        (fx- (##sys#size s2) start2)))
+         (len (if n
+                  (begin (##sys#check-range n 0 maxlen 'substring=?) n)
+                  maxlen)))
     (##core#inline "C_substring_compare" s1 s2 start1 start2 len) ) )
 
 (define (substring=? s1 s2 #!optional (start1 0) (start2 0) len)
@@ -168,11 +170,13 @@
 (define (##sys#substring-ci=? s1 s2 start1 start2 n)
   (##sys#check-string s1 'substring-ci=?)
   (##sys#check-string s2 'substring-ci=?)
-  (let ((len (or n
-		 (fxmin (fx- (##sys#size s1) start1)
-			(fx- (##sys#size s2) start2) ) ) ) )
-    (##sys#check-fixnum start1 'substring-ci=?)
-    (##sys#check-fixnum start2 'substring-ci=?)
+  (##sys#check-range start1 0 (##sys#size s1) 'substring-ci=?)
+  (##sys#check-range start2 0 (##sys#size s2) 'substring-ci=?)
+  (let* ((maxlen (fxmin (fx- (##sys#size s1) start1)
+                        (fx- (##sys#size s2) start2)))
+         (len (if n
+                  (begin (##sys#check-range n 0 maxlen 'substring-ci=?) n)
+                  maxlen)))
     (##core#inline "C_substring_compare_case_insensitive"
 		   s1 s2 start1 start2 len) ) )
 
diff --git a/tests/data-structures-tests.scm b/tests/data-structures-tests.scm
index 1d7820df..17a3dd58 100644
--- a/tests/data-structures-tests.scm
+++ b/tests/data-structures-tests.scm
@@ -50,6 +50,18 @@
 (assert (not (substring-index-ci "o\x00bar" "foo\x00baz")))
 (assert (= 0 (substring-index "" "")))
 (assert (= 1 (substring-index "" "a" 1)))
+(assert-error (substring=? "a" "a" 2))
+(assert-error (substring=? "a" "a" -2))
+(assert-error (substring=? "a" "a" 0 2))
+(assert-error (substring=? "a" "a" 0 -2))
+(assert-error (substring=? "a" "a" 0 0 2))
+(assert-error (substring=? "a" "a" 0 0 -2))
+(assert-error (substring-ci=? "a" "a" 2))
+(assert-error (substring-ci=? "a" "a" -2))
+(assert-error (substring-ci=? "a" "a" 0 2))
+(assert-error (substring-ci=? "a" "a" 0 -2))
+(assert-error (substring-ci=? "a" "a" 0 0 2))
+(assert-error (substring-ci=? "a" "a" 0 0 -2))
 (assert-error (substring-index "" "a" 2))
 (assert-error (substring-index "a" "b" 2))
 (assert (not (substring-index "a" "b" 1)))