From dbfc6a32bb60d2841e300c99e1b39c87254ece1d Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 17 Mar 2021 15:04:56 +0100 Subject: http-client: 'http-fetch' and 'http-fetch/cached' accept #:log-port. * guix/http-client.scm (http-fetch, http-fetch/cached): Add #:log-port and honor it. --- guix/http-client.scm | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) (limited to 'guix/http-client.scm') diff --git a/guix/http-client.scm b/guix/http-client.scm index 2d7458a56e..4b4c14ed0b 100644 --- a/guix/http-client.scm +++ b/guix/http-client.scm @@ -79,6 +79,7 @@ (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 @@ 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. +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 @@ Raise an '&http-get-error' condition if downloading fails." 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 @@ returning." (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 @@ 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. -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 @@ TIMEOUT specifies the timeout in seconds for connection establishment." 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)) -- cgit v1.2.3