diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2017-11-15 10:23:38 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2017-11-16 08:45:15 +0100 |
| commit | 7482b98120b5e3380129719f13254b90b18553b9 (patch) | |
| tree | c2f34e33f67eaecc831b57c852444d65b35c510c /guix/http-client.scm | |
| parent | 866f37fb7e4f3e0bd695a951071383cdff3da8cd (diff) | |
| download | gnu-guix-7482b98120b5e3380129719f13254b90b18553b9.tar gnu-guix-7482b98120b5e3380129719f13254b90b18553b9.tar.gz | |
cve: Use 'http-fetch/cached' instead of having custom caching.
That way CVE fetching benefits from 'If-Modified-Since' handling.
* guix/http-client.scm (http-fetch/cached): Add #:write-cache and
#:cache-miss parameters and honor them.
* guix/cve.scm (%current-year-ttl, %past-year-ttl): Reduce.
(call-with-cve-port): Remove.
(write-cache): New procedure.
(fetch-vulnerabilities): Rewrite in terms of 'http-fetch/cached'.
Diffstat (limited to 'guix/http-client.scm')
| -rw-r--r-- | guix/http-client.scm | 13 |
1 files changed, 10 insertions, 3 deletions
diff --git a/guix/http-client.scm b/guix/http-client.scm index 59788c1f38..bab31875d1 100644 --- a/guix/http-client.scm +++ b/guix/http-client.scm @@ -302,9 +302,15 @@ Raise an '&http-get-error' condition if downloading fails." (base64-encode digest 0 (bytevector-length digest) #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? + (write-cache dump-port) + (cache-miss (const #t))) "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. + +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." (let ((file (cache-file-for-uri uri))) (define (update-cache cache-port) (define cache-time @@ -327,11 +333,12 @@ Raise an '&http-get-error' condition if downloading fails." (raise c)))) (let ((port (http-fetch uri #:text? text? #:headers headers))) + (cache-miss uri) (mkdir-p (dirname file)) (when cache-port (close-port cache-port)) (with-atomic-file-output file - (cut dump-port port <>)) + (cut write-cache port <>)) (close-port port) (open-input-file file)))) |