ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2025-01-12 06:06:53 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

tests: install: Enable the use of multiple disk devices for tests.

Browse source 
* gnu/tests/install.scm (run-install)[packages]: Unconditionally add to OS.
[NUMBER-OF-DISKS]: Add argument, update doc and adjust.  The returned gexp
output is now a list of images rather than the image itself.
* gnu/tests/install.scm (qemu-command*): Rename IMAGE argument to IMAGES, to
account for the above change.  Adjust doc.  Generate a QEMU '-drive' argument
for each disk image.
(%test-installed-os): Rename the IMAGE variable to IMAGES.
(%test-installed-extlinux-os): Likewise.
(%test-iso-image-installer): Likewise.
(%test-separate-home-os): Likewise.
(%test-separate-store-os): Likewise.
(%test-raid-root-os): Likewise.
(%test-encrypted-root-os): Likewise.
(%test-lvm-separate-home-os): Likewise.
(%test-encrypted-root-not-boot-os): Likewise.
(%test-btrfs-root-os): Likewise.
(%test-btrfs-raid-root-os): Likewise.
(%test-btrfs-root-on-subvolume-os): Likewise.
(%test-jfs-root-os): Likewise.
(%test-f2fs-root-os): Likewise.
(%test-xfs-root-os): Likewise.
(guided-installation-test): Likewise.
This commit is contained in:
Maxim Cournoyer 2022-03-11 08:00:36 -05:00
parent 52d710b917
commit 252330edd4
No known key found for this signature in database
GPG key ID: 1260E46482E63562
1 changed files with 140 additions and 122 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

124
gnu/tests/install.scm
View file

@ -229,10 +229,8 @@ (define* (run-install target-os target-os-source
;; 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 +238,13 @@ (define* (run-install target-os target-os-source
(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,10 +256,11 @@ (define* (run-install target-os target-os-source
;; 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
(base-image -> (os->image
(operating-system-with-gc-roots
os (list target guile-final))
(operating-system-add-packages
os packages)
(list target guile-final))
#:type (lookup-image-type-by-name
installation-image-type)))
(image ->
@ -276,13 +276,18 @@ (define install
(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))
(mkdir-p #$output)
(for-each (lambda (n)
(system* "qemu-img" "create" "-f" "qcow2"
#$output #$(number->string target-size))
(format #f "~a/disk~a.qcow2" #$output n)
#$(number->string target-size)))
(iota #$number-of-disks))
(define marionette
(make-marionette
@ -303,8 +308,12 @@ (define marionette
(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,16 +347,23 @@ (define marionette
(exit #$(and gui-test
(gui-test #~marionette)))))))
(gexp->derivation "installation" install
(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* image #:key (uefi-support? #f) (memory-size 256))
(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
above IMAGE, a disk image. The QEMU VM has access to MEMORY-SIZE MiB of RAM."
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 #~(begin
(use-modules (srfi srfi-1))
`(,(string-append #$qemu-minimal "/bin/"
#$(qemu-command system))
"-snapshot" ;for the volatile, writable overlay
@ -358,7 +374,10 @@ (define* (qemu-command* image #:key (uefi-support? #f) (memory-size 256))
'("-bios" #$uefi-firmware)
'())
"-no-reboot" "-m" #$(number->string memory-size)
"-drive" (format #f "file=~a,if=virtio" #$image))))))
,@(append-map (lambda (image)
(list "-drive" (format #f "file=~a,if=virtio"
image)))
#$images))))))
(define %test-installed-os
(system-test
@ -368,8 +387,8 @@ (define %test-installed-os
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* image)))
(mlet* %store-monad ((images (run-install %minimal-os %minimal-os-source))
(command (qemu-command* images)))
(run-basic-test %minimal-os command
"installed-os")))))
@ -380,13 +399,13 @@ (define %test-installed-extlinux-os
"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
(mlet* %store-monad ((images (run-install %minimal-extlinux-os
%minimal-extlinux-os-source
#:packages
(list syslinux)
#:script
%extlinux-gpt-installation-script))
(command (qemu-command* image)))
(command (qemu-command* images)))
(run-basic-test %minimal-extlinux-os command
"installed-extlinux-os")))))
@ -456,14 +475,14 @@ (define %test-iso-image-installer
(description
"")
(value
(mlet* %store-monad ((image (run-install
(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* image)))
(command (qemu-command* images)))
(run-basic-test %minimal-os-on-vda command name)))))
@ -514,11 +533,11 @@ (define %test-separate-home-os
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
(mlet* %store-monad ((images (run-install %separate-home-os
%separate-home-os-source
#:script
%simple-installation-script))
(command (qemu-command* image)))
(command (qemu-command* images)))
(run-basic-test %separate-home-os command "separate-home-os")))))
@ -591,11 +610,11 @@ (define %test-separate-store-os
"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
(mlet* %store-monad ((images (run-install %separate-store-os
%separate-store-os-source
#:script
%separate-store-installation-script))
(command (qemu-command* image)))
(command (qemu-command* images)))
(run-basic-test %separate-store-os command "separate-store-os")))))
@ -672,12 +691,12 @@ (define %test-raid-root-os
"Test functionality of an OS installed with a RAID root partition managed
by 'mdadm'.")
(value
(mlet* %store-monad ((image (run-install %raid-root-os
(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* image)))
(command (qemu-command* images)))
(run-basic-test %raid-root-os
`(,@command) "raid-root-os")))))
@ -806,11 +825,11 @@ (define %test-encrypted-root-os
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
(mlet* %store-monad ((images (run-install %encrypted-root-os
%encrypted-root-os-source
#:script
%encrypted-root-installation-script))
(command (qemu-command* image)))
(command (qemu-command* images)))
(run-basic-test %encrypted-root-os command "encrypted-root-os"
#:initialization enter-luks-passphrase)))))
@ -890,13 +909,13 @@ (define %test-lvm-separate-home-os
(description
"Test functionality of an OS installed with a LVM /home partition")
(value
(mlet* %store-monad ((image (run-install %lvm-separate-home-os
(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* image)))
(command (qemu-command* images)))
(run-basic-test %lvm-separate-home-os
`(,@command) "lvm-separate-home-os")))))
@ -992,11 +1011,11 @@ (define %test-encrypted-root-not-boot-os
store a couple of full system images.")
(value
(mlet* %store-monad
((image (run-install %encrypted-root-not-boot-os
((images (run-install %encrypted-root-not-boot-os
%encrypted-root-not-boot-os-source
#:script
%encrypted-root-not-boot-installation-script))
(command (qemu-command* image)))
(command (qemu-command* images)))
(run-basic-test %encrypted-root-not-boot-os command
"encrypted-root-not-boot-os"
#:initialization enter-luks-passphrase)))))
@ -1068,11 +1087,11 @@ (define %test-btrfs-root-os
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
(mlet* %store-monad ((images (run-install %btrfs-root-os
%btrfs-root-os-source
#:script
%btrfs-root-installation-script))
(command (qemu-command* image)))
(command (qemu-command* images)))
(run-basic-test %btrfs-root-os command "btrfs-root-os")))))
@ -1136,11 +1155,11 @@ (define %test-btrfs-raid-root-os
RAID-0 (stripe) root partition.")
(value
(mlet* %store-monad
((image (run-install %btrfs-raid-root-os
((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* image)))
(command (qemu-command* images)))
(run-basic-test %btrfs-raid-root-os `(,@command) "btrfs-raid-root-os")))))
@ -1227,12 +1246,11 @@ (define %test-btrfs-root-on-subvolume-os
build (current-guix) and then store a couple of full system images.")
(value
(mlet* %store-monad
((image
(run-install %btrfs-root-on-subvolume-os
((images (run-install %btrfs-root-on-subvolume-os
%btrfs-root-on-subvolume-os-source
#:script
%btrfs-root-on-subvolume-installation-script))
(command (qemu-command* image)))
(command (qemu-command* images)))
(run-basic-test %btrfs-root-on-subvolume-os command
"btrfs-root-on-subvolume-os")))))
@ -1302,11 +1320,11 @@ (define %test-jfs-root-os
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
(mlet* %store-monad ((images (run-install %jfs-root-os
%jfs-root-os-source
#:script
%jfs-root-installation-script))
(command (qemu-command* image)))
(command (qemu-command* images)))
(run-basic-test %jfs-root-os command "jfs-root-os")))))
@ -1375,11 +1393,11 @@ (define %test-f2fs-root-os
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
(mlet* %store-monad ((images (run-install %f2fs-root-os
%f2fs-root-os-source
#:script
%f2fs-root-installation-script))
(command (qemu-command* image)))
(command (qemu-command* images)))
(run-basic-test %f2fs-root-os command "f2fs-root-os")))))
@ -1448,11 +1466,11 @@ (define %test-xfs-root-os
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
(mlet* %store-monad ((images (run-install %xfs-root-os
%xfs-root-os-source
#:script
%xfs-root-installation-script))
(command (qemu-command* image)))
(command (qemu-command* images)))
(run-basic-test %xfs-root-os command "xfs-root-os")))))
@ -1720,7 +1738,7 @@ (define* (guided-installation-test name
"Install an OS using the graphical installer and test it.")
(value
(mlet* %store-monad
((image (run-install target-os '(this is unused)
((images (run-install target-os '(this is unused)
#:script #f
#:os installation-os-for-gui-tests
#:uefi-support? uefi-support?
@ -1735,7 +1753,7 @@ (define* (guided-installation-test name
#:desktop? desktop?
#:encrypted? encrypted?
#:uefi-support? uefi-support?))))
(command (qemu-command* image
(command (qemu-command* images
#:uefi-support? uefi-support?
#:memory-size 512)))
(run-basic-test target-os command name