diff options
Diffstat (limited to 'gnu/tests/install.scm')
| -rw-r--r-- | gnu/tests/install.scm | 400 |
1 files changed, 258 insertions, 142 deletions
diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm index ae8c6051f1..be8bb1b583 100644 --- a/gnu/tests/install.scm +++ b/gnu/tests/install.scm @@ -4,7 +4,7 @@ ;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org> ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> -;;; Copyright © 2020, 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com> +;;; Copyright © 2020, 2021, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -70,6 +70,8 @@ %test-btrfs-root-os %test-btrfs-root-on-subvolume-os %test-btrfs-raid-root-os + %test-btrfs-raid10-root-os + %test-btrfs-raid10-root-os-degraded %test-jfs-root-os %test-f2fs-root-os %test-xfs-root-os @@ -229,10 +231,8 @@ reboot\n") ;; Since the image has no network access, use the ;; current Guix so the store items we need are in ;; the image and add packages provided. - (inherit (operating-system-add-packages - (operating-system-with-current-guix - installation-os) - packages)) + (inherit (operating-system-with-current-guix + installation-os)) (kernel-arguments '("console=ttyS0"))) #:imported-modules '((gnu services herd) (gnu installer tests) @@ -240,12 +240,13 @@ reboot\n") (uefi-support? #f) (installation-image-type 'efi-raw) (install-size 'guess) - (target-size (* 2200 MiB))) + (target-size (* 2200 MiB)) + (number-of-disks 1)) "Run SCRIPT (a shell script following the system installation procedure) in -OS to install TARGET-OS. Return a VM image of TARGET-SIZE bytes containing -the installed system. The packages specified in PACKAGES will be appended to -packages defined in installation-os." - +OS to install TARGET-OS. Return the VM disk images of TARGET-SIZE bytes +containing the installed system. PACKAGES is a list of packages added to OS. +NUMBER-OF-DISKS can be used to specify a number of disks different than one, +such as for RAID systems." (mlet* %store-monad ((_ (set-grafting #f)) (system (current-system)) @@ -257,12 +258,13 @@ packages defined in installation-os." ;; succeed. Also add guile-final, which is pulled in ;; through provenance.drv and may not always be present. (target (operating-system-derivation target-os)) - (base-image -> - (os->image - (operating-system-with-gc-roots - os (list target guile-final)) - #:type (lookup-image-type-by-name - installation-image-type))) + (base-image -> (os->image + (operating-system-with-gc-roots + (operating-system-add-packages + os packages) + (list target guile-final)) + #:type (lookup-image-type-by-name + installation-image-type))) (image -> (system-image (image @@ -276,13 +278,18 @@ packages defined in installation-os." (gnu build marionette)) #~(begin (use-modules (guix build utils) - (gnu build marionette)) + (gnu build marionette) + (srfi srfi-1)) (set-path-environment-variable "PATH" '("bin") (list #$qemu-minimal)) - (system* "qemu-img" "create" "-f" "qcow2" - #$output #$(number->string target-size)) + (mkdir-p #$output) + (for-each (lambda (n) + (system* "qemu-img" "create" "-f" "qcow2" + (format #f "~a/disk~a.qcow2" #$output n) + #$(number->string target-size))) + (iota #$number-of-disks)) (define marionette (make-marionette @@ -303,8 +310,12 @@ packages defined in installation-os." (error "unsupported installation-image-type:" installation-image-type))) - "-drive" - ,(string-append "file=" #$output ",if=virtio") + ,@(append-map + (lambda (n) + (list "-drive" + (format #f "file=~a/disk~a.qcow2,if=virtio" + #$output n))) + (iota #$number-of-disks)) ,@(if (file-exists? "/dev/kvm") '("-enable-kvm") '())))) @@ -338,32 +349,26 @@ packages defined in installation-os." (exit #$(and gui-test (gui-test #~marionette))))))) - (gexp->derivation "installation" install - #:substitutable? #f))) ;too big - -(define* (qemu-command/writable-image image - #:key - (uefi-support? #f) - (memory-size 256)) - "Return as a monadic value the command to run QEMU on a writable copy of -IMAGE, a disk image. The QEMU VM has access to MEMORY-SIZE MiB of RAM." + (mlet %store-monad ((images-dir (gexp->derivation "installation" + install + #:substitutable? #f))) ;too big + (return (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils)) + (find-files #$images-dir))))))) + +(define* (qemu-command* images #:key (uefi-support? #f) (memory-size 256)) + "Return as a monadic value the command to run QEMU with a writable overlay +on top of IMAGES, a list of disk images. The QEMU VM has access to MEMORY-SIZE +MiB of RAM." (mlet* %store-monad ((system (current-system)) (uefi-firmware -> (and uefi-support? (uefi-firmware system)))) - (return #~(let ((image #$image)) - ;; First we need a writable copy of the image. - (format #t "creating writable image from '~a'...~%" image) - (unless (zero? (system* #+(file-append qemu-minimal - "/bin/qemu-img") - "create" "-f" "qcow2" "-F" "qcow2" - "-o" - (string-append "backing_file=" image) - "disk.img")) - (error "failed to create writable QEMU image" image)) - - (chmod "disk.img" #o644) + (return #~(begin + (use-modules (srfi srfi-1)) `(,(string-append #$qemu-minimal "/bin/" #$(qemu-command system)) + "-snapshot" ;for the volatile, writable overlay ,@(if (file-exists? "/dev/kvm") '("-enable-kvm") '()) @@ -371,7 +376,10 @@ IMAGE, a disk image. The QEMU VM has access to MEMORY-SIZE MiB of RAM." '("-bios" #$uefi-firmware) '()) "-no-reboot" "-m" #$(number->string memory-size) - "-drive" "file=disk.img,if=virtio"))))) + ,@(append-map (lambda (image) + (list "-drive" (format #f "file=~a,if=virtio" + image))) + #$images)))))) (define %test-installed-os (system-test @@ -381,8 +389,8 @@ IMAGE, a disk image. The QEMU VM has access to MEMORY-SIZE MiB of RAM." 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 %minimal-os %minimal-os-source)) - (command (qemu-command/writable-image image))) + (mlet* %store-monad ((images (run-install %minimal-os %minimal-os-source)) + (command (qemu-command* images))) (run-basic-test %minimal-os command "installed-os"))))) @@ -393,13 +401,13 @@ build (current-guix) and then store a couple of full system images.") "Test basic functionality of an OS booted with an extlinux bootloader. As per %test-installed-os, this test is expensive in terms of CPU and storage.") (value - (mlet* %store-monad ((image (run-install %minimal-extlinux-os - %minimal-extlinux-os-source - #:packages - (list syslinux) - #:script - %extlinux-gpt-installation-script)) - (command (qemu-command/writable-image image))) + (mlet* %store-monad ((images (run-install %minimal-extlinux-os + %minimal-extlinux-os-source + #:packages + (list syslinux) + #:script + %extlinux-gpt-installation-script)) + (command (qemu-command* images))) (run-basic-test %minimal-extlinux-os command "installed-extlinux-os"))))) @@ -469,14 +477,14 @@ reboot\n") (description "") (value - (mlet* %store-monad ((image (run-install - %minimal-os-on-vda - %minimal-os-on-vda-source - #:script - %simple-installation-script-for-/dev/vda - #:installation-image-type - 'uncompressed-iso9660)) - (command (qemu-command/writable-image image))) + (mlet* %store-monad ((images (run-install + %minimal-os-on-vda + %minimal-os-on-vda-source + #:script + %simple-installation-script-for-/dev/vda + #:installation-image-type + 'uncompressed-iso9660)) + (command (qemu-command* images))) (run-basic-test %minimal-os-on-vda command name))))) @@ -527,11 +535,11 @@ reboot\n") partition. In particular, home directories must be correctly created (see <https://bugs.gnu.org/21108>).") (value - (mlet* %store-monad ((image (run-install %separate-home-os - %separate-home-os-source - #:script - %simple-installation-script)) - (command (qemu-command/writable-image image))) + (mlet* %store-monad ((images (run-install %separate-home-os + %separate-home-os-source + #:script + %simple-installation-script)) + (command (qemu-command* images))) (run-basic-test %separate-home-os command "separate-home-os"))))) @@ -604,11 +612,11 @@ reboot\n") "Test basic functionality of an OS installed like one would do by hand, where /gnu lives on a separate partition.") (value - (mlet* %store-monad ((image (run-install %separate-store-os - %separate-store-os-source - #:script - %separate-store-installation-script)) - (command (qemu-command/writable-image image))) + (mlet* %store-monad ((images (run-install %separate-store-os + %separate-store-os-source + #:script + %separate-store-installation-script)) + (command (qemu-command* images))) (run-basic-test %separate-store-os command "separate-store-os"))))) @@ -685,12 +693,12 @@ reboot\n") "Test functionality of an OS installed with a RAID root partition managed by 'mdadm'.") (value - (mlet* %store-monad ((image (run-install %raid-root-os - %raid-root-os-source - #:script - %raid-root-installation-script - #:target-size (* 3200 MiB))) - (command (qemu-command/writable-image image))) + (mlet* %store-monad ((images (run-install %raid-root-os + %raid-root-os-source + #:script + %raid-root-installation-script + #:target-size (* 3200 MiB))) + (command (qemu-command* images))) (run-basic-test %raid-root-os `(,@command) "raid-root-os"))))) @@ -819,11 +827,11 @@ to enter the LUKS passphrase." 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 %encrypted-root-os - %encrypted-root-os-source - #:script - %encrypted-root-installation-script)) - (command (qemu-command/writable-image image))) + (mlet* %store-monad ((images (run-install %encrypted-root-os + %encrypted-root-os-source + #:script + %encrypted-root-installation-script)) + (command (qemu-command* images))) (run-basic-test %encrypted-root-os command "encrypted-root-os" #:initialization enter-luks-passphrase))))) @@ -903,13 +911,13 @@ reboot\n") (description "Test functionality of an OS installed with a LVM /home partition") (value - (mlet* %store-monad ((image (run-install %lvm-separate-home-os - %lvm-separate-home-os-source - #:script - %lvm-separate-home-installation-script - #:packages (list lvm2-static) - #:target-size (* 3200 MiB))) - (command (qemu-command/writable-image image))) + (mlet* %store-monad ((images (run-install %lvm-separate-home-os + %lvm-separate-home-os-source + #:script + %lvm-separate-home-installation-script + #:packages (list lvm2-static) + #:target-size (* 3200 MiB))) + (command (qemu-command* images))) (run-basic-test %lvm-separate-home-os `(,@command) "lvm-separate-home-os"))))) @@ -1005,11 +1013,11 @@ 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 %encrypted-root-not-boot-os - %encrypted-root-not-boot-os-source - #:script - %encrypted-root-not-boot-installation-script)) - (command (qemu-command/writable-image image))) + ((images (run-install %encrypted-root-not-boot-os + %encrypted-root-not-boot-os-source + #:script + %encrypted-root-not-boot-installation-script)) + (command (qemu-command* images))) (run-basic-test %encrypted-root-not-boot-os command "encrypted-root-not-boot-os" #:initialization enter-luks-passphrase))))) @@ -1081,11 +1089,11 @@ reboot\n") 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-os - %btrfs-root-os-source - #:script - %btrfs-root-installation-script)) - (command (qemu-command/writable-image image))) + (mlet* %store-monad ((images (run-install %btrfs-root-os + %btrfs-root-os-source + #:script + %btrfs-root-installation-script)) + (command (qemu-command* images))) (run-basic-test %btrfs-root-os command "btrfs-root-os"))))) @@ -1149,11 +1157,11 @@ reboot\n") RAID-0 (stripe) root partition.") (value (mlet* %store-monad - ((image (run-install %btrfs-raid-root-os - %btrfs-raid-root-os-source - #:script %btrfs-raid-root-installation-script - #:target-size (* 2800 MiB))) - (command (qemu-command/writable-image image))) + ((images (run-install %btrfs-raid-root-os + %btrfs-raid-root-os-source + #:script %btrfs-raid-root-installation-script + #:target-size (* 2800 MiB))) + (command (qemu-command* images))) (run-basic-test %btrfs-raid-root-os `(,@command) "btrfs-raid-root-os"))))) @@ -1240,15 +1248,123 @@ 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))) + ((images (run-install %btrfs-root-on-subvolume-os + %btrfs-root-on-subvolume-os-source + #:script + %btrfs-root-on-subvolume-installation-script)) + (command (qemu-command* images))) (run-basic-test %btrfs-root-on-subvolume-os command "btrfs-root-on-subvolume-os"))))) + +;;; +;;; Btrfs RAID10 root file system. +;;; + +(define-os-with-source (%btrfs-raid10-root-os + %btrfs-raid10-root-os-source) + ;; The OS we want to install. + (use-modules (gnu) (gnu tests) (srfi srfi-1)) + + (operating-system + (host-name "hurd") + (timezone "Europe/Paris") + (locale "en_US.UTF-8") + (bootloader (bootloader-configuration + (bootloader grub-bootloader) + (targets (list "/dev/vdb" "/dev/vdc" "/dev/vdd" "/dev/vde")))) + (kernel-arguments '("console=ttyS0")) + (file-systems (cons* (file-system + (device (uuid "16ff18e2-eb41-4324-8df5-80d3b53c411b")) + (mount-point "/") + (options "compress-force=zstd,degraded") + (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-raid10-root-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 +for d in vdb vdc vdd vde; do + parted --script /dev/$d mklabel gpt \\ + mkpart primary ext2 1M 2M \\ + mkpart primary ext2 2M 100% \\ + set 1 boot on \\ + set 1 bios_grub on +done + +# Create the RAID10 Btrfs array. +mkfs.btrfs -d raid10 -m raid1c4 /dev/{vdb2,vdc2,vdd2,vde2} \\ + --uuid 16ff18e2-eb41-4324-8df5-80d3b53c411b + +# Mount it, ready for installation. +mount UUID=16ff18e2-eb41-4324-8df5-80d3b53c411b -o compress-force=zstd /mnt + +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-raid10-root-images + (mlet %store-monad + ((images (run-install %btrfs-raid10-root-os + %btrfs-raid10-root-os-source + #:script + %btrfs-raid10-root-installation-script + #:number-of-disks 4 + #:target-size (* 1100 MiB)))) + (return images))) + +(define %test-btrfs-raid10-root-os + (system-test + (name "btrfs-raid10-root-os") + (description + "Test basic functionality of an OS installed on top of a Btrfs RAID10 file +system spanning 4 disks. 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 + ((images %test-btrfs-raid10-root-images) + (command (qemu-command* images))) + (run-basic-test %btrfs-raid10-root-os command + "btrfs-raid10-root-os"))))) + +(define %test-btrfs-raid10-root-os-degraded + (system-test + (name "btrfs-raid10-root-os-degraded") + (description + "Test basic functionality of an OS installed on top of a Btrfs RAID10 file +system spanning 6 disks, degraded to 5 disks. 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 + ;; Drop the first image; this boots because the root file system uses + ;; the Btrfs "degraded" mount option. + ((images %test-btrfs-raid10-root-images) + (command (qemu-command* #~(cdr #$images)))) + (run-basic-test %btrfs-raid10-root-os command + "btrfs-raid10-root-os"))))) + ;;; ;;; JFS root file system. @@ -1315,11 +1431,11 @@ reboot\n") 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 %jfs-root-os - %jfs-root-os-source - #:script - %jfs-root-installation-script)) - (command (qemu-command/writable-image image))) + (mlet* %store-monad ((images (run-install %jfs-root-os + %jfs-root-os-source + #:script + %jfs-root-installation-script)) + (command (qemu-command* images))) (run-basic-test %jfs-root-os command "jfs-root-os"))))) @@ -1388,11 +1504,11 @@ reboot\n") 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 %f2fs-root-os - %f2fs-root-os-source - #:script - %f2fs-root-installation-script)) - (command (qemu-command/writable-image image))) + (mlet* %store-monad ((images (run-install %f2fs-root-os + %f2fs-root-os-source + #:script + %f2fs-root-installation-script)) + (command (qemu-command* images))) (run-basic-test %f2fs-root-os command "f2fs-root-os"))))) @@ -1461,11 +1577,11 @@ reboot\n") 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 %xfs-root-os - %xfs-root-os-source - #:script - %xfs-root-installation-script)) - (command (qemu-command/writable-image image))) + (mlet* %store-monad ((images (run-install %xfs-root-os + %xfs-root-os-source + #:script + %xfs-root-installation-script)) + (command (qemu-command* images))) (run-basic-test %xfs-root-os command "xfs-root-os"))))) @@ -1733,24 +1849,24 @@ build (current-guix) and then store a couple of full system images.") "Install an OS using the graphical installer and test it.") (value (mlet* %store-monad - ((image (run-install target-os '(this is unused) - #:script #f - #:os installation-os-for-gui-tests - #:uefi-support? uefi-support? - #:install-size install-size - #:target-size target-size - #:installation-image-type - 'uncompressed-iso9660 - #:gui-test - (lambda (marionette) - (gui-test-program - marionette - #:desktop? desktop? - #:encrypted? encrypted? - #:uefi-support? uefi-support?)))) - (command (qemu-command/writable-image image - #:uefi-support? uefi-support? - #:memory-size 512))) + ((images (run-install target-os '(this is unused) + #:script #f + #:os installation-os-for-gui-tests + #:uefi-support? uefi-support? + #:install-size install-size + #:target-size target-size + #:installation-image-type + 'uncompressed-iso9660 + #:gui-test + (lambda (marionette) + (gui-test-program + marionette + #:desktop? desktop? + #:encrypted? encrypted? + #:uefi-support? uefi-support?)))) + (command (qemu-command* images + #:uefi-support? uefi-support? + #:memory-size 512))) (run-basic-test target-os command name #:initialization (and encrypted? enter-luks-passphrase) #:root-password %root-password |