diff options
Diffstat (limited to 'gnu/tests/install.scm')
| -rw-r--r-- | gnu/tests/install.scm | 107 |
1 files changed, 102 insertions, 5 deletions
diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm index 94d970e1cc..db355b85ca 100644 --- a/gnu/tests/install.scm +++ b/gnu/tests/install.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2017, 2019 Tobias Geerinckx-Rice <me@tobias.gr> ;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org> +;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -61,6 +62,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 @@ -226,19 +228,21 @@ packages defined in installation-os." (mlet* %store-monad ((_ (set-grafting #f)) (system (current-system)) - (target (operating-system-derivation target-os)) + (target (current-target-system)) + (base-image -> (find-image + installation-disk-image-file-system-type + target)) ;; Since the installation system has no network access, ;; we cheat a little bit by adding TARGET to its GC ;; roots. This way, we know 'guix system init' will ;; succeed. Also add guile-final, which is pulled in ;; through provenance.drv and may not always be present. - (image + (target (operating-system-derivation target-os)) + (image -> (system-image (image - (inherit - (find-image - installation-disk-image-file-system-type)) + (inherit base-image) (size install-size) (operating-system (operating-system-with-gc-roots @@ -865,6 +869,99 @@ build (current-guix) and then store a couple of full system images.") ;;; +;;; 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. ;;; |