Dear Chickeneers,
the attached patch fixes a potential buffer overrun in
substring-index[-ci] I ran into today (pun intended). See commit message
for details. I included a regression test but I'm not sure whether it's
ideal because it adds a dependency on object-evict to the
data-structures tests. Alternative ideas welcome. While I was at it I
also added a range check for the start index argument and got rid of the
square brackets :-)
I guess this might warrant a CVE?
Cheers
Moritz
--
bevuta IT GmbH - professional IT solutions
Marktstrasse 10 | http://www.bevuta.com/ | HRB 62476 AG Cologne
D-50968 Cologne | Tel.: +49 221 282678-0 | CEO: Pablo Beyen
From 230eed2745ea2b57de3c9073e8596892b1da2d8c Mon Sep 17 00:00:00 2001
From: Moritz Heidkamp
Date: Sun, 14 Dec 2014 23:33:52 +0100
Subject: [PATCH] Fix buffer overrun in substring-index[-ci]
When passing a start index greater than 0, substring-index[-ci] would
scan past the end of the subject string, leading to bogus results in
case the substring is accidentally run into beyond the end of the
subject. This patch fixes the issue and also adds a range check for the
start index.
---
data-structures.scm | 22 ++
tests/data-structures-tests.scm | 11 ++-
2 files changed, 24 insertions(+), 9 deletions(-)
diff --git a/data-structures.scm b/data-structures.scm
index a94c163..511a3c1 100644
--- a/data-structures.scm
+++ b/data-structures.scm
@@ -307,15 +307,21 @@
(define (traverse which where start test loc)
(##sys#check-string which loc)
(##sys#check-string where loc)
-(let ([wherelen (##sys#size where)]
- [whichlen (##sys#size which)] )
+(let* ((wherelen (##sys#size where))
+ (whichlen (##sys#size which))
+ (end (fx- wherelen whichlen)))
(##sys#check-exact start loc)
- (let loop ([istart start] [iend whichlen])
- (cond [(fx> iend wherelen) #f]
- [(test istart whichlen) istart]
- [else
- (loop (fx+ istart 1)
- (fx+ iend 1) ) ] ) ) ) )
+ (if (and (fx>= start 0)
+ (fx> wherelen start))
+ (let loop ((istart start))
+ (cond ((fx> istart end) #f)
+ ((test istart whichlen) istart)
+ (else (loop (fx+ istart 1)
+ (##sys#error-hook (foreign-value "C_OUT_OF_RANGE_ERROR" int)
+ loc
+ start
+ wherelen
+
(set! ##sys#substring-index
(lambda (which where start)
(traverse
diff --git a/tests/data-structures-tests.scm b/tests/data-structures-tests.scm
index 51c25a9..34ccb2f 100644
--- a/tests/data-structures-tests.scm
+++ b/tests/data-structures-tests.scm
@@ -1,6 +1,6 @@
data-structures-tests.scm
-(use data-structures)
+(use data-structures lolevel)
(define-syntax assert-error
(syntax-rules ()
@@ -57,6 +57,15 @@
(assert (< 0 (string-compare3-ci "foo\x00b" "foo\x00a")))
(assert (< 0 (string-compare3-ci "foo\x00b" "foo\x00A")))
+
+;; This used to fail because substring-index and co. used to search
+;; beyond the end of the subject string when a start index > 0 was
+;; provided. We use object-evict to ensure that the strings are placed
+;; in adjacent memory ranges so we can detect this error.
+(let* ((foo (object-evict (make-string 32 #\x)))
+ (bar (object-evict "y")))
+ (assert (not (substring-index "y" foo 30
+
;; topological-sort
(assert (equal? '() (topological-sort '() eq?)))
--
2.1.3
signature.asc
Description: PGP signature
___
Chicken-hackers mailing list
Chicken-hackers@nongnu.org
https://lists.nongnu.org/mailman/listinfo/chicken-hackers
