summaryrefslogtreecommitdiff
path: root/guix/scripts
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-10-26 21:24:26 +0100
committerLudovic Courtès <ludo@gnu.org>2015-10-27 00:01:20 +0100
commit65797bfffd1b4d9126f11ffb6b59a1a7a18d48f0 (patch)
treebf47bd6fcbd04f5902dce3f5df27fc26236cd317 /guix/scripts
parent5b516ef3696270f21327d9f63a9ccb4f1b83f346 (diff)
guix system: Add the 'list-generations' command.
* guix/scripts/system.scm (display-system-generation, list-generations): New procedures. (process-action): Clarify docstring. (process-command): New procedure. (guix-system)[parse-sub-command]: Add 'list-generations' Call 'process-command' instead of 'process-action'. * doc/guix.texi (Using the Configuration System): Mention generations, rollback, and 'list-generations'. (Invoking guix system): Document 'list-generations'.
Diffstat (limited to 'guix/scripts')
-rw-r--r--guix/scripts/system.scm72
1 files changed, 67 insertions, 5 deletions
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 6db6a01ac9..d847c75444 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -42,6 +42,8 @@
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-19)
#:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-34)
+ #:use-module (srfi srfi-35)
#:use-module (srfi srfi-37)
#:use-module (ice-9 match)
#:export (guix-system
@@ -353,6 +355,48 @@ list of services."
;;;
+;;; Generations.
+;;;
+
+(define* (display-system-generation number
+ #:optional (profile %system-profile))
+ "Display a summary of system generation NUMBER in a human-readable format."
+ (unless (zero? number)
+ (let* ((generation (generation-file-name profile number))
+ (param-file (string-append generation "/parameters"))
+ (params (call-with-input-file param-file read-boot-parameters)))
+ (display-generation profile number)
+ (format #t (_ " file name: ~a~%") generation)
+ (format #t (_ " canonical file name: ~a~%") (readlink* generation))
+ (match params
+ (($ <boot-parameters> label root kernel)
+ ;; TRANSLATORS: Please preserve the two-space indentation.
+ (format #t (_ " label: ~a~%") label)
+ (format #t (_ " root device: ~a~%") root)
+ (format #t (_ " kernel: ~a~%") kernel))
+ (_
+ #f)))))
+
+(define* (list-generations pattern #:optional (profile %system-profile))
+ "Display in a human-readable format all the system generations matching
+PATTERN, a string. When PATTERN is #f, display all the system generations."
+ (cond ((not (file-exists? profile)) ; XXX: race condition
+ (raise (condition (&profile-not-found-error
+ (profile profile)))))
+ ((string-null? pattern)
+ (for-each display-system-generation (profile-generations profile)))
+ ((matching-generations pattern profile)
+ =>
+ (lambda (numbers)
+ (if (null-list? numbers)
+ (exit 1)
+ (leave-on-EPIPE
+ (for-each display-system-generation numbers)))))
+ (else
+ (leave (_ "invalid syntax: ~a~%") pattern))))
+
+
+;;;
;;; Action.
;;;
@@ -468,7 +512,7 @@ building anything."
;;;
(define (show-help)
- (display (_ "Usage: guix system [OPTION] ACTION FILE
+ (display (_ "Usage: guix system [OPTION] ACTION [FILE]
Build the operating system declared in FILE according to ACTION.\n"))
(newline)
(display (_ "The valid values for ACTION are:\n"))
@@ -476,6 +520,8 @@ Build the operating system declared in FILE according to ACTION.\n"))
(display (_ "\
reconfigure switch to a new operating system configuration\n"))
(display (_ "\
+ list-generations list the system generations\n"))
+ (display (_ "\
build build the operating system without installing anything\n"))
(display (_ "\
vm build a virtual machine image that shares the host's store\n"))
@@ -577,8 +623,10 @@ Build the operating system declared in FILE according to ACTION.\n"))
;;;
(define (process-action action args opts)
- "Process ACTION, a sub-command, whose arguments are listed in ARGS. OPTS is
-the raw alist of options resulting from command-line parsing."
+ "Process ACTION, a sub-command, with the arguments are listed in ARGS.
+ACTION must be one of the sub-commands that takes an operating system
+declaration as an argument (a file name.) OPTS is the raw alist of options
+resulting from command-line parsing."
(let* ((file (match args
(() #f)
((x . _) x)))
@@ -625,6 +673,20 @@ the raw alist of options resulting from command-line parsing."
#:target target #:device device))))
#:system system))))
+(define (process-command command args opts)
+ "Process COMMAND, one of the 'guix system' sub-commands. ARGS is its
+argument list and OPTS is the option alist."
+ (case command
+ ((list-generations)
+ ;; List generations. No need to connect to the daemon, etc.
+ (let ((pattern (match args
+ (() "")
+ ((pattern) pattern)
+ (x (leave (_ "wrong number of arguments~%"))))))
+ (list-generations pattern)))
+ (else
+ (process-action command args opts))))
+
(define (guix-system . args)
(define (parse-sub-command arg result)
;; Parse sub-command ARG and augment RESULT accordingly.
@@ -633,7 +695,7 @@ the raw alist of options resulting from command-line parsing."
(let ((action (string->symbol arg)))
(case action
((build vm vm-image disk-image reconfigure init
- extension-graph dmd-graph)
+ extension-graph dmd-graph list-generations)
(alist-cons 'action action result))
(else (leave (_ "~a: unknown action~%") action))))))
@@ -676,6 +738,6 @@ the raw alist of options resulting from command-line parsing."
parse-sub-command))
(args (option-arguments opts))
(command (assoc-ref opts 'action)))
- (process-action command args opts))))
+ (process-command command args opts))))
;;; system.scm ends here