From patchwork Sat Oct 2 10:22:40 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 33549 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 44D3227BBE3; Sat, 2 Oct 2021 11:26:08 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.9 required=5.0 tests=BAYES_00,MAILING_LIST_MULTI, RCVD_IN_MSPIKE_H2,SPF_HELO_PASS autolearn=unavailable autolearn_force=no version=3.4.2 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id DCBD027BBE1 for ; Sat, 2 Oct 2021 11:26:07 +0100 (BST) Received: from localhost ([::1]:53648 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mWcDW-0003ML-Vx for patchwork@mira.cbaines.net; Sat, 02 Oct 2021 06:26:07 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:38432) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mWcBY-0002HV-KD for guix-patches@gnu.org; Sat, 02 Oct 2021 06:24:04 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:46433) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1mWcBY-0000Cy-CX for guix-patches@gnu.org; Sat, 02 Oct 2021 06:24:04 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1mWcBY-0007ZM-9J for guix-patches@gnu.org; Sat, 02 Oct 2021 06:24:04 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#50960] [PATCH 10/10] shell: Maintain a profile cache. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sat, 02 Oct 2021 10:24:04 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 50960 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 50960@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 50960-submit@debbugs.gnu.org id=B50960.163317019328986 (code B ref 50960); Sat, 02 Oct 2021 10:24:04 +0000 Received: (at 50960) by debbugs.gnu.org; 2 Oct 2021 10:23:13 +0000 Received: from localhost ([127.0.0.1]:57971 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mWcAj-0007XM-3g for submit@debbugs.gnu.org; Sat, 02 Oct 2021 06:23:13 -0400 Received: from eggs.gnu.org ([209.51.188.92]:33150) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mWcAY-0007UY-Li for 50960@debbugs.gnu.org; Sat, 02 Oct 2021 06:23:03 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:49206) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mWcAT-0007hX-G3; Sat, 02 Oct 2021 06:22:57 -0400 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=36460 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1mWcAT-0007gb-6e; Sat, 02 Oct 2021 06:22:57 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Sat, 2 Oct 2021 12:22:40 +0200 Message-Id: <20211002102240.27815-10-ludo@gnu.org> X-Mailer: git-send-email 2.33.0 In-Reply-To: <20211002102240.27815-1-ludo@gnu.org> References: <20211002102240.27815-1-ludo@gnu.org> MIME-Version: 1.0 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+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches With this change, running "guix shell" (no arguments) is equivalent to: guix environment -r ~/.cache/guix/profiles/some-root -l guix.scm This is the cache miss. On cache hit, it's equivalent to: guix environment -p ~/.cache/guix/profiles/some-root ... which can run in 0.1s. * guix/scripts/shell.scm (auto-detect-manifest): Looked for a cached GC root to the profile and use it. (%profile-cache-directory): New variable. (profile-cache-key, profile-cached-gc-root): New procedures. (guix-shell)[cache-entries, entry-expiration]: New procedures. Add call to 'maybe-remove-expired-cache-entries'. --- guix/scripts/shell.scm | 90 +++++++++++++++++++++++++++++++++++++++--- 1 file changed, 84 insertions(+), 6 deletions(-) diff --git a/guix/scripts/shell.scm b/guix/scripts/shell.scm index 2f15befbd3..7c116cc770 100644 --- a/guix/scripts/shell.scm +++ b/guix/scripts/shell.scm @@ -29,6 +29,15 @@ #:use-module (srfi srfi-37) #:use-module (srfi srfi-71) #:use-module (ice-9 match) + #:autoload (guix base32) (bytevector->base32-string) + #:autoload (rnrs bytevectors) (string->utf8) + #:autoload (guix utils) (cache-directory) + #:autoload (guix describe) (current-channels) + #:autoload (guix channels) (channel-commit) + #:autoload (gcrypt hash) (sha256) + #:use-module ((guix build utils) #:select (mkdir-p)) + #:use-module (guix cache) + #:use-module ((ice-9 ftw) #:select (scandir)) #:export (guix-shell)) (define (show-help) @@ -161,16 +170,85 @@ Return the modified OPTS." (warning (G_ "no packages specified; creating an empty environment~%")) opts) (file + ;; Load environment from FILE; if possible, use/maintain a GC root to + ;; the corresponding profile in cache. (info (G_ "loading environment from '~a'...~%") file) - (match (basename file) - ("guix.scm" - (alist-cons 'load `(package ,file) opts)) - ("manifest.scm" - (alist-cons 'manifest file opts))))))) + (let* ((root (profile-cached-gc-root file)) + (stat (and root (false-if-exception (lstat root))))) + (if (and stat + (<= (stat:mtime ((@ (guile) stat) file)) + (stat:mtime stat))) + (let ((now (current-time))) + ;; Update the atime on ROOT to reflect usage. + (utime root + now (stat:mtime stat) + 0 (stat:mtimensec stat) + AT_SYMLINK_NOFOLLOW) + (alist-cons 'profile root opts)) ;load right away + (let ((opts (match (basename file) + ("guix.scm" + (alist-cons 'load `(package ,file) opts)) + ("manifest.scm" + (alist-cons 'manifest file opts))))) + (if (and root (not (assq-ref opts 'gc-root))) + (begin + (if stat + (delete-file root) + (mkdir-p (dirname root))) + (alist-cons 'gc-root root opts)) + opts)))))))) + + +;;; +;;; Profile cache. +;;; + +(define %profile-cache-directory + ;; Directory where profiles created by 'guix shell' alone (without extra + ;; options) are cached. + (make-parameter (string-append (cache-directory #:ensure? #f) + "/profiles"))) + +(define (profile-cache-key file) + "Return the cache key for the profile corresponding to FILE, a 'guix.scm' or +'manifest.scm' file, or #f if we lack channel information." + (match (current-channels) + (() #f) + (((= channel-commit commits) ...) + (let ((stat (stat file))) + (bytevector->base32-string + (sha256 (string->utf8 + (string-append (string-join commits) ":" + (basename file) ":" + (number->string (stat:dev stat)) ":" + (number->string (stat:ino stat)))))))))) + +(define (profile-cached-gc-root file) + "Return the cached GC root for FILE, a 'guix.scm' or 'manifest.scm' file, or +#f if we lack information to cache it." + (match (profile-cache-key file) + (#f #f) + (key (string-append (%profile-cache-directory) "/" key)))) (define-command (guix-shell . args) (category development) (synopsis "spawn one-off software environments") - (guix-environment* (parse-args args))) + (define (cache-entries directory) + (filter-map (match-lambda + ((or "." "..") #f) + (file (string-append directory "/" file))) + (or (scandir directory) '()))) + + (define* (entry-expiration file) + ;; Return the time at which FILE, a cached profile, is considered expired. + (match (false-if-exception (lstat file)) + (#f 0) ;FILE may have been deleted in the meantime + (st (+ (stat:atime st) (* 60 60 24 7))))) + + (let ((result (guix-environment* (parse-args args)))) + (maybe-remove-expired-cache-entries (%profile-cache-directory) + cache-entries + #:entry-expiration entry-expiration) + result))