From patchwork Thu Feb 13 20:27:15 2020 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Maxim Cournoyer X-Patchwork-Id: 20241 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 8D29627BBE4; Thu, 13 Feb 2020 20:28:24 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.8 required=5.0 tests=BAYES_00,DKIM_ADSP_CUSTOM_MED, DKIM_SIGNED,FREEMAIL_FROM,MAILING_LIST_MULTI,T_DKIM_INVALID, URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.2 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTP id 1830327BBEA for ; Thu, 13 Feb 2020 20:28:21 +0000 (GMT) Received: from localhost ([::1]:58792 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1j2L5w-000561-IQ for patchwork@mira.cbaines.net; Thu, 13 Feb 2020 15:28:20 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]:53906) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1j2L5k-00055U-Dp for guix-patches@gnu.org; Thu, 13 Feb 2020 15:28:13 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1j2L5e-0006BX-Oz for guix-patches@gnu.org; Thu, 13 Feb 2020 15:28:08 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:54555) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1j2L5e-0006Af-Gs for guix-patches@gnu.org; Thu, 13 Feb 2020 15:28:02 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1j2L5e-0002VZ-Ck for guix-patches@gnu.org; Thu, 13 Feb 2020 15:28:02 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#37305] [PATCH V2] Allow booting from a Btrfs subvolume. Resent-From: Maxim Cournoyer Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Thu, 13 Feb 2020 20:28:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 37305 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: Ludovic =?utf-8?q?Court=C3=A8s?= Cc: 37305@debbugs.gnu.org Received: via spool by 37305-submit@debbugs.gnu.org id=B37305.15816256499602 (code B ref 37305); Thu, 13 Feb 2020 20:28:02 +0000 Received: (at 37305) by debbugs.gnu.org; 13 Feb 2020 20:27:29 +0000 Received: from localhost ([127.0.0.1]:60528 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1j2L55-0002Un-Ny for submit@debbugs.gnu.org; Thu, 13 Feb 2020 15:27:29 -0500 Received: from mail-qk1-f193.google.com ([209.85.222.193]:43860) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1j2L52-0002UX-Du for 37305@debbugs.gnu.org; Thu, 13 Feb 2020 15:27:26 -0500 Received: by mail-qk1-f193.google.com with SMTP id p7so7006697qkh.10 for <37305@debbugs.gnu.org>; Thu, 13 Feb 2020 12:27:24 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:cc:subject:references:date:in-reply-to:message-id :user-agent:mime-version; bh=0nRwqXQpuyYdADG1qh6Nw0GmonIRWRE1LhUKkOLPLAI=; b=VdDmGGBrSx3uL9yzYTcDwyNm6mYDIyUfEgWR3/WqiiAaYOa1BR9sBpBc1FL+w6n7vx XXNACkM3Cz/7ze4qHnY4Ggy6COCMbnEhZHxFj36hwDgqC/rqKufgozJQYdfML3HcaNdt /11wD1l78I+bLWC7L4maumRgVG2KikZsPZ7M3fC9FaaiE0nnIimceUs2wKQqiYZc2y/7 1vam/HT6zy/5XTcxsYw16pAyWMHlTs/J+h5jEK0Ncvz+XD6xYvULDqPyfTblUtI08CQt 7tpotAUGv7pwfJhjtAQcI3Xy1EYN6oWvc2HykmoZI6KkaF7hYhSyn4E1N+p82HfzMgup kRWA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:cc:subject:references:date:in-reply-to :message-id:user-agent:mime-version; bh=0nRwqXQpuyYdADG1qh6Nw0GmonIRWRE1LhUKkOLPLAI=; b=i79f4+EiO2a6nmdcgagpgT+F/EQRFzX6c+x9hdbsY0nb9PG8eIAhVakrissEWR1Jej KgxYvdXXN1TCkVYrEdzCbaCYqVZC75F4H1KbFOv1lbkGuTIEc/QgJmHZeM5YqpExFn9x 0UYvnIkUse3oXrGJGE7ohK/Gld8SlLouj1kAxLMsFbQc4Fsj52tlTz6qc8osMn4e7wn+ jj+5yYpd1aG9iHksBh/0N/xfxc9dw6tF0i76gyABw5pClQdEBRC5/GYmqJbqIRJRNjPc hryUgHCdYGVGh4BTdrBbF/+52l1dM1jz/yiDiwS0swA+s4tP+Mbgh3NqGliIwAB4n0Gx O57w== X-Gm-Message-State: APjAAAUkY3pjoJ5HoKaaONp8qg5vgBbyd+B6ZVvVWP818hqCpcVQjULU c3/8T4iuJa6RgsRMp17N99rVgDwP X-Google-Smtp-Source: APXvYqzk4vc+/PziT/EO64SAE8dTGaSf7HdvK+D3A4Zbyhcu43J35eTeirCpMRVfYS3mupWth6+zRQ== X-Received: by 2002:a37:6752:: with SMTP id b79mr17822145qkc.224.1581625638806; Thu, 13 Feb 2020 12:27:18 -0800 (PST) Received: from kwak ([2607:fad8:4:6:afc9:fe0d:91fc:113b]) by smtp.gmail.com with ESMTPSA id g11sm511131qtc.48.2020.02.13.12.27.16 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 13 Feb 2020 12:27:17 -0800 (PST) From: Maxim Cournoyer References: <87sgpby4p9.fsf@gmail.com> <87y2yg3t3s.fsf@gnu.org> <87k14sfaz7.fsf@gmail.com> Date: Thu, 13 Feb 2020 15:27:15 -0500 In-Reply-To: <87k14sfaz7.fsf@gmail.com> (Maxim Cournoyer's message of "Wed, 12 Feb 2020 03:47:40 -0500") Message-ID: <87lfp6b5cs.fsf_-_@gmail.com> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.3 (gnu/linux) MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 209.51.188.43 X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches I've fixed a few problems I've found with more extensive testing. Attached is the version 2 of the patch series. From 6cf2ece21683e98544f8f46675aef58d5a7231fd Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Sun, 14 Jul 2019 20:50:23 +0900 Subject: [PATCH 8/9] bootloader: grub: Allow booting from a Btrfs subvolume. * gnu/bootloader/grub.scm (grub-configuration-file) [btrfs-subvolume-path]: New parameter. When it is defined, prepend its value to the kernel and initrd file paths. * 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-path): New procedures. * gnu/system.scm (operating-system-bootcfg): Specify the Btrfs subvolume path of the GNU store to the `operating-system-bootcfg' procedure, using the new BTRFS-SUBVOLUME-PATH argument. * doc/guix.texi (File Systems): Add a Btrfs subsection to document the use of subvolumes. Document the new `properties' field of the `' 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 | 42 +++++++----- gnu/system.scm | 9 ++- gnu/system/file-systems.scm | 51 +++++++++++++++ gnu/tests/install.scm | 87 +++++++++++++++++++++++++ 7 files changed, 290 insertions(+), 19 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index d6bfbd7b55..f0956f965a 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -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 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 diff --git a/gnu/bootloader/depthcharge.scm b/gnu/bootloader/depthcharge.scm index 58cc3f3932..0a50374bd9 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 5b4dd84965..6b5ff298e7 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 b99f5fa4f4..c9794c35c2 100644 --- a/gnu/bootloader/grub.scm +++ b/gnu/bootloader/grub.scm @@ -4,6 +4,7 @@ ;;; Copyright © 2017 Leo Famulari ;;; Copyright © 2017 Mathieu Othacehe ;;; Copyright © 2019 Jan (janneke) Nieuwenhuizen +;;; Copyright © 2020 Maxim Cournoyer ;;; ;;; This file is part of GNU Guix. ;;; @@ -327,35 +328,46 @@ code." (define* (grub-configuration-file config entries #:key (system (%current-system)) - (old-entries '())) + (old-entries '()) + btrfs-subvolume-path) "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." +entries corresponding to old generations of the system. BTRFS-SUBVOLUME-PATH +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-path + #~(string-append #$btrfs-subvolume-path #$kernel*) + kernel*)) + (initrd (if btrfs-subvolume-path + #~(string-append #$btrfs-subvolume-path #$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-PATH 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)) diff --git a/gnu/system.scm b/gnu/system.scm index 2e6d03272d..ebc8bf1db8 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -5,6 +5,7 @@ ;;; Copyright © 2016 Chris Marusich ;;; Copyright © 2017 Mathieu Othacehe ;;; Copyright © 2019 Meiyo Peng +;;; Copyright © 2019 Maxim Cournoyer ;;; ;;; 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 , 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-path (btrfs-store-subvolume-path + 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 2c3c159d04..daef1c9d72 100644 --- a/gnu/system/file-systems.scm +++ b/gnu/system/file-systems.scm @@ -21,7 +21,9 @@ #: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-9 gnu) #:use-module (guix records) #:use-module (gnu system uuid) @@ -44,9 +46,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-path file-system-label file-system-label? @@ -112,6 +117,8 @@ (default #f)) (dependencies file-system-dependencies ; list of (default '())) ; or + (properties file-system-properties ; list of name-value pairs + (default '())) (location file-system-location (default (current-source-location)) (innate))) @@ -582,4 +589,48 @@ 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-path file-systems) + "Return the subvolume path within the Btrfs top level onto which the store +is located. When the BTRFS-SUBVOLUME-PATH file system property is not set, it +is assumed that the store subvolume path is a 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-path") + (and=> subvol (cut string-append "/" <>)) + (error "The store is on a Btrfs subvolume, but the \ +subvolume name is unknown. +Hint: Define the \"btrfs-subvolume-path\" file system property or +use the \"subvol\" Btrfs file system option.")))) + (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 diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm index d475bda2c7..b32130c2f3 100644 --- a/gnu/tests/install.scm +++ b/gnu/tests/install.scm @@ -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,92 @@ 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 +mkfs.btrfs -L btrfs-pool /dev/vdb2 +mount /dev/vdb2 /mnt +btrfs subvolume create /mnt/rootfs +btrfs subvolume create /mnt/homefs +herd start cow-store /mnt/rootfs +mkdir /mnt/rootfs/etc +cp /etc/target-config.scm /mnt/rootfs/etc/config.scm +guix system build /mnt/rootfs/etc/config.scm +guix system init /mnt/rootfs/etc/config.scm /mnt/rootfs --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.23.0