system: Record store file system info in each generation.

* gnu/system.scm (<boot-parameters>)[store-device, store-mount-point]: New fields. (read-boot-parameters): Initialize them. (operating-system-grub.cfg): Likewise. Remove STORE-FS argument from call to 'grub-configuration-file'. (operating-system-parameters-file): Add 'store' element in 'boot-parameters'. * gnu/system/grub.scm (strip-mount-point): Replace 'store-fs' parameter by 'mount-point'; adjust accordingly. Adjust callers. (<menu-entry>)[device, device-mount-point]: New fields. (eye-candy): Replace 'root-fs' parameter by 'store-device'; add 'store-mount-point'. Use keyword arguments for 'system' and 'port'. (grub-root-search): Remove 'root-fs' by 'device' and adjust accordingly. (grub-configuration-file): Remove 'store-fs' parameter. Adjust accordingly. * guix/scripts/system.scm (previous-grub-entries): Initialize 'device' and 'device-mount-point' fields from PARAMS. * doc/guix.texi (GRUB Configuration): Document 'device' and 'device-mount-point'. Explain that 'linux' can be prefixed by a GRUB device name. Co-authored-by: Ludovic Courtès <ludo@gnu.org>
2024-12-24 13:28:12 -05:00 · 2016-10-28 03:07:18 -07:00 · 2016-10-28 03:07:18 -07:00 · 1ef8b72a7f
commit 1ef8b72a7f
parent b7f3cf2c9a
4 changed files with 128 additions and 46 deletions
--- a/doc/guix.texi
+++ b/doc/guix.texi
@ -11088,6 +11088,17 @@ The Linux kernel image to boot, for example:
 (file-append linux-libre "/bzImage")
@end example

+It is also possible to specify a device explicitly in the file path
+using GRUB's device naming convention (@pxref{Naming convention,,, grub,
+GNU GRUB manual}), for example:
+
+@example
+"(hd0,msdos1)/boot/vmlinuz"
+@end example
+
+If the device is specified explicitly as above, then the @code{device}
+field is ignored entirely.
+
@item @code{linux-arguments} (default: @code{()})
 The list of extra Linux kernel command-line arguments---e.g.,
@code{("console=ttyS0")}.
@ -11096,6 +11107,22 @@ The list of extra Linux kernel command-line arguments---e.g.,
 A G-Expression or string denoting the file name of the initial RAM disk
 to use (@pxref{G-Expressions}).

+@item @code{device} (default: @code{#f})
+The device where the kernel and initrd are to be found---i.e., the GRUB
+@dfn{root} for this menu entry (@pxref{root,,, grub, GNU GRUB manual}).
+
+This may be a file system label (a string), a file system UUID (a
+bytevector, @pxref{File Systems}), or @code{#f}, in which case GRUB will
+search the device containing the file specified by the @code{linux}
+field (@pxref{search,,, grub, GNU GRUB manual}).  It must @emph{not} be
+an OS device name such as @file{/dev/sda1}.
+
+@item @code{device-mount-point} (default: @code{"/"})
+The mount point of the above device on the system.  You probably do not
+need to change the default value.  GuixSD uses it to strip the prefix of
+store file names for systems where @file{/gnu} or @file{/gnu/store} is
+on a separate partition.
+
@end table
@end deftp

--- a/gnu/system.scm
+++ b/gnu/system.scm
@ -2,6 +2,7 @@
 ;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com>
+;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@ -99,6 +100,8 @@ (define-module (gnu system)
            boot-parameters?
            boot-parameters-label
            boot-parameters-root-device
+            boot-parameters-store-device
+            boot-parameters-store-mount-point
            boot-parameters-kernel
            boot-parameters-kernel-arguments
            boot-parameters-initrd
@ -733,6 +736,12 @@ (define* (operating-system-grub.cfg os #:optional (old-entries '()))
                           (file-system-device root-fs)))
       (entries ->  (list (menu-entry
                           (label label)
+
+                           ;; The device where the kernel and initrd live.
+                           (device (file-system-device store-fs))
+                           (device-mount-point
+                            (file-system-mount-point store-fs))
+
                           (linux kernel)
                           (linux-arguments
                            (cons* (string-append "--root=" root-device)
@ -741,8 +750,7 @@ (define* (operating-system-grub.cfg os #:optional (old-entries '()))
                                                    "/boot")
                                   (operating-system-kernel-arguments os)))
                           (initrd initrd)))))
-    (grub-configuration-file (operating-system-bootloader os)
-                             store-fs entries
+    (grub-configuration-file (operating-system-bootloader os) entries
                             #:old-entries old-entries)))

 (define (operating-system-parameters-file os)
@ -750,16 +758,24 @@ (define (operating-system-parameters-file os)
 this file is the reconstruction of GRUB menu entries for old configurations."
  (mlet %store-monad ((initrd   (operating-system-initrd-file os))
                      (root ->  (operating-system-root-file-system os))
+                      (store -> (operating-system-store-file-system os))
                      (label -> (kernel->grub-label
                                 (operating-system-kernel os))))
    (gexp->file "parameters"
-                #~(boot-parameters (version 0)
-                                   (label #$label)
-                                   (root-device #$(file-system-device root))
-                                   (kernel #$(operating-system-kernel-file os))
-                                   (kernel-arguments
-                                    #$(operating-system-kernel-arguments os))
-                                   (initrd #$initrd))
+                #~(boot-parameters
+                   (version 0)
+                   (label #$label)
+                   (root-device #$(file-system-device root))
+                   (kernel #$(operating-system-kernel-file os))
+                   (kernel-arguments
+                    #$(operating-system-kernel-arguments os))
+                   (initrd #$initrd)
+                   (store
+                    (device #$(case (file-system-title store)
+                                ((uuid) (file-system-device store))
+                                ((label) (file-system-device store))
+                                (else #f)))
+                    (mount-point #$(file-system-mount-point store))))
                #:set-load-path? #f)))


@ -770,7 +786,16 @@ (define (operating-system-parameters-file os)
 (define-record-type* <boot-parameters>
  boot-parameters make-boot-parameters boot-parameters?
  (label            boot-parameters-label)
+  ;; Because we will use the 'store-device' to create the GRUB search command,
+  ;; the 'store-device' has slightly different semantics than 'root-device'.
+  ;; The 'store-device' can be a file system uuid, a file system label, or #f,
+  ;; but it cannot be a device path such as "/dev/sda3", since GRUB would not
+  ;; understand that.  The 'root-device', on the other hand, corresponds
+  ;; exactly to the device field of the <file-system> object representing the
+  ;; OS's root file system, so it might be a device path like "/dev/sda3".
  (root-device      boot-parameters-root-device)
+  (store-device     boot-parameters-store-device)
+  (store-mount-point boot-parameters-store-mount-point)
  (kernel           boot-parameters-kernel)
  (kernel-arguments boot-parameters-kernel-arguments)
  (initrd           boot-parameters-initrd))
@ -804,7 +829,21 @@ (define (read-boot-parameters port)
         (('initrd ('string-append directory file)) ;the old format
          (string-append directory file))
         (('initrd (? string? file))
-          file)))))
+          file)))
+
+      (store-device
+       (match (assq 'store rest)
+         (('store ('device device) _ ...)
+          device)
+         (_                                       ;the old format
+          root)))
+
+      (store-mount-point
+       (match (assq 'store rest)
+         (('store ('device _) ('mount-point mount-point) _ ...)
+          mount-point)
+         (_                                       ;the old format
+          "/")))))
    (x                                            ;unsupported format
     (warning (_ "unrecognized boot parameters for '~a'~%")
              system)
--- a/gnu/system/grub.scm
+++ b/gnu/system/grub.scm
@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@ -32,6 +33,7 @@ (define-module (gnu system grub)
  #:use-module (ice-9 match)
  #:use-module (ice-9 regex)
  #:use-module (srfi srfi-1)
+  #:use-module (rnrs bytevectors)
  #:export (grub-image
            grub-image?
            grub-image-aspect-ratio
@ -61,16 +63,15 @@ (define-module (gnu system grub)
 ;;;
 ;;; Code:

-(define (strip-mount-point fs file)
-  "Strip the mount point of FS from FILE, which is a gexp or other lowerable
-object denoting a file name."
-  (let ((mount-point (file-system-mount-point fs)))
-    (if (string=? mount-point "/")
-	file
-	#~(let ((file #$file))
-            (if (string-prefix? #$mount-point file)
-                (substring #$file #$(string-length mount-point))
-                file)))))
+(define (strip-mount-point mount-point file)
+  "Strip MOUNT-POINT from FILE, which is a gexp or other lowerable object
+denoting a file name."
+  (if (string=? mount-point "/")
+      file
+      #~(let ((file #$file))
+          (if (string-prefix? #$mount-point file)
+              (substring #$file #$(string-length mount-point))
+              file))))

 (define-record-type* <grub-image>
  grub-image make-grub-image
@ -121,6 +122,10 @@ (define-record-type* <menu-entry>
  menu-entry make-menu-entry
  menu-entry?
  (label           menu-entry-label)
+  (device          menu-entry-device       ; file system uuid, label, or #f
+                   (default #f))
+  (device-mount-point menu-entry-device-mount-point
+                      (default "/"))
  (linux           menu-entry-linux)
  (linux-arguments menu-entry-linux-arguments
                   (default '()))          ; list of string-valued gexps
@ -162,12 +167,14 @@ (define* (grub-background-image config #:key (width 1024) (height 768))
        (with-monad %store-monad
          (return #f)))))

-(define (eye-candy config root-fs system port)
+(define* (eye-candy config store-device store-mount-point
+                    #:key 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.  STORE-DEVICE designates the device holding the store, and
+STORE-MOUNT-POINT is its mount point; these are used to determine where the
+background image and fonts must be searched for.  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
@ -191,7 +198,7 @@ (define (theme-colors type)
                     (symbol->string (assoc-ref colors 'bg)))))

  (define font-file
-    (strip-mount-point root-fs
+    (strip-mount-point store-mount-point
                       (file-append grub "/share/grub/unicode.pf2")))

  (mlet* %store-monad ((image (grub-background-image config)))
@ -215,10 +222,10 @@ (define font-file
  set menu_color_highlight=white/blue
 fi~%"
                           #$setup-gfxterm-body
-                           #$(grub-root-search root-fs font-file)
+                           #$(grub-root-search store-device font-file)
                           #$font-file

-                           #$(strip-mount-point root-fs image)
+                           #$(strip-mount-point store-mount-point image)
                           #$(theme-colors grub-theme-color-normal)
                           #$(theme-colors grub-theme-color-highlight))))))

@ -227,8 +234,8 @@ (define font-file
 ;;; 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 device file)
+  "Return the GRUB 'search' command to look for DEVICE, which contains FILE,
 a gexp.  The result is a gexp that can be inserted in the grub.cfg-generation
 code."
  ;; Usually FILE is a file name gexp like "/gnu/store/…-linux/vmlinuz", but
@ -236,20 +243,18 @@ (define (grub-root-search root-fs file)
  ;; custom menu entries.  In the latter case, don't emit a 'search' command.
  (if (and (string? file) (not (string-prefix? "/" file)))
      ""
-      (case (file-system-title root-fs)
-        ;; Preferably refer to ROOT-FS by its UUID or label.  This is more
+      (match device
+        ;; Preferably refer to DEVICE by its UUID or label.  This is more
        ;; efficient and less ambiguous, see <>.
-        ((uuid)
+        ((? bytevector? uuid)
         (format #f "search --fs-uuid --set ~a"
-                 (uuid->string (file-system-device root-fs))))
-        ((label)
-         (format #f "search --label --set ~a"
-                 (file-system-device root-fs)))
-        (else
-         ;; As a last resort, look for any device containing FILE.
+                 (uuid->string device)))
+        ((? string? label)
+         (format #f "search --label --set ~a" label))
+        (#f
         #~(format #f "search --file --set ~a" #$file)))))

-(define* (grub-configuration-file config store-fs entries
+(define* (grub-configuration-file config entries
                                  #:key
                                  (system (%current-system))
                                  (old-entries '()))
@ -262,22 +267,30 @@ (define all-entries

  (define entry->gexp
    (match-lambda
-     (($ <menu-entry> label linux arguments initrd)
-      ;; Use the right file names for LINUX and STORE-FS in case STORE-FS is
-      ;; not the "/" file system.
-      (let ((linux  (strip-mount-point store-fs linux))
-            (initrd (strip-mount-point store-fs initrd)))
+     (($ <menu-entry> label device device-mount-point
+                      linux arguments initrd)
+      ;; Here DEVICE is the store and DEVICE-MOUNT-POINT is its mount point.
+      ;; Use the right file names for LINUX and INITRD in case
+      ;; DEVICE-MOUNT-POINT is not "/", meaning that the store is on a
+      ;; separate partition.
+      (let ((linux  (strip-mount-point device-mount-point linux))
+            (initrd (strip-mount-point device-mount-point initrd)))
        #~(format port "menuentry ~s {
  ~a
  linux ~a ~a
  initrd ~a
 }~%"
                  #$label
-                  #$(grub-root-search store-fs linux)
+                  #$(grub-root-search 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
+                                        (menu-entry-device (first entries))
+                                        (menu-entry-device-mount-point
+                                         (first entries))
+                                        #:system system
+                                        #:port #~port)))
    (define builder
      #~(call-with-output-file #$output
          (lambda (port)
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
+;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@ -384,6 +385,8 @@ (define (system->grub-entry system number time)
        (label (string-append label " (#"
                              (number->string number) ", "
                              (seconds->string time) ")"))
+        (device (boot-parameters-store-device params))
+        (device-mount-point (boot-parameters-store-mount-point params))
        (linux kernel)
        (linux-arguments
         (cons* (string-append "--root=" root-device)