web: Don't throw if a response is longer than its Content-Length says.

* module/web/response.scm (make-delimited-input-port): Read at most LEN
  bytes from PORT, instead of trying to read more and returning an error
  if more is available.  Try again when 'get-bytevector-n!' return zero.
* test-suite/tests/web-response.test (example-1): Add garbage after the
  body itself.

module/web/response.scm

@@ -1,6 +1,6 @@
 ;;; HTTP response objects
 
-;; Copyright (C)  2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
 
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
@@ -246,15 +246,20 @@ closes PORT, unless KEEP-ALIVE? is true."
                   bytes-read len))
 
   (define (read! bv start count)
-    (let ((ret (get-bytevector-n! port bv start count)))
+    ;; Read at most LEN bytes in total.  HTTP/1.1 doesn't say what to do
-      (if (eof-object? ret)
+    ;; when a server provides more than the Content-Length, but it seems
+    ;; wise to just stop reading at LEN.
+    (let ((count (min count (- len bytes-read))))
+      (let loop ((ret (get-bytevector-n! port bv start count)))
+        (cond ((eof-object? ret)
                (if (= bytes-read len)
-              0
+                   0                              ; EOF
-              (fail))
+                   (fail)))
-          (begin
+              ((and (zero? ret) (> count 0))
+               ;; Do not return zero since zero means EOF, so try again.
+               (loop (get-bytevector-n! port bv start count)))
+              (else
                (set! bytes-read (+ bytes-read ret))
-            (if (> bytes-read len)
-                (fail)
                ret)))))
 
   (define close

test-suite/tests/web-response.test

@@ -1,6 +1,6 @@
 ;;;; web-response.test --- HTTP responses       -*- mode: scheme; coding: utf-8; -*-
 ;;;;
-;;;;   Copyright (C) 2010, 2011, 2012 Free Software Foundation, Inc.
+;;;;   Copyright (C) 2010, 2011, 2012, 2014 Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -39,7 +39,9 @@ Content-Encoding: gzip\r
 Content-Length: 36\r
 Content-Type: text/html; charset=utf-8\r
 \r
-abcdefghijklmnopqrstuvwxyz0123456789")
+abcdefghijklmnopqrstuvwxyz0123456789
+-> Here is trailing garbage that should be ignored because it is
+   beyond Content-Length.")
 
 (define example-2
   "HTTP/1.1 200 OK\r