From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp0 ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms11 with LMTPS id kMxoElDe9l9UdwAA0tVLHw (envelope-from ) for ; Thu, 07 Jan 2021 10:11:28 +0000 Received: from aspmx1.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp0 with LMTPS id uLc2DlDe9l9pUwAA1q6Kng (envelope-from ) for ; Thu, 07 Jan 2021 10:11:28 +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 5C7DC9403A9 for ; Thu, 7 Jan 2021 10:11:27 +0000 (UTC) Received: from localhost ([::1]:32900 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1kxSGM-0005Ot-42 for larch@yhetil.org; Thu, 07 Jan 2021 05:11:26 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]:38034) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1kxSFy-0005Nl-KT for guix-patches@gnu.org; Thu, 07 Jan 2021 05:11:02 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:34991) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1kxSFy-0000sH-DP for guix-patches@gnu.org; Thu, 07 Jan 2021 05:11:02 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1kxSFy-0005g3-8x for guix-patches@gnu.org; Thu, 07 Jan 2021 05:11:02 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#45327] [PATCH v2] 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: Thu, 07 Jan 2021 10:11:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 45327 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 45327@debbugs.gnu.org Received: via spool by 45327-submit@debbugs.gnu.org id=B45327.161001421121759 (code B ref 45327); Thu, 07 Jan 2021 10:11:02 +0000 Received: (at 45327) by debbugs.gnu.org; 7 Jan 2021 10:10:11 +0000 Received: from localhost ([127.0.0.1]:46534 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1kxSF8-0005es-S5 for submit@debbugs.gnu.org; Thu, 07 Jan 2021 05:10:11 -0500 Received: from eggs.gnu.org ([209.51.188.92]:44480) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1kxSF5-0005e1-QA for 45327@debbugs.gnu.org; Thu, 07 Jan 2021 05:10:08 -0500 Received: from fencepost.gnu.org ([2001:470:142:3::e]:53119) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1kxSEz-0000Lh-Sh; Thu, 07 Jan 2021 05:10:01 -0500 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=44162 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1kxSEx-0000hJ-Dm; Thu, 07 Jan 2021 05:10:00 -0500 From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Date: Thu, 7 Jan 2021 11:09:47 +0100 Message-Id: <20210107100947.31189-1-ludo@gnu.org> X-Mailer: git-send-email 2.29.2 In-Reply-To: <86wnx97try.fsf@gmail.com> References: <86wnx97try.fsf@gmail.com> 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: -1.84 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: 5C7DC9403A9 X-Spam-Score: -1.84 X-Migadu-Scanner: scn0.migadu.com X-TUID: rLC8MD1UsBXt 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/cache.scm (file-expiration-time): Add optional 'timestamp' parameter and honor it. --- guix/cache.scm | 9 +++++---- guix/git.scm | 44 ++++++++++++++++++++++++++++++++++++++++++-- 2 files changed, 47 insertions(+), 6 deletions(-) Hi! This v2 changes two things: • Increase the default expiration time to three months; • Check the mtime rather than the atime of checkouts. 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… Thoughts? Ludo’. diff --git a/guix/cache.scm b/guix/cache.scm index feff131068..0401a9d428 100644 --- a/guix/cache.scm +++ b/guix/cache.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2020 Ludovic Courtès +;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2020, 2021 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -47,13 +47,14 @@ (unless (= ENOENT (system-error-errno args)) (apply throw args))))) -(define (file-expiration-time ttl) +(define* (file-expiration-time ttl #:optional (timestamp stat:atime)) "Return a procedure that, when passed a file, returns its \"expiration -time\" computed as its last-access time + TTL seconds." +time\" computed as its timestamp + TTL seconds. Call TIMESTAMP to obtain the +relevant timestamp from the result of 'stat'." (lambda (file) (match (stat file #f) (#f 0) ;FILE may have been deleted in the meantime - (st (+ (stat:atime st) ttl))))) + (st (+ (timestamp st) ttl))))) (define* (remove-expired-cache-entries entries #:key diff --git a/guix/git.scm b/guix/git.scm index ca77b9f54b..a5103547d3 100644 --- a/guix/git.scm +++ b/guix/git.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017, 2020 Mathieu Othacehe -;;; Copyright © 2018, 2019, 2020 Ludovic Courtès +;;; Copyright © 2018, 2019, 2020, 2021 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -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,24 @@ definitely available in REPOSITORY, false otherwise." (_ #f))) +(define cached-checkout-expiration + ;; Return the expiration time procedure for a cached checkout. + ;; TODO: Honor $GUIX_GIT_CACHE_EXPIRATION. + + ;; Use the mtime rather than the atime to cope with file systems mounted + ;; with 'noatime'. + (file-expiration-time (* 90 24 3600) stat:mtime)) + +(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 +362,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 +416,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