03/08: shell: Cache profiles even when using package specs.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 0552dcb294bbfed76d7a495f5e368c53f20b852a
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Wed Jan 5 19:29:50 2022 +0100

    shell: Cache profiles even when using package specs.
    
    This enables profile caching not just when '-m' or '-f' is used, but
    also when package specs are passed on the command line, as in:
    
      guix shell -D guix git
    
    It also changes profile cache keys to include the system type, which was
    previously ignored.
    
    * guix/scripts/shell.scm (options-with-caching)[single-file-for-caching]:
    Remove.
    Call 'profile-cached-gc-root' instead; adjust to accept two values.
    (profile-cache-primary-key): New procedure.
    (profile-cache-key): Remove.
    (profile-file-cache-key, profile-spec-cache-key): New procedures.
    (profile-cached-gc-root): Rewrite to include functionality formally in
    'single-file-for-caching', but extend to handle package specs.
    * gnu/packages.scm (cache-is-authoritative?): Export.
    * guix/transformations.scm (transformation-option-key?): New procedure.
    * doc/guix.texi (Invoking guix shell): Move '--rebuild-cache'
    documentation to the bottom, just above '--root'.  Explain caching and
    how these two options relate to that.
---
 doc/guix.texi            |  45 ++++++++-----
 gnu/packages.scm         |   3 +-
 guix/scripts/shell.scm   | 161 ++++++++++++++++++++++++++++++-----------------
 guix/transformations.scm |   9 ++-
 4 files changed, 142 insertions(+), 76 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 443059147f..876172fa3a 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -5806,17 +5806,6 @@ This is similar to the same-named option in 
@command{guix package}
 (@pxref{profile-manifest, @option{--manifest}}) and uses the same
 manifest files.
 
-@item --rebuild-cache
-When using @option{--manifest}, @option{--file}, or when invoked without
-arguments, @command{guix shell} caches the environment so that
-subsequent uses are instantaneous.  The cache is invalidated anytime the
-file is modified.
-
-The @option{--rebuild-cache} forces the cached environment to be
-refreshed even if the file has not changed.  This is useful if the
-@command{guix.scm} or @command{manifest.scm} has external dependencies,
-or if its behavior depends, say, on environment variables.
-
 @item --pure
 Unset existing environment variables when building the new environment, except
 those specified with @option{--preserve} (see below).  This has the effect of
@@ -5932,6 +5921,21 @@ directory:
 guix shell --container --expose=$HOME=/exchange guile -- guile
 @end example
 
+@item --rebuild-cache
+@cindex caching, of profiles
+@cindex caching, in @command{guix shell}
+In most cases, @command{guix shell} caches the environment so that
+subsequent uses are instantaneous.  Least-recently used cache entries
+are periodically removed.  The cache is also invalidated, when using
+@option{--file} or @option{--manifest}, anytime the corresponding file
+is modified.
+
+The @option{--rebuild-cache} forces the cached environment to be
+refreshed.  This is useful when using @option{--file} or
+@option{--manifest} and the @command{guix.scm} or @command{manifest.scm}
+file has external dependencies, or if its behavior depends, say, on
+environment variables.
+
 @item --root=@var{file}
 @itemx -r @var{file}
 @cindex persistent environment
@@ -5942,11 +5946,20 @@ register it as a garbage collector root.
 This is useful if you want to protect your environment from garbage
 collection, to make it ``persistent''.
 
-When this option is omitted, the environment is protected from garbage
-collection only for the duration of the @command{guix shell}
-session.  This means that next time you recreate the same environment,
-you could have to rebuild or re-download packages.  @xref{Invoking guix
-gc}, for more on GC roots.
+When this option is omitted, @command{guix shell} caches profiles so
+that subsequent uses of the same environment are instantaneous---this is
+comparable to using @option{--root} except that @command{guix shell}
+takes care of periodically removing the least-recently used garbage
+collector roots.
+
+In some cases, @command{guix shell} does not cache profiles---e.g., if
+transformation options such as @option{--with-latest} are used.  In
+those cases, the environment is protected from garbage collection only
+for the duration of the @command{guix shell} session.  This means that
+next time you recreate the same environment, you could have to rebuild
+or re-download packages.
+
+@xref{Invoking guix gc}, for more on GC roots.
 @end table
 
 @command{guix shell} also supports all of the common build options that
diff --git a/gnu/packages.scm b/gnu/packages.scm
index ccfc83dd11..65ab7a7c1e 100644
--- a/gnu/packages.scm
+++ b/gnu/packages.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic 
Courtès <ludo@gnu.org>
+;;; Copyright © 2012-2020, 2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
 ;;; Copyright © 2016, 2017 Alex Kost <alezost@gmail.com>
@@ -51,6 +51,7 @@
             %auxiliary-files-path
             %package-module-path
             %default-package-module-path
+            cache-is-authoritative?
 
             fold-packages
             fold-available-packages
diff --git a/guix/scripts/shell.scm b/guix/scripts/shell.scm
index 546639818f..a92932cbc9 100644
--- a/guix/scripts/shell.scm
+++ b/guix/scripts/shell.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021-2022 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -21,7 +21,8 @@
   #:use-module ((guix diagnostics) #:select (location))
   #:use-module (guix scripts environment)
   #:autoload   (guix scripts build) (show-build-options-help)
-  #:autoload   (guix transformations) (show-transformation-options-help)
+  #:autoload   (guix transformations) (transformation-option-key?
+                                       show-transformation-options-help)
   #:use-module (guix scripts)
   #:use-module (guix packages)
   #:use-module (guix profiles)
@@ -40,6 +41,7 @@
   #:use-module ((guix build utils) #:select (mkdir-p))
   #:use-module (guix cache)
   #:use-module ((ice-9 ftw) #:select (scandir))
+  #:autoload   (gnu packages) (cache-is-authoritative?)
   #:export (guix-shell))
 
 (define (show-help)
@@ -201,51 +203,35 @@ a hash-prefixed comment, or a blank line."
     (const #f)))
 
 (define (options-with-caching opts)
-  "If OPTS contains exactly one 'load' or one 'manifest' key, automatically
-add a 'profile' key (when a profile for that file is already in cache) or a
-'gc-root' key (to add the profile to cache)."
-  (define (single-file-for-caching opts)
-    (let loop ((opts opts)
-               (file #f))
-      (match opts
-        (() file)
-        ((('package . _) . _) #f)
-        ((('load . ('package candidate)) . rest)
-         (and (not file) (loop rest candidate)))
-        ((('manifest . candidate) . rest)
-         (and (not file) (loop rest candidate)))
-        ((('expression . _) . _) #f)
-        ((_ . rest) (loop rest file)))))
-
-  ;; Check whether there's a single 'load' or 'manifest' option.  When that is
-  ;; the case, arrange to automatically cache the resulting profile.
-  (match (single-file-for-caching opts)
-    (#f opts)
-    (file
-     (let* ((root (profile-cached-gc-root file))
-            (stat (and root (false-if-exception (lstat root)))))
-       (if (and (not (assoc-ref opts 'rebuild-cache?))
-                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
-                         (remove (match-lambda
-                                   (('load . _) #t)
-                                   (('manifest . _) #t)
-                                   (_ #f))
-                                 opts)))          ;load right away
-           (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))))))
+  "If OPTS contains only options that allow us to compute a cache key,
+automatically add a 'profile' key (when a profile for that file is already in
+cache) or a 'gc-root' key (to add the profile to cache)."
+  ;; Attempt to compute a file name for use as the cached profile GC root.
+  (let* ((root timestamp (profile-cached-gc-root opts))
+         (stat (and root (false-if-exception (lstat root)))))
+    (if (and (not (assoc-ref opts 'rebuild-cache?))
+             stat
+             (<= timestamp (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
+                      (remove (match-lambda
+                                (('load . _) #t)
+                                (('manifest . _) #t)
+                                (('package . _) #t)
+                                (('ad-hoc-package . _) #t)
+                                (_ #f))
+                              opts)))             ;load right away
+        (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))))
 
 (define (auto-detect-manifest opts)
   "If OPTS do not specify packages or a manifest, load a \"guix.scm\" or
@@ -308,28 +294,87 @@ echo ~a >> ~a
   (make-parameter (string-append (cache-directory #:ensure? #f)
                                  "/profiles")))
 
-(define (profile-cache-key file)
+(define (profile-cache-primary-key)
+  "Return the \"primary key\" used when computing keys for the profile cache.
+Return #f if no such key can be obtained and caching cannot be
+performed--e.g., because the package cache is not authoritative."
+  (and (cache-is-authoritative?)
+       (match (current-channels)
+         (()
+          #f)
+         (((= channel-commit commits) ...)
+          (string-join commits)))))
+
+(define (profile-file-cache-key file system)
   "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) ...)
+  (match (profile-cache-primary-key)
+    (#f #f)
+    (primary-key
      (let ((stat (stat file)))
        (bytevector->base32-string
         ;; Since FILE is not canonicalized, only include the device/inode
         ;; numbers.  XXX: In some rare cases involving Btrfs and NFS, this can
         ;; be insufficient: <https://lwn.net/Articles/866582/>.
         (sha256 (string->utf8
-                 (string-append (string-join commits) ":"
+                 (string-append primary-key ":" system ":"
                                 (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 (profile-spec-cache-key specs system)
+  "Return the cache key corresponding to SPECS built for SYSTEM, where SPECS
+is a list of package specs.  Return #f if caching is not possible."
+  (match (profile-cache-primary-key)
+    (#f #f)
+    (primary-key
+     (bytevector->base32-string
+      (sha256 (string->utf8
+               (string-append primary-key ":" system ":"
+                              (object->string specs))))))))
+
+(define (profile-cached-gc-root opts)
+  "Return two values: the file name of a GC root for use as a profile cache
+for the options in OPTS, and a timestamp which, if greater than the GC root's
+mtime, indicates that the GC root is stale.  If OPTS do not permit caching,
+return #f and #f."
+  (define (key->file key)
+    (string-append (%profile-cache-directory) "/" key))
+
+  (let loop ((opts opts)
+             (system (%current-system))
+             (file #f)
+             (specs '()))
+    (match opts
+      (()
+       (if file
+           (values (and=> (profile-file-cache-key file system) key->file)
+                   (stat:mtime (stat file)))
+           (values (and=> (profile-spec-cache-key specs system) key->file)
+                   0)))
+      (((and spec ('package . _)) . rest)
+       (if (not file)
+           (loop rest system file (cons spec specs))
+           (values #f #f)))
+      ((('load . ('package candidate)) . rest)
+       (if (and (not file) (null? specs))
+           (loop rest system candidate specs)
+           (values #f #f)))
+      ((('manifest . candidate) . rest)
+       (if (and (not file) (null? specs))
+           (loop rest system candidate specs)
+           (values #f #f)))
+      ((('expression . _) . _)
+       ;; Arbitrary expressions might be non-deterministic or otherwise depend
+       ;; on external state so do not cache when they're used.
+       (values #f #f))
+      ((((? transformation-option-key?) . _) . _)
+       ;; Transformation options are potentially "non-deterministic", or at
+       ;; least depending on external state (with-source, with-commit, etc.),
+       ;; so do not cache anything when they're used.
+       (values #f #f))
+      ((('system . system) . rest)
+       (loop rest system file specs))
+      ((_ . rest) (loop rest system file specs)))))
 
 
 ;;;
diff --git a/guix/transformations.scm b/guix/transformations.scm
index c43c00cdd3..0976f0d824 100644
--- a/guix/transformations.scm
+++ b/guix/transformations.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès 
<ludo@gnu.org>
+;;; Copyright © 2016-2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2021 Marius Bakke <marius@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -56,6 +56,7 @@
             tuned-package
 
             show-transformation-options-help
+            transformation-option-key?
             %transformation-options))
 
 ;;; Commentary:
@@ -796,6 +797,12 @@ are replaced by their latest upstream version."
           (and (eq? k key) proc)))
        %transformations))
 
+(define (transformation-option-key? key)
+  "Return true if KEY is an option key (as returned while parsing options with
+%TRANSFORMATION-OPTIONS) corresponding to a package transformation option.
+For example, (transformation-option-key? 'with-input) => #t."
+  (->bool (transformation-procedure key)))
+
 
 ;;;
 ;;; Command-line handling.