diff --git a/doc/guix.texi b/doc/guix.texi index bbb2ba732d..f2eba59d9c 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -6600,6 +6600,9 @@ The ``baking'' process is performed by worker threads. By default, one thread per CPU core is created, but this can be customized. See @option{--workers} below. +When @option{--ttl} is used, cached entries are automatically deleted +when they have expired. + @item --workers=@var{N} When @option{--cache} is used, request the allocation of @var{N} worker threads to ``bake'' archives. @@ -6614,6 +6617,9 @@ This allows the user's Guix to keep substitute information in cache for 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. + @item --nar-path=@var{path} Use @var{path} as the prefix for the URLs of ``nar'' files (@pxref{Invoking guix archive, normalized archives}). diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm index 70d914d60c..9dc006e7ab 100644 --- a/guix/scripts/publish.scm +++ b/guix/scripts/publish.scm @@ -50,11 +50,13 @@ #:use-module (guix store) #:use-module ((guix serialization) #:select (write-file)) #:use-module (guix zlib) + #:use-module (guix cache) #:use-module (guix ui) #:use-module (guix scripts) #:use-module ((guix utils) #:select (with-atomic-file-output compressed-file?)) - #:use-module ((guix build utils) #:select (dump-port mkdir-p)) + #:use-module ((guix build utils) + #:select (dump-port mkdir-p find-files)) #:export (%public-key %private-key @@ -365,6 +367,14 @@ at a time." (run-single-baker item (lambda () exp ...))) +(define (narinfo-files cache) + "Return the list of .narinfo files under CACHE." + (if (file-is-directory? cache) + (find-files cache + (lambda (file stat) + (string-suffix? ".narinfo" file))) + '())) + (define* (render-narinfo/cached store request hash #:key ttl (compression %no-compression) (nar-path "nar") @@ -372,6 +382,14 @@ at a time." "Respond to the narinfo request for REQUEST. If the narinfo is available in CACHE, then send it; otherwise, return 404 and \"bake\" that nar and narinfo requested using POOL." + (define (delete-entry narinfo) + ;; Delete NARINFO and the corresponding nar from CACHE. + (let ((nar (string-append (string-drop-right narinfo + (string-length ".narinfo")) + ".nar"))) + (delete-file* narinfo) + (delete-file* nar))) + (let* ((item (hash-part->path store hash)) (compression (actual-compression item compression)) (cached (and (not (string-null? item)) @@ -398,7 +416,16 @@ requested using POOL." (bake-narinfo+nar cache item #:ttl ttl #:compression compression - #:nar-path nar-path))) + #:nar-path nar-path)) + + (when ttl + (single-baker 'cache-cleanup + (maybe-remove-expired-cache-entries cache + narinfo-files + #:entry-expiration + (file-expiration-time ttl) + #:delete-entry delete-entry + #:cleanup-period ttl)))) (not-found request)) (else (not-found request)))))