From 8cf7dd24ab035ee6a9d2a4f667ba139f888639e5 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 15 May 2020 16:01:20 +0200 Subject: bootloader: grub: Refer to the native 'grub-mklayout' and font file. * gnu/bootloader/grub.scm (eye-candy): Refer to the native FONT-FILE. (keyboard-layout-file): Refer to the native 'grub-mklayout'. --- gnu/bootloader/grub.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'gnu/bootloader') diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm index 3f61b4a9631..8c5b5eac0c8 100644 --- a/gnu/bootloader/grub.scm +++ b/gnu/bootloader/grub.scm @@ -176,7 +176,7 @@ system string---e.g., \"x86_64-linux\"." (if (memq 'gfxterm (bootloader-configuration-terminal-outputs config)) #~(format #f "if loadfont ~a; then setup_gfxterm -fi~%" #$font-file) +fi~%" #+font-file) "")) (define (theme-colors type) @@ -237,7 +237,7 @@ the 'share/X11/xkb/symbols/' directory of 'xkeyboard-config'." ;; 'grub-kbdcomp' passes all its arguments but '-o' to 'ckbcomp' ;; (from the 'console-setup' package). - (invoke #$(file-append grub "/bin/grub-mklayout") + (invoke #+(file-append grub "/bin/grub-mklayout") "-i" #+(keyboard-layout->console-keymap layout) "-o" #$output)))) -- cgit v1.3 From 9cdb10d52e34f7e8fa3b6238fe268646a4bbb877 Mon Sep 17 00:00:00 2001 From: Stefan Date: Sun, 17 May 2020 23:53:50 +0200 Subject: gnu: grub: Allow a PNG image and replace "aspect-ratio" with "resolution". * gnu/bootloaders/grub.scm (): Remove this record and replace it by ... ()[image]: ... this field with the default from %background-image, ()[resolution]: ... this field with the defaults from 'width' and 'height' of 'grub-background-image'. ()[images]: Remove this field. (svg->png): Rename to ... (image->png): ... and use 'copy-file' instead of 'svg->png', if the suffix of the image file is not ".svg". (grub-background-image): Remove the arguments 'width' and 'height'. (grub-theme-image): Add function. (grub-theme-resolution): Add function. (grub-theme-gfxmode): Add function. (grub-image): Remove function. (grub-image?): Remove function. (grub-image-aspect-ratio): Remove function. (grub-image-file): Remove function. (grub-theme-images): Remove function. (%default-theme): Remove variable. (%background-image): Remove variable. Using image formats different to SVG was not possible. For a to be chosen, the 'aspect-ratio' of it had to be 4/3, as the resolution of any image was defaulting to 1024 x 768. There was no code to determine the proper boot-resolution to make any use of a list of images with different aspect-ratios. It seems to be a better solution to only define a single image with any format, and use a given resolution only for the conversion from a SVG file. This also makes the use of a special record unnecessary. Moving the default values from '%background-image' and '%default-theme' into makes a customisation easier without (inherit) and allows to remove the undocumented variables %background-image' and '%default-theme'. Signed-off-by: Mathieu Othacehe --- gnu/bootloader/grub.scm | 93 ++++++++++++++++++++----------------------------- 1 file changed, 37 insertions(+), 56 deletions(-) (limited to 'gnu/bootloader') diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm index 8c5b5eac0c8..fb871c6e965 100644 --- a/gnu/bootloader/grub.scm +++ b/gnu/bootloader/grub.scm @@ -37,19 +37,13 @@ #:use-module (ice-9 regex) #:use-module (srfi srfi-1) #:use-module (srfi srfi-2) - #:export (grub-image - grub-image? - grub-image-aspect-ratio - grub-image-file - - grub-theme + #:export (grub-theme grub-theme? - grub-theme-images + grub-theme-image + grub-theme-resolution grub-theme-color-normal grub-theme-color-highlight - - %background-image - %default-theme + grub-theme-gfxmode grub-bootloader grub-efi-bootloader @@ -77,70 +71,57 @@ denoting a file name." file)))) (#f file))) -(define-record-type* - grub-image make-grub-image - grub-image? - (aspect-ratio grub-image-aspect-ratio ;rational number - (default 4/3)) - (file grub-image-file)) ;file-valued gexp (SVG) - (define-record-type* + ;; Default theme contributed by Felipe López. grub-theme make-grub-theme grub-theme? - (images grub-theme-images - (default '())) ;list of + (image grub-theme-image + (default (file-append %artwork-repository + "/grub/GuixSD-fully-black-4-3.svg"))) + (resolution grub-theme-resolution + (default '(1024 . 768))) (color-normal grub-theme-color-normal - (default '((fg . cyan) (bg . blue)))) + (default '((fg . light-gray) (bg . black)))) (color-highlight grub-theme-color-highlight - (default '((fg . white) (bg . blue)))) - (gfxmode grub-gfxmode + (default '((fg . yellow) (bg . black)))) + (gfxmode grub-theme-gfxmode (default '("auto")))) ;list of string -(define %background-image - (grub-image - (aspect-ratio 4/3) - (file (file-append %artwork-repository - "/grub/GuixSD-fully-black-4-3.svg")))) - -(define %default-theme - ;; Default theme contributed by Felipe López. - (grub-theme - (images (list %background-image)) - (color-highlight '((fg . yellow) (bg . black))) - (color-normal '((fg . light-gray) (bg . black))))) ;XXX: #x303030 - ;;; ;;; Background image & themes. ;;; (define (bootloader-theme config) - "Return user defined theme in CONFIG if defined or %default-theme + "Return user defined theme in CONFIG if defined or a default theme otherwise." - (or (bootloader-configuration-theme config) %default-theme)) + (or (bootloader-configuration-theme config) (grub-theme))) -(define* (svg->png svg #:key width height) - "Build a PNG of HEIGHT x WIDTH from SVG." +(define* (image->png image #:key width height) + "Build a PNG of HEIGHT x WIDTH from IMAGE if its file suffix is \".svg\". +Otherwise the picture in IMAGE is just copied." (computed-file "grub-image.png" (with-imported-modules '((gnu build svg)) (with-extensions (list guile-rsvg guile-cairo) - #~(begin - (use-modules (gnu build svg)) - (svg->png #+svg #$output - #:width #$width - #:height #$height)))))) - -(define* (grub-background-image config #:key (width 1024) (height 768)) - "Return the GRUB background image defined in CONFIG with a ratio of -WIDTH/HEIGHT, or #f if none was found." - (let* ((ratio (/ width height)) - (image (find (lambda (image) - (= (grub-image-aspect-ratio image) ratio)) - (grub-theme-images - (bootloader-theme config))))) + #~(if (string-suffix? ".svg" #+image) + (begin + (use-modules (gnu build svg)) + (svg->png #+image #$output + #:width #$width + #:height #$height)) + (copy-file #+image #$output)))))) + +(define* (grub-background-image config) + "Return the GRUB background image defined in CONFIG or #f if none was found. +If the suffix of the image file is \".svg\", then it is converted into a PNG +file with the resolution provided in CONFIG." + (let* ((theme (bootloader-theme config)) + (image (grub-theme-image theme))) (and image - (svg->png (grub-image-file image) - #:width width #:height height)))) + (match (grub-theme-resolution theme) + (((? number? width) . (? number? height)) + (image->png image #:width width #:height height)) + (_ #f))))) (define* (eye-candy config store-device store-mount-point #:key system port) @@ -153,7 +134,7 @@ system string---e.g., \"x86_64-linux\"." (define setup-gfxterm-body (let ((gfxmode (or (and-let* ((theme (bootloader-configuration-theme config)) - (gfxmode (grub-gfxmode theme))) + (gfxmode (grub-theme-gfxmode theme))) (string-join gfxmode ";")) "auto"))) -- cgit v1.3 From b460ba7992a0b4af2ddb5927dcf062784539ef7b Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Sun, 14 Jul 2019 20:50:23 +0900 Subject: bootloader: grub: Allow booting from a Btrfs subvolume. * gnu/bootloader/grub.scm (strip-mount-point): Remove procedure. (normalize-file): Add procedure. (grub-configuration-file): New BTRFS-SUBVOLUME-FILE-NAME parameter. When defined, prepend its value to the kernel and initrd file names, using the NORMALIZE-FILE procedure. Adjust the call to EYE-CANDY to pass the BTRFS-SUBVOLUME-FILE-NAME argument. Normalize the KEYMAP file as well. (eye-candy): Add a BTRFS-SUBVOLUME-FILE-NAME parameter, and use it, along with the NORMALIZE-FILE procedure, to normalize the FONT-FILE and IMAGE nested variables. Adjust doc. * gnu/bootloader/depthcharge.scm (depthcharge-configuration-file): Adapt. * gnu/bootloader/extlinux.scm (extlinux-configuration-file): Likewise. * gnu/system/file-systems.scm (btrfs-subvolume?) (btrfs-store-subvolume-file-name): New procedures. * gnu/system.scm (operating-system-bootcfg): Specify the Btrfs subvolume file name the store resides on to the `operating-system-bootcfg' procedure, using the new BTRFS-SUBVOLUME-FILE-NAME argument. * doc/guix.texi (File Systems): Add a Btrfs subsection to document the use of subvolumes. * gnu/tests/install.scm (%btrfs-root-on-subvolume-os) (%btrfs-root-on-subvolume-os-source) (%btrfs-root-on-subvolume-installation-script) (%test-btrfs-root-on-subvolume-os): New variables. --- doc/guix.texi | 104 ++++++++++++++++++++++++++++++++++ gnu/bootloader/depthcharge.scm | 3 +- gnu/bootloader/extlinux.scm | 3 +- gnu/bootloader/grub.scm | 123 +++++++++++++++++++++++++---------------- gnu/system.scm | 9 ++- gnu/system/file-systems.scm | 55 ++++++++++++++++++ gnu/tests/install.scm | 94 +++++++++++++++++++++++++++++++ tests/file-systems.scm | 45 +++++++++++++++ 8 files changed, 385 insertions(+), 51 deletions(-) (limited to 'gnu/bootloader') diff --git a/doc/guix.texi b/doc/guix.texi index 05f2d595b24..216422fe314 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -11782,6 +11782,110 @@ and unmount user-space FUSE file systems. This requires the @code{fuse.ko} kernel module to be loaded. @end defvr +@node Btrfs file system +@subsection Btrfs file system + +The Btrfs has special features, such as subvolumes, that merit being +explained in more details. The following section attempts to cover +basic as well as complex uses of a Btrfs file system with the Guix +System. + +In its simplest usage, a Btrfs file system can be described, for +example, by: + +@lisp +(file-system + (mount-point "/home") + (type "btrfs") + (device (file-system-label "my-home"))) +@end lisp + +The example below is more complex, as it makes use of a Btrfs +subvolume, named @code{rootfs}. The parent Btrfs file system is labeled +@code{my-btrfs-pool}, and is located on an encrypted device (hence the +dependency on @code{mapped-devices}): + +@lisp +(file-system + (device (file-system-label "my-btrfs-pool")) + (mount-point "/") + (type "btrfs") + (options "subvol=rootfs") + (dependencies mapped-devices)) +@end lisp + +Some bootloaders, for example GRUB, only mount a Btrfs partition at its +top level during the early boot, and rely on their configuration to +refer to the correct subvolume path within that top level. The +bootloaders operating in this way typically produce their configuration +on a running system where the Btrfs partitions are already mounted and +where the subvolume information is readily available. As an example, +@command{grub-mkconfig}, the configuration generator command shipped +with GRUB, reads @file{/proc/self/mountinfo} to determine the top-level +path of a subvolume. + +The Guix System produces a bootloader configuration using the operating +system configuration as its sole input; it is therefore necessary to +extract the subvolume name on which @file{/gnu/store} lives (if any) +from that operating system configuration. To better illustrate, +consider a subvolume named 'rootfs' which contains the root file system +data. In such situation, the GRUB bootloader would only see the top +level of the root Btrfs partition, e.g.: + +@example +/ (top level) +├── rootfs (subvolume directory) + ├── gnu (normal directory) + ├── store (normal directory) +[...] +@end example + +Thus, the subvolume name must be prepended to the @file{/gnu/store} path +of the kernel, initrd binaries and any other files referred to in the +GRUB configuration that must be found during the early boot. + +The next example shows a nested hierarchy of subvolumes and +directories: + +@example +/ (top level) +├── rootfs (subvolume) + ├── gnu (normal directory) + ├── store (subvolume) +[...] +@end example + +This scenario would work without mounting the 'store' subvolume. +Mounting 'rootfs' is sufficient, since the subvolume name matches its +intended mount point in the file system hierarchy. Alternatively, the +'store' subvolume could be referred to by setting the @code{subvol} +option to either @code{/rootfs/gnu/store} or @code{rootfs/gnu/store}. + +Finally, a more contrived example of nested subvolumes: + +@example +/ (top level) +├── root-snapshots (subvolume) + ├── root-current (subvolume) + ├── guix-store (subvolume) +[...] +@end example + +Here, the 'guix-store' subvolume doesn't match its intended mount point, +so it is necessary to mount it. The subvolume must be fully specified, +by passing its file name to the @code{subvol} option. To illustrate, +the 'guix-store' subvolume could be mounted on @file{/gnu/store} by using +a file system declaration such as: + +@lisp +(file-system + (device (file-system-label "btrfs-pool-1")) + (mount-point "/gnu/store") + (type "btrfs") + (options "subvol=root-snapshots/root-current/guix-store,\ +compress-force=zstd,space_cache=v2")) +@end lisp + @node Mapped Devices @section Mapped Devices diff --git a/gnu/bootloader/depthcharge.scm b/gnu/bootloader/depthcharge.scm index 58cc3f39322..0a50374bd9b 100644 --- a/gnu/bootloader/depthcharge.scm +++ b/gnu/bootloader/depthcharge.scm @@ -82,7 +82,8 @@ (define* (depthcharge-configuration-file config entries #:key (system (%current-system)) - (old-entries '())) + (old-entries '()) + #:allow-other-keys) (match entries ((entry) (let ((kernel (menu-entry-linux entry)) diff --git a/gnu/bootloader/extlinux.scm b/gnu/bootloader/extlinux.scm index 5b4dd849656..6b5ff298e74 100644 --- a/gnu/bootloader/extlinux.scm +++ b/gnu/bootloader/extlinux.scm @@ -28,7 +28,8 @@ (define* (extlinux-configuration-file config entries #:key (system (%current-system)) - (old-entries '())) + (old-entries '()) + #:allow-other-keys) "Return the U-Boot configuration file corresponding to CONFIG, a object, and where the store is available at STORE-FS, a object. OLD-ENTRIES is taken to be a list of menu entries diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm index fb871c6e965..bb40c551a74 100644 --- a/gnu/bootloader/grub.scm +++ b/gnu/bootloader/grub.scm @@ -58,18 +58,29 @@ ;;; ;;; Code: -(define (strip-mount-point mount-point file) - "Strip MOUNT-POINT from FILE, which is a gexp or other lowerable object -denoting a file name." - (match mount-point - ((? string? mount-point) - (if (string=? mount-point "/") - file - #~(let ((file #$file)) - (if (string-prefix? #$mount-point file) - (substring #$file #$(string-length mount-point)) - file)))) - (#f file))) +(define* (normalize-file file mount-point btrfs-subvolume-file-name) + "Strip MOUNT-POINT and prepend BTRFS-SUBVOLUME-FILE-NAME to FILE, a +G-expression or other lowerable object denoting a file name." + + (define (strip-mount-point mount-point file) + (if mount-point + (if (string=? mount-point "/") + file + #~(let ((file #$file)) + (if (string-prefix? #$mount-point file) + (substring #$file #$(string-length mount-point)) + 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) + file)) + + (prepend-btrfs-subvolume-file-name btrfs-subvolume-file-name + (strip-mount-point mount-point file))) + + (define-record-type* ;; Default theme contributed by Felipe López. @@ -124,13 +135,14 @@ file with the resolution provided in CONFIG." (_ #f))))) (define* (eye-candy config store-device store-mount-point - #:key system 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\"." + #:key btrfs-store-subvolume-file-name system 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)) @@ -167,11 +179,14 @@ fi~%" #+font-file) (symbol->string (assoc-ref colors 'bg))))) (define font-file - (strip-mount-point store-mount-point - (file-append grub "/share/grub/unicode.pf2"))) + (normalize-file (file-append grub "/share/grub/unicode.pf2") + store-mount-point + btrfs-store-subvolume-file-name)) (define image - (grub-background-image config)) + (normalize-file (grub-background-image config) + store-mount-point + btrfs-store-subvolume-file-name)) (and image #~(format #$port " @@ -196,7 +211,7 @@ fi~%" #$(setup-gfxterm config font-file) #$(grub-setup-io config) - #$(strip-mount-point store-mount-point image) + #$image #$(theme-colors grub-theme-color-normal) #$(theme-colors grub-theme-color-highlight)))) @@ -304,52 +319,66 @@ code." (define* (grub-configuration-file config entries #:key (system (%current-system)) - (old-entries '())) + (old-entries '()) + btrfs-subvolume-file-name) "Return the GRUB configuration file corresponding to CONFIG, a object, and where the store is available at -STORE-FS, a object. OLD-ENTRIES is taken to be a list of menu -entries corresponding to old generations of the system." +STORE-FS, a 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." (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)) - (kernel (menu-entry-linux entry)) - (arguments (menu-entry-linux-arguments entry)) - (initrd (menu-entry-initrd 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. - (let ((kernel (strip-mount-point device-mount-point kernel)) - (initrd (strip-mount-point device-mount-point initrd))) - #~(format port "menuentry ~s { + + ;; 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 { ~a linux ~a ~a initrd ~a }~%" - #$label - #$(grub-root-search device kernel) - #$kernel (string-join (list #$@arguments)) - #$initrd)))) + #$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)) (define keyboard-layout-config - (let ((layout (bootloader-configuration-keyboard-layout config)) - (grub (bootloader-package - (bootloader-configuration-bootloader config)))) - #~(let ((keymap #$(and layout - (keyboard-layout-file layout #:grub grub)))) - (when keymap - (format port "\ + (let* ((layout (bootloader-configuration-keyboard-layout config)) + (grub (bootloader-package + (bootloader-configuration-bootloader config))) + (keymap* (and layout + (keyboard-layout-file layout #:grub grub))) + (keymap (and keymap* + (if btrfs-subvolume-file-name + #~(string-append #$btrfs-subvolume-file-name + #$keymap*) + keymap*)))) + #~(when #$keymap + (format port "\ insmod keylayouts -keymap ~a~%" keymap))))) +keymap ~a~%" #$keymap)))) (define builder #~(call-with-output-file #$output diff --git a/gnu/system.scm b/gnu/system.scm index cd75e4d4baf..d929187695f 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -8,6 +8,7 @@ ;;; Copyright © 2020 Danny Milosavljevic ;;; Copyright © 2020 Brice Waegeneire ;;; Copyright © 2020 Florian Pelz +;;; Copyright © 2020 Maxim Cournoyer ;;; ;;; This file is part of GNU Guix. ;;; @@ -1102,19 +1103,23 @@ entry." (define* (operating-system-bootcfg os #:optional (old-entries '())) "Return the bootloader configuration file for OS. Use OLD-ENTRIES, a list of , to populate the \"old entries\" menu." - (let* ((root-fs (operating-system-root-file-system os)) + (let* ((file-systems (operating-system-file-systems os)) + (root-fs (operating-system-root-file-system os)) (root-device (file-system-device root-fs)) (params (operating-system-boot-parameters os root-device #:system-kernel-arguments? #t)) (entry (boot-parameters->menu-entry params)) (bootloader-conf (operating-system-bootloader os))) + (define generate-config-file (bootloader-configuration-file-generator (bootloader-configuration-bootloader bootloader-conf))) (generate-config-file bootloader-conf (list entry) - #:old-entries old-entries))) + #:old-entries old-entries + #:btrfs-subvolume-file-name + (btrfs-store-subvolume-file-name file-systems)))) (define* (operating-system-boot-parameters os root-device #:key system-kernel-arguments?) diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm index 07f272db7c4..0f94577760a 100644 --- a/gnu/system/file-systems.scm +++ b/gnu/system/file-systems.scm @@ -22,7 +22,10 @@ #:use-module (ice-9 match) #:use-module (rnrs bytevectors) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-2) #:use-module (srfi srfi-9) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-35) #:use-module (srfi srfi-9 gnu) #:use-module (guix records) #:use-module (gnu system uuid) @@ -49,6 +52,8 @@ file-system-location file-system-type-predicate + btrfs-subvolume? + btrfs-store-subvolume-file-name file-system-label file-system-label? @@ -566,4 +571,54 @@ system has the given TYPE." (lambda (fs) (string=? (file-system-type fs) type))) + +;;; +;;; Btrfs specific helpers. +;;; + +(define (btrfs-subvolume? fs) + "Predicate to check if FS, a file-system object, is a Btrfs subvolume." + (and-let* ((btrfs-file-system? (string= "btrfs" (file-system-type fs))) + (option-keys (map (match-lambda + ((key . value) key) + (key key)) + (file-system-options->alist + (file-system-options fs))))) + (find (cut string-prefix? "subvol" <>) option-keys))) + +(define (btrfs-store-subvolume-file-name file-systems) + "Return the subvolume file name within the Btrfs top level onto which the +store is located, else #f." + + (define (prepend-slash/maybe s) + (if (string=? "/" (string-take s 1)) + s + (string-append "/" s))) + + (define (file-name-depth file-name) + (length (string-tokenize file-name %not-slash))) + + (and-let* ((btrfs-subvolume-fs (filter btrfs-subvolume? file-systems)) + (btrfs-subvolume-fs* + (sort btrfs-subvolume-fs + (lambda (fs1 fs2) + (> (file-name-depth (file-system-mount-point fs1)) + (file-name-depth (file-system-mount-point fs2)))))) + (store-subvolume-fs + (find (lambda (fs) (file-prefix? (file-system-mount-point fs) + (%store-prefix))) + btrfs-subvolume-fs*)) + (options (file-system-options->alist + (file-system-options store-subvolume-fs)))) + ;; XXX: Deriving the subvolume name based from a subvolume ID is not + ;; supported, as we'd need to query the actual file system. + (or (and=> (assoc-ref options "subvol") prepend-slash/maybe) + ;; FIXME: Use &fix-hint once it no longer pulls in (guix utils). + (raise (condition + (&message + (message "The store is on a Btrfs subvolume, but the \ +subvolume name is unknown. +Hint: Use the \"subvol\" Btrfs file system option."))))))) + + ;;; file-systems.scm ends here diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm index 94d970e1cc5..cea26c8ef3b 100644 --- a/gnu/tests/install.scm +++ b/gnu/tests/install.scm @@ -61,6 +61,7 @@ %test-raid-root-os %test-encrypted-root-os %test-btrfs-root-os + %test-btrfs-root-on-subvolume-os %test-jfs-root-os %test-f2fs-root-os @@ -863,6 +864,99 @@ build (current-guix) and then store a couple of full system images.") (command (qemu-command/writable-image image))) (run-basic-test %btrfs-root-os command "btrfs-root-os"))))) + +;;; +;;; Btrfs root file system on a subvolume. +;;; + +(define-os-with-source (%btrfs-root-on-subvolume-os + %btrfs-root-on-subvolume-os-source) + ;; The OS we want to install. + (use-modules (gnu) (gnu tests) (srfi srfi-1)) + + (operating-system + (host-name "hurd") + (timezone "America/Montreal") + (locale "en_US.UTF-8") + (bootloader (bootloader-configuration + (bootloader grub-bootloader) + (target "/dev/vdb"))) + (kernel-arguments '("console=ttyS0")) + (file-systems (cons* (file-system + (device (file-system-label "btrfs-pool")) + (mount-point "/") + (options "subvol=rootfs,compress=zstd") + (type "btrfs")) + (file-system + (device (file-system-label "btrfs-pool")) + (mount-point "/home") + (options "subvol=homefs,compress=lzo") + (type "btrfs")) + %base-file-systems)) + (users (cons (user-account + (name "charlie") + (group "users") + (supplementary-groups '("wheel" "audio" "video"))) + %base-user-accounts)) + (services (cons (service marionette-service-type + (marionette-configuration + (imported-modules '((gnu services herd) + (guix combinators))))) + %base-services)))) + +(define %btrfs-root-on-subvolume-installation-script + ;; Shell script of a simple installation. + "\ +. /etc/profile +set -e -x +guix --version + +export GUIX_BUILD_OPTIONS=--no-grafts +ls -l /run/current-system/gc-roots +parted --script /dev/vdb mklabel gpt \\ + mkpart primary ext2 1M 3M \\ + mkpart primary ext2 3M 2G \\ + set 1 boot on \\ + set 1 bios_grub on + +# Setup the top level Btrfs file system with its subvolume. +mkfs.btrfs -L btrfs-pool /dev/vdb2 +mount /dev/vdb2 /mnt +btrfs subvolume create /mnt/rootfs +btrfs subvolume create /mnt/homefs +umount /dev/vdb2 + +# Mount the subvolumes, ready for installation. +mount LABEL=btrfs-pool -o 'subvol=rootfs,compress=zstd' /mnt +mkdir /mnt/home +mount LABEL=btrfs-pool -o 'subvol=homefs,compress=zstd' /mnt/home + +herd start cow-store /mnt +mkdir /mnt/etc +cp /etc/target-config.scm /mnt/etc/config.scm +guix system build /mnt/etc/config.scm +guix system init /mnt/etc/config.scm /mnt --no-substitutes +sync +reboot\n") + +(define %test-btrfs-root-on-subvolume-os + (system-test + (name "btrfs-root-on-subvolume-os") + (description + "Test basic functionality of an OS installed like one would do by hand. +This test is expensive in terms of CPU and storage usage since we need to +build (current-guix) and then store a couple of full system images.") + (value + (mlet* %store-monad + ((image + (run-install %btrfs-root-on-subvolume-os + %btrfs-root-on-subvolume-os-source + #:script + %btrfs-root-on-subvolume-installation-script)) + (command (qemu-command/writable-image image))) + (run-basic-test %btrfs-root-on-subvolume-os command + "btrfs-root-on-subvolume-os"))))) + ;;; ;;; JFS root file system. diff --git a/tests/file-systems.scm b/tests/file-systems.scm index 41f10210674..7f7c373884f 100644 --- a/tests/file-systems.scm +++ b/tests/file-systems.scm @@ -83,4 +83,49 @@ #f (alist->file-system-options '())) + +;;; +;;; Btrfs related. +;;; + +(define %btrfs-root-subvolume + (file-system + (device (file-system-label "btrfs-pool")) + (mount-point "/") + (type "btrfs") + (options "subvol=rootfs,compress=zstd"))) + +(define %btrfs-store-subvolid + (file-system + (device (file-system-label "btrfs-pool")) + (mount-point "/gnu/store") + (type "btrfs") + (options "subvolid=10,compress=zstd") + (dependencies (list %btrfs-root-subvolume)))) + +(define %btrfs-store-subvolume + (file-system + (device (file-system-label "btrfs-pool")) + (mount-point "/gnu/store") + (type "btrfs") + (options "subvol=/some/nested/file/name") + (dependencies (list %btrfs-root-subvolume)))) + +(test-assert "btrfs-subvolume? (subvol)" + (btrfs-subvolume? %btrfs-root-subvolume)) + +(test-assert "btrfs-subvolume? (subvolid)" + (btrfs-subvolume? %btrfs-store-subvolid)) + +(test-equal "btrfs-store-subvolume-file-name" + "/some/nested/file/name" + (parameterize ((%store-prefix "/gnu/store")) + (btrfs-store-subvolume-file-name (list %btrfs-root-subvolume + %btrfs-store-subvolume)))) + +(test-error "btrfs-store-subvolume-file-name (subvolid)" + (parameterize ((%store-prefix "/gnu/store")) + (btrfs-store-subvolume-file-name (list %btrfs-root-subvolume + %btrfs-store-subvolid)))) + (test-end) -- cgit v1.3 From 7feefb3b82186be382725ac2d6b7e9f8953e4a83 Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Sat, 23 May 2020 19:09:14 +0200 Subject: bootloader: Add 'disk-image-installer'. * gnu/bootloader.scm ()[disk-image-installer]: New field, (bootloader-disk-image-installer): export it. * gnu/bootloader/grub.scm (install-grub-disk-image): New procedure ... (grub-bootloader): ... used as "disk-image-installer" here. (grub-efi-bootloader): set "disk-image-installer" to #f. * gnu/system/image.scm (root-partition?, find-root-partition): Move to "Helpers" section. (root-partition-index): New procedure. (system-disk-image): Honor disk-image-installer, and use it to install the bootloader directly on the disk-image, if supported. --- gnu/bootloader.scm | 5 ++++- gnu/bootloader/grub.scm | 45 ++++++++++++++++++++++++++++++++++++++++++++- gnu/system/image.scm | 32 ++++++++++++++++++++++---------- 3 files changed, 70 insertions(+), 12 deletions(-) (limited to 'gnu/bootloader') diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm index 01bdd4acaa9..668caa7fc3f 100644 --- a/gnu/bootloader.scm +++ b/gnu/bootloader.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017 David Craven -;;; Copyright © 2017 Mathieu Othacehe +;;; Copyright © 2017, 2020 Mathieu Othacehe ;;; Copyright © 2017 Leo Famulari ;;; Copyright © 2019 Ludovic Courtès ;;; @@ -42,6 +42,7 @@ bootloader-name bootloader-package bootloader-installer + bootloader-disk-image-installer bootloader-configuration-file bootloader-configuration-file-generator @@ -125,6 +126,8 @@ record." (name bootloader-name) (package bootloader-package) (installer bootloader-installer) + (disk-image-installer bootloader-disk-image-installer + (default #f)) (configuration-file bootloader-configuration-file) (configuration-file-generator bootloader-configuration-file-generator)) diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm index bb40c551a74..57deaba9127 100644 --- a/gnu/bootloader/grub.scm +++ b/gnu/bootloader/grub.scm @@ -2,7 +2,7 @@ ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès ;;; Copyright © 2016 Chris Marusich ;;; Copyright © 2017 Leo Famulari -;;; Copyright © 2017 Mathieu Othacehe +;;; Copyright © 2017, 2020 Mathieu Othacehe ;;; Copyright © 2019, 2020 Jan (janneke) Nieuwenhuizen ;;; Copyright © 2020 Maxim Cournoyer ;;; @@ -436,6 +436,47 @@ fi~%")))) "--boot-directory" install-dir device)))) +(define install-grub-disk-image + #~(lambda (bootloader root-index image) + ;; Install GRUB on the given IMAGE. The root partition index is + ;; ROOT-INDEX. + (let ((grub-mkimage + (string-append bootloader "/bin/grub-mkimage")) + (modules '("biosdisk" "part_msdos" "fat" "ext2")) + (grub-bios-setup + (string-append bootloader "/sbin/grub-bios-setup")) + (root-device (format #f "hd0,msdos~a" root-index)) + (boot-img (string-append bootloader "/lib/grub/i386-pc/boot.img")) + (device-map "device.map")) + + ;; Create a minimal, standalone GRUB image that will be written + ;; directly in the MBR-GAP (space between the end of the MBR and the + ;; first partition). + (apply invoke grub-mkimage + "-O" "i386-pc" + "-o" "core.img" + "-p" (format #f "(~a)/boot/grub" root-device) + modules) + + ;; Create a device mapping file. + (call-with-output-file device-map + (lambda (port) + (format port "(hd0) ~a~%" image))) + + ;; Copy the default boot.img, that will be written on the MBR sector + ;; by GRUB-BIOS-SETUP. + (copy-file boot-img "boot.img") + + ;; Install both the "boot.img" and the "core.img" files on the given + ;; IMAGE. On boot, the MBR sector will execute the minimal GRUB + ;; written in the MBR-GAP. GRUB configuration and missing modules will + ;; be read from ROOT-DEVICE. + (invoke grub-bios-setup + "-m" device-map + "-r" root-device + "-d" "." + image)))) + (define install-grub-efi #~(lambda (bootloader efi-dir mount-point) ;; Install GRUB onto the EFI partition mounted at EFI-DIR, for the @@ -465,6 +506,7 @@ fi~%")))) (name 'grub) (package grub) (installer install-grub) + (disk-image-installer install-grub-disk-image) (configuration-file "/boot/grub/grub.cfg") (configuration-file-generator grub-configuration-file))) @@ -480,6 +522,7 @@ fi~%")))) (bootloader (inherit grub-bootloader) (installer install-grub-efi) + (disk-image-installer #f) (name 'grub-efi) (package grub-efi))) diff --git a/gnu/system/image.scm b/gnu/system/image.scm index a1214dd20a6..92b3f4424ea 100644 --- a/gnu/system/image.scm +++ b/gnu/system/image.scm @@ -147,6 +147,18 @@ (guix build utils)) gexp* ...)))) +(define (root-partition? partition) + "Return true if PARTITION is the root partition, false otherwise." + (member 'boot (partition-flags partition))) + +(define (find-root-partition image) + "Return the root partition of the given IMAGE." + (srfi-1:find root-partition? (image-partitions image))) + +(define (root-partition-index image) + "Return the index of the root partition of the given IMAGE." + (1+ (srfi-1:list-index root-partition? (image-partitions image)))) + ;; ;; Disk image. @@ -276,9 +288,17 @@ image ~a { (let* ((substitutable? (image-substitutable? image)) (builder (with-imported-modules* - (let ((inputs '#+(list genimage coreutils findutils))) + (let ((inputs '#+(list genimage coreutils findutils)) + (bootloader-installer + #+(bootloader-disk-image-installer bootloader))) (set-path-environment-variable "PATH" '("bin" "sbin") inputs) - (genimage #$(image->genimage-cfg image) #$output)))) + (genimage #$(image->genimage-cfg image) #$output) + ;; Install the bootloader directly on the disk-image. + (when bootloader-installer + (bootloader-installer + #+(bootloader-package bootloader) + #$(root-partition-index image) + (string-append #$output "/" #$genimage-name)))))) (image-dir (computed-file "image-dir" builder))) (computed-file name #~(symlink @@ -371,14 +391,6 @@ used in the image. " ;; Image creation. ;; -(define (root-partition? partition) - "Return true if PARTITION is the root partition, false otherwise." - (member 'boot (partition-flags partition))) - -(define (find-root-partition image) - "Return the root partition of the given IMAGE." - (srfi-1:find root-partition? (image-partitions image))) - (define (image->root-file-system image) "Return the IMAGE root partition file-system type." (let ((format (image-format image))) -- cgit v1.3 From 7e6a42f215726b6ea5b1a2a8b8bc80481f7ebcd9 Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Sat, 23 May 2020 19:09:38 +0200 Subject: bootloader: grub: Do not run grub-install when creating a disk-image. * gnu/bootloader/grub.scm (install-grub): When creating a disk-image, grub-install will fail because it lacks root permissions. In that case, do not run grub-install and only copy Grub modules to the /boot directory. --- gnu/bootloader/grub.scm | 26 ++++++++++++++++---------- 1 file changed, 16 insertions(+), 10 deletions(-) (limited to 'gnu/bootloader') diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm index 57deaba9127..23c7a820844 100644 --- a/gnu/bootloader/grub.scm +++ b/gnu/bootloader/grub.scm @@ -423,18 +423,24 @@ fi~%")))) (define install-grub #~(lambda (bootloader device mount-point) - ;; Install GRUB on DEVICE which is mounted at MOUNT-POINT. (let ((grub (string-append bootloader "/sbin/grub-install")) (install-dir (string-append mount-point "/boot"))) - ;; Tell 'grub-install' that there might be a LUKS-encrypted /boot or - ;; root partition. - (setenv "GRUB_ENABLE_CRYPTODISK" "y") - - ;; Hide potentially confusing messages from the user, such as - ;; "Installing for i386-pc platform." - (invoke/quiet grub "--no-floppy" "--target=i386-pc" - "--boot-directory" install-dir - device)))) + ;; Install GRUB on DEVICE which is mounted at MOUNT-POINT. If DEVICE + ;; is #f, then we populate the disk-image rooted at MOUNT-POINT. + (if device + (begin + ;; Tell 'grub-install' that there might be a LUKS-encrypted + ;; /boot or root partition. + (setenv "GRUB_ENABLE_CRYPTODISK" "y") + + ;; Hide potentially confusing messages from the user, such as + ;; "Installing for i386-pc platform." + (invoke/quiet grub "--no-floppy" "--target=i386-pc" + "--boot-directory" install-dir + device)) + ;; When creating a disk-image, only install GRUB modules. + (copy-recursively (string-append bootloader "/lib/") + install-dir))))) (define install-grub-disk-image #~(lambda (bootloader root-index image) -- cgit v1.3 From 7202895e5afa9922ba06eaba295645b08d6fd254 Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Sat, 23 May 2020 19:09:46 +0200 Subject: bootloader: grub: Use inheritance to define grub-minimal-bootloader. * gnu/bootloader/grub.scm (grub-minimal-bootloader): Inherit from grub-bootloader to avoid field redefinition. --- gnu/bootloader/grub.scm | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) (limited to 'gnu/bootloader') diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm index 23c7a820844..40918ea3078 100644 --- a/gnu/bootloader/grub.scm +++ b/gnu/bootloader/grub.scm @@ -516,13 +516,10 @@ fi~%")))) (configuration-file "/boot/grub/grub.cfg") (configuration-file-generator grub-configuration-file))) -(define grub-minimal-bootloader +(define* grub-minimal-bootloader (bootloader - (name 'grub) - (package grub-minimal) - (installer install-grub) - (configuration-file "/boot/grub/grub.cfg") - (configuration-file-generator grub-configuration-file))) + (inherit grub-bootloader) + (package grub-minimal))) (define* grub-efi-bootloader (bootloader -- cgit v1.3 From e7b86a0d88760275afefa0c44a3c30602f80aac0 Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Wed, 27 May 2020 22:44:28 -0400 Subject: bootloader: grub: Rename the btrfs-subvolume-file-name parameter. Following discussion in , it seems more appropriate to give the parameter a more generic name that better describes what it does. * gnu/bootloader/grub.scm (normalize-file): Rename the BTRFS-SUBVOLUME-FILE-NAME parameter to STORE-DIRECTORY-PREFIX, and always assume this argument to be a string. (eye-candy): Likewise. Default STORE-DIRECTORY-PREFIX to "". (grub-configuration-file): Likewise. * gnu/system.scm (operating-system-bootcfg): Adapt. --- gnu/bootloader/grub.scm | 47 ++++++++++++++++++++++------------------------- gnu/system.scm | 2 +- 2 files changed, 23 insertions(+), 26 deletions(-) (limited to 'gnu/bootloader') diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm index 40918ea3078..2d9a39afc3e 100644 --- a/gnu/bootloader/grub.scm +++ b/gnu/bootloader/grub.scm @@ -58,8 +58,8 @@ ;;; ;;; 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) @@ -72,13 +72,13 @@ G-expression or other lowerable object denoting a file name." 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))) @@ -135,14 +135,14 @@ file with the resolution provided in CONFIG." (_ #f))))) (define* (eye-candy config store-device store-mount-point - #:key btrfs-store-subvolume-file-name system port) + #:key store-directory-prefix system 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." +\"x86_64-linux\". STORE-DIRECTORY-PREFIX is a directory prefix to prepend to +any store file name." (define setup-gfxterm-body (let ((gfxmode (or (and-let* ((theme (bootloader-configuration-theme config)) @@ -181,12 +181,12 @@ fi~%" #+font-file) (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 " @@ -320,13 +320,13 @@ code." #:key (system (%current-system)) (old-entries '()) - btrfs-subvolume-file-name) + store-directory-prefix) "Return the GRUB configuration file corresponding to CONFIG, a object, and where the store is available at -STORE-FS, a 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 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) @@ -336,17 +336,14 @@ Btrfs root file system resides." (arguments (menu-entry-linux-arguments entry)) (kernel (normalize-file (menu-entry-linux entry) device-mount-point - btrfs-subvolume-file-name)) + store-directory-prefix)) (initrd (normalize-file (menu-entry-initrd entry) device-mount-point - btrfs-subvolume-file-name))) + store-directory-prefix))) ;; 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 { ~a linux ~a ~a @@ -360,7 +357,7 @@ Btrfs root file system resides." (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 + #:store-directory-prefix store-directory-prefix #:system system #:port #~port)) @@ -371,8 +368,8 @@ Btrfs root file system resides." (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 diff --git a/gnu/system.scm b/gnu/system.scm index d929187695f..ac8bbd1d16f 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -1118,7 +1118,7 @@ a list of , to populate the \"old entries\" menu." (generate-config-file bootloader-conf (list entry) #:old-entries old-entries - #:btrfs-subvolume-file-name + #:store-directory-prefix (btrfs-store-subvolume-file-name file-systems)))) (define* (operating-system-boot-parameters os root-device -- cgit v1.3 From 1244491a0d5334e1589159a2ff67bbc967b9648b Mon Sep 17 00:00:00 2001 From: "Jan (janneke) Nieuwenhuizen" Date: Tue, 26 May 2020 18:09:01 +0200 Subject: bootloader: grub: Add support for multiboot. * gnu/bootloader/grub.scm (grub-configuration-file): Add support for multiboot. --- gnu/bootloader/grub.scm | 76 +++++++++++++++++++++++++++++++------------------ 1 file changed, 49 insertions(+), 27 deletions(-) (limited to 'gnu/bootloader') diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm index 2d9a39afc3e..d4dbb571315 100644 --- a/gnu/bootloader/grub.scm +++ b/gnu/bootloader/grub.scm @@ -330,36 +330,58 @@ 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 - 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 KERNEL and INITRD in case - ;; DEVICE-MOUNT-POINT is not "/", meaning that the store is on a - ;; separate partition. - #~(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)) - #:store-directory-prefix store-directory-prefix - #: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 + #:system system + #:port #~port))) (define keyboard-layout-config (let* ((layout (bootloader-configuration-keyboard-layout config)) @@ -384,7 +406,7 @@ keymap ~a~%" #$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 -- cgit v1.3 From 536c53d347291dcc75e1073af6e6c5c614e0fff4 Mon Sep 17 00:00:00 2001 From: Stefan Date: Tue, 9 Jun 2020 14:16:59 +0200 Subject: gnu: grub: Support graphical gfxterm on all systems. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/bootloaders/grub.scm (eye-candy): Use gfxterm depending only on (bootloader-configuration (terminal-outputs …)), which defaults to '(gfxterm). This makes the system argument obsolete. Signed-off-by: Mathieu Othacehe --- gnu/bootloader/grub.scm | 47 ++++++++++++++--------------------------------- 1 file changed, 14 insertions(+), 33 deletions(-) (limited to 'gnu/bootloader') diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm index d4dbb571315..fa391fd6b44 100644 --- a/gnu/bootloader/grub.scm +++ b/gnu/bootloader/grub.scm @@ -5,6 +5,7 @@ ;;; Copyright © 2017, 2020 Mathieu Othacehe ;;; Copyright © 2019, 2020 Jan (janneke) Nieuwenhuizen ;;; Copyright © 2020 Maxim Cournoyer +;;; Copyright © 2020 Stefan ;;; ;;; This file is part of GNU Guix. ;;; @@ -135,41 +136,25 @@ file with the resolution provided in CONFIG." (_ #f))))) (define* (eye-candy config store-device store-mount-point - #:key store-directory-prefix 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\". STORE-DIRECTORY-PREFIX is a directory prefix to prepend to -any store file name." - (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) @@ -190,8 +175,6 @@ fi~%" #+font-file) (and image #~(format #$port " -function setup_gfxterm {~a} - # Set 'root' to the partition that contains /gnu/store. ~a @@ -206,7 +189,6 @@ else 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) @@ -380,7 +362,6 @@ menuentry ~s { device mount-point #:store-directory-prefix store-directory-prefix - #:system system #:port #~port))) (define keyboard-layout-config -- cgit v1.3 From 80352a2f6878a3a51c3e26cb768b9ae3d63a5de7 Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Tue, 9 Jun 2020 18:47:13 +0200 Subject: bootloader: grub: Fix cross-compilation. This is a follow-up of 536c53d347291dcc75e1073af6e6c5c614e0fff4, that do not use the native version of "font-file", breaking cross-compilation. * gnu/bootloader/grub.scm (eye-candy): Use the native version of "font-file". --- gnu/bootloader/grub.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gnu/bootloader') diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm index fa391fd6b44..b905ae360c0 100644 --- a/gnu/bootloader/grub.scm +++ b/gnu/bootloader/grub.scm @@ -151,7 +151,7 @@ if loadfont ~a; then insmod all_video insmod gfxterm fi~%" - #$font-file + #+font-file #$(string-join (grub-theme-gfxmode (bootloader-theme config)) ";")) -- cgit v1.3