diff options
| author | Philip McGrath <philip@philipmcgrath.com> | 2022-05-18 14:10:53 -0400 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2022-05-22 01:07:52 +0200 |
| commit | 00a5a07bb2af8b46169944ba772ad46d4e6e9172 (patch) | |
| tree | 9575df0f40a89a980c9755a8968c73f21de91420 | |
| parent | dce724dc82c4ec4b55288b539e23239eb9677350 (diff) | |
http-client: Accept '#:headers' in 'http-fetched/cached'.
Callers can supply alternative headers as with 'http-fetch'.
* guix/http-client.scm (http-fetch/cached): Add '#:headers' argument.
Signed-off-by: Ludovic Courtès <ludo@gnu.org>
| -rw-r--r-- | guix/http-client.scm | 19 |
1 files changed, 12 insertions, 7 deletions
diff --git a/guix/http-client.scm b/guix/http-client.scm index a367c41afa..699f5dfd57 100644 --- a/guix/http-client.scm +++ b/guix/http-client.scm @@ -296,6 +296,7 @@ returning." #f #f base64url-alphabet)))) (define* (http-fetch/cached uri #:key (ttl (%http-cache-ttl)) text? + (headers '((user-agent . "GNU Guile"))) (write-cache dump-port) (cache-miss (const #t)) (log-port (current-error-port)) @@ -307,6 +308,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. +HEADERS is an alist of extra HTTP headers, to which cache-related headers are +added automatically as appropriate. + TIMEOUT specifies the timeout in seconds for connection establishment. Write information about redirects to LOG-PORT." @@ -316,12 +320,12 @@ Write information about redirects to LOG-PORT." (and cache-port (stat:mtime (stat cache-port)))) - (define headers - `((user-agent . "GNU Guile") - ,@(if cache-time - `((if-modified-since - . ,(time-utc->date (make-time time-utc 0 cache-time)))) - '()))) + (define extended-headers + (if cache-time + `((if-modified-since + . ,(time-utc->date (make-time time-utc 0 cache-time))) + ,@headers) + headers)) ;; Update the cache and return an input port. (guard (c ((http-get-error? c) @@ -332,7 +336,8 @@ Write information about redirects to LOG-PORT." (raise c)))) (let ((port (http-fetch uri #:text? text? #:log-port log-port - #:headers headers #:timeout timeout))) + #:headers extended-headers + #:timeout timeout))) (cache-miss uri) (mkdir-p (dirname file)) (when cache-port |