nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

substitute: Honor the 'max-age' of 'Cache-Control' headers. 

This allows substitute servers to tell 'guix substitute' how long they
can cache narinfo lookups.

* guix/scripts/substitute.scm (cache-narinfo!): Add 'ttl' parameter.
[cache-entry]: Honor it.
(fetch-narinfos)[handle-narinfo-response]: Check the 'Cache-Control'
header of RESPONSE and pass its 'max-age' value to 'cache-narinfo!'.
This commit is contained in:
Ludovic Courtès 2016-03-16 15:31:18 +01:00
parent 1cf7e31898
commit 23d60ba65c
1 changed files with 13 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
guix/scripts/substitute.scm
View File

@ -108,9 +108,8 @@ disabled!~%"))
(define %narinfo-ttl (define %narinfo-ttl
;; Number of seconds during which cached narinfo lookups are considered ;; Number of seconds during which cached narinfo lookups are considered
;; valid. This is a reasonable default value (corresponds to the TTL for ;; valid for substitute servers that do not advertise a TTL via the
;; nginx's .nar cache on hydra.gnu.org) but we'd rather want publishers to ;; 'Cache-Control' response header.
;; state what their TTL is in /nix-cache-info. (XXX)
(* 36 3600)) (* 36 3600))
(define %narinfo-negative-ttl (define %narinfo-negative-ttl
@ -471,9 +470,10 @@ for PATH."
(lambda _ (lambda _
(values #f #f)))) (values #f #f))))
(define (cache-narinfo! cache-url path narinfo) (define (cache-narinfo! cache-url path narinfo ttl)
"Cache locally NARNIFO for PATH, which originates from CACHE-URL. NARINFO "Cache locally NARNIFO for PATH, which originates from CACHE-URL, with the
may be #f, in which case it indicates that PATH is unavailable at CACHE-URL." given TTL (a number of seconds or #f). NARINFO may be #f, in which case it
indicates that PATH is unavailable at CACHE-URL."
(define now (define now
(current-time time-monotonic)) (current-time time-monotonic))
@ -481,7 +481,8 @@ may be #f, in which case it indicates that PATH is unavailable at CACHE-URL."
`(narinfo (version 2) `(narinfo (version 2)
(cache-uri ,cache-uri) (cache-uri ,cache-uri)
(date ,(time-second now)) (date ,(time-second now))
(ttl ,%narinfo-ttl) ;TODO: Make this per-entry. (ttl ,(or ttl
(if narinfo %narinfo-ttl %narinfo-negative-ttl)))
(value ,(and=> narinfo narinfo->string)))) (value ,(and=> narinfo narinfo->string))))
(let ((file (narinfo-cache-file cache-url path))) (let ((file (narinfo-cache-file cache-url path)))
@ -584,13 +585,15 @@ if file doesn't exist, and the narinfo otherwise."
(set! done (+ 1 done))))) (set! done (+ 1 done)))))
(define (handle-narinfo-response request response port result) (define (handle-narinfo-response request response port result)
(let ((len (response-content-length response))) (let* ((len (response-content-length response))
(cache (response-cache-control response))
(ttl (and cache (assoc-ref cache 'max-age))))
;; Make sure to read no more than LEN bytes since subsequent bytes may ;; Make sure to read no more than LEN bytes since subsequent bytes may
;; belong to the next response. ;; belong to the next response.
(case (response-code response) (case (response-code response)
((200) ; hit ((200) ; hit
(let ((narinfo (read-narinfo port url #:size len))) (let ((narinfo (read-narinfo port url #:size len)))
(cache-narinfo! url (narinfo-path narinfo) narinfo) (cache-narinfo! url (narinfo-path narinfo) narinfo ttl)
(update-progress!) (update-progress!)
(cons narinfo result))) (cons narinfo result)))
((404) ; failure ((404) ; failure
@ -601,7 +604,7 @@ if file doesn't exist, and the narinfo otherwise."
(read-to-eof port)) (read-to-eof port))
(cache-narinfo! url (cache-narinfo! url
(find (cut string-contains <> hash-part) paths) (find (cut string-contains <> hash-part) paths)
#f) #f ttl)
(update-progress!) (update-progress!)
result)) result))
(else ; transient failure (else ; transient failure