summaryrefslogtreecommitdiff
path: root/guix/http-client.scm
diff options
context:
space:
mode:
authorMark H Weaver <mhw@netris.org>2015-06-10 17:50:27 -0400
committerMark H Weaver <mhw@netris.org>2015-06-10 17:50:27 -0400
commit14928016556300a6763334d4279c3d117902caaf (patch)
treed0dc262b14164b82f97dd6e896ca9e93a1fabeea /guix/http-client.scm
parent1511e0235525358abb52cf62abeb9457605b5093 (diff)
parent57cd353d87d6e9e6e882327be70b4d7b5ce863ba (diff)
Merge branch 'master' into core-updates
Diffstat (limited to 'guix/http-client.scm')
-rw-r--r--guix/http-client.scm93
1 files changed, 12 insertions, 81 deletions
diff --git a/guix/http-client.scm b/guix/http-client.scm
index 3bffbb1c24..dc8d3298fc 100644
--- a/guix/http-client.scm
+++ b/guix/http-client.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2012, 2015 Free Software Foundation, Inc.
;;;
@@ -21,7 +21,7 @@
(define-module (guix http-client)
#:use-module (guix utils)
#:use-module (web uri)
- #:use-module (web client)
+ #:use-module ((web client) #:hide (open-socket-for-uri))
#:use-module (web response)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-34)
@@ -30,14 +30,15 @@
#:use-module (rnrs bytevectors)
#:use-module (guix ui)
#:use-module (guix utils)
- #:use-module ((guix build download) #:select (resolve-uri-reference))
+ #:use-module ((guix build download)
+ #:select (open-socket-for-uri resolve-uri-reference))
+ #:re-export (open-socket-for-uri)
#:export (&http-get-error
http-get-error?
http-get-error-uri
http-get-error-code
http-get-error-reason
- open-socket-for-uri
http-fetch))
;;; Commentary:
@@ -174,59 +175,13 @@ 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.
(module-define! (resolve-module '(web client))
'shutdown (const #f))
-(define* (open-socket-for-uri uri #:key (buffered? #t))
- "Return an open port for URI. When BUFFERED? is false, the returned port is
-unbuffered."
- (define rmem-max
- ;; The maximum size for a receive buffer on Linux, see socket(7).
- "/proc/sys/net/core/rmem_max")
-
- (define buffer-size
- (if (file-exists? rmem-max)
- (call-with-input-file rmem-max read)
- 126976)) ; the default for Linux, per 'rmem_default'
-
- (let ((s ((@ (web client) open-socket-for-uri) uri)))
- ;; Work around <http://bugs.gnu.org/15368> by restoring a decent
- ;; buffer size.
- (setsockopt s SOL_SOCKET SO_RCVBUF buffer-size)
- (unless buffered?
- (setvbuf s _IONBF))
- s))
-
(define* (http-fetch uri #:key port (text? #f) (buffered? #t))
"Return an input port containing the data at URI, and the expected number of
bytes available or #f. If TEXT? is true, the data at URI is considered to be
@@ -235,44 +190,20 @@ unbuffered port, suitable for use in `filtered-port'.
Raise an '&http-get-error' condition if downloading fails."
(let loop ((uri uri))
- (let ((port (or port
- (open-socket-for-uri uri
- #:buffered? buffered?))))
+ (let ((port (or port (open-socket-for-uri uri))))
+ (unless buffered?
+ (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)))