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'.

2 files changed, 110 insertions, 9 deletions

diff --git a/doc/guix.texi b/doc/guix.texi
index 7715b72818..20bf28424e 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -5369,9 +5369,24 @@ information about the @code{nss-certs} package that is used here.
 Assuming the above snippet is stored in the @file{my-system-config.scm}
 file, the @command{guix system reconfigure my-system-config.scm} command
 instantiates that configuration, and makes it the default GRUB boot
-entry (@pxref{Invoking guix system}).  The normal way to change the
-system's configuration is by updating this file and re-running the
-@command{guix system} command.
+entry (@pxref{Invoking guix system}).
+
+The normal way to change the system's configuration is by updating this
+file and re-running @command{guix system reconfigure}.  One should never
+have to touch files in @command{/etc} or to run commands that modify the
+system state such as @command{useradd} or @command{grub-install}.  In
+fact, you must avoid that since that would not only void your warranty
+but also prevent you from rolling back to previous versions of your
+system, should you ever need to.
+
+@cindex roll-back, of the operating system
+Speaking of roll-back, each time you run @command{guix system
+reconfigure}, a new @dfn{generation} of the system is created---without
+modifying or deleting previous generations.  Old system generations get
+an entry in the GRUB boot menu, allowing you to boot them in case
+something went wrong with the latest generation.  Reassuring, no?  The
+@command{guix system list-generations} command lists the system
+generations available on disk.
 
 At the Scheme level, the bulk of an @code{operating-system} declaration
 is instantiated with the following monadic procedure (@pxref{The Store
@@ -7077,7 +7092,7 @@ supported:
 @item reconfigure
 Build the operating system described in @var{file}, activate it, and
 switch to it@footnote{This action is usable only on systems already
-running GNU.}.
+running GuixSD.}.
 
 This effects all the configuration specified in @var{file}: user
 accounts, system services, global package list, setuid programs, etc.
@@ -7218,6 +7233,30 @@ KVM kernel module should be loaded, and the @file{/dev/kvm} device node
 must exist and be readable and writable by the user and by the daemon's
 build users.
 
+Once you have built, configured, re-configured, and re-re-configured
+your GuixSD installation, you may find it useful to list the operating
+system generations available on disk---and that you can choose from the
+GRUB boot menu:
+
+@table @code
+
+@item list-generations
+List a summary of each generation of the operating system available on
+disk, in a human-readable way.  This is similar to the
+@option{--list-generations} option of @command{guix package}
+(@pxref{Invoking guix package}).
+
+Optionally, one can specify a pattern, with the same syntax that is used
+in @command{guix package --list-generations}, to restrict the list of
+generations displayed.  For instance, the following command displays
+generations up to 10-day old:
+
+@example
+$ guix system list-generations 10d
+@end example
+
+@end table
+
 The @command{guix system} command has even more to offer!  The following
 sub-commands allow you to visualize how your system services relate to
 each other:
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