diff options
author | Ludovic Courtès <ludo@gnu.org> | 2017-09-19 11:49:29 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2017-09-19 12:19:15 +0200 |
commit | 3ce1b9021a1244063bf800e9d68763f12234edd5 (patch) | |
tree | 72275a651f8aaeac508c405a5287177f8d14f23f /guix/http-client.scm | |
parent | 82781d871f8753737448c562b3906b2a7f89581c (diff) | |
download | gnu-guix-3ce1b9021a1244063bf800e9d68763f12234edd5.tar gnu-guix-3ce1b9021a1244063bf800e9d68763f12234edd5.tar.gz |
http-client: 'http-client/cached' uses 'If-Modified-Since'.
* guix/http-client.scm (http-fetch/cached)[update-cache]: Add
'cache-port' parameter. Check its mtime and compute 'if-modified-since'
header accordingly. Guard 'http-get-error?' and honor 304.
Adjust callers of 'update-cache'.
* guix/gnu-maintenance.scm (ftp.gnu.org-files): Set #:ttl to 15m.
Diffstat (limited to 'guix/http-client.scm')
-rw-r--r-- | guix/http-client.scm | 38 |
1 files changed, 27 insertions, 11 deletions
diff --git a/guix/http-client.scm b/guix/http-client.scm index 5c9342c218..853bba4fe3 100644 --- a/guix/http-client.scm +++ b/guix/http-client.scm @@ -306,14 +306,32 @@ Raise an '&http-get-error' condition if downloading fails." "Like 'http-fetch', return an input port, but cache its contents in ~/.cache/guix. The cache remains valid for TTL seconds." (let ((file (cache-file-for-uri uri))) - (define (update-cache) + (define (update-cache cache-port) + (define cache-time + (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)))) + '()))) + ;; Update the cache and return an input port. - (let ((port (http-fetch uri #:text? text?))) - (mkdir-p (dirname file)) - (with-atomic-file-output file - (cut dump-port port <>)) - (close-port port) - (open-input-file file))) + (guard (c ((http-get-error? c) + (if (= 304 (http-get-error-code c)) ;"Not Modified" + cache-port + (raise c)))) + (let ((port (http-fetch uri #:text? text? + #:headers headers))) + (mkdir-p (dirname file)) + (when cache-port + (close-port cache-port)) + (with-atomic-file-output file + (cut dump-port port <>)) + (close-port port) + (open-input-file file)))) (define (old? port) ;; Return true if PORT has passed TTL. @@ -325,13 +343,11 @@ Raise an '&http-get-error' condition if downloading fails." (lambda () (let ((port (open-input-file file))) (if (old? port) - (begin - (close-port port) - (update-cache)) + (update-cache port) port))) (lambda args (if (= ENOENT (system-error-errno args)) - (update-cache) + (update-cache #f) (apply throw args)))))) ;;; http-client.scm ends here |