amaharaneko/guix-mirrors
1
1
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2025-10-02 02:15:12 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

services: Add 'system-provenance' procedure.

Browse source 
* gnu/services.scm (sexp->channel, system-provenance): New procedures.
* guix/scripts/system.scm (sexp->channel): Remove.
(display-system-generation): Use 'system-provenance' instead of parsing
the "provenance" file right here.
This commit is contained in:
Ludovic Courtès 2020-07-14 15:50:38 +02:00
parent 0a72157271
commit b91a73a6a4
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 46 additions and 35 deletions
Download patch file Download diff file Expand all files Collapse all files

49
guix/scripts/system.scm
View file

@ -446,19 +446,6 @@ 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)
rest ...)
;; XXX: In the future REST may include a channel introduction.
(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."
@ -482,13 +469,10 @@ list of services."
(uuid->string root)
root))
(kernel (boot-parameters-kernel params))
(multiboot-modules (boot-parameters-multiboot-modules params))
(provenance (catch 'system-error
(lambda ()
(call-with-input-file
(string-append generation "/provenance")
read))
(const #f))))
(multiboot-modules (boot-parameters-multiboot-modules params)))
(define-values (channels config-file)
(system-provenance generation))
(display-generation profile number)
(format #t (G_ " file name: ~a~%") generation)
(format #t (G_ " canonical file name: ~a~%") (readlink* generation))
@ -518,21 +502,16 @@ list of services."
(format #t (G_ " multiboot: ~a~%")
(string-join modules "\n "))))
(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))))))))
(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 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