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.
This commit is contained in:
Maxim Cournoyer 2019-07-14 20:50:23 +09:00
parent fa35fb58c8
commit b460ba7992
No known key found for this signature in database
GPG key ID: 1260E46482E63562
8 changed files with 385 additions and 51 deletions

View file

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

View file

@ -82,7 +82,8 @@ (define builder
(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))

View file

@ -28,7 +28,8 @@ (define-module (gnu bootloader extlinux)
(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
<u-boot-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

View file

@ -58,18 +58,29 @@ (define-module (gnu bootloader grub)
;;;
;;; 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)
(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))))
(#f 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)
file))
(prepend-btrfs-subvolume-file-name btrfs-subvolume-file-name
(strip-mount-point mount-point file)))
(define-record-type* <grub-theme>
;; Default theme contributed by Felipe López.
@ -124,13 +135,14 @@ (define* (grub-background-image 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 @@ (define (theme-colors type)
(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 @@ (define image
#$(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,26 +319,34 @@ (define (grub-root-search device file)
(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
<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."
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."
(define all-entries
(append entries (bootloader-configuration-menu-entries config)))
(define (menu-entry->gexp entry)
(let ((device (menu-entry-device 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)))
(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)))
;; 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
@ -332,24 +355,30 @@ (define (menu-entry->gexp entry)
#$label
#$(grub-root-search device kernel)
#$kernel (string-join (list #$@arguments))
#$initrd))))
#$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))
(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
(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

View file

@ -8,6 +8,7 @@
;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org>
;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re>
;;; Copyright © 2020 Florian Pelz <pelzflorian@pelzflorian.de>
;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -1102,19 +1103,23 @@ (define (operating-system-store-file-system os)
(define* (operating-system-bootcfg os #:optional (old-entries '()))
"Return the bootloader configuration file for OS. Use OLD-ENTRIES,
a list of <menu-entry>, 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?)

View file

@ -22,7 +22,10 @@ (define-module (gnu system file-systems)
#: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 @@ (define-module (gnu system file-systems)
file-system-location
file-system-type-predicate
btrfs-subvolume?
btrfs-store-subvolume-file-name
file-system-label
file-system-label?
@ -566,4 +571,54 @@ (define (file-system-type-predicate 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

View file

@ -61,6 +61,7 @@ (define-module (gnu tests install)
%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 @@ (define %test-btrfs-root-os
(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.

View file

@ -83,4 +83,49 @@ (define-module (test-file-systems)
#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)