me
/
guix
Archived
1
0
Fork 0

http-client: Remove monkey patching for 2.0.5.

* guix/http-client.scm (read-response-body*): Remove.
  (http-fetch): Remove hacks for 2.0.5.
master
Ludovic Courtès 2015-05-07 21:51:12 +02:00
parent 09d809db6a
commit 005c8fc6e0
1 changed files with 4 additions and 54 deletions

View File

@ -175,33 +175,7 @@ closes PORT, unless KEEP-ALIVE? is true."
;; 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."
(define bad-response
(@@ (web response) bad-response))
(if (member '(chunked) (response-transfer-encoding r))
(let ((chunk-port (make-chunked-input-port (response-port r)
#:keep-alive? #t)))
(get-bytevector-all chunk-port))
(let ((nbytes (response-content-length r)))
;; Backport of Guile commit 84dfde82ae8f6ec247c1c147c1e2ae50b207bad9
;; ("fix response-body-port for responses without content-length").
(if nbytes
(let ((bv (get-bytevector-n (response-port r) nbytes)))
(if (= (bytevector-length bv) nbytes)
bv
(bad-response "EOF while reading response body: ~a bytes of ~a"
(bytevector-length bv) nbytes)))
(get-bytevector-all (response-port r))))))
;; Install this patch only on Guile 2.0.5.
(unless (guile-version>? "2.0.5")
(module-set! (resolve-module '(web response))
'read-response-body read-response-body*)))
'make-delimited-input-port make-delimited-input-port)))
;; XXX: Work around <http://bugs.gnu.org/13095>, present in Guile
;; up to 2.0.7.
@ -221,39 +195,15 @@ Raise an '&http-get-error' condition if downloading fails."
(setvbuf port _IONBF))
(let*-values (((resp data)
;; Try hard to use the API du jour to get an input port.
;; On Guile 2.0.5 and before, we can only get a string or
;; bytevector, and not an input port. Work around that.
(if (guile-version>? "2.0.7")
(http-get uri #:streaming? #t #:port port) ; 2.0.9+
(if (defined? 'http-get*)
(http-get* uri #:decode-body? text?
#:port port) ; 2.0.7
(http-get uri #:decode-body? text?
#:port port)))) ; 2.0.5-
(http-get* uri #:decode-body? text? ; 2.0.7
#:port port)))
((code)
(response-code resp)))
(case code
((200)
(let ((len (response-content-length resp)))
(cond ((not data)
(begin
;; Guile 2.0.5 and earlier did not support chunked
;; transfer encoding, which is required for instance when
;; fetching %PACKAGE-LIST-URL (see
;; <http://lists.gnu.org/archive/html/guile-devel/2011-09/msg00089.html>).
;; Normally the `when-guile<=2.0.5' block above fixes
;; that, but who knows what could happen.
(warning (_ "using Guile ~a, which does not support ~s encoding~%")
(version)
(response-transfer-encoding resp))
(leave (_ "download failed; use a newer Guile~%")
uri resp)))
((string? data) ; `http-get' from 2.0.5-
(values (open-input-string data) len))
((bytevector? data) ; likewise
(values (open-bytevector-input-port data) len))
(else ; input port
(values data len)))))
(values data (response-content-length resp)))
((301 ; moved permanently
302) ; found (redirection)
(let ((uri (resolve-uri-reference (response-location resp) uri)))