diff options
| -rw-r--r-- | guix/http-client.scm | 41 |
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." |