me/guix
Archived
1
0
Fork 0
Code Activity

http-client: Accept '#:headers' in 'http-fetched/cached'.

Browse source 
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>
This commit is contained in:
Philip McGrath 2022-05-18 14:10:53 -04:00 • committed by Ludovic Courtès
parent dce724dc82
commit 00a5a07bb2
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 12 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

19
guix/http-client.scm
View file

@ -296,6 +296,7 @@ returning."
#f #f base64url-alphabet)))) #f #f base64url-alphabet))))
(define* (http-fetch/cached uri #:key (ttl (%http-cache-ttl)) text? (define* (http-fetch/cached uri #:key (ttl (%http-cache-ttl)) text?
(headers '((user-agent . "GNU Guile")))
(write-cache dump-port) (write-cache dump-port)
(cache-miss (const #t)) (cache-miss (const #t))
(log-port (current-error-port)) (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 the data to cache. Call CACHE-MISS with URI just before fetching data from
URI. 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. TIMEOUT specifies the timeout in seconds for connection establishment.
Write information about redirects to LOG-PORT." Write information about redirects to LOG-PORT."
@ -316,12 +320,12 @@ Write information about redirects to LOG-PORT."
(and cache-port (and cache-port
(stat:mtime (stat cache-port)))) (stat:mtime (stat cache-port))))
(define headers (define extended-headers
`((user-agent . "GNU Guile") (if cache-time
,@(if cache-time `((if-modified-since
`((if-modified-since . ,(time-utc->date (make-time time-utc 0 cache-time)))
. ,(time-utc->date (make-time time-utc 0 cache-time)))) ,@headers)
'()))) headers))
;; Update the cache and return an input port. ;; Update the cache and return an input port.
(guard (c ((http-get-error? c) (guard (c ((http-get-error? c)
@ -332,7 +336,8 @@ Write information about redirects to LOG-PORT."
(raise c)))) (raise c))))
(let ((port (http-fetch uri #:text? text? (let ((port (http-fetch uri #:text? text?
#:log-port log-port #:log-port log-port
#:headers headers #:timeout timeout))) #:headers extended-headers
#:timeout timeout)))
(cache-miss uri) (cache-miss uri)
(mkdir-p (dirname file)) (mkdir-p (dirname file))
(when cache-port (when cache-port