* gnu/packages/patches/guile-web.patch: New file.
* gnu-system.am: Add it
* gnu/packages/guile.scm (guile-2.0): Add the patch.
---
gnu-system.am | 1 +
gnu/packages/guile.scm | 3 +-
gnu/packages/patches/guile-web.patch | 78 ++++++++++++++++++++++++++++++++++++
3 files changed, 81 insertions(+), 1 deletion(-)
create mode 100644 gnu/packages/patches/guile-web.patch
diff --git a/gnu-system.am b/gnu-system.am
index a2377fd..88313e2 100644
--- a/gnu-system.am
+++ b/gnu-system.am
@@ -233,6 +233,7 @@ dist_patch_DATA =
\
gnu/packages/patches/guile-default-utf8.patch \
gnu/packages/patches/guile-linux-syscalls.patch \
gnu/packages/patches/guile-relocatable.patch \
+ gnu/packages/patches/guile-web.patch \
gnu/packages/patches/hop-bigloo-4.0b.patch \
gnu/packages/patches/libevent-dns-tests.patch \
gnu/packages/patches/libtool-skip-tests.patch \
diff --git a/gnu/packages/guile.scm b/gnu/packages/guile.scm
index 653d42c..867a646 100644
--- a/gnu/packages/guile.scm
+++ b/gnu/packages/guile.scm
@@ -113,7 +113,8 @@ without requiring the source code to be rewritten.")
".tar.xz"))
(sha256
(base32
- "0nw9y8vjyz4r61v06p9msks5lm58pd91irmzg4k487vmv743h2pp"))))
+ "0nw9y8vjyz4r61v06p9msks5lm58pd91irmzg4k487vmv743h2pp"))
+ (patches (list (search-patch "guile-web.patch")))))
(build-system gnu-build-system)
(native-inputs `(("pkgconfig" ,pkg-config)))
(inputs `(("libffi" ,libffi)
diff --git a/gnu/packages/patches/guile-web.patch
b/gnu/packages/patches/guile-web.patch
new file mode 100644
index 0000000..3ac6497
--- /dev/null
+++ b/gnu/packages/patches/guile-web.patch
@@ -0,0 +1,78 @@
+From 802a25b1ed5c738aa5f9d3d01f33eb89b22afd1b Mon Sep 17 00:00:00 2001
+From: Ludovic Courtès <l...@gnu.org>
+Date: Wed, 15 Jan 2014 22:41:23 +0000
+Subject: 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.
+---
+diff --git a/module/web/response.scm b/module/web/response.scm
+index 570a2d7..58e3f11 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 f9679f5..99b1293 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
--
1.8.4.rc3
