--- Begin Message ---
Subject: |
[PATCH] git: Periodically delete least-recently-used cached checkouts. |
Date: |
Sat, 19 Dec 2020 23:06:30 +0100 |
This ensures ~/.cache/guix/checkouts is periodically cleaned up.
* guix/git.scm (cached-checkout-expiration)
(%checkout-cache-cleanup-period): New variables.
(delete-checkout): New procedure.
(update-cached-checkout)[cache-entries]: New procedure.
Add call to 'maybe-remove-expired-cache-entries'.
---
guix/git.scm | 38 +++++++++++++++++++++++++++++++++++++-
1 file changed, 37 insertions(+), 1 deletion(-)
Hi!
I noticed that my ~/.cache/guix/checkouts directory had accumulated
a lot of cruft from channels, playing with ‘--with-branch’ and such,
and that it would be nice to clean it up once in a while.
This is what this patch does. It uses the (guix cache) default
strategy, which consists in deleting least-recently-used items by
looking at their atime.
Thoughts?
Ludo’.
diff --git a/guix/git.scm b/guix/git.scm
index ca77b9f54b..5df11db38e 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -23,8 +23,10 @@
#:use-module (git submodule)
#:use-module (guix i18n)
#:use-module (guix base32)
+ #:use-module (guix cache)
#:use-module (gcrypt hash)
- #:use-module ((guix build utils) #:select (mkdir-p))
+ #:use-module ((guix build utils)
+ #:select (mkdir-p delete-file-recursively))
#:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix records)
@@ -35,6 +37,7 @@
#:use-module (rnrs bytevectors)
#:use-module (ice-9 format)
#:use-module (ice-9 match)
+ #:use-module (ice-9 ftw)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-34)
@@ -318,6 +321,20 @@ definitely available in REPOSITORY, false otherwise."
(_
#f)))
+(define cached-checkout-expiration
+ ;; Return the expiration time of a cached checkout.
+ (file-expiration-time (* 30 24 3600)))
+
+(define %checkout-cache-cleanup-period
+ ;; Period for the removal of expired cached checkouts.
+ (* 5 24 3600))
+
+(define (delete-checkout directory)
+ "Delete DIRECTORY recursively, in an atomic fashion."
+ (let ((trashed (string-append directory ".trashed")))
+ (rename-file directory trashed)
+ (delete-file-recursively trashed)))
+
(define* (update-cached-checkout url
#:key
(ref '(branch . "master"))
@@ -341,6 +358,14 @@ When RECURSIVE? is true, check out submodules as well, if
any.
When CHECK-OUT? is true, reset the cached working tree to REF; otherwise leave
it unchanged."
+ (define (cache-entries directory)
+ (filter-map (match-lambda
+ ((or "." "..")
+ #f)
+ (file
+ (string-append directory "/" file)))
+ (or (scandir directory) '())))
+
(define canonical-ref
;; We used to require callers to specify "origin/" for each branch, which
;; made little sense since the cache should be transparent to them. So
@@ -387,6 +412,17 @@ it unchanged."
;; REPOSITORY as soon as possible.
(repository-close! repository)
+ ;; When CACHE-DIRECTORY is a sub-directory of the default cache
+ ;; directory, remove expired checkouts that are next to it.
+ (let ((parent (dirname cache-directory)))
+ (when (string=? parent (%repository-cache-directory))
+ (maybe-remove-expired-cache-entries parent cache-entries
+ #:entry-expiration
+ cached-checkout-expiration
+ #:delete-entry delete-checkout
+ #:cleanup-period
+
%checkout-cache-cleanup-period)))
+
(values cache-directory (oid->string oid) relation)))))
(define* (latest-repository-commit store url
--
2.29.2
--- End Message ---
--- Begin Message ---
Subject: |
Re: bug#45327: [PATCH] git: Periodically delete least-recently-used cached checkouts. |
Date: |
Wed, 13 Jan 2021 16:47:54 +0100 |
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/27.1 (gnu/linux) |
Hi,
zimoun <zimon.toutoune@gmail.com> skribis:
> On Thu, 7 Jan 2021 at 11:10, Ludovic Courtès <ludo@gnu.org> wrote:
>
>> • Increase the default expiration time to three months;
>
> That's long enough for my vacations. ;-)
Pffew. :-)
Pushed as 87b0001325992db60fdf24ac09ce254cd003721c!
>> As zimoun proposed, I agree that we should make the expiration time
>> configurable. I started doing that but that requires ‘string->duration’,
>> which is currently in (guix ui), and this code is supposed to be
>> “UI-free”. So I’d first like to move this and similar tools to a new
>> (guix units) module…
>
> You mean 2 another patches are coming: one moving to the new (guix
> units) and then another one honoring GUIX_GIT_CACHE_EXPIRATION, right?
Yup! (Not ETA though…)
Thanks,
Ludo’.
--- End Message ---