From c95644f0172ba87822ee7ecee3d2743ebd2c84bc Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Fri, 21 Jul 2017 17:02:19 +0200
Subject: [PATCH] publish: Make the cache eviction policy less aggressive.
Suggested by Mark H Weaver <mhw@netris.org>.
* guix/scripts/publish.scm (nar-expiration-time): New procedure.
(render-narinfo/cached): Use it as the #:entry-expiration passed to
'maybe-remove-expired-cache-entries'.
---
doc/guix.texi | 3 ++-
guix/scripts/publish.scm | 20 +++++++++++++++++++-
2 files changed, 21 insertions(+), 2 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index dbdd9b5ff52..875c1ffa263 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -6960,7 +6960,8 @@ guarantee that the store items it provides will indeed remain available
for as long as @var{ttl}.
Additionally, when @option{--cache} is used, cached entries that have
-not been accessed for @var{ttl} may be deleted.
+not been accessed for @var{ttl} and that no longer have a corresponding
+item in the store, may be deleted.
@item --nar-path=@var{path}
Use @var{path} as the prefix for the URLs of ``nar'' files
diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index cd57b13dc35..ade3c49a543 100644
--- a/guix/scripts/publish.scm
+++ b/guix/scripts/publish.scm
@@ -385,6 +385,24 @@ (define (narinfo-files cache)
(string-suffix? ".narinfo" file)))
'()))
+(define (nar-expiration-time ttl)
+ "Return the narinfo expiration time (in seconds since the Epoch). The
+expiration time is +inf.0 when passed an item that is still in the store; in
+other cases, it is the last-access time of the item plus TTL.
+
+This policy allows us to keep cached nars that correspond to valid store
+items. Failing that, we could eventually have to recompute them and return
+404 in the meantime."
+ (let ((expiration-time (file-expiration-time ttl)))
+ (lambda (file)
+ (let ((item (string-append (%store-prefix) "/"
+ (basename file ".narinfo"))))
+ ;; Note: We don't need to use 'valid-path?' here because FILE would
+ ;; not exist if ITEM were not valid in the first place.
+ (if (file-exists? item)
+ +inf.0
+ (expiration-time file))))))
+
(define* (render-narinfo/cached store request hash
#:key ttl (compression %no-compression)
(nar-path "nar")
@@ -436,7 +454,7 @@ (define (delete-entry narinfo)
(maybe-remove-expired-cache-entries cache
narinfo-files
#:entry-expiration
- (file-expiration-time ttl)
+ (nar-expiration-time ttl)
#:delete-entry delete-entry
#:cleanup-period ttl))))
(not-found request
--
GitLab