mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
http-client: 'http-fetch' and 'http-fetch/cached' accept #:timeout.
* guix/http-client.scm (http-fetch): Add #:timeout and pass it to 'guix:open-connection-for-uri'. (http-fetch/cached): Add #:timeout parameter and pass it to 'http-fetch'.
This commit is contained in:
parent
6c46e477eb
commit
d11f7f62b6
1 changed files with 13 additions and 5 deletions
|
@ -71,7 +71,8 @@ (define-condition-type &http-get-error &error
|
|||
|
||||
(define* (http-fetch uri #:key port (text? #f) (buffered? #t)
|
||||
(verify-certificate? #t)
|
||||
(headers '((user-agent . "GNU Guile"))))
|
||||
(headers '((user-agent . "GNU Guile")))
|
||||
timeout)
|
||||
"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
|
||||
textual. Follow any HTTP redirection. When BUFFERED? is #f, return an
|
||||
|
@ -80,13 +81,17 @@ (define* (http-fetch uri #:key port (text? #f) (buffered? #t)
|
|||
|
||||
When VERIFY-CERTIFICATE? is true, verify HTTPS server certificates.
|
||||
|
||||
TIMEOUT specifies the timeout in seconds for connection establishment; when
|
||||
TIMEOUT is #f, connection establishment never times out.
|
||||
|
||||
Raise an '&http-get-error' condition if downloading fails."
|
||||
(let loop ((uri (if (string? uri)
|
||||
(string->uri uri)
|
||||
uri)))
|
||||
(let ((port (or port (guix:open-connection-for-uri uri
|
||||
#:verify-certificate?
|
||||
verify-certificate?)))
|
||||
verify-certificate?
|
||||
#:timeout timeout)))
|
||||
(headers (match (uri-userinfo uri)
|
||||
((? string? str)
|
||||
(cons (cons 'Authorization
|
||||
|
@ -155,13 +160,16 @@ (define (cache-file-for-uri uri)
|
|||
|
||||
(define* (http-fetch/cached uri #:key (ttl (%http-cache-ttl)) text?
|
||||
(write-cache dump-port)
|
||||
(cache-miss (const #t)))
|
||||
(cache-miss (const #t))
|
||||
(timeout 10))
|
||||
"Like 'http-fetch', return an input port, but cache its contents in
|
||||
~/.cache/guix. The cache remains valid for TTL seconds.
|
||||
|
||||
Call WRITE-CACHE with the HTTP input port and the cache output port to write
|
||||
the data to cache. Call CACHE-MISS with URI just before fetching data from
|
||||
URI."
|
||||
URI.
|
||||
|
||||
TIMEOUT specifies the timeout in seconds for connection establishment."
|
||||
(let ((file (cache-file-for-uri uri)))
|
||||
(define (update-cache cache-port)
|
||||
(define cache-time
|
||||
|
@ -183,7 +191,7 @@ (define headers
|
|||
cache-port)
|
||||
(raise c))))
|
||||
(let ((port (http-fetch uri #:text? text?
|
||||
#:headers headers)))
|
||||
#:headers headers #:timeout timeout)))
|
||||
(cache-miss uri)
|
||||
(mkdir-p (dirname file))
|
||||
(when cache-port
|
||||
|
|
Loading…
Reference in a new issue