~ruther/guix-local

d72b42064b3cdeca7adbf13cce00faff5b61472a — Ludovic Courtès 9 years ago 2ea2aac
publish: Remove expired cache entries when '--ttl' is used.

* guix/scripts/publish.scm (narinfo-files): New procedure.
(render-narinfo/cached)[delete-file]: New procedure.  Add call to
'maybe-remove-expired-cache-entries'.
* doc/guix.texi (Invoking guix publish): Document the interation between
--cache and --ttl.
2 files changed, 35 insertions(+), 2 deletions(-)

M doc/guix.texi
M guix/scripts/publish.scm
M doc/guix.texi => doc/guix.texi +6 -0
@@ 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}).

M guix/scripts/publish.scm => guix/scripts/publish.scm +29 -2
@@ 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)))))