system: Add -I, --list-installed option.

* guix/scripts/system.scm (display-system-generation): Add
 #:list-installed-regex and honor it.
(list-generations): Likewise.
(show-help, %options): Add "--list-installed".
(process-command): For 'describe' and 'list-generation', honor the
'list-installed option.
* doc/guix.texi (Invoking Guix System): Add information for
--list-installed flag.

Signed-off-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
Antero Mejr 2022-07-13 15:01:22 +00:00 committed by Ludovic Courtès
parent 55725724dd
commit 95acd67dd3
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 58 additions and 19 deletions

View file

@ -37781,6 +37781,13 @@ bootloader boot menu:
Describe the running system generation: its file name, the kernel and Describe the running system generation: its file name, the kernel and
bootloader used, etc., as well as provenance information when available. bootloader used, etc., as well as provenance information when available.
The @code{--list-installed} flag is available, with the same
syntax that is used in @command{guix package --list-installed}
(@pxref{Invoking guix package}). When the flag is used,
the description will include a list of packages that are currently
installed in the system profile, with optional filtering based on a
regular expression.
@quotation Note @quotation Note
The @emph{running} system generation---referred to by The @emph{running} system generation---referred to by
@file{/run/current-system}---is not necessarily the @emph{current} @file{/run/current-system}---is not necessarily the @emph{current}
@ -37808,6 +37815,11 @@ generations that are up to 10 days old:
$ guix system list-generations 10d $ guix system list-generations 10d
@end example @end example
The @code{--list-installed} flag may also be specified, with the same
syntax that is used in @command{guix package --list-installed}. This
may be helpful if trying to determine when a package was added to the
system.
@end table @end table
The @command{guix system} command has even more to offer! The following The @command{guix system} command has even more to offer! The following

View file

@ -50,7 +50,8 @@ (define-module (guix scripts system)
#:use-module (guix channels) #:use-module (guix channels)
#:use-module (guix scripts build) #:use-module (guix scripts build)
#:autoload (guix scripts package) (delete-generations #:autoload (guix scripts package) (delete-generations
delete-matching-generations) delete-matching-generations
list-installed)
#:autoload (guix scripts pull) (channel-commit-hyperlink) #:autoload (guix scripts pull) (channel-commit-hyperlink)
#:autoload (guix graph) (export-graph node-type #:autoload (guix graph) (export-graph node-type
graph-backend-name lookup-backend) graph-backend-name lookup-backend)
@ -480,8 +481,10 @@ (define (shepherd-service-node-type services)
;;; ;;;
(define* (display-system-generation number (define* (display-system-generation number
#:optional (profile %system-profile)) #:optional (profile %system-profile)
"Display a summary of system generation NUMBER in a human-readable format." #:key (list-installed-regex #f))
"Display a summary of system generation NUMBER in a human-readable format.
List packages in that system that match LIST-INSTALLED-REGEX."
(define (display-channel channel) (define (display-channel channel)
(format #t " ~a:~%" (channel-name channel)) (format #t " ~a:~%" (channel-name channel))
(format #t (G_ " repository URL: ~a~%") (channel-url channel)) (format #t (G_ " repository URL: ~a~%") (channel-url channel))
@ -544,23 +547,35 @@ (define-values (channels config-file)
(format #t (G_ " configuration file: ~a~%") (format #t (G_ " configuration file: ~a~%")
(if (supports-hyperlinks?) (if (supports-hyperlinks?)
(file-hyperlink config-file) (file-hyperlink config-file)
config-file)))))) config-file)))
(when list-installed-regex
(format #t (G_ " packages:\n"))
(pretty-print-table (list-installed
list-installed-regex
(list (string-append generation "/profile")))
#:left-pad 4)))))
(define* (list-generations pattern #:optional (profile %system-profile)) (define* (list-generations pattern #:optional (profile %system-profile)
#:key (list-installed-regex #f))
"Display in a human-readable format all the system generations matching "Display in a human-readable format all the system generations matching
PATTERN, a string. When PATTERN is #f, display all the system generations." PATTERN, a string. When PATTERN is #f, display all the system generations.
List installed packages that match LIST-INSTALLED-REGEX."
(cond ((not (file-exists? profile)) ; XXX: race condition (cond ((not (file-exists? profile)) ; XXX: race condition
(raise (condition (&profile-not-found-error (raise (condition (&profile-not-found-error
(profile profile))))) (profile profile)))))
((not pattern) ((not pattern)
(for-each display-system-generation (profile-generations profile))) (for-each (cut display-system-generation <>
#:list-installed-regex list-installed-regex)
(profile-generations profile)))
((matching-generations pattern profile) ((matching-generations pattern profile)
=> =>
(lambda (numbers) (lambda (numbers)
(if (null-list? numbers) (if (null-list? numbers)
(exit 1) (exit 1)
(leave-on-EPIPE (leave-on-EPIPE
(for-each display-system-generation numbers))))))) (for-each (cut display-system-generation <>
#:list-installed-regex list-installed-regex)
numbers)))))))
;;; ;;;
@ -1032,6 +1047,11 @@ (define (show-help)
use BACKEND for 'extension-graphs' and 'shepherd-graph'")) use BACKEND for 'extension-graphs' and 'shepherd-graph'"))
(newline) (newline)
(display (G_ " (display (G_ "
-I, --list-installed[=REGEXP]
for 'describe' and 'list-generations', list installed
packages matching REGEXP"))
(newline)
(display (G_ "
-h, --help display this help and exit")) -h, --help display this help and exit"))
(display (G_ " (display (G_ "
-V, --version display version information and exit")) -V, --version display version information and exit"))
@ -1135,6 +1155,9 @@ (define %options
(option '("graph-backend") #t #f (option '("graph-backend") #t #f
(lambda (opt name arg result) (lambda (opt name arg result)
(alist-cons 'graph-backend arg result))) (alist-cons 'graph-backend arg result)))
(option '(#\I "list-installed") #f #t
(lambda (opt name arg result)
(alist-cons 'list-installed (or arg "") result)))
%standard-build-options)) %standard-build-options))
(define %default-options (define %default-options
@ -1322,25 +1345,29 @@ (define-syntax-rule (with-store* store exp ...)
;; The following commands do not need to use the store, and they do not need ;; The following commands do not need to use the store, and they do not need
;; an operating system configuration file. ;; an operating system configuration file.
((list-generations) ((list-generations)
(let ((pattern (match args (let ((list-installed-regex (assoc-ref opts 'list-installed))
(pattern (match args
(() #f) (() #f)
((pattern) pattern) ((pattern) pattern)
(x (leave (G_ "wrong number of arguments~%")))))) (x (leave (G_ "wrong number of arguments~%"))))))
(list-generations pattern))) (list-generations pattern #:list-installed-regex list-installed-regex)))
((describe) ((describe)
;; Describe the running system, which is not necessarily the current ;; Describe the running system, which is not necessarily the current
;; generation. /run/current-system might point to ;; generation. /run/current-system might point to
;; /var/guix/profiles/system-N-link, or it might point directly to ;; /var/guix/profiles/system-N-link, or it might point directly to
;; /gnu/store/…-system. Try both. ;; /gnu/store/…-system. Try both.
(match (generation-number "/run/current-system" %system-profile) (let ((list-installed-regex (assoc-ref opts 'list-installed)))
(0 (match (generation-number "/run/current-system" %system-profile)
(match (generation-number %system-profile) (0
(0 (match (generation-number %system-profile)
(leave (G_ "no system generation, nothing to describe~%"))) (0
(generation (leave (G_ "no system generation, nothing to describe~%")))
(display-system-generation generation)))) (generation
(generation (display-system-generation
(display-system-generation generation)))) generation #:list-installed-regex list-installed-regex))))
(generation
(display-system-generation
generation #:list-installed-regex list-installed-regex)))))
((search) ((search)
(apply (resolve-subcommand "search") args)) (apply (resolve-subcommand "search") args))
((edit) ((edit)