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.
This commit is contained in:
Ludovic Courtès 2017-09-19 11:49:29 +02:00
parent 82781d871f
commit 3ce1b9021a
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 30 additions and 12 deletions

View File

@ -454,7 +454,9 @@ hosted on ftp.gnu.org, or not under that name (this is the case for
(define (string->lines str)
(string-tokenize str (char-set-complement (char-set #\newline))))
(let ((port (http-fetch/cached %gnu-file-list-uri #:ttl (* 60 60))))
;; Since https://ftp.gnu.org honors 'If-Modified-Since', the hard-coded
;; TTL can be relatively short.
(let ((port (http-fetch/cached %gnu-file-list-uri #:ttl (* 15 60))))
(map trim-leading-components
(call-with-gzip-input-port port
(compose string->lines get-string-all))))))

View File

@ -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