From mboxrd@z Thu Jan 1 00:00:00 1970 From: Cyril Roelandt Subject: [PATCH] gnu: patch Guile 2.0 to fix bug #14884. Date: Fri, 24 Jan 2014 03:32:23 +0100 Message-ID: <1390530743-2583-1-git-send-email-tipecaml@gmail.com> References: <20140123194402.GB13401@debian> Mime-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:41854) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1W6War-0008KY-FS for guix-devel@gnu.org; Thu, 23 Jan 2014 21:34:10 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1W6Wam-00075G-Gd for guix-devel@gnu.org; Thu, 23 Jan 2014 21:34:05 -0500 Received: from mail-we0-x22a.google.com ([2a00:1450:400c:c03::22a]:62876) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1W6Wam-00075B-6J for guix-devel@gnu.org; Thu, 23 Jan 2014 21:34:00 -0500 Received: by mail-we0-f170.google.com with SMTP id u57so2096840wes.29 for ; Thu, 23 Jan 2014 18:33:58 -0800 (PST) In-Reply-To: <20140123194402.GB13401@debian> List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org Sender: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org To: guix-devel@gnu.org * 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 +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