Thanks! A signed off copy is attached (waiting for another chicken-hacker
to approve).
cheers,
felix
From 7c4e7e84ddcc20e262b1aa15eef25c8133f63a7e Mon Sep 17 00:00:00 2001
From: felix <fe...@call-with-current-continuation.org>
Date: Mon, 11 Mar 2024 12:15:44 +0100
Subject: [PATCH] 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. (Patch contributed by
"siiky")
Signed-off-by: felix <fe...@call-with-current-continuation.org>
---
data-structures.scm | 24 ++++++++++++++----------
tests/data-structures-tests.scm | 12 ++++++++++++
2 files changed, 26 insertions(+), 10 deletions(-)
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)))
--
2.40.0
