03/05: http-client: Work around <http://bugs.gnu.org/22273>.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 793a43f4099c94a74fa3374b0ed732cb14e120e9
Author: Ludovic Courtès <address@hidden>
Date:   Wed Jan 6 21:36:15 2016 +0100

    http-client: Work around <http://bugs.gnu.org/22273>.
    
    * guix/http-client.scm (read-header-line): New procedure.  Use it.
---
 guix/http-client.scm |   22 +++++++++++++++++++++-
 1 files changed, 21 insertions(+), 1 deletions(-)

diff --git a/guix/http-client.scm b/guix/http-client.scm
index b0aae52..31b511e 100644
--- a/guix/http-client.scm
+++ b/guix/http-client.scm
@@ -188,13 +188,33 @@ closes PORT, unless KEEP-ALIVE? is true."
 
    (make-custom-binary-input-port "delimited input port" read! #f #f close))
 
+ (define (read-header-line port)
+   "Read an HTTP header line and return it without its final CRLF or LF.
+Raise a 'bad-header' exception if the line does not end in CRLF or LF,
+or if EOF is reached."
+   (match (%read-line port)
+     (((? string? line) . #\newline)
+      ;; '%read-line' does not consider #\return a delimiter; so if it's
+      ;; there, remove it.  We are more tolerant than the RFC in that we
+      ;; tolerate LF-only endings.
+      (if (string-suffix? "\r" line)
+          (string-drop-right line 1)
+          line))
+     ((line . _)                                ;EOF or missing delimiter
+      ((@@ (web http) bad-header) 'read-header-line line))))
+
  (unless (guile-version>? "2.0.11")
    ;; Guile <= 2.0.9 had a bug whereby 'response-body-port' would read more
    ;; than what 'content-length' says.  See Guile commit 802a25b.
    ;; Guile <= 2.0.11 had a bug whereby the 'close' method of the response
    ;; body port would fail with wrong-arg-num.  See Guile commit 5a10e41.
    (module-set! (resolve-module '(web response))
-                'make-delimited-input-port make-delimited-input-port)))
+                'make-delimited-input-port make-delimited-input-port)
+
+   ;; Guile <= 2.0.11 was affected by <http://bugs.gnu.org/22273>.  See Guile
+   ;; commit 4c7732c.
+   (when (module-variable %web-http 'read-line*)
+     (module-set! %web-http 'read-line* read-header-line))))
 
 ;; XXX: Work around <http://bugs.gnu.org/13095>, present in Guile
 ;; up to 2.0.7.