aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2016-03-16 14:51:37 +0100
committerLudovic Courtès <ludo@gnu.org>2016-03-16 15:57:47 +0100
commit1cf7e31898ba444c7c1614aa5d5680806b60442a (patch)
treea91c109ad8d162caa6ca415fbcf27b37f2dd325b
parent81b55bf7a99de4e8fee224296bf654b0a96b493a (diff)
downloadpatches-1cf7e31898ba444c7c1614aa5d5680806b60442a.tar
patches-1cf7e31898ba444c7c1614aa5d5680806b60442a.tar.gz
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.
-rwxr-xr-xguix/scripts/substitute.scm23
1 files changed, 12 insertions, 11 deletions
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 524d453ffa..4b009d8c81 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -452,18 +452,18 @@ for PATH."
(call-with-input-file cache-file
(lambda (p)
(match (read p)
- (('narinfo ('version 1)
+ (('narinfo ('version 2)
('cache-uri cache-uri)
- ('date date) ('value #f))
+ ('date date) ('ttl _) ('value #f))
;; A cached negative lookup.
(if (obsolete? date now %narinfo-negative-ttl)
(values #f #f)
(values #t #f)))
- (('narinfo ('version 1)
+ (('narinfo ('version 2)
('cache-uri cache-uri)
- ('date date) ('value value))
+ ('date date) ('ttl ttl) ('value value))
;; A cached positive lookup
- (if (obsolete? date now %narinfo-ttl)
+ (if (obsolete? date now ttl)
(values #f #f)
(values #t (string->narinfo value cache-uri))))
(('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))
(define (cache-entry cache-uri narinfo)
- `(narinfo (version 1)
+ `(narinfo (version 2)
(cache-uri ,cache-uri)
(date ,(time-second now))
+ (ttl ,%narinfo-ttl) ;TODO: Make this per-entry.
(value ,(and=> narinfo narinfo->string))))
(let ((file (narinfo-cache-file cache-url path)))
@@ -704,12 +705,12 @@ indefinitely."
(call-with-input-file file
(lambda (port)
(match (read port)
- (('narinfo ('version 1) ('cache-uri _) ('date date)
- ('value #f))
+ (('narinfo ('version 2) ('cache-uri _)
+ ('date date) ('ttl _) ('value #f))
(obsolete? date now %narinfo-negative-ttl))
- (('narinfo ('version 1) ('cache-uri _) ('date date)
- ('value _))
- (obsolete? date now %narinfo-ttl))
+ (('narinfo ('version 2) ('cache-uri _)
+ ('date date) ('ttl ttl) ('value _))
+ (obsolete? date now ttl))
(_ #t)))))
(lambda args
;; FILE may have been deleted.