ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 05:18:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

shell: Maintain a profile cache.

Browse source 
shell: Maintain a profile cache.

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 (options-with-caching): New procedure.
(parse-args): Use it.
(%profile-cache-directory): New variable.
(profile-cache-key, profile-cached-gc-root): New procedures.
(show-help, %options): Add '--rebuild-cache'.
(guix-shell)[cache-entries, entry-expiration]: New procedures.
Add call to 'maybe-remove-expired-cache-entries'.
* doc/guix.texi (Invoking guix shell): Document '--rebuild-cache'.
This commit is contained in:
Ludovic Courtès 2021-10-01 22:47:33 +02:00
parent 2cb0b3709a
commit 9730692d9f
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 130 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
doc/guix.texi
View file

@ -5769,6 +5769,17 @@ 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

127
guix/scripts/shell.scm
View file

@ -31,7 +31,15 @@ (define-module (guix scripts shell)
#:use-module (srfi srfi-71)
#:use-module (ice-9 match)
#:autoload (ice-9 rdelim) (read-line)
#:autoload (guix utils) (config-directory)
#:autoload (guix base32) (bytevector->base32-string)
#:autoload (rnrs bytevectors) (string->utf8)
#:autoload (guix utils) (config-directory 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)
@ -48,6 +56,8 @@ (define (show-help)
FILE evaluates to"))
(display (G_ "
-q inhibit loading of 'guix.scm' and 'manifest.scm'"))
(display (G_ "
--rebuild-cache rebuild cached environment, if any"))
(show-environment-options-help)
(newline)
@ -109,7 +119,10 @@ (define %options
result)))
(option '(#\q) #f #f
(lambda (opt name arg result)
(alist-cons 'explicit-loading? #t result))))
(alist-cons 'explicit-loading? #t result)))
(option '("rebuild-cache") #f #f
(lambda (opt name arg result)
(alist-cons 'rebuild-cache? #t result))))
(filter-map (lambda (opt)
(and (not (any (lambda (name)
(member name to-remove))
@ -132,11 +145,12 @@ (define (handle-argument arg result)
(let ((args command (break (cut string=? "--" <>) args)))
(let ((opts (parse-command-line args %options (list %default-options)
#:argument-handler handle-argument)))
(auto-detect-manifest
(match command
(() opts)
(("--") opts)
(("--" command ...) (alist-cons 'exec command opts)))))))
(options-with-caching
(auto-detect-manifest
(match command
(() opts)
(("--") opts)
(("--" command ...) (alist-cons 'exec command opts))))))))
(define (find-file-in-parent-directories candidates)
"Find one of CANDIDATES in the current directory or one of its ancestors."
@ -187,6 +201,53 @@ (define (authorized-shell-directory? directory)
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))))))
(define (auto-detect-manifest opts)
"If OPTS do not specify packages or a manifest, load a \"guix.scm\" or
\"manifest.scm\" file from the current directory or one of its ancestors.
@ -236,9 +297,59 @@ (define disallow-implicit-load?
(authorized-directory-file)))
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
;; 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) ":"
(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))