summaryrefslogtreecommitdiff
path: root/gnu/tests/install.scm
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/tests/install.scm')
-rw-r--r--gnu/tests/install.scm400
1 files changed, 258 insertions, 142 deletions
diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm
index ae8c6051f11..be8bb1b5835 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
generated by cgit v1.2.3 (git 2.47.1) at 2025-02-02 01:22:00 +0000