* [PATCH] gnu: patch Guile 2.0 to fix bug #14884.
[not found] <20140123194402.GB13401@debian>
@ 2014-01-24 2:32 ` Cyril Roelandt
2014-01-25 15:52 ` Ludovic Courtès
0 siblings, 1 reply; 2+ messages in thread
From: Cyril Roelandt @ 2014-01-24 2:32 UTC (permalink / raw)
To: guix-devel
* 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 <ludo@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
^ permalink raw reply related [flat|nested] 2+ messages in thread
* Re: [PATCH] gnu: patch Guile 2.0 to fix bug #14884.
2014-01-24 2:32 ` [PATCH] gnu: patch Guile 2.0 to fix bug #14884 Cyril Roelandt
@ 2014-01-25 15:52 ` Ludovic Courtès
0 siblings, 0 replies; 2+ messages in thread
From: Ludovic Courtès @ 2014-01-25 15:52 UTC (permalink / raw)
To: Cyril Roelandt; +Cc: guix-devel
Cyril Roelandt <tipecaml@gmail.com> skribis:
> * gnu/packages/patches/guile-web.patch: New file.
> * gnu-system.am: Add it
> * gnu/packages/guile.scm (guile-2.0): Add the patch.
Thanks for the patch. I am tempted to wait a bit to see how things go
with Guile 2.0.10. Maybe we’ll just upgrade when it’s out.
Ludo’.
^ permalink raw reply [flat|nested] 2+ messages in thread
end of thread, other threads:[~2014-01-25 15:57 UTC | newest]
Thread overview: 2+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
[not found] <20140123194402.GB13401@debian>
2014-01-24 2:32 ` [PATCH] gnu: patch Guile 2.0 to fix bug #14884 Cyril Roelandt
2014-01-25 15:52 ` Ludovic Courtès
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).