GNU bug report logs - #45327
[PATCH] git: Periodically delete least-recently-used cached checkouts.

Previous Next

Full log

View this message in rfc822 format

From: help-debbugs <at> gnu.org (GNU bug Tracking System)
To: Ludovic Courtès <ludo <at> gnu.org>
Cc: tracker <at> debbugs.gnu.org
Subject: bug#45327: closed ([PATCH] git: Periodically delete
 least-recently-used cached checkouts.)
Date: Wed, 13 Jan 2021 15:49:02 +0000

[Message part 1 (text/plain, inline)]

Your message dated Wed, 13 Jan 2021 16:47:54 +0100
with message-id <87wnwg7s9h.fsf_-_ <at> gnu.org>
and subject line Re: bug#45327: [PATCH] git: Periodically delete least-recently-used cached checkouts.
has caused the debbugs.gnu.org bug report #45327,
regarding [PATCH] git: Periodically delete least-recently-used cached checkouts.
to be marked as done.

(If you believe you have received this mail in error, please contact
help-debbugs <at> gnu.org.)


-- 
45327: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=45327
GNU Bug Tracking System
Contact help-debbugs <at> gnu.org with problems

[Message part 2 (message/rfc822, inline)]

From: Ludovic Courtès <ludo <at> gnu.org>
To: guix-patches <at> gnu.org
Cc: Ludovic Courtès <ludo <at> gnu.org>
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

[Message part 3 (message/rfc822, inline)]

From: Ludovic Courtès <ludo <at> gnu.org>
To: zimoun <zimon.toutoune <at> gmail.com>
Cc: Guillaume Le Vaillant <glv <at> posteo.net>, 45327-done <at> debbugs.gnu.org
Subject: Re: bug#45327: [PATCH] git: Periodically delete least-recently-used
 cached checkouts.
Date: Wed, 13 Jan 2021 16:47:54 +0100

Hi,

zimoun <zimon.toutoune <at> gmail.com> skribis:

> On Thu, 7 Jan 2021 at 11:10, Ludovic Courtès <ludo <at> 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’.

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.