me/guix
Archived
1
0
Fork 0
Code Activity

http-client: 'http-fetch' and 'http-fetch/cached' accept #:timeout.

Browse source 
* 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:
Ludovic Courtès 2020-10-12 11:19:32 +02:00
parent 6c46e477eb
commit d11f7f62b6
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 13 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

18
guix/http-client.scm
View file

@ -71,7 +71,8 @@
(define* (http-fetch uri #:key port (text? #f) (buffered? #t) (define* (http-fetch uri #:key port (text? #f) (buffered? #t)
(verify-certificate? #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 "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 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 textual. Follow any HTTP redirection. When BUFFERED? is #f, return an
@ -80,13 +81,17 @@ extra HTTP headers.
When VERIFY-CERTIFICATE? is true, verify HTTPS server certificates. 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." Raise an '&http-get-error' condition if downloading fails."
(let loop ((uri (if (string? uri) (let loop ((uri (if (string? uri)
(string->uri uri) (string->uri uri)
uri))) uri)))
(let ((port (or port (guix:open-connection-for-uri uri (let ((port (or port (guix:open-connection-for-uri uri
#:verify-certificate? #:verify-certificate?
verify-certificate?))) verify-certificate?
#:timeout timeout)))
(headers (match (uri-userinfo uri) (headers (match (uri-userinfo uri)
((? string? str) ((? string? str)
(cons (cons 'Authorization (cons (cons 'Authorization
@ -155,13 +160,16 @@ Raise an '&http-get-error' condition if downloading fails."
(define* (http-fetch/cached uri #:key (ttl (%http-cache-ttl)) text? (define* (http-fetch/cached uri #:key (ttl (%http-cache-ttl)) text?
(write-cache dump-port) (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 "Like 'http-fetch', return an input port, but cache its contents in
~/.cache/guix. The cache remains valid for TTL seconds. ~/.cache/guix. The cache remains valid for TTL seconds.
Call WRITE-CACHE with the HTTP input port and the cache output port to write 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 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))) (let ((file (cache-file-for-uri uri)))
(define (update-cache cache-port) (define (update-cache cache-port)
(define cache-time (define cache-time
@ -183,7 +191,7 @@ URI."
cache-port) cache-port)
(raise c)))) (raise c))))
(let ((port (http-fetch uri #:text? text? (let ((port (http-fetch uri #:text? text?
#:headers headers))) #:headers headers #:timeout timeout)))
(cache-miss uri) (cache-miss uri)
(mkdir-p (dirname file)) (mkdir-p (dirname file))
(when cache-port (when cache-port