http-client: Add workaround for HTTP pipelining on Guile <= 2.0.9.

Reported by Ricardo Wurmus <ricardo.wurmus@mdc-berlin.de>.

* guix/http-client.scm (make-delimited-input-port): New procedure.
  Install it in (web response) for Guile <= 2.0.9.

1 files changed, 41 insertions, 0 deletions

diff --git a/guix/http-client.scm b/guix/http-client.scm
index 051fceecb5..3bffbb1c24 100644
--- a/guix/http-client.scm
+++ b/guix/http-client.scm
@@ -135,6 +135,47 @@ closed it will also close PORT, unless the KEEP-ALIVE? is true."
  (when (module-variable %web-http 'read-chunk-body)
    (module-set! %web-http 'make-chunked-input-port make-chunked-input-port))
 
+ (define (make-delimited-input-port port len keep-alive?)
+   "Return an input port that reads from PORT, and makes sure that
+exactly LEN bytes are available from PORT.  Closing the returned port
+closes PORT, unless KEEP-ALIVE? is true."
+   (define bytes-read 0)
+
+   (define (fail)
+     ((@@ (web response) bad-response)
+      "EOF while reading response body: ~a bytes of ~a"
+      bytes-read len))
+
+   (define (read! bv start count)
+     ;; 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?)
+          (lambda ()
+            (close port))))
+
+   (make-custom-binary-input-port "delimited input port" read! #f #f close))
+
+ (unless (guile-version>? "2.0.9")
+   ;; Guile <= 2.0.9 had a bug whereby 'response-body-port' would read more
+   ;; than what 'content-length' says.  See Guile commit 802a25b.
+   (module-set! (resolve-module '(web response))
+                'make-delimited-input-port make-delimited-input-port))
+
  (define (read-response-body* r)
    "Reads the response body from @var{r}, as a bytevector.  Returns
  @code{#f} if there was no response body."