;;; Copyright © 2017, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019, 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2020 Stefan <stefan-guix@vodafonemail.de>
;;;
;;; This file is part of GNU Guix.
;;;
;;;
;;; Code:
-(define* (normalize-file file mount-point btrfs-subvolume-file-name)
- "Strip MOUNT-POINT and prepend BTRFS-SUBVOLUME-FILE-NAME to FILE, a
+(define* (normalize-file file mount-point store-directory-prefix)
+ "Strip MOUNT-POINT and prepend STORE-DIRECTORY-PREFIX, if any, to FILE, a
G-expression or other lowerable object denoting a file name."
(define (strip-mount-point mount-point file)
file)))
file))
- (define (prepend-btrfs-subvolume-file-name btrfs-subvolume-file-name file)
- (if btrfs-subvolume-file-name
- #~(string-append #$btrfs-subvolume-file-name #$file)
+ (define (prepend-store-directory-prefix store-directory-prefix file)
+ (if store-directory-prefix
+ #~(string-append #$store-directory-prefix #$file)
file))
- (prepend-btrfs-subvolume-file-name btrfs-subvolume-file-name
- (strip-mount-point mount-point file)))
+ (prepend-store-directory-prefix store-directory-prefix
+ (strip-mount-point mount-point file)))
(_ #f)))))
(define* (eye-candy config store-device store-mount-point
- #:key btrfs-store-subvolume-file-name system port)
+ #:key store-directory-prefix port)
"Return a gexp that writes to PORT (a port-valued gexp) the 'grub.cfg' part
concerned with graphics mode, background images, colors, and 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\". BTRFS-STORE-SUBVOLUME-FILE-NAME is the file name of the
-Btrfs subvolume, to be prepended to any store path, if any."
- (define setup-gfxterm-body
- (let ((gfxmode
- (or (and-let* ((theme (bootloader-configuration-theme config))
- (gfxmode (grub-theme-gfxmode theme)))
- (string-join gfxmode ";"))
- "auto")))
-
- ;; Intel and EFI systems need to be switched into graphics mode, whereas
- ;; most other modern architectures have no other mode and therefore
- ;; don't need to be switched.
-
- ;; XXX: Do we really need to restrict to x86 systems? We could imitate
- ;; what the GRUB default configuration does and decide based on whether
- ;; a user provided 'gfxterm' in the terminal-outputs field of their
- ;; bootloader-configuration record.
- (if (string-match "^(x86_64|i[3-6]86)-" system)
- (format #f "
- set gfxmode=~a
- insmod all_video
- insmod gfxterm~%" gfxmode)
- "")))
-
+fonts must be searched for. STORE-DIRECTORY-PREFIX is a directory prefix to
+prepend to any store file name."
(define (setup-gfxterm config font-file)
(if (memq 'gfxterm (bootloader-configuration-terminal-outputs config))
- #~(format #f "if loadfont ~a; then
- setup_gfxterm
-fi~%" #+font-file)
+ #~(format #f "
+if loadfont ~a; then
+ set gfxmode=~a
+ insmod all_video
+ insmod gfxterm
+fi~%"
+ #+font-file
+ #$(string-join
+ (grub-theme-gfxmode (bootloader-theme config))
+ ";"))
""))
(define (theme-colors type)
(define font-file
(normalize-file (file-append grub "/share/grub/unicode.pf2")
store-mount-point
- btrfs-store-subvolume-file-name))
+ store-directory-prefix))
(define image
(normalize-file (grub-background-image config)
store-mount-point
- btrfs-store-subvolume-file-name))
+ store-directory-prefix))
(and image
#~(format #$port "
-function setup_gfxterm {~a}
-
# Set 'root' to the partition that contains /gnu/store.
~a
set menu_color_normal=cyan/blue
set menu_color_highlight=white/blue
fi~%"
- #$setup-gfxterm-body
#$(grub-root-search store-device font-file)
#$(setup-gfxterm config font-file)
#$(grub-setup-io config)
((? file-system-label? label)
(format #f "search --label --set ~a"
(file-system-label->string label)))
+ ((? (lambda (device)
+ (and (string? device) (string-contains device ":/"))) nfs-uri)
+ ;; This assumes that if your root file system is on NFS, then
+ ;; you also want to load your grub extra files, kernel and initrd
+ ;; from there.
+ ;;
+ ;; We explicitly set "root=(tftp)" here even though if grub.cfg
+ ;; had been loaded via TFTP, Grub would have set "root=(tftp)"
+ ;; automatically anyway. The reason is if you have a system that
+ ;; used to be on NFS but now is local, root would be set to local
+ ;; disk. If you then selected an older system generation that is
+ ;; supposed to boot from network in the Grub boot menu, Grub still
+ ;; wouldn't load those files from network otherwise.
+ ;;
+ ;; TFTP is preferred to HTTP because it is used more widely and
+ ;; specified in standards more widely--especially BOOTP/DHCPv4
+ ;; defines a TFTP server for DHCP option 66, but not HTTP.
+ ;;
+ ;; Note: DHCPv6 specifies option 59 to contain a boot-file-url,
+ ;; which can contain a HTTP or TFTP URL.
+ ;;
+ ;; Note: It is assumed that the file paths are of a similar
+ ;; setup on both the TFTP server and the NFS server (it is
+ ;; not possible to search for files on TFTP).
+ ;;
+ ;; TODO: Allow HTTP.
+ "set root=(tftp)")
((or #f (? string?))
#~(format #f "search --file --set ~a" #$file)))))
#:key
(system (%current-system))
(old-entries '())
- btrfs-subvolume-file-name)
+ store-directory-prefix)
"Return the GRUB configuration file corresponding to CONFIG, a
<bootloader-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.
-BTRFS-SUBVOLUME-FILE-NAME may be used to specify on which subvolume a
-Btrfs root file system resides."
+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-DIRECTORY-PREFIX may be used to specify a store prefix, as is required
+when booting a root file system on a Btrfs subvolume."
(define all-entries
(append entries (bootloader-configuration-menu-entries config)))
(define (menu-entry->gexp entry)
- (let* ((device (menu-entry-device entry))
- (device-mount-point (menu-entry-device-mount-point entry))
- (label (menu-entry-label entry))
- (arguments (menu-entry-linux-arguments entry))
- (kernel (normalize-file (menu-entry-linux entry)
- device-mount-point
- btrfs-subvolume-file-name))
- (initrd (normalize-file (menu-entry-initrd entry)
- device-mount-point
- btrfs-subvolume-file-name)))
- ;; Here DEVICE is the store and DEVICE-MOUNT-POINT is its mount point.
- ;; Use the right file names for KERNEL and INITRD in case
- ;; DEVICE-MOUNT-POINT is not "/", meaning that the store is on a
- ;; separate partition.
-
- ;; When BTRFS-SUBVOLUME-FILE-NAME is defined, prepend it the kernel and
- ;; initrd paths, to allow booting from a Btrfs subvolume.
- #~(format port "menuentry ~s {
+ (let ((label (menu-entry-label entry))
+ (linux (menu-entry-linux entry))
+ (device (menu-entry-device entry))
+ (device-mount-point (menu-entry-device-mount-point entry)))
+ (if linux
+ (let ((arguments (menu-entry-linux-arguments entry))
+ (linux (normalize-file linux
+ device-mount-point
+ store-directory-prefix))
+ (initrd (normalize-file (menu-entry-initrd entry)
+ device-mount-point
+ store-directory-prefix)))
+ ;; 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.
+
+ ;; When BTRFS-SUBVOLUME-FILE-NAME is defined, prepend it the linux and
+ ;; initrd paths, to allow booting from a Btrfs subvolume.
+ #~(format port "menuentry ~s {
~a
linux ~a ~a
initrd ~a
}~%"
- #$label
- #$(grub-root-search device kernel)
- #$kernel (string-join (list #$@arguments))
- #$initrd)))
- (define sugar
- (eye-candy config
- (menu-entry-device (first all-entries))
- (menu-entry-device-mount-point (first all-entries))
- #:btrfs-store-subvolume-file-name btrfs-subvolume-file-name
- #:system system
- #:port #~port))
+ #$label
+ #$(grub-root-search device linux)
+ #$linux (string-join (list #$@arguments))
+ #$initrd))
+ (let ((kernel (menu-entry-multiboot-kernel entry))
+ (arguments (menu-entry-multiboot-arguments entry))
+ (modules (menu-entry-multiboot-modules entry))
+ (root-index 1)) ; XXX EFI will need root-index 2
+ #~(format port "
+menuentry ~s {
+ multiboot ~a root=device:hd0s~a~a~a
+}~%"
+ #$label
+ #$kernel
+ #$root-index (string-join (list #$@arguments) " " 'prefix)
+ (string-join (map string-join '#$modules)
+ "\n module " 'prefix))))))
+
+ (define (sugar)
+ (let* ((entry (first all-entries))
+ (device (menu-entry-device entry))
+ (mount-point (menu-entry-device-mount-point entry)))
+ (eye-candy config
+ device
+ mount-point
+ #:store-directory-prefix store-directory-prefix
+ #:port #~port)))
(define keyboard-layout-config
(let* ((layout (bootloader-configuration-keyboard-layout config))
(keymap* (and layout
(keyboard-layout-file layout #:grub grub)))
(keymap (and keymap*
- (if btrfs-subvolume-file-name
- #~(string-append #$btrfs-subvolume-file-name
+ (if store-directory-prefix
+ #~(string-append #$store-directory-prefix
#$keymap*)
keymap*))))
#~(when #$keymap
"# This file was generated from your Guix configuration. Any changes
# will be lost upon reconfiguration.
")
- #$sugar
+ #$(sugar)
#$keyboard-layout-config
(format port "
set default=~a
;;;
;;; Bootloader definitions.
;;;
+;;; For all these grub-bootloader variables the path to /boot/grub/grub.cfg
+;;; is fixed. Inheriting and overwriting the field 'configuration-file' will
+;;; break 'guix system delete-generations', 'guix system switch-generation',
+;;; and 'guix system roll-back'.
(define grub-bootloader
(bootloader
(configuration-file "/boot/grub/grub.cfg")
(configuration-file-generator grub-configuration-file)))
-(define* grub-minimal-bootloader
+(define grub-minimal-bootloader
(bootloader
(inherit grub-bootloader)
(package grub-minimal)))
-(define* grub-efi-bootloader
+(define grub-efi-bootloader
(bootloader
(inherit grub-bootloader)
(installer install-grub-efi)
(name 'grub-efi)
(package grub-efi)))
-(define* grub-mkrescue-bootloader
+(define grub-mkrescue-bootloader
(bootloader
(inherit grub-efi-bootloader)
(package grub-hybrid)))
HCoop / jackhill / guix / guix.git / blobdiff