From 1cf7e31898ba444c7c1614aa5d5680806b60442a Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 16 Mar 2016 14:51:37 +0100 Subject: 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. --- guix/scripts/substitute.scm | 23 ++++++++++++----------- 1 file 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 @@ (define cache-file (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 @@ (define now (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 @@ (define (expired? file) (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. -- cgit v1.2.3