Patches to implement system roll-back and switch-generation

Patches to implement system roll-back and switch-generation

[Chris Marusich]

[-- Attachment #1.1: Type: text/plain, Size: 2101 bytes --]

Hi,

Here are some patches which, when applied to
1df00601b280db1cdfe0fc8d539ee6c6c726c355, make it possible to switch
system generations using two new "guix system" subcommands: "roll-back"
and "switch-generation".  These commands currently just rebuild the
grub.cfg file with a new default entry.  As a result, if you want to
roll back or switch to another system generation, you don't have to
manually select a previous version every single time you boot, which is
nice.

I believe my patch does NOT yet make the regenerated grub.cfg a GC root,
so it is possible that after rolling back or switching generations,
invoking GC might clean up some things you'd rather keep around (like
the grub background image file).  Please be careful not to try this
patch on a machine you care about; please use a VM instead.  I've
verified that it works in a VM.

I'm hoping for some constructive feedback.  I've had a rough time
getting this to work on my own because this is the first real work I've
tried doing with Guile or a free software project, and because a lot of
the machinery that already exists (e.g., in (guix scripts system))
assumes that we are going to get the info we need for building the grub
config from an operating system configuration file, which is not true
for this use case.  I've also had quite a hard time understanding the
relationship between monadic values in the store monad, gexps,
derivations, and how to use them effectively.  If you notice I am doing
something strange or outright incorrect, please let me know so I can fix
it and do better.

Unfortunately, these patches do not apply cleanly to the current master
branch because of commit 0f65f54ebd76324653fd5506a7dab42ee44d9255.  This
commit has thrown a wrench in my plans.  When I try to rebase onto
master, there are multiple conflicts, and I am not sure yet what the
best way to resolve them will be.  In any case, I think it will be more
productive to ask for feedback now, rather than to continue on my own
down uncertain paths.

I look forward to your feedback.

-- 
Chris

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: 0001-Improve-docstring-switch-to-generation.patch --]
[-- Type: text/x-patch, Size: 1021 bytes --]

From 1741e8a66be3d7e5f647796f434689b0a61e1122 Mon Sep 17 00:00:00 2001
From: Chris Marusich <cmmarusich@gmail.com>
Date: Tue, 12 Jul 2016 22:58:03 -0700
Subject: [PATCH 1/9] Improve docstring: switch-to-generation

---
 guix/profiles.scm | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/guix/profiles.scm b/guix/profiles.scm
index 4a2ba1c..38f69dd 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -1011,7 +1011,9 @@ that fails."
 
 (define (switch-to-generation profile number)
   "Atomically switch PROFILE to the generation NUMBER.  Return the number of
-the generation that was current before switching."
+the generation that was current before switching.  Raise a
+&profile-not-found-error when the profile does not exist.  Raise a
+&missing-generation-error when the generation does not exist."
   (let ((current    (generation-number profile))
         (generation (generation-file-name profile number)))
     (cond ((not (file-exists? profile))
-- 
2.9.2


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.3: 0002-Refactor-extract-procedure-relative-generation-spec-.patch --]
[-- Type: text/x-patch, Size: 2619 bytes --]

From 9f554133be83f06d5a3d0bfc713331e59eb2116c Mon Sep 17 00:00:00 2001
From: Chris Marusich <cmmarusich@gmail.com>
Date: Tue, 12 Jul 2016 22:53:10 -0700
Subject: [PATCH 2/9] Refactor: extract procedure:
 relative-generation-spec->number

---
 guix/profiles.scm        | 16 ++++++++++++++++
 guix/scripts/package.scm |  7 +------
 2 files changed, 17 insertions(+), 6 deletions(-)

diff --git a/guix/profiles.scm b/guix/profiles.scm
index 38f69dd..3828d44 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -96,6 +96,7 @@
             generation-number
             generation-numbers
             profile-generations
+            relative-generation-spec->number
             relative-generation
             previous-generation-number
             generation-time
@@ -968,6 +969,21 @@ former profiles were found."
         '()
         generations)))
 
+(define (relative-generation-spec->number profile spec)
+  "Return PROFILE's generation specified by SPEC, which is a string.  The SPEC
+may be a N, -N, or +N, where N is a number.  If the spec is N, then the number
+returned is N.  If it is -N, then the number returned is the profile's current
+generation number minus N.  If it is +N, then the number returned is the
+profile's current generation number plus N.  Return #f if there is no such
+generation."
+  (let ((number (string->number spec)))
+    (and number
+         (case (string-ref spec 0)
+           ((#\+ #\-)
+            (relative-generation profile number))
+           (else number)))))
+
+
 (define* (relative-generation profile shift #:optional
                               (current (generation-number profile)))
   "Return PROFILE's generation shifted from the CURRENT generation by SHIFT.
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index b87aee0..1d8972c 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -774,12 +774,7 @@ processed, #f otherwise."
                                    #:key dry-run?)
   "Switch PROFILE to the generation specified by SPEC."
   (unless dry-run?
-    (let* ((number (string->number spec))
-           (number (and number
-                        (case (string-ref spec 0)
-                          ((#\+ #\-)
-                           (relative-generation profile number))
-                          (else number)))))
+    (let ((number (relative-generation-spec->number profile spec)))
       (if number
           (switch-to-generation* profile number)
           (leave (_ "cannot switch to generation '~a'~%") spec)))))
-- 
2.9.2


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.4: 0003-Rename-previous-grub-entries-to-grub-entries.patch --]
[-- Type: text/x-patch, Size: 1635 bytes --]

From 42b1f00ce802745fbdc3b9bc5be38ccd47c0af33 Mon Sep 17 00:00:00 2001
From: Chris Marusich <cmmarusich@gmail.com>
Date: Sat, 16 Jul 2016 15:53:22 -0700
Subject: [PATCH 3/9] Rename previous-grub-entries to grub-entries

This procedure actually returns an entry for every generation of the profile,
so its name is confusing if it suggests that it only returns "previous"
entries.
---
 guix/scripts/system.scm | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 953c624..25a7743 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -370,7 +370,7 @@ it atomically, and then run OS's activation script."
     (date->string (time-utc->date time)
                   "~Y-~m-~d ~H:~M")))
 
-(define* (previous-grub-entries #:optional (profile %system-profile))
+(define* (grub-entries #:optional (profile %system-profile))
   "Return a list of 'menu-entry' for the generations of PROFILE."
   (define (system->grub-entry system number time)
     (unless-file-not-found
@@ -564,7 +564,7 @@ building anything."
                       (operating-system-grub.cfg os
                                                  (if (eq? 'init action)
                                                      '()
-                                                     (previous-grub-entries)))))
+                                                     (grub-entries)))))
 
        ;; For 'init' and 'reconfigure', always build GRUB.CFG, even if
        ;; --no-grub is passed, because GRUB.CFG because we then use it as a GC
-- 
2.9.2


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.5: 0004-Fix-docstrings-these-procedures-return-derivations.patch --]
[-- Type: text/x-patch, Size: 2072 bytes --]

From a440eb18eaa6c2fe12d91db1c9d62e79823e7ad0 Mon Sep 17 00:00:00 2001
From: Chris Marusich <cmmarusich@gmail.com>
Date: Mon, 1 Aug 2016 07:51:38 -0700
Subject: [PATCH 4/9] Fix docstrings: these procedures return derivations

---
 gnu/system.scm      | 4 ++--
 gnu/system/grub.scm | 8 ++++----
 2 files changed, 6 insertions(+), 6 deletions(-)

diff --git a/gnu/system.scm b/gnu/system.scm
index 7edb018..1d1ed5e 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -718,8 +718,8 @@ listed in OS.  The C library expects to find it under
   (store-file-system (operating-system-file-systems os)))
 
 (define* (operating-system-grub.cfg os #:optional (old-entries '()))
-  "Return the GRUB configuration file for OS.  Use OLD-ENTRIES to populate the
-\"old entries\" menu."
+  "Return a derivation which builds the GRUB configuration file for OS.  Use
+OLD-ENTRIES to populate the \"old entries\" menu."
   (mlet* %store-monad
       ((system      (operating-system-derivation os))
        (root-fs ->  (operating-system-root-file-system os))
diff --git a/gnu/system/grub.scm b/gnu/system/grub.scm
index 4592747..c426d5f 100644
--- a/gnu/system/grub.scm
+++ b/gnu/system/grub.scm
@@ -239,10 +239,10 @@ code."
                                   #:key
                                   (system (%current-system))
                                   (old-entries '()))
-  "Return the GRUB configuration file corresponding to CONFIG, a
-<grub-configuration> object, and where the store is available at STORE-FS, a
-<file-system> object.  OLD-ENTRIES is taken to be a list of menu entries
-corresponding to old generations of the system."
+  "Return a derivation which builds the GRUB configuration file corresponding
+to CONFIG, a <grub-configuration> object, and where the store is available at
+STORE-FS, a <file-system> object.  OLD-ENTRIES is taken to be a list of menu
+entries corresponding to old generations of the system."
   (define all-entries
     (append entries (grub-configuration-menu-entries config)))
 
-- 
2.9.2


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.6: 0005-Factor-out-procedure-device-title.patch --]
[-- Type: text/x-patch, Size: 2560 bytes --]

From 227ffc6c34c7bef29a39b2745865ac25c28a7e74 Mon Sep 17 00:00:00 2001
From: Chris Marusich <cmmarusich@gmail.com>
Date: Mon, 1 Aug 2016 08:46:48 -0700
Subject: [PATCH 5/9] Factor out procedure: device->title

---
 gnu/build/file-systems.scm | 31 ++++++++++++++++++-------------
 1 file changed, 18 insertions(+), 13 deletions(-)

diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index f1fccbd..4a8acd5 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -38,6 +38,7 @@
             find-partition-by-uuid
             find-partition-by-luks-uuid
             canonicalize-device-spec
+            device->title
 
             uuid->string
             string->uuid
@@ -364,19 +365,6 @@ the following:
     ;; this long.
     20)
 
-  (define canonical-title
-    ;; The realm of canonicalization.
-    (if (eq? title 'any)
-        (if (string? spec)
-            ;; The "--root=SPEC" kernel command-line option always provides a
-            ;; string, but the string can represent a device, a UUID, or a
-            ;; label.  So check for all three.
-            (cond ((string-prefix? "/" spec) 'device)
-                  ((string->uuid spec) 'uuid)
-                  (else 'label))
-            'uuid)
-        title))
-
   (define (resolve find-partition spec fmt)
     (let loop ((count 0))
       (let ((device (find-partition spec)))
@@ -391,6 +379,10 @@ the following:
                   (sleep 1)
                   (loop (+ 1 count))))))))
 
+  (define canonical-title (if (eq? title 'any)
+                              (device->title spec)
+                              title))
+
   (case canonical-title
     ((device)
      ;; Nothing to do.
@@ -407,6 +399,19 @@ the following:
     (else
      (error "unknown device title" title))))
 
+(define (device->title device)
+  "Guess the title for the given DEVICE, which must be a device parameter from
+a <file-system> object.  As a special case, when the DEVICE is a UUID, it may
+be specified as a string."
+  (if (string? device)
+      ;; The "--root=SPEC" kernel command-line option always provides a
+      ;; string, but the string can represent a device, a UUID, or a
+      ;; label.  So check for all three.
+      (cond ((string-prefix? "/" device) 'device)
+            ((string->uuid device) 'uuid)
+            (else 'label))
+      'uuid))
+
 (define (check-file-system device type)
   "Run a file system check of TYPE on DEVICE."
   (define fsck
-- 
2.9.2


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.7: 0006-gnu-system-and-gnu-system-grub-use-root-fs-device-no.patch --]
[-- Type: text/x-patch, Size: 5453 bytes --]

From 1ade872ffae08ded1b8dae2fca05fee33ac0c69f Mon Sep 17 00:00:00 2001
From: Chris Marusich <cmmarusich@gmail.com>
Date: Mon, 1 Aug 2016 08:57:08 -0700
Subject: [PATCH 6/9] gnu/system and gnu/system/grub: use root-fs-device, not
 root-fs

---
 gnu/system.scm      |  3 ++-
 gnu/system/grub.scm | 37 ++++++++++++++++++++-----------------
 2 files changed, 22 insertions(+), 18 deletions(-)

diff --git a/gnu/system.scm b/gnu/system.scm
index 1d1ed5e..3750094 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -740,7 +740,8 @@ OLD-ENTRIES to populate the \"old entries\" menu."
                                    (operating-system-kernel-arguments os)))
                            (initrd (file-append system "/initrd"))))))
     (grub-configuration-file (operating-system-bootloader os)
-                             store-fs entries
+                             (file-system-device store-fs)
+                             entries
                              #:old-entries old-entries)))
 
 (define (operating-system-parameters-file os)
diff --git a/gnu/system/grub.scm b/gnu/system/grub.scm
index c426d5f..02f8e68 100644
--- a/gnu/system/grub.scm
+++ b/gnu/system/grub.scm
@@ -26,6 +26,7 @@
   #:use-module (guix download)
   #:use-module (gnu artwork)
   #:use-module (gnu system file-systems)
+  #:use-module (gnu build file-systems)
   #:autoload   (gnu packages grub) (grub)
   #:autoload   (gnu packages inkscape) (inkscape)
   #:autoload   (gnu packages imagemagick) (imagemagick)
@@ -154,12 +155,12 @@ WIDTH/HEIGHT, or #f if none was found."
         (with-monad %store-monad
           (return #f)))))
 
-(define (eye-candy config root-fs system port)
+(define (eye-candy config root-fs-device system port)
   "Return in %STORE-MONAD a gexp that writes to PORT (a port-valued gexp) the
 'grub.cfg' part concerned with graphics mode, background images, colors, and
-all that.  ROOT-FS is a file-system object denoting the root file system where
-the store is.  SYSTEM must be the target system string---e.g.,
-\"x86_64-linux\"."
+all that.  ROOT-FS-DEVICE is the device parameter from a <file-system> object
+denoting the root file system where the store is.  SYSTEM must be the target
+system string---e.g., \"x86_64-linux\"."
   (define setup-gfxterm-body
     ;; Intel systems need to be switched into graphics mode, whereas most
     ;; other modern architectures have no other mode and therefore don't need
@@ -206,7 +207,7 @@ else
   set menu_color_highlight=white/blue
 fi~%"
                            #$setup-gfxterm-body
-                           #$(grub-root-search root-fs font-file)
+                           #$(grub-root-search root-fs-device font-file)
                            #$font-file
 
                            #$image
@@ -218,31 +219,32 @@ fi~%"
 ;;; Configuration file.
 ;;;
 
-(define (grub-root-search root-fs file)
-  "Return the GRUB 'search' command to look for ROOT-FS, which contains FILE,
+(define (grub-root-search root-fs-device file)
+  "Return the GRUB 'search' command to look for ROOT-FS-DEVICE, which contains FILE,
 a gexp.  The result is a gexp that can be inserted in the grub.cfg-generation
 code."
-  (case (file-system-title root-fs)
-    ;; Preferably refer to ROOT-FS by its UUID or label.  This is more
-    ;; efficient and less ambiguous, see <>.
+  (case (device->title root-fs-device)
+    ;; Preferably refer to ROOT-FS-DEVICE by its UUID or label.  This is more
+    ;; efficient and less ambiguous.
     ((uuid)
      (format #f "search --fs-uuid --set ~a"
-             (uuid->string (file-system-device root-fs))))
+             (uuid->string root-fs-device)))
     ((label)
      (format #f "search --label --set ~a"
-             (file-system-device root-fs)))
+             root-fs-device))
     (else
      ;; As a last resort, look for any device containing FILE.
      #~(format #f "search --file --set ~a" #$file))))
 
-(define* (grub-configuration-file config store-fs entries
+(define* (grub-configuration-file config store-fs-device entries
                                   #:key
                                   (system (%current-system))
                                   (old-entries '()))
   "Return a derivation which builds the GRUB configuration file corresponding
 to CONFIG, a <grub-configuration> object, and where the store is available at
-STORE-FS, a <file-system> object.  OLD-ENTRIES is taken to be a list of menu
-entries corresponding to old generations of the system."
+STORE-FS-DEVICE, the device parameter from a <file-system> object.
+OLD-ENTRIES is taken to be a list of menu entries corresponding to old
+generations of the system."
   (define all-entries
     (append entries (grub-configuration-menu-entries config)))
 
@@ -255,11 +257,12 @@ entries corresponding to old generations of the system."
   initrd ~a
 }~%"
                 #$label
-                #$(grub-root-search store-fs linux)
+                #$(grub-root-search store-fs-device linux)
                 #$linux (string-join (list #$@arguments))
                 #$initrd))))
 
-  (mlet %store-monad ((sugar (eye-candy config store-fs system #~port)))
+  (mlet %store-monad
+      ((sugar (eye-candy config store-fs-device system #~port)))
     (define builder
       #~(call-with-output-file #$output
           (lambda (port)
-- 
2.9.2


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.8: 0007-gnu-build-install-Factor-out-procedure-install-grub-.patch --]
[-- Type: text/x-patch, Size: 2589 bytes --]

From 55cf900abf6dba10ed640d24433cc1ca23e4acf2 Mon Sep 17 00:00:00 2001
From: Chris Marusich <cmmarusich@gmail.com>
Date: Tue, 2 Aug 2016 21:28:21 -0700
Subject: [PATCH 7/9] gnu/build/install: Factor out procedure:
 install-grub-config

---
 gnu/build/install.scm | 22 ++++++++++++++--------
 1 file changed, 14 insertions(+), 8 deletions(-)

diff --git a/gnu/build/install.scm b/gnu/build/install.scm
index 7431a09..ce4f06e 100644
--- a/gnu/build/install.scm
+++ b/gnu/build/install.scm
@@ -22,6 +22,7 @@
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 match)
   #:export (install-grub
+            install-grub-config
             populate-root-file-system
             reset-timestamps
             register-closure
@@ -36,13 +37,24 @@
 ;;;
 ;;; Code:
 
-(define* (install-grub grub.cfg device mount-point)
+(define (install-grub grub.cfg device mount-point)
   "Install GRUB with GRUB.CFG on DEVICE, which is assumed to be mounted on
 MOUNT-POINT.
 
 Note that the caller must make sure that GRUB.CFG is registered as a GC root
 so that the fonts, background images, etc. referred to by GRUB.CFG are not
 GC'd."
+  (install-grub-config grub.cfg mount-point)
+  (unless (zero? (system* "grub-install" "--no-floppy"
+                          "--boot-directory"
+                          (string-append mount-point "/boot")
+                          device))
+    (error "failed to install GRUB")))
+
+(define (install-grub-config grub.cfg mount-point)
+  "Atomically copy GRUB.CFG into boot/grub/grub.cfg on the MOUNT-POINT.  Note
+that the caller must make sure that GRUB.CFG is registered as a GC root so
+that the fonts, background images, etc. referred to by GRUB.CFG are not GC'd."
   (let* ((target (string-append mount-point "/boot/grub/grub.cfg"))
          (pivot  (string-append target ".new")))
     (mkdir-p (dirname target))
@@ -50,13 +62,7 @@ GC'd."
     ;; Copy GRUB.CFG instead of just symlinking it, because symlinks won't
     ;; work when /boot is on a separate partition.  Do that atomically.
     (copy-file grub.cfg pivot)
-    (rename-file pivot target)
-
-    (unless (zero? (system* "grub-install" "--no-floppy"
-                            "--boot-directory"
-                            (string-append mount-point "/boot")
-                            device))
-      (error "failed to install GRUB"))))
+    (rename-file pivot target)))
 
 (define (evaluate-populate-directive directive target)
   "Evaluate DIRECTIVE, an sexp describing a file or directory to create under
-- 
2.9.2


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.9: 0008-grub-entries-take-a-list-of-numbers-on-input.patch --]
[-- Type: text/x-patch, Size: 1681 bytes --]

From 059e79ab26f5e8ee60b60f5df01907300346c8e2 Mon Sep 17 00:00:00 2001
From: Chris Marusich <cmmarusich@gmail.com>
Date: Thu, 28 Jul 2016 02:31:38 -0700
Subject: [PATCH 8/9] grub-entries: take a list of numbers on input

---
 guix/scripts/system.scm | 9 +++++----
 1 file changed, 5 insertions(+), 4 deletions(-)

diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 25a7743..f450c9a 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -370,8 +370,10 @@ it atomically, and then run OS's activation script."
     (date->string (time-utc->date time)
                   "~Y-~m-~d ~H:~M")))
 
-(define* (grub-entries #:optional (profile %system-profile))
-  "Return a list of 'menu-entry' for the generations of PROFILE."
+(define* (grub-entries #:optional (profile %system-profile)
+                                  (numbers (generation-numbers profile)))
+  "Return a list of 'menu-entry' for the generations of PROFILE specified by
+NUMBERS, which is a list of generation numbers."
   (define (system->grub-entry system number time)
     (unless-file-not-found
      (let* ((file             (string-append system "/parameters"))
@@ -396,8 +398,7 @@ it atomically, and then run OS's activation script."
                 kernel-arguments))
         (initrd #~(string-append #$system "/initrd"))))))
 
-  (let* ((numbers (generation-numbers profile))
-         (systems (map (cut generation-file-name profile <>)
+  (let* ((systems (map (cut generation-file-name profile <>)
                        numbers))
          (times   (map (lambda (system)
                          (unless-file-not-found
-- 
2.9.2


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.10: 0009-Implement-switch-generation-and-roll-back.patch --]
[-- Type: text/x-patch, Size: 6384 bytes --]

From b5816897c6db7984f678963dabe8ae58c6947677 Mon Sep 17 00:00:00 2001
From: Chris Marusich <cmmarusich@gmail.com>
Date: Wed, 3 Aug 2016 00:41:01 -0700
Subject: [PATCH 9/9] Implement switch-generation and roll-back

---
 guix/scripts/system.scm | 87 ++++++++++++++++++++++++++++++++++++++++++++++---
 1 file changed, 83 insertions(+), 4 deletions(-)

diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index f450c9a..5c72808 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -408,6 +408,57 @@ NUMBERS, which is a list of generation numbers."
 
 \f
 ;;;
+;;; Roll-back.
+;;;
+(define (roll-back-system store)
+  "Roll back the system profile to its previous generation."
+  (switch-to-system-generation store "-1"))
+\f
+;;;
+;;; Switch generations.
+;;;
+(define (switch-to-system-generation store spec)
+  "Switch the system profile to the generation specified by SPEC, and
+re-install grub with a grub configuration file that uses the specified system
+generation as its default entry."
+  (let ((number (relative-generation-spec->number %system-profile spec)))
+      (if number
+          (begin
+            (reinstall-grub store number)
+            (switch-to-generation* %system-profile number))
+          (leave (_ "cannot switch to system generation '~a'~%") spec))))
+
+(define (reinstall-grub store number)
+  "Re-install grub for existing system profile generation NUMBER."
+  (unless-file-not-found
+   (let*
+       ((generation (generation-file-name %system-profile number))
+        (file (string-append generation "/parameters"))
+        (params (call-with-input-file file read-boot-parameters))
+        ;; We assume that the root file system contains the store.  If this
+        ;; assumption is ever false, then problems might occur.
+        (root-device (boot-parameters-root-device params))
+        ;; Generate a new grub configuration which uses default values for
+        ;; just about everything.  If the specified system generation was
+        ;; built from an operating system configuration file that contained
+        ;; non-default values in its grub-configuration, then the grub
+        ;; configuration we generate here will be different.  However, even
+        ;; if that is the case, this default configuration will be good
+        ;; enough to enable the user to boot into the specified generation.
+        (grub-config (grub-configuration (device root-device)))
+        ;; Make the specified system generation the default entry.
+        (entries (grub-entries %system-profile (list number)))
+        (old-entries (grub-entries))
+        (grub.cfg-derivation (run-with-store store
+                    (grub-configuration-file grub-config
+                                             root-device
+                                             entries
+                                             #:old-entries old-entries))))
+     (build-derivations store (list grub.cfg-derivation))
+     (install-grub-config (derivation->output-path grub.cfg-derivation) "/"))))
+
+\f
+;;;
 ;;; Graphs.
 ;;;
 
@@ -642,14 +693,19 @@ building anything."
 ;;;
 
 (define (show-help)
-  (display (_ "Usage: guix system [OPTION] ACTION [FILE]
-Build the operating system declared in FILE according to ACTION.\n"))
+  (display (_ "Usage: guix system [OPTION ...] ACTION [ARG ...] [FILE]
+Build the operating system declared in FILE according to ACTION.
+Some ACTIONS support additional ARGS.\n"))
   (newline)
   (display (_ "The valid values for ACTION are:\n"))
   (newline)
   (display (_ "\
    reconfigure      switch to a new operating system configuration\n"))
   (display (_ "\
+   roll-back        switch to the previous operating system configuration\n"))
+  (display (_ "\
+   switch-generation switch to an existing operating system configuration\n"))
+  (display (_ "\
    list-generations list the system generations\n"))
   (display (_ "\
    build            build the operating system without installing anything\n"))
@@ -809,6 +865,8 @@ resulting from command-line parsing."
 (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."
+  ;; The following commands do not need to use the store, and they do not need
+  ;; an operating system configuration file.
   (case command
     ((list-generations)
      ;; List generations.  No need to connect to the daemon, etc.
@@ -818,7 +876,27 @@ argument list and OPTS is the option alist."
                       (x (leave (_ "wrong number of arguments~%"))))))
        (list-generations pattern)))
     (else
-     (process-action command args opts))))
+     ;; The following commands need to use the store, but they do not need an
+     ;; operating system configuration file.
+     (case command
+       ((switch-generation)
+        (with-store store
+          (set-build-options-from-command-line store opts)
+          (let ((pattern (match args
+                           ((pattern) pattern)
+                           (x (leave (_ "wrong number of arguments~%"))))))
+            (switch-to-system-generation store pattern))))
+       ((roll-back)
+        (with-store store
+          (set-build-options-from-command-line store opts)
+          (let ((pattern (match args
+                           (() "")
+                           (x (leave (_ "wrong number of arguments~%"))))))
+            (roll-back-system store))))
+       (else
+        ;; The following commands need to use the store, and they also
+        ;; need an operating system configuration file.
+        (process-action command args opts))))))
 
 (define (guix-system . args)
   (define (parse-sub-command arg result)
@@ -828,7 +906,8 @@ argument list and OPTS is the option alist."
         (let ((action (string->symbol arg)))
           (case action
             ((build container vm vm-image disk-image reconfigure init
-              extension-graph shepherd-graph list-generations)
+              extension-graph shepherd-graph list-generations roll-back
+              switch-generation)
              (alist-cons 'action action result))
             (else (leave (_ "~a: unknown action~%") action))))))
 
-- 
2.9.2


[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 818 bytes --]

Re: Patches to implement system roll-back and switch-generation

[Ludovic Courtès]

Hi!

Chris Marusich <cmmarusich@gmail.com> skribis:

> Here are some patches which, when applied to
> 1df00601b280db1cdfe0fc8d539ee6c6c726c355, make it possible to switch
> system generations using two new "guix system" subcommands: "roll-back"
> and "switch-generation".  These commands currently just rebuild the
> grub.cfg file with a new default entry.  As a result, if you want to
> roll back or switch to another system generation, you don't have to
> manually select a previous version every single time you boot, which is
> nice.

Awesome!

> I believe my patch does NOT yet make the regenerated grub.cfg a GC root,
> so it is possible that after rolling back or switching generations,
> invoking GC might clean up some things you'd rather keep around (like
> the grub background image file).  Please be careful not to try this
> patch on a machine you care about; please use a VM instead.  I've
> verified that it works in a VM.

Indeed.  I think you’ll need to extract and reuse the logic in
‘install-grub*’ that installs the GC root.

> Unfortunately, these patches do not apply cleanly to the current master
> branch because of commit 0f65f54ebd76324653fd5506a7dab42ee44d9255.  This
> commit has thrown a wrench in my plans.  When I try to rebase onto
> master, there are multiple conflicts, and I am not sure yet what the
> best way to resolve them will be.  In any case, I think it will be more
> productive to ask for feedback now, rather than to continue on my own
> down uncertain paths.

Sorry about that!  Hopefully we can work around the conflicts.

Overall the patches LGTM.  You’re going to hate me for that, but could
you please add ChangeLog-style commit logs?  Also, could you send the
revised patches using ‘git send-email’?

> From 1741e8a66be3d7e5f647796f434689b0a61e1122 Mon Sep 17 00:00:00 2001
> From: Chris Marusich <cmmarusich@gmail.com>
> Date: Tue, 12 Jul 2016 22:58:03 -0700
> Subject: [PATCH 1/9] Improve docstring: switch-to-generation
>
> ---
>  guix/profiles.scm | 4 +++-
>  1 file changed, 3 insertions(+), 1 deletion(-)
>
> diff --git a/guix/profiles.scm b/guix/profiles.scm
> index 4a2ba1c..38f69dd 100644
> --- a/guix/profiles.scm
> +++ b/guix/profiles.scm
> @@ -1011,7 +1011,9 @@ that fails."
>  
>  (define (switch-to-generation profile number)
>    "Atomically switch PROFILE to the generation NUMBER.  Return the number of
> -the generation that was current before switching."
> +the generation that was current before switching.  Raise a
> +&profile-not-found-error when the profile does not exist.  Raise a
> +&missing-generation-error when the generation does not exist."
>    (let ((current    (generation-number profile))
>          (generation (generation-file-name profile number)))

OK.

> From 9f554133be83f06d5a3d0bfc713331e59eb2116c Mon Sep 17 00:00:00 2001
> From: Chris Marusich <cmmarusich@gmail.com>
> Date: Tue, 12 Jul 2016 22:53:10 -0700
> Subject: [PATCH 2/9] Refactor: extract procedure:
>  relative-generation-spec->number

OK.

> From 42b1f00ce802745fbdc3b9bc5be38ccd47c0af33 Mon Sep 17 00:00:00 2001
> From: Chris Marusich <cmmarusich@gmail.com>
> Date: Sat, 16 Jul 2016 15:53:22 -0700
> Subject: [PATCH 3/9] Rename previous-grub-entries to grub-entries
>
> This procedure actually returns an entry for every generation of the profile,
> so its name is confusing if it suggests that it only returns "previous"
> entries.

OK!  Maybe ‘profile-grub-entries’ would work too, to suggest that it’s
stateful?

> From a440eb18eaa6c2fe12d91db1c9d62e79823e7ad0 Mon Sep 17 00:00:00 2001
> From: Chris Marusich <cmmarusich@gmail.com>
> Date: Mon, 1 Aug 2016 07:51:38 -0700
> Subject: [PATCH 4/9] Fix docstrings: these procedures return derivations
>
> ---
>  gnu/system.scm      | 4 ++--
>  gnu/system/grub.scm | 8 ++++----
>  2 files changed, 6 insertions(+), 6 deletions(-)
>
> diff --git a/gnu/system.scm b/gnu/system.scm
> index 7edb018..1d1ed5e 100644
> --- a/gnu/system.scm
> +++ b/gnu/system.scm
> @@ -718,8 +718,8 @@ listed in OS.  The C library expects to find it under
>    (store-file-system (operating-system-file-systems os)))
>  
>  (define* (operating-system-grub.cfg os #:optional (old-entries '()))
> -  "Return the GRUB configuration file for OS.  Use OLD-ENTRIES to populate the
> -\"old entries\" menu."
> +  "Return a derivation which builds the GRUB configuration file for OS.  Use
> +OLD-ENTRIES to populate the \"old entries\" menu."
>    (mlet* %store-monad
>        ((system      (operating-system-derivation os))
>         (root-fs ->  (operating-system-root-file-system os))
> diff --git a/gnu/system/grub.scm b/gnu/system/grub.scm
> index 4592747..c426d5f 100644
> --- a/gnu/system/grub.scm
> +++ b/gnu/system/grub.scm
> @@ -239,10 +239,10 @@ code."
>                                    #:key
>                                    (system (%current-system))
>                                    (old-entries '()))
> -  "Return the GRUB configuration file corresponding to CONFIG, a
> -<grub-configuration> object, and where the store is available at STORE-FS, a
> -<file-system> object.  OLD-ENTRIES is taken to be a list of menu entries
> -corresponding to old generations of the system."
> +  "Return a derivation which builds the GRUB configuration file corresponding
> +to CONFIG, a <grub-configuration> object, and where the store is available at
> +STORE-FS, a <file-system> object.  OLD-ENTRIES is taken to be a list of menu
> +entries corresponding to old generations of the system."

OK, although I often write “Return something” when that really means
“Return a derivation that builds something”.

> From 227ffc6c34c7bef29a39b2745865ac25c28a7e74 Mon Sep 17 00:00:00 2001
> From: Chris Marusich <cmmarusich@gmail.com>
> Date: Mon, 1 Aug 2016 08:46:48 -0700
> Subject: [PATCH 5/9] Factor out procedure: device->title
>
> ---
>  gnu/build/file-systems.scm | 31 ++++++++++++++++++-------------
>  1 file changed, 18 insertions(+), 13 deletions(-)
>
> diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
> index f1fccbd..4a8acd5 100644
> --- a/gnu/build/file-systems.scm
> +++ b/gnu/build/file-systems.scm
> @@ -38,6 +38,7 @@
>              find-partition-by-uuid
>              find-partition-by-luks-uuid
>              canonicalize-device-spec
> +            device->title
>  
>              uuid->string
>              string->uuid
> @@ -364,19 +365,6 @@ the following:
>      ;; this long.
>      20)
>  
> -  (define canonical-title
> -    ;; The realm of canonicalization.
> -    (if (eq? title 'any)
> -        (if (string? spec)
> -            ;; The "--root=SPEC" kernel command-line option always provides a
> -            ;; string, but the string can represent a device, a UUID, or a
> -            ;; label.  So check for all three.
> -            (cond ((string-prefix? "/" spec) 'device)
> -                  ((string->uuid spec) 'uuid)
> -                  (else 'label))
> -            'uuid)
> -        title))
> -
>    (define (resolve find-partition spec fmt)
>      (let loop ((count 0))
>        (let ((device (find-partition spec)))
> @@ -391,6 +379,10 @@ the following:
>                    (sleep 1)
>                    (loop (+ 1 count))))))))
>  
> +  (define canonical-title (if (eq? title 'any)

Put the “(if” on the next line.

> +(define (device->title device)
> +  "Guess the title for the given DEVICE, which must be a device parameter from
> +a <file-system> object.  As a special case, when the DEVICE is a UUID, it may
> +be specified as a string."

What about calling it ‘inferred-device-title’ instead, since it’s not
just a conversion?

> From 1ade872ffae08ded1b8dae2fca05fee33ac0c69f Mon Sep 17 00:00:00 2001
> From: Chris Marusich <cmmarusich@gmail.com>
> Date: Mon, 1 Aug 2016 08:57:08 -0700
> Subject: [PATCH 6/9] gnu/system and gnu/system/grub: use root-fs-device, not
>  root-fs

[...]

> -(define (grub-root-search root-fs file)
> -  "Return the GRUB 'search' command to look for ROOT-FS, which contains FILE,
> +(define (grub-root-search root-fs-device file)
> +  "Return the GRUB 'search' command to look for ROOT-FS-DEVICE, which contains FILE,
>  a gexp.  The result is a gexp that can be inserted in the grub.cfg-generation
>  code."
> -  (case (file-system-title root-fs)
> -    ;; Preferably refer to ROOT-FS by its UUID or label.  This is more
> -    ;; efficient and less ambiguous, see <>.
> +  (case (device->title root-fs-device)
> +    ;; Preferably refer to ROOT-FS-DEVICE by its UUID or label.  This is more
> +    ;; efficient and less ambiguous.

I’m not convinced by this patch.  What’s the rationale?  To better deal
with cases where the title is 'any?

> From 55cf900abf6dba10ed640d24433cc1ca23e4acf2 Mon Sep 17 00:00:00 2001
> From: Chris Marusich <cmmarusich@gmail.com>
> Date: Tue, 2 Aug 2016 21:28:21 -0700
> Subject: [PATCH 7/9] gnu/build/install: Factor out procedure:
>  install-grub-config

OK.

> From 059e79ab26f5e8ee60b60f5df01907300346c8e2 Mon Sep 17 00:00:00 2001
> From: Chris Marusich <cmmarusich@gmail.com>
> Date: Thu, 28 Jul 2016 02:31:38 -0700
> Subject: [PATCH 8/9] grub-entries: take a list of numbers on input

OK.

> From b5816897c6db7984f678963dabe8ae58c6947677 Mon Sep 17 00:00:00 2001
> From: Chris Marusich <cmmarusich@gmail.com>
> Date: Wed, 3 Aug 2016 00:41:01 -0700
> Subject: [PATCH 9/9] Implement switch-generation and roll-back
>
> ---
>  guix/scripts/system.scm | 87 ++++++++++++++++++++++++++++++++++++++++++++++---
>  1 file changed, 83 insertions(+), 4 deletions(-)
>
> diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
> index f450c9a..5c72808 100644
> --- a/guix/scripts/system.scm
> +++ b/guix/scripts/system.scm
> @@ -408,6 +408,57 @@ NUMBERS, which is a list of generation numbers."
>  
>  \f
>  ;;;
> +;;; Roll-back.
> +;;;
> +(define (roll-back-system store)
> +  "Roll back the system profile to its previous generation."
> +  (switch-to-system-generation store "-1"))
> +\f
> +;;;
> +;;; Switch generations.
> +;;;
> +(define (switch-to-system-generation store spec)
> +  "Switch the system profile to the generation specified by SPEC, and
> +re-install grub with a grub configuration file that uses the specified system
> +generation as its default entry."
> +  (let ((number (relative-generation-spec->number %system-profile spec)))
> +      (if number
> +          (begin
> +            (reinstall-grub store number)
> +            (switch-to-generation* %system-profile number))
> +          (leave (_ "cannot switch to system generation '~a'~%") spec))))
> +
> +(define (reinstall-grub store number)
> +  "Re-install grub for existing system profile generation NUMBER."
> +  (unless-file-not-found
> +   (let*
> +       ((generation (generation-file-name %system-profile number))

No newline after ‘let*’.

> +        (file (string-append generation "/parameters"))
> +        (params (call-with-input-file file read-boot-parameters))
> +        ;; We assume that the root file system contains the store.  If this
> +        ;; assumption is ever false, then problems might occur.
> +        (root-device (boot-parameters-root-device params))
> +        ;; Generate a new grub configuration which uses default values for
> +        ;; just about everything.  If the specified system generation was
> +        ;; built from an operating system configuration file that contained
> +        ;; non-default values in its grub-configuration, then the grub
> +        ;; configuration we generate here will be different.  However, even
> +        ;; if that is the case, this default configuration will be good
> +        ;; enough to enable the user to boot into the specified generation.
> +        (grub-config (grub-configuration (device root-device)))
> +        ;; Make the specified system generation the default entry.
> +        (entries (grub-entries %system-profile (list number)))
> +        (old-entries (grub-entries))

Should we remove NUMBER from OLD-ENTRIES?

> +        (grub.cfg-derivation (run-with-store store
> +                    (grub-configuration-file grub-config
> +                                             root-device
> +                                             entries
> +                                             #:old-entries old-entries))))
> +     (build-derivations store (list grub.cfg-derivation))

Add call to ‘show-what-to-build’ before.  I’d remove “-derivation” from
the identifier, that’s not very helpful IMO.  :-)

> +     (install-grub-config (derivation->output-path grub.cfg-derivation) "/"))))

And yeah, GRUB.CFG must be registered as a GC root before we can safely
apply this patch.

The rest LGTM.  We’ll also need a few lines describing these actions in
guix.texi.

Thanks a lot for this very useful contribution!

Ludo’.

Re: Patches to implement system roll-back and switch-generation

[Chris Marusich]

[-- Attachment #1: Type: text/plain, Size: 15318 bytes --]

Hi,

ludo@gnu.org (Ludovic Courtès) writes:

> Hi!
>
> Chris Marusich <cmmarusich@gmail.com> skribis:
>
>> I believe my patch does NOT yet make the regenerated grub.cfg a GC root,
>> so it is possible that after rolling back or switching generations,
>> invoking GC might clean up some things you'd rather keep around (like
>> the grub background image file).  Please be careful not to try this
>> patch on a machine you care about; please use a VM instead.  I've
>> verified that it works in a VM.
>
> Indeed.  I think you’ll need to extract and reuse the logic in
> ‘install-grub*’ that installs the GC root.

Yes, that sounds like the right approach.  I'll do that.

>> Unfortunately, these patches do not apply cleanly to the current master
>> branch because of commit 0f65f54ebd76324653fd5506a7dab42ee44d9255.  This
>> commit has thrown a wrench in my plans.  When I try to rebase onto
>> master, there are multiple conflicts, and I am not sure yet what the
>> best way to resolve them will be.  In any case, I think it will be more
>> productive to ask for feedback now, rather than to continue on my own
>> down uncertain paths.
>
> Sorry about that!  Hopefully we can work around the conflicts.

I think we can.  But I think it will require backwards incompatible
changes to the boot parameters file.  Here's why:

Many of the existing procedures in (gnu system grub) take a "file
system" object as input (e.g. the 'grub-configuration-file' procedure).
However, the boot parameters file does not currently contain all the
information that a "file system" object contains.  Here's an example of
what it contains today:

--8<---------------cut here---------------start------------->8---
(boot-parameters
  (version 0)
  (label "GNU with Linux-Libre 4.1.20 (beta)")
  (root-device "root")
  (kernel
    "/gnu/store/zygby8db0adcyj3m6rjflr80jarfy9b5-linux-libre-4.1.20")
  (kernel-arguments ())
  (initrd
    (string-append
      "/gnu/store/hlra3a0g3a14bjvdn3vbagwfvy4nmhn8-base-initrd"
      "/initrd")))
--8<---------------cut here---------------end--------------->8---

To avoid backwards-incompatible changes to the structure of the boot
parameters file, I had originally planned to refactor the procedures in
(gnu system grub) so that I could use them with the limited information
that is contained in the version 0 boot parameters file.  However,
commit 0f65f54e has modified these procedures in a way that makes it
very awkward to refactor the "file system" object out of them.  Now, to
re-use the existing procedures, I believe I will need to add this
missing information (i.e., the information contained in a file system
object) to the boot parameters file, so that I can construct a "file
system" object to pass to those procedures.  Does that sound right to
you?

If I do that, then it will probably be a backwards-incompatible change,
so I will do it in the following way.  I will simply store an entire
"file system" object in the boot parameters file.  I will bump the
version of the boot parameters file from 0 to 1.  To ensure that all new
system generations use version 1, I will update commands like
"reconfigure" to always create a version 1 boot parameters file.  I will
make the new commands (roll-back and switch-generation) refuse to switch
to any system generation which uses version 0 (because it isn't possible
to construct a complete "file system" object from a version 0 boot
parameters file).  I will also update existing commands like
'list-generations' so that they will gracefully handle both versions.

Does this sound like the right approach to you?

> Overall the patches LGTM.  You’re going to hate me for that, but could
> you please add ChangeLog-style commit logs?  Also, could you send the
> revised patches using ‘git send-email’?

I don't mind at all; I'm happy to make any changes that will improve the
quality of the end result.

I've tried using 'git send-email' on GuixSD before, and it didn't work
for me (because a mail transfer agent is not running on my GuixSD
system).  When the new patches are ready, I'll try once more to get it
working.

>> From 42b1f00ce802745fbdc3b9bc5be38ccd47c0af33 Mon Sep 17 00:00:00 2001
>> From: Chris Marusich <cmmarusich@gmail.com>
>> Date: Sat, 16 Jul 2016 15:53:22 -0700
>> Subject: [PATCH 3/9] Rename previous-grub-entries to grub-entries
>>
>> This procedure actually returns an entry for every generation of the profile,
>> so its name is confusing if it suggests that it only returns "previous"
>> entries.
>
> OK!  Maybe ‘profile-grub-entries’ would work too, to suggest that it’s
> stateful?

Yes, I like that better.

>> From a440eb18eaa6c2fe12d91db1c9d62e79823e7ad0 Mon Sep 17 00:00:00 2001
>> From: Chris Marusich <cmmarusich@gmail.com>
>> Date: Mon, 1 Aug 2016 07:51:38 -0700
>> Subject: [PATCH 4/9] Fix docstrings: these procedures return derivations
>>
>> ---
>>  gnu/system.scm      | 4 ++--
>>  gnu/system/grub.scm | 8 ++++----
>>  2 files changed, 6 insertions(+), 6 deletions(-)
>>
>> diff --git a/gnu/system.scm b/gnu/system.scm
>> index 7edb018..1d1ed5e 100644
>> --- a/gnu/system.scm
>> +++ b/gnu/system.scm
>> @@ -718,8 +718,8 @@ listed in OS.  The C library expects to find it under
>>    (store-file-system (operating-system-file-systems os)))
>>  
>>  (define* (operating-system-grub.cfg os #:optional (old-entries '()))
>> -  "Return the GRUB configuration file for OS.  Use OLD-ENTRIES to populate the
>> -\"old entries\" menu."
>> +  "Return a derivation which builds the GRUB configuration file for OS.  Use
>> +OLD-ENTRIES to populate the \"old entries\" menu."
>>    (mlet* %store-monad
>>        ((system      (operating-system-derivation os))
>>         (root-fs ->  (operating-system-root-file-system os))
>> diff --git a/gnu/system/grub.scm b/gnu/system/grub.scm
>> index 4592747..c426d5f 100644
>> --- a/gnu/system/grub.scm
>> +++ b/gnu/system/grub.scm
>> @@ -239,10 +239,10 @@ code."
>>                                    #:key
>>                                    (system (%current-system))
>>                                    (old-entries '()))
>> -  "Return the GRUB configuration file corresponding to CONFIG, a
>> -<grub-configuration> object, and where the store is available at STORE-FS, a
>> -<file-system> object.  OLD-ENTRIES is taken to be a list of menu entries
>> -corresponding to old generations of the system."
>> +  "Return a derivation which builds the GRUB configuration file corresponding
>> +to CONFIG, a <grub-configuration> object, and where the store is available at
>> +STORE-FS, a <file-system> object.  OLD-ENTRIES is taken to be a list of menu
>> +entries corresponding to old generations of the system."
>
> OK, although I often write “Return something” when that really means
> “Return a derivation that builds something”.

Upon closer inspection, it looks like this procedure,
'grub-configuration-file', actually returns a monadic value (in the
store monad), which "contains" a derivation, which in turn builds the
grub configuration file.  Even in a case like this, where there is so
much indirection, is it appropriate to elide all those details?

If this is the style we should consistently use in our documentation,
then that's fine, and I will happily follow suit in the name of
consistency.  However, as a newcomer to this code base, to gexps, to
derivations, and to monads, in the beginning I was very confused about
how to use this procedure's return value.

If I can think of a good way to make stuff like this more obvious for
newcomers, I'll let you know.  For now, though, I think the best thing
to do is to change my patches to conform to the existing style.

>> From 227ffc6c34c7bef29a39b2745865ac25c28a7e74 Mon Sep 17 00:00:00 2001
>> From: Chris Marusich <cmmarusich@gmail.com>
>> Date: Mon, 1 Aug 2016 08:46:48 -0700
>> Subject: [PATCH 5/9] Factor out procedure: device->title
>>
>> ---
>>  gnu/build/file-systems.scm | 31 ++++++++++++++++++-------------
>>  1 file changed, 18 insertions(+), 13 deletions(-)
>>
>> diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
>> index f1fccbd..4a8acd5 100644
>> --- a/gnu/build/file-systems.scm
>> +++ b/gnu/build/file-systems.scm
>> @@ -38,6 +38,7 @@
>>              find-partition-by-uuid
>>              find-partition-by-luks-uuid
>>              canonicalize-device-spec
>> +            device->title
>>  
>>              uuid->string
>>              string->uuid
>> @@ -364,19 +365,6 @@ the following:
>>      ;; this long.
>>      20)
>>  
>> -  (define canonical-title
>> -    ;; The realm of canonicalization.
>> -    (if (eq? title 'any)
>> -        (if (string? spec)
>> -            ;; The "--root=SPEC" kernel command-line option always provides a
>> -            ;; string, but the string can represent a device, a UUID, or a
>> -            ;; label.  So check for all three.
>> -            (cond ((string-prefix? "/" spec) 'device)
>> -                  ((string->uuid spec) 'uuid)
>> -                  (else 'label))
>> -            'uuid)
>> -        title))
>> -
>>    (define (resolve find-partition spec fmt)
>>      (let loop ((count 0))
>>        (let ((device (find-partition spec)))
>> @@ -391,6 +379,10 @@ the following:
>>                    (sleep 1)
>>                    (loop (+ 1 count))))))))
>>  
>> +  (define canonical-title (if (eq? title 'any)
>
> Put the “(if” on the next line.

OK.

>> +(define (device->title device)
>> +  "Guess the title for the given DEVICE, which must be a device parameter from
>> +a <file-system> object.  As a special case, when the DEVICE is a UUID, it may
>> +be specified as a string."
>
> What about calling it ‘inferred-device-title’ instead, since it’s not
> just a conversion?

That's a good point.  I'll use that name.

>> From 1ade872ffae08ded1b8dae2fca05fee33ac0c69f Mon Sep 17 00:00:00 2001
>> From: Chris Marusich <cmmarusich@gmail.com>
>> Date: Mon, 1 Aug 2016 08:57:08 -0700
>> Subject: [PATCH 6/9] gnu/system and gnu/system/grub: use root-fs-device, not
>>  root-fs
>
> [...]
>
>> -(define (grub-root-search root-fs file)
>> -  "Return the GRUB 'search' command to look for ROOT-FS, which contains FILE,
>> +(define (grub-root-search root-fs-device file)
>> +  "Return the GRUB 'search' command to look for ROOT-FS-DEVICE, which contains FILE,
>>  a gexp.  The result is a gexp that can be inserted in the grub.cfg-generation
>>  code."
>> -  (case (file-system-title root-fs)
>> -    ;; Preferably refer to ROOT-FS by its UUID or label.  This is more
>> -    ;; efficient and less ambiguous, see <>.
>> +  (case (device->title root-fs-device)
>> +    ;; Preferably refer to ROOT-FS-DEVICE by its UUID or label.  This is more
>> +    ;; efficient and less ambiguous.
>
> I’m not convinced by this patch.  What’s the rationale?  To better deal
> with cases where the title is 'any?

The intent of this change was to avoid making backwards-incompatible
changes to the boot parameters file, which only contains the "file
system" device, not a whole "file system" object.  However, going
forward, I will abandon this refactoring in favor of the alternative
plan presented earlier in this email.

>> From b5816897c6db7984f678963dabe8ae58c6947677 Mon Sep 17 00:00:00 2001
>> From: Chris Marusich <cmmarusich@gmail.com>
>> Date: Wed, 3 Aug 2016 00:41:01 -0700
>> Subject: [PATCH 9/9] Implement switch-generation and roll-back
>>
>> ---
>>  guix/scripts/system.scm | 87 ++++++++++++++++++++++++++++++++++++++++++++++---
>>  1 file changed, 83 insertions(+), 4 deletions(-)
>>
>> diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
>> index f450c9a..5c72808 100644
>> --- a/guix/scripts/system.scm
>> +++ b/guix/scripts/system.scm
>> @@ -408,6 +408,57 @@ NUMBERS, which is a list of generation numbers."
>>  
>>  \f
>>  ;;;
>> +;;; Roll-back.
>> +;;;
>> +(define (roll-back-system store)
>> +  "Roll back the system profile to its previous generation."
>> +  (switch-to-system-generation store "-1"))
>> +\f
>> +;;;
>> +;;; Switch generations.
>> +;;;
>> +(define (switch-to-system-generation store spec)
>> +  "Switch the system profile to the generation specified by SPEC, and
>> +re-install grub with a grub configuration file that uses the specified system
>> +generation as its default entry."
>> +  (let ((number (relative-generation-spec->number %system-profile spec)))
>> +      (if number
>> +          (begin
>> +            (reinstall-grub store number)
>> +            (switch-to-generation* %system-profile number))
>> +          (leave (_ "cannot switch to system generation '~a'~%") spec))))
>> +
>> +(define (reinstall-grub store number)
>> +  "Re-install grub for existing system profile generation NUMBER."
>> +  (unless-file-not-found
>> +   (let*
>> +       ((generation (generation-file-name %system-profile number))
>
> No newline after ‘let*’.

OK.

>> +        (file (string-append generation "/parameters"))
>> +        (params (call-with-input-file file read-boot-parameters))
>> +        ;; We assume that the root file system contains the store.  If this
>> +        ;; assumption is ever false, then problems might occur.
>> +        (root-device (boot-parameters-root-device params))
>> +        ;; Generate a new grub configuration which uses default values for
>> +        ;; just about everything.  If the specified system generation was
>> +        ;; built from an operating system configuration file that contained
>> +        ;; non-default values in its grub-configuration, then the grub
>> +        ;; configuration we generate here will be different.  However, even
>> +        ;; if that is the case, this default configuration will be good
>> +        ;; enough to enable the user to boot into the specified generation.
>> +        (grub-config (grub-configuration (device root-device)))
>> +        ;; Make the specified system generation the default entry.
>> +        (entries (grub-entries %system-profile (list number)))
>> +        (old-entries (grub-entries))
>
> Should we remove NUMBER from OLD-ENTRIES?

That makes sense.  I'll add some logic to filter it out.

>> +        (grub.cfg-derivation (run-with-store store
>> +                    (grub-configuration-file grub-config
>> +                                             root-device
>> +                                             entries
>> +                                             #:old-entries old-entries))))
>> +     (build-derivations store (list grub.cfg-derivation))
>
> Add call to ‘show-what-to-build’ before.  I’d remove “-derivation” from
> the identifier, that’s not very helpful IMO.  :-)

I didn't know about that procedure!  Both of your suggestions sound good
to me.

> The rest LGTM.  We’ll also need a few lines describing these actions in
> guix.texi.

OK.  I will update the documentation in the next set of patches.

> Thanks a lot for this very useful contribution!

Thank you for your patience.  I'll send the updated patches when they're
ready.

-- 
Chris

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 818 bytes --]

Re: Patches to implement system roll-back and switch-generation

[Ludovic Courtès]

Hello,

Chris Marusich <cmmarusich@gmail.com> skribis:

> ludo@gnu.org (Ludovic Courtès) writes:

[...]

>> Sorry about that!  Hopefully we can work around the conflicts.
>
> I think we can.  But I think it will require backwards incompatible
> changes to the boot parameters file.  Here's why:
>
> Many of the existing procedures in (gnu system grub) take a "file
> system" object as input (e.g. the 'grub-configuration-file' procedure).
> However, the boot parameters file does not currently contain all the
> information that a "file system" object contains.

Good point.  This ‘store-fs’ argument was added in response to
<http://bugs.gnu.org/22281>.

> Here's an example of what it contains today:
>
> (boot-parameters
>   (version 0)
>   (label "GNU with Linux-Libre 4.1.20 (beta)")
>   (root-device "root")
>   (kernel
>     "/gnu/store/zygby8db0adcyj3m6rjflr80jarfy9b5-linux-libre-4.1.20")
>   (kernel-arguments ())
>   (initrd
>     (string-append
>       "/gnu/store/hlra3a0g3a14bjvdn3vbagwfvy4nmhn8-base-initrd"
>       "/initrd")))
>
> To avoid backwards-incompatible changes to the structure of the boot
> parameters file, I had originally planned to refactor the procedures in
> (gnu system grub) so that I could use them with the limited information
> that is contained in the version 0 boot parameters file.  However,
> commit 0f65f54e has modified these procedures in a way that makes it
> very awkward to refactor the "file system" object out of them.  Now, to
> re-use the existing procedures, I believe I will need to add this
> missing information (i.e., the information contained in a file system
> object) to the boot parameters file, so that I can construct a "file
> system" object to pass to those procedures.  Does that sound right to
> you?

Yes, I think so.

More precisely, I think we need to add a ‘device’ field to <menu-entry>,
which could be the UUID or label of the device where the kernel and
initrd are to be found, or #f, in which case grub.cfg would contain a
“search --file” command (instead of “search --label” or “search
--fs-uuid”).

Correspondingly, we’d add a ‘device’ (or ‘boot-device’?) field to
<boot-parameters>.  The key is that ‘device’ can be different from
‘root-device’ because the store and root devices can be different from
one another.

That way we could remove the ‘store-fs’ parameter of
‘grub-configuration-file’ since that information would now be contained
in each <menu-entry>.

> If I do that, then it will probably be a backwards-incompatible change,
> so I will do it in the following way.  I will simply store an entire
> "file system" object in the boot parameters file.  I will bump the
> version of the boot parameters file from 0 to 1.  To ensure that all new
> system generations use version 1, I will update commands like
> "reconfigure" to always create a version 1 boot parameters file.  I will
> make the new commands (roll-back and switch-generation) refuse to switch
> to any system generation which uses version 0 (because it isn't possible
> to construct a complete "file system" object from a version 0 boot
> parameters file).  I will also update existing commands like
> 'list-generations' so that they will gracefully handle both versions.
>
> Does this sound like the right approach to you?

I think we don’t need to bump the version number: ‘read-boot-parameters’
can simply do what it currently does for ‘initrd’ and
‘kernel-arguments’, which is to provide a default value when they’re
missing.  Here the default value could be ‘root-device’.

> I've tried using 'git send-email' on GuixSD before, and it didn't work
> for me (because a mail transfer agent is not running on my GuixSD
> system).  When the new patches are ready, I'll try once more to get it
> working.

AFAICT an MTA is not needed.

>>> -  "Return the GRUB configuration file corresponding to CONFIG, a
>>> -<grub-configuration> object, and where the store is available at STORE-FS, a
>>> -<file-system> object.  OLD-ENTRIES is taken to be a list of menu entries
>>> -corresponding to old generations of the system."
>>> +  "Return a derivation which builds the GRUB configuration file corresponding
>>> +to CONFIG, a <grub-configuration> object, and where the store is available at
>>> +STORE-FS, a <file-system> object.  OLD-ENTRIES is taken to be a list of menu
>>> +entries corresponding to old generations of the system."
>>
>> OK, although I often write “Return something” when that really means
>> “Return a derivation that builds something”.
>
> Upon closer inspection, it looks like this procedure,
> 'grub-configuration-file', actually returns a monadic value (in the
> store monad), which "contains" a derivation, which in turn builds the
> grub configuration file.  Even in a case like this, where there is so
> much indirection, is it appropriate to elide all those details?
>
> If this is the style we should consistently use in our documentation,
> then that's fine, and I will happily follow suit in the name of
> consistency.  However, as a newcomer to this code base, to gexps, to
> derivations, and to monads, in the beginning I was very confused about
> how to use this procedure's return value.
>
> If I can think of a good way to make stuff like this more obvious for
> newcomers, I'll let you know.  For now, though, I think the best thing
> to do is to change my patches to conform to the existing style.

I think so.  :-)

That said, I can understand that the indirections can be confusing,
esp. since these parts are not properly documented.  That “return a
file” really means “return a derivation as a monadic value” is non
obvious.

We can now avoid monadic procedures by using the declarative counterpart
of the monadic API.  That is, we could write:

  (define (grub-configuration-file …)      ;normal proc
    (computed-file "grub.cfg" builder))

instead of:

  (define (grub-configuration-file …)      ;monadic proc
    (gexp->derivation "grub.cfg" builder))

I would welcome such changes.

> Thank you for your patience.  I'll send the updated patches when they're
> ready.

Awesome, thanks!

Ludo’.

Re: Patches to implement system roll-back and switch-generation

[Chris Marusich]

[-- Attachment #1: Type: text/plain, Size: 7013 bytes --]

Hi Ludo,

ludo@gnu.org (Ludovic Courtès) writes:

> Hello,
>
> Chris Marusich <cmmarusich@gmail.com> skribis:
>
>> ludo@gnu.org (Ludovic Courtès) writes:
>
> [...]
>
>>> Sorry about that!  Hopefully we can work around the conflicts.
>>
>> I think we can.  But I think it will require backwards incompatible
>> changes to the boot parameters file.  Here's why:
>>
>> Many of the existing procedures in (gnu system grub) take a "file
>> system" object as input (e.g. the 'grub-configuration-file' procedure).
>> However, the boot parameters file does not currently contain all the
>> information that a "file system" object contains.
>
> Good point.  This ‘store-fs’ argument was added in response to
> <http://bugs.gnu.org/22281>.
>
>> Here's an example of what it contains today:
>>
>> (boot-parameters
>>   (version 0)
>>   (label "GNU with Linux-Libre 4.1.20 (beta)")
>>   (root-device "root")
>>   (kernel
>>     "/gnu/store/zygby8db0adcyj3m6rjflr80jarfy9b5-linux-libre-4.1.20")
>>   (kernel-arguments ())
>>   (initrd
>>     (string-append
>>       "/gnu/store/hlra3a0g3a14bjvdn3vbagwfvy4nmhn8-base-initrd"
>>       "/initrd")))
>>
>> To avoid backwards-incompatible changes to the structure of the boot
>> parameters file, I had originally planned to refactor the procedures in
>> (gnu system grub) so that I could use them with the limited information
>> that is contained in the version 0 boot parameters file.  However,
>> commit 0f65f54e has modified these procedures in a way that makes it
>> very awkward to refactor the "file system" object out of them.  Now, to
>> re-use the existing procedures, I believe I will need to add this
>> missing information (i.e., the information contained in a file system
>> object) to the boot parameters file, so that I can construct a "file
>> system" object to pass to those procedures.  Does that sound right to
>> you?
>
> Yes, I think so.
>
> More precisely, I think we need to add a ‘device’ field to <menu-entry>,
> which could be the UUID or label of the device where the kernel and
> initrd are to be found, or #f, in which case grub.cfg would contain a
> “search --file” command (instead of “search --label” or “search
> --fs-uuid”).
>
> Correspondingly, we’d add a ‘device’ (or ‘boot-device’?) field to
> <boot-parameters>.  The key is that ‘device’ can be different from
> ‘root-device’ because the store and root devices can be different from
> one another.
>
> That way we could remove the ‘store-fs’ parameter of
> ‘grub-configuration-file’ since that information would now be contained
> in each <menu-entry>.
>

That sounds promising!  I'll try that approach.

>
>> If I do that, then it will probably be a backwards-incompatible change,
>> so I will do it in the following way.  I will simply store an entire
>> "file system" object in the boot parameters file.  I will bump the
>> version of the boot parameters file from 0 to 1.  To ensure that all new
>> system generations use version 1, I will update commands like
>> "reconfigure" to always create a version 1 boot parameters file.  I will
>> make the new commands (roll-back and switch-generation) refuse to switch
>> to any system generation which uses version 0 (because it isn't possible
>> to construct a complete "file system" object from a version 0 boot
>> parameters file).  I will also update existing commands like
>> 'list-generations' so that they will gracefully handle both versions.
>>
>> Does this sound like the right approach to you?
>
> I think we don’t need to bump the version number: ‘read-boot-parameters’
> can simply do what it currently does for ‘initrd’ and
> ‘kernel-arguments’, which is to provide a default value when they’re
> missing.  Here the default value could be ‘root-device’.

I think you're probably right about this, too.  I'll try it that way.

>
>> I've tried using 'git send-email' on GuixSD before, and it didn't work
>> for me (because a mail transfer agent is not running on my GuixSD
>> system).  When the new patches are ready, I'll try once more to get it
>> working.
>
> AFAICT an MTA is not needed.
>

I'll let you know if it works!

>
>>>> -  "Return the GRUB configuration file corresponding to CONFIG, a
>>>> -<grub-configuration> object, and where the store is available at STORE-FS, a
>>>> -<file-system> object.  OLD-ENTRIES is taken to be a list of menu entries
>>>> -corresponding to old generations of the system."
>>>> +  "Return a derivation which builds the GRUB configuration file corresponding
>>>> +to CONFIG, a <grub-configuration> object, and where the store is available at
>>>> +STORE-FS, a <file-system> object.  OLD-ENTRIES is taken to be a list of menu
>>>> +entries corresponding to old generations of the system."
>>>
>>> OK, although I often write “Return something” when that really means
>>> “Return a derivation that builds something”.
>>
>> Upon closer inspection, it looks like this procedure,
>> 'grub-configuration-file', actually returns a monadic value (in the
>> store monad), which "contains" a derivation, which in turn builds the
>> grub configuration file.  Even in a case like this, where there is so
>> much indirection, is it appropriate to elide all those details?
>>
>> If this is the style we should consistently use in our documentation,
>> then that's fine, and I will happily follow suit in the name of
>> consistency.  However, as a newcomer to this code base, to gexps, to
>> derivations, and to monads, in the beginning I was very confused about
>> how to use this procedure's return value.
>>
>> If I can think of a good way to make stuff like this more obvious for
>> newcomers, I'll let you know.  For now, though, I think the best thing
>> to do is to change my patches to conform to the existing style.
>
> I think so.  :-)
>
> That said, I can understand that the indirections can be confusing,
> esp. since these parts are not properly documented.  That “return a
> file” really means “return a derivation as a monadic value” is non
> obvious.
>
> We can now avoid monadic procedures by using the declarative counterpart
> of the monadic API.  That is, we could write:
>
>   (define (grub-configuration-file …)      ;normal proc
>     (computed-file "grub.cfg" builder))
>
> instead of:
>
>   (define (grub-configuration-file …)      ;monadic proc
>     (gexp->derivation "grub.cfg" builder))
>
> I would welcome such changes.
>

That's an interesting idea.  However, in this case, I think we need to
pass the build options (from the parsed command-line arguments) along
somehow.  How should we set the build options when using the declarative
'computed-file' procedure?  It seems like the most obvious way would be
to pass the build options in as arguments to the 'computed-file'
procedure, but is there a better way?

-- 
Chris

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 818 bytes --]

Re: Patches to implement system roll-back and switch-generation

[Ludovic Courtès]

Hi Chris,

Chris Marusich <cmmarusich@gmail.com> skribis:

> ludo@gnu.org (Ludovic Courtès) writes:
>> We can now avoid monadic procedures by using the declarative counterpart
>> of the monadic API.  That is, we could write:
>>
>>   (define (grub-configuration-file …)      ;normal proc
>>     (computed-file "grub.cfg" builder))
>>
>> instead of:
>>
>>   (define (grub-configuration-file …)      ;monadic proc
>>     (gexp->derivation "grub.cfg" builder))
>>
>> I would welcome such changes.
>>
>
> That's an interesting idea.  However, in this case, I think we need to
> pass the build options (from the parsed command-line arguments) along
> somehow.  How should we set the build options when using the declarative
> 'computed-file' procedure?  It seems like the most obvious way would be
> to pass the build options in as arguments to the 'computed-file'
> procedure, but is there a better way?

Which build options?  There’s a direct correspondence between, say,
‘gexp->derivation’ and ‘computed-file’ and the arguments are essentially
the same.  Unless I’m overlooking something (again!), the change I
suggest above is a mechanical change.

HTH,
Ludo’.