From 12e7ca2628a7e16a1afacfd8953bd6bcfe5c10bd 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 4/5] 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: Add test "btrfs-root-on-subvolume-os".
---
doc/guix.texi | 104 ++++++++++++++++++++++++++++
gnu/bootloader/depthcharge.scm | 3 +-
gnu/bootloader/extlinux.scm | 3 +-
gnu/bootloader/grub.scm | 122 ++++++++++++++++++++-------------
gnu/system.scm | 9 ++-
gnu/system/file-systems.scm | 58 ++++++++++++++++
gnu/tests/install.scm | 94 +++++++++++++++++++++++++
tests/file-systems.scm | 45 ++++++++++++
8 files changed, 388 insertions(+), 50 deletions(-)
@@ -11589,6 +11589,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" . "zstd")))
+@end lisp
+
@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
@@ -63,18 +63,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* <grub-image>
grub-image make-grub-image
@@ -142,13 +153,15 @@ WIDTH/HEIGHT, or #f if none was found."
#:width width #:height height))))
(define* (eye-candy config store-device store-mount-point
+ btrfs-store-subvolume-file-name
#: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\"."
+ "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))
@@ -185,11 +198,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 "
@@ -214,7 +230,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))))
@@ -318,52 +334,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
<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 (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-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
@@ -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.
;;;
@@ -1001,19 +1002,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)
@@ -48,6 +51,8 @@
file-system-location
file-system-type-predicate
+ btrfs-subvolume?
+ btrfs-store-subvolume-file-name
file-system-label
file-system-label?
@@ -565,4 +570,57 @@ 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)
+ ;; 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.
+Hint: Use the \"subvol\" Btrfs file system option.")))))))
+
+
;;; file-systems.scm ends here
@@ -48,6 +48,7 @@
%test-raid-root-os
%test-encrypted-root-os
%test-btrfs-root-os
+ %test-btrfs-root-on-subvolume-os
%test-jfs-root-os
%test-gui-installed-os
@@ -834,6 +835,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.
@@ -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)
--
2.25.1