3
5
Fork 0
mirror of git://git.savannah.gnu.org/guix.git synced 2023-12-14 03:33:07 +01:00

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.
This commit is contained in:
Ludovic Courtès 2015-04-08 21:38:52 +02:00
parent 9bea87a542
commit 0cc0095f3c

View file

@ -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."