~ chicken-core (chicken-5) 63d0445ed379a43343cfcea7032a284cf7deca2b


commit 63d0445ed379a43343cfcea7032a284cf7deca2b
Author:     Moritz Heidkamp <moritz.heidkamp@bevuta.com>
AuthorDate: Sun Dec 14 23:33:52 2014 +0100
Commit:     Peter Bex <peter.bex@xs4all.nl>
CommitDate: Thu Dec 18 18:57:23 2014 +0100

    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.
    
    Signed-off-by: Peter Bex <peter.bex@xs4all.nl>

diff --git a/NEWS b/NEWS
index a293ed21..738c4000 100644
--- a/NEWS
+++ b/NEWS
@@ -15,6 +15,7 @@
 - Security fixes
   - CVE-2014-6310: Use POSIX poll() on Android platform to avoid
     potential select() buffer overrun.
+  - substring-index no longer scans beyond string boundaries.
 
 - Core libraries
   - alist-ref from unit data-structures now gives an error when passed
diff --git a/data-structures.scm b/data-structures.scm
index 22637e4c..6c554386 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 
Trap