summaryrefslogtreecommitdiff
path: root/guix/scripts/system.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-11-30 23:07:39 +0100
committerLudovic Courtès <ludo@gnu.org>2019-12-07 00:59:56 +0100
commit60f4564a63316c5655cfd1e01ea2ebfdd9cfb9f1 (patch)
tree8d6ddfaa7ca6ee0f10595cf48ae84e767da3923d /guix/scripts/system.scm
parenteaabc5e87f4e48d7bce88ca231f5fc2d554ca3d6 (diff)
guix system: "list-generations" displays provenance info.
* guix/scripts/pull.scm (channel-commit-hyperlink): Export. * guix/scripts/system.scm (display-system-generation) [display-channel]: New procedure. Read the "provenance" file of GENERATION and display channel info and the configuration file name when available.
Diffstat (limited to 'guix/scripts/system.scm')
-rw-r--r--guix/scripts/system.scm49
1 files changed, 47 insertions, 2 deletions
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index c9d790a731..129c248283 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -36,9 +36,11 @@
#:use-module (guix records)
#:use-module (guix profiles)
#:use-module (guix scripts)
+ #:use-module (guix channels)
#:use-module (guix scripts build)
#:autoload (guix scripts package) (delete-generations
delete-matching-generations)
+ #:autoload (guix scripts pull) (channel-commit-hyperlink)
#:use-module (guix graph)
#:use-module (guix scripts graph)
#:use-module (guix scripts system reconfigure)
@@ -456,9 +458,30 @@ list of services."
;;; Generations.
;;;
+(define (sexp->channel sexp)
+ "Return the channel corresponding to SEXP, an sexp as found in the
+\"provenance\" file produced by 'provenance-service-type'."
+ (match sexp
+ (('channel ('name name)
+ ('url url)
+ ('branch branch)
+ ('commit commit))
+ (channel (name name) (url url)
+ (branch branch) (commit commit)))))
+
(define* (display-system-generation number
#:optional (profile %system-profile))
"Display a summary of system generation NUMBER in a human-readable format."
+ (define (display-channel channel)
+ (format #t " ~a:~%" (channel-name channel))
+ (format #t (G_ " repository URL: ~a~%") (channel-url channel))
+ (when (channel-branch channel)
+ (format #t (G_ " branch: ~a~%") (channel-branch channel)))
+ (format #t (G_ " commit: ~a~%")
+ (if (supports-hyperlinks?)
+ (channel-commit-hyperlink channel)
+ (channel-commit channel))))
+
(unless (zero? number)
(let* ((generation (generation-file-name profile number))
(params (read-boot-parameters-file generation))
@@ -468,7 +491,13 @@ list of services."
(root-device (if (bytevector? root)
(uuid->string root)
root))
- (kernel (boot-parameters-kernel params)))
+ (kernel (boot-parameters-kernel params))
+ (provenance (catch 'system-error
+ (lambda ()
+ (call-with-input-file
+ (string-append generation "/provenance")
+ read))
+ (const #f))))
(display-generation profile number)
(format #t (G_ " file name: ~a~%") generation)
(format #t (G_ " canonical file name: ~a~%") (readlink* generation))
@@ -495,7 +524,23 @@ list of services."
(else
root-device)))
- (format #t (G_ " kernel: ~a~%") kernel))))
+ (format #t (G_ " kernel: ~a~%") kernel)
+
+ (match provenance
+ (#f #t)
+ (('provenance ('version 0)
+ ('channels channels ...)
+ ('configuration-file config-file))
+ (unless (null? channels)
+ ;; TRANSLATORS: Here "channel" is the same terminology as used in
+ ;; "guix describe" and "guix pull --channels".
+ (format #t (G_ " channels:~%"))
+ (for-each display-channel (map sexp->channel channels)))
+ (when config-file
+ (format #t (G_ " configuration file: ~a~%")
+ (if (supports-hyperlinks?)
+ (file-hyperlink config-file)
+ config-file))))))))
(define* (list-generations pattern #:optional (profile %system-profile))
"Display in a human-readable format all the system generations matching