Control: tags -1 patch
Upstream patch cherry-picked.
--
tobi
commit 8a460209d78ed532c0b92e32c21625c4952bde3c
Author: Peter Bex <pe...@more-magic.net>
Date: Sun Jun 14 19:52:26 2015 +0200
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*
Signed-off-by: Evan Hanson <ev...@foldling.org>
--- a/data-structures.scm
+++ b/data-structures.scm
@@ -504,7 +504,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
@@ -513,15 +513,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
--- a/tests/data-structures-tests.scm
+++ b/tests/data-structures-tests.scm
@@ -43,6 +43,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?)))
