From e73112a8a476f89a4728a865576dab7e8042bb47 Mon Sep 17 00:00:00 2001
From: Maxim Cournoyer <maxim.cournoyer@gmail.com>
Date: Sun, 14 Jul 2019 20:50:23 +0900
Subject: [PATCH 8/8] bootloader: grub: Allow booting from a Btrfs subvolume.
* gnu/bootloader/grub.scm (grub-configuration-file)
[btrfs-subvolume-file-name]: New parameter. When it is defined,
prepend its value to the kernel and initrd file names.
* 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. Document the new `properties' field of the `<file-system>'
record.
* gnu/tests/install.scm: Add test "btrfs-root-on-subvolume-os".
---
doc/guix.texi | 114 +++++++++++++++++++++++++++++++++
gnu/bootloader/depthcharge.scm | 3 +-
gnu/bootloader/extlinux.scm | 3 +-
gnu/bootloader/grub.scm | 45 ++++++++-----
gnu/system.scm | 9 ++-
gnu/system/file-systems.scm | 58 +++++++++++++++++
gnu/tests/install.scm | 96 +++++++++++++++++++++++++++
7 files changed, 308 insertions(+), 20 deletions(-)
@@ -11442,6 +11442,13 @@ a dependency of @file{/sys/fs/cgroup/cpu} and
Another example is a file system that depends on a mapped device, for
example for an encrypted partition (@pxref{Mapped Devices}).
+
+@item @code{properties} (default: @code{'()})
+This is a list of key-value pairs that can be used to specify properties
+not captured by other fields. For example, the top level path of a
+Btrfs subvolume within its Btrfs pool can be specified using the
+@code{btrfs-subvolume-path} property (@pxref{Btrfs file system}).
+
@end table
@end deftp
@@ -11491,6 +11498,113 @@ 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}):
+
+@example
+(file-system
+ (device (file-system-label "my-btrfs-pool"))
+ (mount-point "/")
+ (type "btrfs")
+ (options '("defaults" ("subvol" . "rootfs"))
+ (dependencies mapped-devices))
+@end example
+
+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 and initrd binaries in the GRUB configuration in order for
+those to be found.
+
+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.
+
+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' module name doesn't match its intended mount
+point, so it is necessary to mount it. The layout cannot simply be
+described by the <file-system> record, so it is required to specify the
+exact path at which the subvolume exists within the top level of its
+parent file system. This can be achieved by attaching a
+@code{btrfs-subvolume-path} property to the corresponding file system
+record:
+
+@lisp
+(file-system
+ ...
+ (properties '((btrfs-subvolume-path
+ . "/root-snapshots/root-current/guix-store"))))
+@end lisp
+
+The default behavior of Guix is to assume that a subvolume exists
+directly at the root of the top volume hierarchy. When this is not the
+case, the above property must be used for the system to boot correctly
+when using a GRUB based bootloader.
+
@node Mapped Devices
@section Mapped Devices
@@ -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))
@@ -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
<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
@@ -4,6 +4,7 @@
;;; Copyright © 2017 Leo Famulari <leo@famulari.name>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -327,35 +328,47 @@ 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
<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))
- (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* (strip-mount-point
+ device-mount-point (menu-entry-linux entry)))
+ (initrd* (strip-mount-point
+ device-mount-point (menu-entry-initrd entry)))
+ (kernel (if btrfs-subvolume-file-name
+ #~(string-append #$btrfs-subvolume-file-name #$kernel*)
+ kernel*))
+ (initrd (if btrfs-subvolume-file-name
+ #~(string-append #$btrfs-subvolume-file-name #$initrd*)
+ initrd*)))
;; 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))
@@ -5,6 +5,7 @@
;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019 Meiyo Peng <meiyo.peng@gmail.com>
+;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -992,19 +993,23 @@ entry."
(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?)
@@ -21,7 +21,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)
@@ -44,9 +47,12 @@
file-system-create-mount-point?
file-system-dependencies
file-system-location
+ file-system-properties
file-system-type-predicate
file-system-independent-mount-option?
+ btrfs-subvolume?
+ btrfs-store-subvolume-file-name
file-system-label
file-system-label?
@@ -112,6 +118,8 @@
(default #f))
(dependencies file-system-dependencies ; list of <file-system>
(default '())) ; or <mapped-device>
+ (properties file-system-properties ; list of name-value pairs
+ (default '()))
(location file-system-location
(default (current-source-location))
(innate)))
@@ -584,4 +592,54 @@ system has the given TYPE."
(or (string-prefix-ci? "x-" option-name)
(member option-name %file-system-independent-mount-options))))
+(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 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. When the BTRFS-SUBVOLUME-FILE-NAME file
+system property is not set, it is assumed that the store subvolume
+file name is located at the root of the top level of the file system."
+
+ (define (find-mount-point-fs mount-point file-systems)
+ (find (lambda (fs)
+ (string= mount-point (file-system-mount-point fs)))
+ file-systems))
+
+ ;; Find a subvolume mounted at either /gnu/store, /gnu, or /.
+ (let loop ((mount-point (%store-prefix)))
+ (let ((mount-point-fs (find-mount-point-fs mount-point file-systems)))
+ (cond
+ ((string-null? mount-point)
+ #f) ;store is not on a Btrfs subvolume
+ ((and=> mount-point-fs btrfs-subvolume?)
+ (let* ((fs-options (file-system-options mount-point-fs))
+ (subvolid (assoc-ref fs-options "subvolid"))
+ (subvol (assoc-ref fs-options "subvol")))
+ (or (assoc-ref (file-system-properties mount-point-fs)
+ "btrfs-subvolume-file-name")
+ (and=> subvol (cut string-append "/" <>))
+ ;; XXX: Importing (guix utils) and using &fix-hint causes the
+ ;; following error when booting the init RAM disk: "ERROR: In
+ ;; procedure dynamic-func:\nIn procedure dynamic-pointer: Symbol
+ ;; not found: strverscmp", so we just embed the hint in the
+ ;; message.
+ (raise (condition
+ (&message
+ (message "The store is on a Btrfs subvolume, but the \
+subvolume name is unknown.\nHint: Define the \"btrfs-subvolume-file-name\" \
+file system property or use the \"subvol\" Btrfs file system")))))))
+ (else
+ (loop
+ (cond ((string-suffix? "/" mount-point)
+ (string-drop-right mount-point 1))
+ ((string-take mount-point
+ (1+ (string-index-right mount-point #\/)))))))))))
+
;;; file-systems.scm ends here
@@ -44,6 +44,7 @@
%test-raid-root-os
%test-encrypted-root-os
%test-btrfs-root-os
+ %test-btrfs-root-on-subvolume-os
%test-jfs-root-os))
;;; Commentary:
@@ -811,6 +812,101 @@ 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.
--
2.25.0