~ chicken-core (chicken-5) cd1b9775005ebe220ba11265dbf5396142e65f26

commit cd1b9775005ebe220ba11265dbf5396142e65f26
Author:     Peter Bex <peter.bex@xs4all.nl>
AuthorDate: Sun Sep 22 11:37:09 2013 +0200
Commit:     Peter Bex <peter.bex@xs4all.nl>
CommitDate: Tue Sep 24 09:05:48 2013 +0200

    Read no more than the buffer length when a length of #f is passed in
    
    Signed-off-by: Mario Domenech Goulart <mario.goulart@gmail.com>
    Signed-off-by: Peter Bex <peter.bex@xs4all.nl>

diff --git a/NEWS b/NEWS
index 5b3cfdb3..d4e65e98 100644
--- a/NEWS
+++ b/NEWS
@@ -1,5 +1,8 @@
 4.8.3
 
+- Security fixes
+  - read-string! no longer reads beyond its buffer when length is #f.
+
 - Runtime system
   - The procedure trace buffer has been made resizable.
 
diff --git a/extras.scm b/extras.scm
index 49ab5cf2..8f17e1f3 100644
--- a/extras.scm
+++ b/extras.scm
@@ -176,10 +176,10 @@
 (define (read-string! n dest #!optional (port ##sys#standard-input) (start 0))
   (##sys#check-input-port port #t 'read-string!)
   (##sys#check-string dest 'read-string!)
-  (when n
-    (##sys#check-exact n 'read-string!)
-    (when (fx> (fx+ start n) (##sys#size dest))
-      (set! n (fx- (##sys#size dest) start))))
+  (when n (##sys#check-exact n 'read-string!))
+  (let ((dest-size (##sys#size dest)))
+    (unless (and n (fx<= (fx+ start n) dest-size))
+      (set! n (fx- dest-size start))))
   (##sys#check-exact start 'read-string!)
   (##sys#read-string! n dest port start) )
 
diff --git a/tests/port-tests.scm b/tests/port-tests.scm
index 409c552a..bd7c8586 100644
--- a/tests/port-tests.scm
+++ b/tests/port-tests.scm
@@ -295,7 +295,49 @@ EOF
 
 (test-group
  "read-line string port position tests"
-(test-port-position read-string-line/pos))
+ (test-port-position read-string-line/pos))
+
+(test-group "read-string!"
+  (let ((in (open-input-string "1234567890"))
+        (buf (make-string 5)))
+    (test-equal "read-string! won't read past buffer if given #f"
+                (read-string! #f buf in)
+                5)
+    (test-equal "read-string! reads the requested bytes with #f"
+                buf
+                "12345")
+    (test-equal "read-string! won't read past buffer if given #f and offset"
+                (read-string! #f buf in 3)
+                2)
+    (test-equal "read-string! reads the requested bytes with #f and offset"
+                buf
+                "12367")
+    (test-equal "read-string! reads until the end correctly"
+                (read-string! #f buf in)
+                3)
+    (test-equal "read-string! leaves the buffer's tail intact"
+                buf
+                "89067"))
+  (let ((in (open-input-string "1234567890"))
+        (buf (make-string 5)))
+    (test-equal "read-string! won't read past buffer if given size"
+                (read-string! 10 buf in)
+                5)
+    (test-equal "read-string! reads the requested bytes with buffer size"
+                buf
+                "12345")
+    (test-equal "read-string! won't read past buffer if given size and offset"
+                (read-string! 10 buf in 3)
+                2)
+    (test-equal "read-string! reads the requested bytes with buffer size and offset"
+                buf
+                "12367")
+    (test-equal "read-string! reads until the end correctly with buffer size"
+                (read-string! 10 buf in)
+                3)
+    (test-equal "read-string! leaves the buffer's tail intact"
+                buf
+                "89067")))
 
 ;; Disabled because it requires `echo -n` for
 ;; the EOF test, and that is not available on all systems.