summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-01-15 23:41:23 +0100
committerLudovic Courtès <ludo@gnu.org>2014-01-15 23:41:49 +0100
commit802a25b1ed5c738aa5f9d3d01f33eb89b22afd1b (patch)
treeef449fcd3c049ca5c64f25ca7fb6136a05d210d4
parent6df03222128887bf9982631183ab1cf6c144fe42 (diff)
downloadguile-802a25b1ed5c738aa5f9d3d01f33eb89b22afd1b.tar.gz
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.
-rw-r--r--module/web/response.scm27
-rw-r--r--test-suite/tests/web-response.test6
2 files changed, 20 insertions, 13 deletions
diff --git a/module/web/response.scm b/module/web/response.scm
index 570a2d7d2..58e3f1141 100644
--- a/module/web/response.scm
+++ b/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,16 +246,21 @@ closes PORT, unless KEEP-ALIVE? is true."
bytes-read len))
(define (read! bv start count)
- (let ((ret (get-bytevector-n! port bv start count)))
- (if (eof-object? ret)
- (if (= bytes-read len)
- 0
- (fail))
- (begin
- (set! bytes-read (+ bytes-read ret))
- (if (> bytes-read len)
- (fail)
- ret)))))
+ ;; Read at most LEN bytes in total. HTTP/1.1 doesn't say what to do
+ ;; 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 ; EOF
+ (fail)))
+ ((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))
+ ret)))))
(define close
(and (not keep-alive?)
diff --git a/test-suite/tests/web-response.test b/test-suite/tests/web-response.test
index f9679f5e2..99b129334 100644
--- a/test-suite/tests/web-response.test
+++ b/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