From 0547bc0c750032b0633276b90cf14a22d9bd9cd7 Mon Sep 17 00:00:00 2001
From: Peter Bex <address@hidden>
Date: Sun, 14 Jun 2015 19:52:26 +0200
Subject: [PATCH] Fix potential buffer overrun error in string-translate*

string-translate* would scan from every position in the target string
for each source string in the map, even if that would mean scanning
past the end.  The out-of-bounds read would be limited to the size of
the overlapping prefix in the trailing garbage beyond the string,
because memcmp will stop scanning as soon as there is a different
byte in either of the memory areas.

This also adds a few basic tests for string-translate*
---
 NEWS                            |  1 +
 data-structures.scm             | 17 +++++++++--------
 tests/data-structures-tests.scm | 11 +++++++++++
 3 files changed, 21 insertions(+), 8 deletions(-)

diff --git a/NEWS b/NEWS
index bf07519..cae9bd3 100644
--- a/NEWS
+++ b/NEWS
@@ -5,6 +5,7 @@
     potential select() buffer overrun.
   - CVE-2014-9651: substring-index[-ci] no longer scans beyond string
     boundaries.
+  - string-translate* 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 b67065e..5664d08 100644
--- a/data-structures.scm
+++ b/data-structures.scm
@@ -514,7 +514,7 @@
 (define (string-translate* str smap)
   (##sys#check-string str 'string-translate*)
   (##sys#check-list smap 'string-translate*)
-  (let ([len (##sys#size str)])
+  (let ((len (##sys#size str)))
     (define (collect i from total fs)
       (if (fx>= i len)
 	  (##sys#fragments->string
@@ -523,15 +523,16 @@
 	    (if (fx> i from) 
 		(cons (##sys#substring str from i) fs)
 		fs) ) )
-	  (let loop ([smap smap])
+	  (let loop ((smap smap))
 	    (if (null? smap) 
 		(collect (fx+ i 1) from (fx+ total 1) fs)
-		(let* ([p (car smap)]
-		       [sm (car p)]
-		       [smlen (string-length sm)]
-		       [st (cdr p)] )
-		  (if (##core#inline "C_substring_compare" str sm i 0 smlen)
-		      (let ([i2 (fx+ i smlen)])
+		(let* ((p (car smap))
+		       (sm (car p))
+		       (smlen (string-length sm))
+		       (st (cdr p)) )
+		  (if (and (fx<= (fx+ i smlen) len)
+			   (##core#inline "C_substring_compare" str sm i 0 smlen))
+		      (let ((i2 (fx+ i smlen)))
 			(when (fx> i from)
 			  (set! fs (cons (##sys#substring str from i) fs)) )
 			(collect 
diff --git a/tests/data-structures-tests.scm b/tests/data-structures-tests.scm
index 51c25a9..b576807 100644
--- a/tests/data-structures-tests.scm
+++ b/tests/data-structures-tests.scm
@@ -57,6 +57,17 @@
 (assert (< 0 (string-compare3-ci "foo\x00b" "foo\x00a")))
 (assert (< 0 (string-compare3-ci "foo\x00b" "foo\x00A")))
 
+(assert (string=? "bde" (string-translate* "abcd"
+					   '(("a" . "b")
+					     ("b" . "")
+					     ("c" . "d")
+					     ("d" . "e")))))
+(assert (string=? "bc" (string-translate* "abc"
+					  '(("ab" . "b")
+					    ("bc" . "WRONG")))))
+(assert (string=? "x" (string-translate* "ab" '(("ab" . "x")))))
+(assert (string=? "xy" (string-translate* "xyz" '(("z" . "")))))
+
 ;; topological-sort
 
 (assert (equal? '() (topological-sort '() eq?)))
-- 
2.1.4