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:
		
							parent
							
								
									55725724dd
								
							
						
					
					
						commit
						95acd67dd3
					
				
					 2 changed files with 58 additions and 19 deletions
				
			
		| 
						 | 
					@ -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
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -50,7 +50,8 @@
 | 
				
			||||||
  #: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 @@ list of 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 @@ list of services."
 | 
				
			||||||
        (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 @@ Some ACTIONS support additional ARGS.\n"))
 | 
				
			||||||
                         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 @@ Some ACTIONS support additional ARGS.\n"))
 | 
				
			||||||
         (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 @@ argument list and OPTS is the option alist."
 | 
				
			||||||
    ;; 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.
 | 
				
			||||||
 | 
					     (let ((list-installed-regex (assoc-ref opts 'list-installed)))
 | 
				
			||||||
       (match (generation-number "/run/current-system" %system-profile)
 | 
					       (match (generation-number "/run/current-system" %system-profile)
 | 
				
			||||||
         (0
 | 
					         (0
 | 
				
			||||||
          (match (generation-number %system-profile)
 | 
					          (match (generation-number %system-profile)
 | 
				
			||||||
            (0
 | 
					            (0
 | 
				
			||||||
             (leave (G_ "no system generation, nothing to describe~%")))
 | 
					             (leave (G_ "no system generation, nothing to describe~%")))
 | 
				
			||||||
            (generation
 | 
					            (generation
 | 
				
			||||||
           (display-system-generation generation))))
 | 
					             (display-system-generation
 | 
				
			||||||
 | 
					              generation #:list-installed-regex list-installed-regex))))
 | 
				
			||||||
         (generation
 | 
					         (generation
 | 
				
			||||||
        (display-system-generation 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)
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Reference in a new issue