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>
This commit is contained in:
Chris Marusich 2016-10-28 03:07:18 -07:00 committed by Ludovic Courtès
parent b7f3cf2c9a
commit 1ef8b72a7f
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
4 changed files with 128 additions and 46 deletions

View File

@ -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

View File

@ -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 @@
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 @@ listed in OS. The C library expects to find it under
(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 @@ listed in OS. The C library expects to find it under
"/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 @@ listed in OS. The C library expects to find it under
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 @@ this file is the reconstruction of GRUB menu entries for old configurations."
(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 @@ this file is the reconstruction of GRUB menu entries for old configurations."
(('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)

View File

@ -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 @@
#: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 @@
;;;
;;; 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 @@ object denoting a file name."
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 @@ 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 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 @@ the store is. SYSTEM must be the target system string---e.g.,
(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 @@ else
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 @@ 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 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 @@ code."
;; 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 @@ corresponding to old generations of the system."
(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)

View File

@ -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 @@ it atomically, and then run OS's activation script."
(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)