02/17: substitute: Delete cached narinfos more than two-month old.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 3f5e14182931f123c10513a3e1e2abaebfb52279
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Wed May 31 23:02:16 2023 +0200

    substitute: Delete cached narinfos more than two-month old.
    
    This allows 'guix substitute' to shrink the cache a bit more, which
    saves space and improves performance of cache-cleanup phases since fewer
    entries need to be traversed.
    
    * guix/scripts/substitute.scm (cached-narinfo-expiration-time): Define
    'max-ttl' and use it as an upper bound.
---
 guix/scripts/substitute.scm | 9 +++++++--
 1 file changed, 7 insertions(+), 2 deletions(-)

diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 3626832dda..de7b77b0bf 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -167,6 +167,11 @@ was found."
 
 (define (cached-narinfo-expiration-time file)
   "Return the expiration time for FILE, which is a cached narinfo."
+  (define max-ttl
+    ;; Upper bound on the TTL used to avoid keeping around cached narinfos for
+    ;; too long, which makes the cache bigger and more expensive to traverse.
+    (* 2 30 24 60 60))                            ;2 months
+
   (catch 'system-error
     (lambda ()
       (call-with-input-file file
@@ -174,10 +179,10 @@ was found."
           (match (read port)
             (('narinfo ('version 2) ('cache-uri uri)
                        ('date date) ('ttl ttl) ('value #f))
-             (+ date ttl))
+             (+ date (min ttl max-ttl)))
             (('narinfo ('version 2) ('cache-uri uri)
                        ('date date) ('ttl ttl) ('value value))
-             (+ date ttl))
+             (+ date (min ttl max-ttl)))
             (x
              0)))))
     (lambda args