From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp1 ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms11 with LMTPS id AXqmLZF53l+ZKQAA0tVLHw (envelope-from ) for ; Sat, 19 Dec 2020 22:07:13 +0000 Received: from aspmx1.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp1 with LMTPS id 8NEZKZF53l+sSgAAbx9fmQ (envelope-from ) for ; Sat, 19 Dec 2020 22:07:13 +0000 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id 74FA99405D4 for ; Sat, 19 Dec 2020 22:07:13 +0000 (UTC) Received: from localhost ([::1]:35044 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1kqkNc-0007ni-Dt for larch@yhetil.org; Sat, 19 Dec 2020 17:07:12 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]:41820) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1kqkNS-0007na-CS for guix-patches@gnu.org; Sat, 19 Dec 2020 17:07:02 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:60016) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1kqkNS-0002jV-4F for guix-patches@gnu.org; Sat, 19 Dec 2020 17:07:02 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1kqkNR-0000IQ-U9 for guix-patches@gnu.org; Sat, 19 Dec 2020 17:07:01 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#45327] [PATCH] git: Periodically delete least-recently-used cached checkouts. Resent-From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sat, 19 Dec 2020 22:07:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 45327 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 45327@debbugs.gnu.org X-Debbugs-Original-To: guix-patches@gnu.org Received: via spool by submit@debbugs.gnu.org id=B.16084156001077 (code B ref -1); Sat, 19 Dec 2020 22:07:01 +0000 Received: (at submit) by debbugs.gnu.org; 19 Dec 2020 22:06:40 +0000 Received: from localhost ([127.0.0.1]:43329 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1kqkN5-0000HG-Lg for submit@debbugs.gnu.org; Sat, 19 Dec 2020 17:06:39 -0500 Received: from lists.gnu.org ([209.51.188.17]:57348) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1kqkN3-0000H3-Hn for submit@debbugs.gnu.org; Sat, 19 Dec 2020 17:06:38 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]:41782) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1kqkN3-0007iq-Ce for guix-patches@gnu.org; Sat, 19 Dec 2020 17:06:37 -0500 Received: from fencepost.gnu.org ([2001:470:142:3::e]:35424) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1kqkN3-0002bw-3e; Sat, 19 Dec 2020 17:06:37 -0500 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=41858 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1kqkN2-0006yy-7i; Sat, 19 Dec 2020 17:06:36 -0500 From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Date: Sat, 19 Dec 2020 23:06:30 +0100 Message-Id: <20201219220630.24605-1-ludo@gnu.org> X-Mailer: git-send-email 2.29.2 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+larch=yhetil.org@gnu.org Sender: "Guix-patches" X-Migadu-Flow: FLOW_IN X-Migadu-Spam-Score: -0.32 Authentication-Results: aspmx1.migadu.com; dkim=none; dmarc=pass (policy=none) header.from=gnu.org; spf=pass (aspmx1.migadu.com: domain of guix-patches-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=guix-patches-bounces@gnu.org X-Migadu-Queue-Id: 74FA99405D4 X-Spam-Score: -0.32 X-Migadu-Scanner: scn0.migadu.com X-TUID: i+rsVqIh6AbT 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