mirror/guix
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2025-01-19 22:16:32 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

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

Browse source 
* guix/http-client.scm (http-fetch, http-fetch/cached): Add #:log-port
and honor it.
This commit is contained in:
Ludovic Courtès 2021-03-17 15:04:56 +01:00
parent c81eeabb99
commit dbfc6a32bb
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 9 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
guix/http-client.scm
View file

@ -79,6 +79,7 @@ (define* (http-fetch uri #:key port (text? #f) (buffered? #t)
(keep-alive? #f)
(verify-certificate? #t)
(headers '((user-agent . "GNU Guile")))
(log-port (current-error-port))
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
@ -94,6 +95,8 @@ (define* (http-fetch uri #:key port (text? #f) (buffered? #t)
TIMEOUT specifies the timeout in seconds for connection establishment; when
TIMEOUT is #f, connection establishment never times out.
Write information about redirects to LOG-PORT.
Raise an '&http-get-error' condition if downloading fails."
(let loop ((uri (if (string? uri)
(string->uri uri)
@ -128,7 +131,7 @@ (define* (http-fetch uri #:key port (text? #f) (buffered? #t)
308) ; permanent redirection
(let ((uri (resolve-uri-reference (response-location resp) uri)))
(close-port port)
(format (current-error-port) (G_ "following redirection to `~a'...~%")
(format log-port (G_ "following redirection to `~a'...~%")
(uri->string uri))
(loop uri)))
(else
@ -276,6 +279,7 @@ (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))
(log-port (current-error-port))
(timeout 10))
"Like 'http-fetch', return an input port, but cache its contents in
~/.cache/guix. The cache remains valid for TTL seconds.
@ -284,7 +288,9 @@ (define* (http-fetch/cached uri #:key (ttl (%http-cache-ttl)) text?
the data to cache. Call CACHE-MISS with URI just before fetching data from
URI.
TIMEOUT specifies the timeout in seconds for connection establishment."
TIMEOUT specifies the timeout in seconds for connection establishment.
Write information about redirects to LOG-PORT."
(let ((file (cache-file-for-uri uri)))
(define (update-cache cache-port)
(define cache-time
@ -306,6 +312,7 @@ (define headers
cache-port)
(raise c))))
(let ((port (http-fetch uri #:text? text?
#:log-port log-port
#:headers headers #:timeout timeout)))
(cache-miss uri)
(mkdir-p (dirname file))