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.master
Maxim Cournoyer
parent
fa35fb58c8
commit
b460ba7992
104
doc/guix.texi
104
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
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -58,18 +58,29 @@
|
|||
;;;
|
||||
;;; Code:
|
||||
|
||||
(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)
|
||||
"Strip MOUNT-POINT from FILE, which is a gexp or other lowerable object
|
||||
denoting a file name."
|
||||
(match mount-point
|
||||
((? string? mount-point)
|
||||
(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 @@ 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,26 +319,34 @@ 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))
|
||||
(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 @@ entries corresponding to old generations of the system."
|
|||
#$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
|
||||
|
|
|
|||
|
|
@ -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 @@ 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?)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
Reference in New Issue