07/07: publish: Make the cache eviction policy less aggressive.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit c95644f0172ba87822ee7ecee3d2743ebd2c84bc
Author: Ludovic Courtès <address@hidden>
Date:   Fri Jul 21 17:02:19 2017 +0200

    publish: Make the cache eviction policy less aggressive.
    
    Suggested by Mark H Weaver <address@hidden>.
    
    * 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 dbdd9b5..875c1ff 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 address@hidden
 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 cd57b13..ade3c49 100644
--- a/guix/scripts/publish.scm
+++ b/guix/scripts/publish.scm
@@ -385,6 +385,24 @@ at a time."
                     (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 @@ requested using POOL."
                  (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