From patchwork Sun Mar 13 05:43:54 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Maxim Cournoyer X-Patchwork-Id: 37774 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 0FC5F27BBEA; Sun, 13 Mar 2022 05:45:34 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-3.7 required=5.0 tests=BAYES_00,DKIM_ADSP_CUSTOM_MED, DKIM_INVALID,DKIM_SIGNED,FREEMAIL_FROM,MAILING_LIST_MULTI, RCVD_IN_MSPIKE_H5,RCVD_IN_MSPIKE_WL,SPF_HELO_PASS autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id EE69327BBE9 for ; Sun, 13 Mar 2022 05:45:32 +0000 (GMT) Received: from localhost ([::1]:42184 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1nTH2q-0005Gd-4G for patchwork@mira.cbaines.net; Sun, 13 Mar 2022 00:45:32 -0500 Received: from eggs.gnu.org ([209.51.188.92]:48896) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nTH2N-0005CE-Qk for guix-patches@gnu.org; Sun, 13 Mar 2022 00:45:03 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:47520) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nTH2N-0007Ua-I6 for guix-patches@gnu.org; Sun, 13 Mar 2022 00:45:03 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1nTH2N-0007sL-Gf for guix-patches@gnu.org; Sun, 13 Mar 2022 00:45:03 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#54368] [PATCH 3/4] tests: install: Enable the use of multiple disk devices for tests. Resent-From: Maxim Cournoyer Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 13 Mar 2022 05:45:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 54368 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 54368@debbugs.gnu.org Cc: Maxim Cournoyer Received: via spool by 54368-submit@debbugs.gnu.org id=B54368.164715029730221 (code B ref 54368); Sun, 13 Mar 2022 05:45:03 +0000 Received: (at 54368) by debbugs.gnu.org; 13 Mar 2022 05:44:57 +0000 Received: from localhost ([127.0.0.1]:41413 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nTH2G-0007rM-PF for submit@debbugs.gnu.org; Sun, 13 Mar 2022 00:44:57 -0500 Received: from mail-qt1-f182.google.com ([209.85.160.182]:37779) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nTH2D-0007qo-Se for 54368@debbugs.gnu.org; Sun, 13 Mar 2022 00:44:54 -0500 Received: by mail-qt1-f182.google.com with SMTP id n11so5111677qtk.4 for <54368@debbugs.gnu.org>; Sat, 12 Mar 2022 21:44:53 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20210112; h=from:to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; bh=1AdbyJSP/ZHSXrZCiAF8sT1AIBAB5ej5/xbmqRVMjpk=; b=Na9ZyeEijMGTPlrtAQyTME4nfzk3l4xHT2ubFMNDOPFJXCRH3MkUSLQ/tADQ8OnBg0 2bFoJNrMIewkIDa38qosuYo9fWCXa+ol7D88puktrih2fe6+cKxMtZztgmX/fs7Wsaiu 7z/dB5tdyFmsofxiqp56g01G4k93t0bwzPlQViirPNRzwEyPdM+TlFzYZOlbNN0KnKlH ZLQzrmXGc50PtUsoqNilh1zK5L9/V3pezqkjUXkKtESloJLvCDJI6I9m7o9nDOBPJla/ o0FL5y1rVvQoAbSqEsc7bn3EQ+l1AErWduUIwjP2ekRJ5FoNo1MOskkGp7ddYrYVzK09 W01g== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=x-gm-message-state:from:to:cc:subject:date:message-id:in-reply-to :references:mime-version:content-transfer-encoding; bh=1AdbyJSP/ZHSXrZCiAF8sT1AIBAB5ej5/xbmqRVMjpk=; b=x8eoqc5tyQCMktTnYiqzAsDvTF+Cao92n0k9ooQm1y6K8XL8iSbJwTXZjklBHEex0p vAUMW/XsyokUZruqYCbfHdR/NlJE4hF/XvLiYJwWttnp+WOsdIT68oJ7rhNizhRQIsu4 mG++5z9vMGw+8lI4IkGBwsoBpyOxf/NDznycjal3b01I5sF90AsLOG81oBIWsh42oak5 GcynSZcjH5RuUx+rt9trswGdqBPwHMCjp1hgI1c8T9m+tjRfkKEoB96iIMbkvO9J+4Xk vOFGE3RfPnENLHDLeeMRIIwF/r/xO4NyAXJ8EjNNKtLL/YGHGwJyK6lO2/xX3ugew1fG sCUg== X-Gm-Message-State: AOAM5328WahTrSKBxyxXAb5GXUgP/kar2LQGlmbuCBH08xy+2sM7845G jR6rIDQTDCIB1jfJ/vgqAj8MBFIIIzU= X-Google-Smtp-Source: ABdhPJygNR6rJbtRvTFyKzm8eNT8pmoOqMJxc12BhIEADSPsFj6fHpm/4NjdHfUgrrYCcGyDWrXZYA== X-Received: by 2002:a05:622a:4cb:b0:2e1:ce8c:f097 with SMTP id q11-20020a05622a04cb00b002e1ce8cf097mr613504qtx.395.1647150287747; Sat, 12 Mar 2022 21:44:47 -0800 (PST) Received: from localhost.localdomain (dsl-153-119.b2b2c.ca. [66.158.153.119]) by smtp.gmail.com with ESMTPSA id v129-20020a379387000000b0064936bab2fcsm6376657qkd.48.2022.03.12.21.44.47 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Sat, 12 Mar 2022 21:44:47 -0800 (PST) From: Maxim Cournoyer Date: Sun, 13 Mar 2022 00:43:54 -0500 Message-Id: <20220313054356.17578-3-maxim.cournoyer@gmail.com> X-Mailer: git-send-email 2.34.0 In-Reply-To: <20220313054356.17578-1-maxim.cournoyer@gmail.com> References: <20220313054356.17578-1-maxim.cournoyer@gmail.com> MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * gnu/tests/install.scm (run-install)[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. --- gnu/tests/install.scm | 244 +++++++++++++++++++++++------------------- 1 file changed, 132 insertions(+), 112 deletions(-) diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm index d1f8cc1c6d..59e76c86e7 100644 --- a/gnu/tests/install.scm +++ b/gnu/tests/install.scm @@ -240,12 +240,14 @@ (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. Unless providing OS, the PACKAGES will be +added to the packages defined in INSTALLATION-OS (from (gnu system install)). +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)) @@ -276,13 +278,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)) - (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 @@ (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 +349,23 @@ (define marionette (exit #$(and gui-test (gui-test #~marionette))))))) - (gexp->derivation "installation" install - #:substitutable? #f))) ;too big + (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 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 +376,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 +389,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 +401,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 - %minimal-extlinux-os-source - #:packages - (list syslinux) - #:script - %extlinux-gpt-installation-script)) - (command (qemu-command* 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"))))) @@ -456,14 +477,14 @@ (define %test-iso-image-installer (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* 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))))) @@ -514,11 +535,11 @@ (define %test-separate-home-os partition. In particular, home directories must be correctly created (see ).") (value - (mlet* %store-monad ((image (run-install %separate-home-os - %separate-home-os-source - #:script - %simple-installation-script)) - (command (qemu-command* 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"))))) @@ -591,11 +612,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 - %separate-store-os-source - #:script - %separate-store-installation-script)) - (command (qemu-command* 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"))))) @@ -672,12 +693,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 - %raid-root-os-source - #:script - %raid-root-installation-script - #:target-size (* 3200 MiB))) - (command (qemu-command* 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"))))) @@ -806,11 +827,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 - %encrypted-root-os-source - #:script - %encrypted-root-installation-script)) - (command (qemu-command* 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))))) @@ -890,13 +911,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 - %lvm-separate-home-os-source - #:script - %lvm-separate-home-installation-script - #:packages (list lvm2-static) - #:target-size (* 3200 MiB))) - (command (qemu-command* 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"))))) @@ -992,11 +1013,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 - %encrypted-root-not-boot-os-source - #:script - %encrypted-root-not-boot-installation-script)) - (command (qemu-command* 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))))) @@ -1068,11 +1089,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 - %btrfs-root-os-source - #:script - %btrfs-root-installation-script)) - (command (qemu-command* 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"))))) @@ -1136,11 +1157,11 @@ (define %test-btrfs-raid-root-os 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* 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"))))) @@ -1227,12 +1248,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 - %btrfs-root-on-subvolume-os-source - #:script - %btrfs-root-on-subvolume-installation-script)) - (command (qemu-command* 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"))))) @@ -1302,11 +1322,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 - %jfs-root-os-source - #:script - %jfs-root-installation-script)) - (command (qemu-command* 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"))))) @@ -1375,11 +1395,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 - %f2fs-root-os-source - #:script - %f2fs-root-installation-script)) - (command (qemu-command* 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"))))) @@ -1448,11 +1468,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 - %xfs-root-os-source - #:script - %xfs-root-installation-script)) - (command (qemu-command* 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"))))) @@ -1720,22 +1740,22 @@ (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) - #: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* image + ((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