diff options
| -rw-r--r-- | gnu/services.scm | 32 | ||||
| -rw-r--r-- | guix/scripts/system.scm | 49 |
2 files changed, 46 insertions, 35 deletions
diff --git a/gnu/services.scm b/gnu/services.scm index f6dc56d940..6509a9014e 100644 --- a/gnu/services.scm +++ b/gnu/services.scm @@ -89,6 +89,7 @@ system-service-type provenance-service-type + system-provenance boot-service-type cleanup-service-type activation-service-type @@ -423,6 +424,19 @@ be parsed by tools; it's potentially more future-proof than code." (branch ,(channel-branch channel)) (commit ,(channel-commit channel)))) +(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 (provenance-file channels config-file) "Return a 'provenance' file describing CHANNELS, a list of channels, and CONFIG-FILE, which can be either #f or a <local-file> containing the OS @@ -474,6 +488,24 @@ channels in use and CONFIG-FILE, if it is true." itself: the channels used when building the system, and its configuration file, when available."))) +(define (system-provenance system) + "Given SYSTEM, the file name of a system generation, return two values: the +list of channels SYSTEM is built from, and its configuration file. If that +information is missing, return the empty list (for channels) and possibly +#false (for the configuration file)." + (catch 'system-error + (lambda () + (match (call-with-input-file (string-append system "/provenance") + read) + (('provenance ('version 0) + ('channels channels ...) + ('configuration-file config-file)) + (values (map sexp->channel channels) + config-file)) + (_ + (values '() #f)))) + (lambda _ + (values '() #f)))) ;;; ;;; Cleanup. diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 61eeec622b..f2b4367094 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -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 |