http-client: Monkey-patch 'make-chunked-input-port' on Guile <= 2.0.11.

Fixes <http://bugs.gnu.org/19976>.

* guix/http-client.scm (when-guile<=2.0.5): Rename to...
  (when-guile<=2.0.5-or-otherwise-broken): ... this.
  (%web-http): New variable.
  Monkey-patch 'make-chunked-input-port' when %WEB-HTTP defines
  'read-chunk-body'.
This commit is contained in:
Ludovic Courtès 2015-03-03 22:26:52 +01:00
parent c28606bd1d
commit 776463ba9f
1 changed files with 10 additions and 2 deletions

View File

@ -55,7 +55,7 @@
(reason http-get-error-reason)) ; string (reason http-get-error-reason)) ; string
(define-syntax when-guile<=2.0.5 (define-syntax when-guile<=2.0.5-or-otherwise-broken
(lambda (s) (lambda (s)
(syntax-case s () (syntax-case s ()
((_ body ...) ((_ body ...)
@ -64,12 +64,15 @@
;; when using "guix pull". ;; when using "guix pull".
#'(begin body ...))))) #'(begin body ...)))))
(when-guile<=2.0.5 (when-guile<=2.0.5-or-otherwise-broken
;; Backport of Guile commits 312e79f8 ("Add HTTP Chunked Encoding support to ;; Backport of Guile commits 312e79f8 ("Add HTTP Chunked Encoding support to
;; web modules.") and 00d3ecf2 ("http: Do not buffer HTTP chunks.") ;; web modules.") and 00d3ecf2 ("http: Do not buffer HTTP chunks.")
(use-modules (ice-9 rdelim)) (use-modules (ice-9 rdelim))
(define %web-http
(resolve-module '(web http)))
;; Chunked Responses ;; Chunked Responses
(define (read-chunk-header port) (define (read-chunk-header port)
(let* ((str (read-line port)) (let* ((str (read-line port))
@ -127,6 +130,11 @@ closed it will also close PORT, unless the KEEP-ALIVE? is true."
(make-custom-binary-input-port "chunked input port" read! #f #f close)) (make-custom-binary-input-port "chunked input port" read! #f #f close))
;; Chunked encoding support in Guile <= 2.0.11 would load whole chunks in
;; memory---see <http://bugs.gnu.org/19939>.
(when (module-variable %web-http 'read-chunk-body)
(module-set! %web-http 'make-chunked-input-port make-chunked-input-port))
(define (read-response-body* r) (define (read-response-body* r)
"Reads the response body from @var{r}, as a bytevector. Returns "Reads the response body from @var{r}, as a bytevector. Returns
@code{#f} if there was no response body." @code{#f} if there was no response body."