ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2025-01-26 04:29:25 -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 ;; Since the image has no network access, use the
;; current Guix so the store items we need are in ;; current Guix so the store items we need are in
;; the image and add packages provided. ;; the image and add packages provided.
(inherit (operating-system-add-packages (inherit (operating-system-with-current-guix
(operating-system-with-current-guix installation-os))
installation-os)
packages))
(kernel-arguments '("console=ttyS0"))) (kernel-arguments '("console=ttyS0")))
#:imported-modules '((gnu services herd) #:imported-modules '((gnu services herd)
(gnu installer tests) (gnu installer tests)
@ -240,12 +238,13 @@ (define* (run-install target-os target-os-source
(uefi-support? #f) (uefi-support? #f)
(installation-image-type 'efi-raw) (installation-image-type 'efi-raw)
(install-size 'guess) (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 "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 OS to install TARGET-OS. Return the VM disk images of TARGET-SIZE bytes
the installed system. The packages specified in PACKAGES will be appended to containing the installed system. PACKAGES is a list of packages added to OS.
packages defined in installation-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)) (mlet* %store-monad ((_ (set-grafting #f))
(system (current-system)) (system (current-system))
@ -257,10 +256,11 @@ (define* (run-install target-os target-os-source
;; succeed. Also add guile-final, which is pulled in ;; succeed. Also add guile-final, which is pulled in
;; through provenance.drv and may not always be present. ;; through provenance.drv and may not always be present.
(target (operating-system-derivation target-os)) (target (operating-system-derivation target-os))
(base-image -> (base-image -> (os->image
(os->image
(operating-system-with-gc-roots (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 #:type (lookup-image-type-by-name
installation-image-type))) installation-image-type)))
(image -> (image ->
@ -276,13 +276,18 @@ (define install
(gnu build marionette)) (gnu build marionette))
#~(begin #~(begin
(use-modules (guix build utils) (use-modules (guix build utils)
(gnu build marionette)) (gnu build marionette)
(srfi srfi-1))
(set-path-environment-variable "PATH" '("bin") (set-path-environment-variable "PATH" '("bin")
(list #$qemu-minimal)) (list #$qemu-minimal))
(mkdir-p #$output)
(for-each (lambda (n)
(system* "qemu-img" "create" "-f" "qcow2" (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 (define marionette
(make-marionette (make-marionette
@ -303,8 +308,12 @@ (define marionette
(error (error
"unsupported installation-image-type:" "unsupported installation-image-type:"
installation-image-type))) installation-image-type)))
"-drive" ,@(append-map
,(string-append "file=" #$output ",if=virtio") (lambda (n)
(list "-drive"
(format #f "file=~a/disk~a.qcow2,if=virtio"
#$output n)))
(iota #$number-of-disks))
,@(if (file-exists? "/dev/kvm") ,@(if (file-exists? "/dev/kvm")
'("-enable-kvm") '("-enable-kvm")
'())))) '()))))
@ -338,16 +347,23 @@ (define marionette
(exit #$(and gui-test (exit #$(and gui-test
(gui-test #~marionette))))))) (gui-test #~marionette)))))))
(gexp->derivation "installation" install (mlet %store-monad ((images-dir (gexp->derivation "installation"
install
#:substitutable? #f))) ;too big #: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 "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)) (mlet* %store-monad ((system (current-system))
(uefi-firmware -> (and uefi-support? (uefi-firmware -> (and uefi-support?
(uefi-firmware system)))) (uefi-firmware system))))
(return #~(begin (return #~(begin
(use-modules (srfi srfi-1))
`(,(string-append #$qemu-minimal "/bin/" `(,(string-append #$qemu-minimal "/bin/"
#$(qemu-command system)) #$(qemu-command system))
"-snapshot" ;for the volatile, writable overlay "-snapshot" ;for the volatile, writable overlay
@ -358,7 +374,10 @@ (define* (qemu-command* image #:key (uefi-support? #f) (memory-size 256))
'("-bios" #$uefi-firmware) '("-bios" #$uefi-firmware)
'()) '())
"-no-reboot" "-m" #$(number->string memory-size) "-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 (define %test-installed-os
(system-test (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 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.") build (current-guix) and then store a couple of full system images.")
(value (value
(mlet* %store-monad ((image (run-install %minimal-os %minimal-os-source)) (mlet* %store-monad ((images (run-install %minimal-os %minimal-os-source))
(command (qemu-command* image))) (command (qemu-command* images)))
(run-basic-test %minimal-os command (run-basic-test %minimal-os command
"installed-os"))))) "installed-os")))))
@ -380,13 +399,13 @@ (define %test-installed-extlinux-os
"Test basic functionality of an OS booted with an extlinux bootloader. As "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.") per %test-installed-os, this test is expensive in terms of CPU and storage.")
(value (value
(mlet* %store-monad ((image (run-install %minimal-extlinux-os (mlet* %store-monad ((images (run-install %minimal-extlinux-os
%minimal-extlinux-os-source %minimal-extlinux-os-source
#:packages #:packages
(list syslinux) (list syslinux)
#:script #:script
%extlinux-gpt-installation-script)) %extlinux-gpt-installation-script))
(command (qemu-command* image))) (command (qemu-command* images)))
(run-basic-test %minimal-extlinux-os command (run-basic-test %minimal-extlinux-os command
"installed-extlinux-os"))))) "installed-extlinux-os")))))
@ -456,14 +475,14 @@ (define %test-iso-image-installer
(description (description
"") "")
(value (value
(mlet* %store-monad ((image (run-install (mlet* %store-monad ((images (run-install
%minimal-os-on-vda %minimal-os-on-vda
%minimal-os-on-vda-source %minimal-os-on-vda-source
#:script #:script
%simple-installation-script-for-/dev/vda %simple-installation-script-for-/dev/vda
#:installation-image-type #:installation-image-type
'uncompressed-iso9660)) 'uncompressed-iso9660))
(command (qemu-command* image))) (command (qemu-command* images)))
(run-basic-test %minimal-os-on-vda command name))))) (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 partition. In particular, home directories must be correctly created (see
<https://bugs.gnu.org/21108>).") <https://bugs.gnu.org/21108>).")
(value (value
(mlet* %store-monad ((image (run-install %separate-home-os (mlet* %store-monad ((images (run-install %separate-home-os
%separate-home-os-source %separate-home-os-source
#:script #:script
%simple-installation-script)) %simple-installation-script))
(command (qemu-command* image))) (command (qemu-command* images)))
(run-basic-test %separate-home-os command "separate-home-os"))))) (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, "Test basic functionality of an OS installed like one would do by hand,
where /gnu lives on a separate partition.") where /gnu lives on a separate partition.")
(value (value
(mlet* %store-monad ((image (run-install %separate-store-os (mlet* %store-monad ((images (run-install %separate-store-os
%separate-store-os-source %separate-store-os-source
#:script #:script
%separate-store-installation-script)) %separate-store-installation-script))
(command (qemu-command* image))) (command (qemu-command* images)))
(run-basic-test %separate-store-os command "separate-store-os"))))) (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 "Test functionality of an OS installed with a RAID root partition managed
by 'mdadm'.") by 'mdadm'.")
(value (value
(mlet* %store-monad ((image (run-install %raid-root-os (mlet* %store-monad ((images (run-install %raid-root-os
%raid-root-os-source %raid-root-os-source
#:script #:script
%raid-root-installation-script %raid-root-installation-script
#:target-size (* 3200 MiB))) #:target-size (* 3200 MiB)))
(command (qemu-command* image))) (command (qemu-command* images)))
(run-basic-test %raid-root-os (run-basic-test %raid-root-os
`(,@command) "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 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.") build (current-guix) and then store a couple of full system images.")
(value (value
(mlet* %store-monad ((image (run-install %encrypted-root-os (mlet* %store-monad ((images (run-install %encrypted-root-os
%encrypted-root-os-source %encrypted-root-os-source
#:script #:script
%encrypted-root-installation-script)) %encrypted-root-installation-script))
(command (qemu-command* image))) (command (qemu-command* images)))
(run-basic-test %encrypted-root-os command "encrypted-root-os" (run-basic-test %encrypted-root-os command "encrypted-root-os"
#:initialization enter-luks-passphrase))))) #:initialization enter-luks-passphrase)))))
@ -890,13 +909,13 @@ (define %test-lvm-separate-home-os
(description (description
"Test functionality of an OS installed with a LVM /home partition") "Test functionality of an OS installed with a LVM /home partition")
(value (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 %lvm-separate-home-os-source
#:script #:script
%lvm-separate-home-installation-script %lvm-separate-home-installation-script
#:packages (list lvm2-static) #:packages (list lvm2-static)
#:target-size (* 3200 MiB))) #:target-size (* 3200 MiB)))
(command (qemu-command* image))) (command (qemu-command* images)))
(run-basic-test %lvm-separate-home-os (run-basic-test %lvm-separate-home-os
`(,@command) "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.") store a couple of full system images.")
(value (value
(mlet* %store-monad (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 %encrypted-root-not-boot-os-source
#:script #:script
%encrypted-root-not-boot-installation-script)) %encrypted-root-not-boot-installation-script))
(command (qemu-command* image))) (command (qemu-command* images)))
(run-basic-test %encrypted-root-not-boot-os command (run-basic-test %encrypted-root-not-boot-os command
"encrypted-root-not-boot-os" "encrypted-root-not-boot-os"
#:initialization enter-luks-passphrase))))) #: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 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.") build (current-guix) and then store a couple of full system images.")
(value (value
(mlet* %store-monad ((image (run-install %btrfs-root-os (mlet* %store-monad ((images (run-install %btrfs-root-os
%btrfs-root-os-source %btrfs-root-os-source
#:script #:script
%btrfs-root-installation-script)) %btrfs-root-installation-script))
(command (qemu-command* image))) (command (qemu-command* images)))
(run-basic-test %btrfs-root-os command "btrfs-root-os"))))) (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.") RAID-0 (stripe) root partition.")
(value (value
(mlet* %store-monad (mlet* %store-monad
((image (run-install %btrfs-raid-root-os ((images (run-install %btrfs-raid-root-os
%btrfs-raid-root-os-source %btrfs-raid-root-os-source
#:script %btrfs-raid-root-installation-script #:script %btrfs-raid-root-installation-script
#:target-size (* 2800 MiB))) #:target-size (* 2800 MiB)))
(command (qemu-command* image))) (command (qemu-command* images)))
(run-basic-test %btrfs-raid-root-os `(,@command) "btrfs-raid-root-os"))))) (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.") build (current-guix) and then store a couple of full system images.")
(value (value
(mlet* %store-monad (mlet* %store-monad
((image ((images (run-install %btrfs-root-on-subvolume-os
(run-install %btrfs-root-on-subvolume-os
%btrfs-root-on-subvolume-os-source %btrfs-root-on-subvolume-os-source
#:script #:script
%btrfs-root-on-subvolume-installation-script)) %btrfs-root-on-subvolume-installation-script))
(command (qemu-command* image))) (command (qemu-command* images)))
(run-basic-test %btrfs-root-on-subvolume-os command (run-basic-test %btrfs-root-on-subvolume-os command
"btrfs-root-on-subvolume-os"))))) "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 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.") build (current-guix) and then store a couple of full system images.")
(value (value
(mlet* %store-monad ((image (run-install %jfs-root-os (mlet* %store-monad ((images (run-install %jfs-root-os
%jfs-root-os-source %jfs-root-os-source
#:script #:script
%jfs-root-installation-script)) %jfs-root-installation-script))
(command (qemu-command* image))) (command (qemu-command* images)))
(run-basic-test %jfs-root-os command "jfs-root-os"))))) (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 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.") build (current-guix) and then store a couple of full system images.")
(value (value
(mlet* %store-monad ((image (run-install %f2fs-root-os (mlet* %store-monad ((images (run-install %f2fs-root-os
%f2fs-root-os-source %f2fs-root-os-source
#:script #:script
%f2fs-root-installation-script)) %f2fs-root-installation-script))
(command (qemu-command* image))) (command (qemu-command* images)))
(run-basic-test %f2fs-root-os command "f2fs-root-os"))))) (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 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.") build (current-guix) and then store a couple of full system images.")
(value (value
(mlet* %store-monad ((image (run-install %xfs-root-os (mlet* %store-monad ((images (run-install %xfs-root-os
%xfs-root-os-source %xfs-root-os-source
#:script #:script
%xfs-root-installation-script)) %xfs-root-installation-script))
(command (qemu-command* image))) (command (qemu-command* images)))
(run-basic-test %xfs-root-os command "xfs-root-os"))))) (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.") "Install an OS using the graphical installer and test it.")
(value (value
(mlet* %store-monad (mlet* %store-monad
((image (run-install target-os '(this is unused) ((images (run-install target-os '(this is unused)
#:script #f #:script #f
#:os installation-os-for-gui-tests #:os installation-os-for-gui-tests
#:uefi-support? uefi-support? #:uefi-support? uefi-support?
@ -1735,7 +1753,7 @@ (define* (guided-installation-test name
#:desktop? desktop? #:desktop? desktop?
#:encrypted? encrypted? #:encrypted? encrypted?
#:uefi-support? uefi-support?)))) #:uefi-support? uefi-support?))))
(command (qemu-command* image (command (qemu-command* images
#:uefi-support? uefi-support? #:uefi-support? uefi-support?
#:memory-size 512))) #:memory-size 512)))
(run-basic-test target-os command name (run-basic-test target-os command name