amaharaneko/guix-mirrors
1
1
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2025-10-02 02:15:12 +00: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
Download patch file Download diff file Expand all files Collapse all files

11
guix/http-client.scm
View file

@ -79,6 +79,7 @@
(keep-alive? #f) (keep-alive? #f)
(verify-certificate? #t) (verify-certificate? #t)
(headers '((user-agent . "GNU Guile"))) (headers '((user-agent . "GNU Guile")))
(log-port (current-error-port))
timeout) 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
@ -94,6 +95,8 @@ When VERIFY-CERTIFICATE? is true, verify HTTPS server certificates.
TIMEOUT specifies the timeout in seconds for connection establishment; when TIMEOUT specifies the timeout in seconds for connection establishment; when
TIMEOUT is #f, connection establishment never times out. TIMEOUT is #f, connection establishment never times out.
Write information about redirects to LOG-PORT.
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)
@ -128,7 +131,7 @@ Raise an '&http-get-error' condition if downloading fails."
308) ; permanent redirection 308) ; permanent redirection
(let ((uri (resolve-uri-reference (response-location resp) uri))) (let ((uri (resolve-uri-reference (response-location resp) uri)))
(close-port port) (close-port port)
(format (current-error-port) (G_ "following redirection to `~a'...~%") (format log-port (G_ "following redirection to `~a'...~%")
(uri->string uri)) (uri->string uri))
(loop uri))) (loop uri)))
(else (else
@ -276,6 +279,7 @@ returning."
(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))
(log-port (current-error-port))
(timeout 10)) (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.
@ -284,7 +288,9 @@ 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." TIMEOUT specifies the timeout in seconds for connection establishment.
Write information about redirects to LOG-PORT."
(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
@ -306,6 +312,7 @@ TIMEOUT specifies the timeout in seconds for connection establishment."
cache-port) cache-port)
(raise c)))) (raise c))))
(let ((port (http-fetch uri #:text? text? (let ((port (http-fetch uri #:text? text?
#:log-port log-port
#:headers headers #:timeout timeout))) #:headers headers #:timeout timeout)))
(cache-miss uri) (cache-miss uri)
(mkdir-p (dirname file)) (mkdir-p (dirname file))