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

substitute: Make room for a 'ttl' field in cached entries. 

* guix/scripts/substitute.scm (cached-narinfo): Expect 'narinfo' sexp
version 2 with a 'ttl' field.
(cache-narinfo!)[cache-entry]: Produce 'narinfo' sexp version 2 with a
'ttl' field.
(remove-expired-cached-narinfos)[expired?]: Read 'narinfo' sexp version 2.
This commit is contained in:
Ludovic Courtès 2016-03-16 14:51:37 +01:00
parent 81b55bf7a9
commit 1cf7e31898
1 changed files with 12 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
guix/scripts/substitute.scm
View File

@ -452,18 +452,18 @@ for PATH."
(call-with-input-file cache-file (call-with-input-file cache-file
(lambda (p) (lambda (p)
(match (read p) (match (read p)
(('narinfo ('version 1) (('narinfo ('version 2)
('cache-uri cache-uri) ('cache-uri cache-uri)
('date date) ('value #f)) ('date date) ('ttl _) ('value #f))
;; A cached negative lookup. ;; A cached negative lookup.
(if (obsolete? date now %narinfo-negative-ttl) (if (obsolete? date now %narinfo-negative-ttl)
(values #f #f) (values #f #f)
(values #t #f))) (values #t #f)))
(('narinfo ('version 1) (('narinfo ('version 2)
('cache-uri cache-uri) ('cache-uri cache-uri)
('date date) ('value value)) ('date date) ('ttl ttl) ('value value))
;; A cached positive lookup ;; A cached positive lookup
(if (obsolete? date now %narinfo-ttl) (if (obsolete? date now ttl)
(values #f #f) (values #f #f)
(values #t (string->narinfo value cache-uri)))) (values #t (string->narinfo value cache-uri))))
(('narinfo ('version v) _ ...) (('narinfo ('version v) _ ...)
@ -478,9 +478,10 @@ may be #f, in which case it indicates that PATH is unavailable at CACHE-URL."
(current-time time-monotonic)) (current-time time-monotonic))
(define (cache-entry cache-uri narinfo) (define (cache-entry cache-uri narinfo)
`(narinfo (version 1) `(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.
(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)))
@ -704,12 +705,12 @@ indefinitely."
(call-with-input-file file (call-with-input-file file
(lambda (port) (lambda (port)
(match (read port) (match (read port)
(('narinfo ('version 1) ('cache-uri _) ('date date) (('narinfo ('version 2) ('cache-uri _)
('value #f)) ('date date) ('ttl _) ('value #f))
(obsolete? date now %narinfo-negative-ttl)) (obsolete? date now %narinfo-negative-ttl))
(('narinfo ('version 1) ('cache-uri _) ('date date) (('narinfo ('version 2) ('cache-uri _)
('value _)) ('date date) ('ttl ttl) ('value _))
(obsolete? date now %narinfo-ttl)) (obsolete? date now ttl))
(_ #t))))) (_ #t)))))
(lambda args (lambda args
;; FILE may have been deleted. ;; FILE may have been deleted.