From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([2001:470:142:3::10]:60025) by lists.gnu.org with esmtp (Exim 4.86_2) (envelope-from ) id 1hoXAu-0001x2-Cm for guix-patches@gnu.org; Fri, 19 Jul 2019 14:00:10 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1hoXAr-0006od-LH for guix-patches@gnu.org; Fri, 19 Jul 2019 14:00:07 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:47718) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1hoXAo-0006lE-Nm for guix-patches@gnu.org; Fri, 19 Jul 2019 14:00:04 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1hoXAo-0001MT-JC for guix-patches@gnu.org; Fri, 19 Jul 2019 14:00:02 -0400 Subject: [bug#36555] [PATCH v4 3/3] tests: Add reconfigure system test. Resent-Message-ID: From: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) References: <87imsci9sj.fsf@sdf.lonestar.org> <87ef30i9fl.fsf@sdf.lonestar.org> <87y3129qsn.fsf@gnu.org> <87sgr9bziq.fsf@sdf.lonestar.org> <87pnmc7nt1.fsf@gnu.org> <8736j7nwcb.fsf@sdf.lonestar.org> <87muhfjm14.fsf@gnu.org> <87ftn63l7d.fsf@sdf.lonestar.org> <87v9w1zgon.fsf_-_@sdf.lonestar.org> <87y30v3qke.fsf@sdf.lonestar.org> <871rylrjt8.fsf_-_@sdf.lonestar.org> <87wogdq575.fsf_-_@sdf.lonestar.org> <87r26lq531.fsf_-_@sdf.lonestar.org> Date: Fri, 19 Jul 2019 13:59:25 -0400 In-Reply-To: <87r26lq531.fsf_-_@sdf.lonestar.org> (Jakob L. Kreuze's message of "Fri, 19 Jul 2019 13:58:26 -0400") Message-ID: <87muh9q51e.fsf_-_@sdf.lonestar.org> MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha256; protocol="application/pgp-signature" List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+kyle=kyleam.com@gnu.org Sender: "Guix-patches" To: Ludovic =?UTF-8?Q?Court=C3=A8s?= Cc: 36555@debbugs.gnu.org --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable * gnu/tests/reconfigure.scm: New file. * gnu/local.mk (GNU_SYSTEM_MODULES): Add it. =2D-- gnu/local.mk | 1 + gnu/tests/reconfigure.scm | 263 ++++++++++++++++++++++++++++++++++++++ 2 files changed, 264 insertions(+) create mode 100644 gnu/tests/reconfigure.scm diff --git a/gnu/local.mk b/gnu/local.mk index 0e17af953..b334d0572 100644 =2D-- a/gnu/local.mk +++ b/gnu/local.mk @@ -592,6 +592,7 @@ GNU_SYSTEM_MODULES =3D \ %D%/tests/mail.scm \ %D%/tests/messaging.scm \ %D%/tests/networking.scm \ + %D%/tests/reconfigure.scm \ %D%/tests/rsync.scm \ %D%/tests/security-token.scm \ %D%/tests/singularity.scm \ diff --git a/gnu/tests/reconfigure.scm b/gnu/tests/reconfigure.scm new file mode 100644 index 000000000..022492e05 =2D-- /dev/null +++ b/gnu/tests/reconfigure.scm @@ -0,0 +1,263 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright =C2=A9 2019 Jakob L. Kreuze +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (gnu tests reconfigure) + #:use-module (gnu bootloader) + #:use-module (gnu services shepherd) + #:use-module (gnu system vm) + #:use-module (gnu system) + #:use-module (gnu tests) + #:use-module (guix derivations) + #:use-module (guix gexp) + #:use-module (guix monads) + #:use-module (guix scripts system reconfigure) + #:use-module (guix store) + #:export (%test-switch-to-system + %test-upgrade-services + %test-install-bootloader)) + +;;; Commentary: +;;; +;;; Test in-place system reconfiguration: advancing the system generation = on a +;;; running instance of the Guix System. +;;; +;;; Code: + +(define* (run-switch-to-system-test) + "Run a test of an OS running SWITCH-SYSTEM-PROGRAM, which creates a new +generation of the system profile." + (define os + (marionette-operating-system + (simple-operating-system) + #:imported-modules '((gnu services herd) + (guix combinators)))) + + (define vm (virtual-machine os)) + + (define (test script) + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (gnu build marionette) + (srfi srfi-64)) + + (define marionette + (make-marionette (list #$vm))) + + (define (system-generations marionette) + "Return the names of the generation symlinks on MARIONETTE." + (marionette-eval + '(begin + (use-modules (ice-9 ftw) + (srfi srfi-1)) + (let* ((profile-dir "/var/guix/profiles/") + (entries (map first (cddr (file-system-tree profile= -dir))))) + (remove (lambda (entry) + (member entry '("per-user" "system"))) + entries))) + marionette)) + + (mkdir #$output) + (chdir #$output) + + (test-begin "switch-to-system") + + (let ((generations-prior (system-generations marionette))) + (test-assert "script successfully evaluated" + (marionette-eval + '(primitive-load #$script) + marionette)) + + (test-equal "script created new generation" + (length (system-generations marionette)) + (1+ (length generations-prior)))) + + (test-end) + (exit (=3D (test-runner-fail-count (test-runner-current)) 0))))) + + (gexp->derivation "switch-to-system" (test (switch-system-program os)))) + +(define* (run-upgrade-services-test) + "Run a test of an OS running UPGRADE-SERVICES-PROGRAM, which upgrades the +Shepherd (PID 1) by unloading obsolete services and loading new services." + (define os + (marionette-operating-system + (simple-operating-system) + #:imported-modules '((gnu services herd) + (guix combinators)))) + + (define vm (virtual-machine os)) + + (define dummy-service + ;; Shepherd service that does nothing, for the sole purpose of ensuring + ;; that it is properly installed and started by the script. + (shepherd-service (provision '(dummy)) + (start #~(const #t)) + (stop #~(const #t)) + (respawn? #f))) + + (define (ensure-service-file service) + "Return the Shepherd service file for SERVICE, after ensuring that it +exists in the store" + (let ((file (shepherd-service-file service))) + (mlet* %store-monad ((store-object (lower-object file)) + (_ (built-derivations (list store-object)))) + (return file)))) + + (define (test enable-dummy disable-dummy) + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (gnu build marionette) + (srfi srfi-64)) + + (define marionette + (make-marionette (list #$vm))) + + (define (running-services marionette) + "Return the names of the running services on MARIONETTE." + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (map live-service-canonical-name (current-services))) + marionette)) + + (mkdir #$output) + (chdir #$output) + + (test-begin "upgrade-services") + + (let ((services-prior (running-services marionette))) + (test-assert "script successfully evaluated" + (marionette-eval + '(primitive-load #$enable-dummy) + marionette)) + + (test-assert "script started new service" + (and (not (memq 'dummy services-prior)) + (memq 'dummy (running-services marionette)))) + + (test-assert "script successfully evaluated" + (marionette-eval + '(primitive-load #$disable-dummy) + marionette)) + + (test-assert "script stopped new service" + (not (memq 'dummy (running-services marionette))))) + + (test-end) + (exit (=3D (test-runner-fail-count (test-runner-current)) 0))))) + + (mlet* %store-monad ((file (ensure-service-file dummy-service))) + (let ((enable (upgrade-services-program (list file) '(dummy) '() '())) + (disable (upgrade-services-program '() '() '(dummy) '()))) + (gexp->derivation "upgrade-services" (test enable disable))))) + +(define* (run-install-bootloader-test) + "Run a test of an OS running INSTALL-BOOTLOADER-PROGRAM, which installs a +bootloader's configuration file." + (define os + (marionette-operating-system + (simple-operating-system) + #:imported-modules '((gnu services herd) + (guix combinators)))) + + (define vm (virtual-machine os)) + + (define (test script) + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (gnu build marionette) + (ice-9 regex) + (srfi srfi-1) + (srfi srfi-64)) + + (define marionette + (make-marionette (list #$vm))) + + (define (generations-in-grub-cfg marionette) + "Return the system generation paths that have GRUB menu entrie= s." + (let ((grub-cfg (marionette-eval + '(begin + (call-with-input-file "/boot/grub/grub.cfg" + (lambda (port) + (get-string-all port)))) + marionette))) + (map (lambda (parameter) + (second (string-split (match:substring parameter) #\= =3D))) + (list-matches "system=3D[^ ]*" grub-cfg)))) + + (mkdir #$output) + (chdir #$output) + + (test-begin "install-bootloader") + + + (test-assert "no prior menu entry for system generation" + (not (member #$os (generations-in-grub-cfg marionette)))) + + (test-assert "script successfully evaluated" + (marionette-eval + '(primitive-load #$script) + marionette)) + + (test-assert "menu entry created for system generation" + (member #$os (generations-in-grub-cfg marionette))) + + (test-end) + (exit (=3D (test-runner-fail-count (test-runner-current)) 0))))) + + (let* ((bootloader ((compose bootloader-configuration-bootloader + operating-system-bootloader) + os)) + ;; The typical use-case for 'install-bootloader-program' is to re= ad + ;; the boot parameters for the existing menu entries on the syste= m, + ;; parse them with 'boot-parameters->menu-entry', and pass the + ;; results to 'operating-system-bootcfg'. However, to obtain boot + ;; parameters, we would need to start the marionette, which we sh= ould + ;; ideally avoid doing outside of the 'test' G-Expression. Thus, = we + ;; generate a bootloader configuration for the script as if there + ;; were no existing menu entries. In the grand scheme of things, = this + ;; matters little -- these tests should not make assertions about= the + ;; behavior of 'operating-system-bootcfg'. + (bootcfg (operating-system-bootcfg os '())) + (bootcfg-file (bootloader-configuration-file bootloader))) + (gexp->derivation + "install-bootloader" + ;; Due to the read-only nature of the virtual machines used in the sy= stem + ;; test suite, the bootloader installer script is omitted. 'grub-inst= all' + ;; would attempt to write directly to the virtual disk if the + ;; installation script were run. + (test (install-bootloader-program #f #f bootcfg bootcfg-file #f "/"))= ))) + +(define %test-switch-to-system + (system-test + (name "switch-to-system") + (description "Create a new generation of the system profile.") + (value (run-switch-to-system-test)))) + +(define %test-upgrade-services + (system-test + (name "upgrade-services") + (description "Upgrade the Shepherd by unloading obsolete services and +loading new services.") + (value (run-upgrade-services-test)))) + +(define %test-install-bootloader + (system-test + (name "install-bootloader") + (description "Install a bootloader and its configuration file.") + (value (run-install-bootloader-test)))) =2D-=20 2.22.0 --=-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQIzBAEBCAAdFiEEa1VJLOiXAjQ2BGSm9Qb9Fp2P2VoFAl0yBP0ACgkQ9Qb9Fp2P 2VpnLw/+OPHBj4VtrOUxGA/8sUL4TQY/Jnp6zPLqss4SdPGcEexRGGxsdVMsVkpL 2iK9o1WNR8f4BSJ+6c8tr4Eov8G5cwicLexqAKVJLIRs2rQQV/MjRsqDEUdV+TCf c74yKPBrdo7u2pzMG0jTG3Oso/iqncWmc9D08nEIiYi+jRZCvC3eJXSxop6rWyeQ fARxI1X/spuik4m4WJQpR5rh5R+5dKEZEZ+VuWhUX9jo+WTAcyn+OLp6KGxXC5tA J/ONhLXK33/6aTrRu/RBcsKmeQleotHyN+c8FhD/nCqTp4xlEYnTGjAFuCgI7UJL ussva6hykZsgtJOkcrIbJAcnH+89qkXwEzI8XbMCbWmUs+bMR3OkzcsnRnzrPJZM +qh+MyyKGp2GciZrrv0Wns8DKKT4phof0eh39oMR6N7Qo1lv4XQgYYi5Mt+9DMp1 IAGNKKJaWnJinREoPYp01z/gI8OHxDZbXyYks0UW8JNDCwqE4tD5fi+KAMxqWIWG DaWlS+8rFVM+KGd2CmZ3A2bULjeKZ5oOd438PFS7Wk4gC5XXlvdMHfBrGnmQdF2V ZADLvVrz2EzferCBqyHfW5SRher8MgoYpnR6D/DaqI1ZYXQCls2zGKMtzUkd0bSk qstoZo4Rq+pLWhDUxBi5rFWsjzVGEBLokd7ofard7cC+5DtLKbs= =7fp0 -----END PGP SIGNATURE----- --=-=-=--