mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2025-01-11 13:49:23 -05:00
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:
parent
82781d871f
commit
3ce1b9021a
2 changed files with 30 additions and 12 deletions
|
@ -454,7 +454,9 @@ (define (trim-leading-components str)
|
|||
(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))))))
|
||||
|
|
|
@ -306,14 +306,32 @@ (define* (http-fetch/cached uri #:key (ttl (%http-cache-ttl)) text?)
|
|||
"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 @@ (define (old? port)
|
|||
(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
|
||||
|
|
Loading…
Reference in a new issue