summaryrefslogtreecommitdiff
path: root/guix/http-client.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-03-03 22:09:30 +0100
committerLudovic Courtès <ludo@gnu.org>2015-03-03 22:58:45 +0100
commitc28606bd1daa08c8e3e0483894bf37963b34a4e2 (patch)
treeea8f3e899b6793a2502494efdd769dafe5cb7c18 /guix/http-client.scm
parent41ce4601337c66301b80cff2a640c428efb64973 (diff)
downloadgnu-guix-c28606bd1daa08c8e3e0483894bf37963b34a4e2.tar
gnu-guix-c28606bd1daa08c8e3e0483894bf37963b34a4e2.tar.gz
http-client: Update backport of chunked encoding support to Guile 2.0.5.
* guix/http-client.scm (read-chunk, read-chunk-body) [when-guile<=2.0.5]: Remove. (make-chunked-input-port) [when-guile<=2.0.5]: Update to Guile commit 00d3ecf2.
Diffstat (limited to 'guix/http-client.scm')
-rw-r--r--guix/http-client.scm69
1 files changed, 33 insertions, 36 deletions
diff --git a/guix/http-client.scm b/guix/http-client.scm
index aad7656e19..6d6af5603d 100644
--- a/guix/http-client.scm
+++ b/guix/http-client.scm
@@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
-;;; Copyright © 2012 Free Software Foundation, Inc.
+;;; Copyright © 2012, 2015 Free Software Foundation, Inc.
;;;
;;; This file is part of GNU Guix.
;;;
@@ -65,8 +65,8 @@
#'(begin body ...)))))
(when-guile<=2.0.5
- ;; Backport of Guile commit 312e79f8 ("Add HTTP Chunked Encoding support to
- ;; web modules.").
+ ;; Backport of Guile commits 312e79f8 ("Add HTTP Chunked Encoding support to
+ ;; web modules.") and 00d3ecf2 ("http: Do not buffer HTTP chunks.")
(use-modules (ice-9 rdelim))
@@ -81,53 +81,50 @@
16)))
size))
- (define (read-chunk port)
- (let ((size (read-chunk-header port)))
- (read-chunk-body port size)))
-
- (define (read-chunk-body port size)
- (let ((bv (get-bytevector-n port size)))
- (get-u8 port) ; CR
- (get-u8 port) ; LF
- bv))
-
(define* (make-chunked-input-port port #:key (keep-alive? #f))
"Returns a new port which translates HTTP chunked transfer encoded
data from PORT into a non-encoded format. Returns eof when it has
read the final chunk from PORT. This does not necessarily mean
that there is no more data on PORT. When the returned port is
closed it will also close PORT, unless the KEEP-ALIVE? is true."
- (define (next-chunk)
- (read-chunk port))
- (define finished? #f)
(define (close)
(unless keep-alive?
(close-port port)))
- (define buffer #vu8())
- (define buffer-size 0)
- (define buffer-pointer 0)
+
+ (define chunk-size 0) ;size of the current chunk
+ (define remaining 0) ;number of bytes left from the current chunk
+ (define finished? #f) ;did we get all the chunks?
+
(define (read! bv idx to-read)
(define (loop to-read num-read)
(cond ((or finished? (zero? to-read))
num-read)
- ((<= to-read (- buffer-size buffer-pointer))
- (bytevector-copy! buffer buffer-pointer
- bv (+ idx num-read)
- to-read)
- (set! buffer-pointer (+ buffer-pointer to-read))
- (loop 0 (+ num-read to-read)))
- (else
- (let ((n (- buffer-size buffer-pointer)))
- (bytevector-copy! buffer buffer-pointer
- bv (+ idx num-read)
- n)
- (set! buffer (next-chunk))
- (set! buffer-pointer 0)
- (set! buffer-size (bytevector-length buffer))
- (set! finished? (= buffer-size 0))
- (loop (- to-read n)
- (+ num-read n))))))
+ ((zero? remaining) ;get a new chunk
+ (let ((size (read-chunk-header port)))
+ (set! chunk-size size)
+ (set! remaining size)
+ (if (zero? size)
+ (begin
+ (set! finished? #t)
+ num-read)
+ (loop to-read num-read))))
+ (else ;read from the current chunk
+ (let* ((ask-for (min to-read remaining))
+ (read (get-bytevector-n! port bv (+ idx num-read)
+ ask-for)))
+ (if (eof-object? read)
+ (begin ;premature termination
+ (set! finished? #t)
+ num-read)
+ (let ((left (- remaining read)))
+ (set! remaining left)
+ (when (zero? left)
+ ;; We're done with this chunk; read CR and LF.
+ (get-u8 port) (get-u8 port))
+ (loop (- to-read read)
+ (+ num-read read))))))))
(loop to-read 0))
+
(make-custom-binary-input-port "chunked input port" read! #f #f close))
(define (read-response-body* r)