From unknown Thu Jun 19 14:06:26 2025 Content-Disposition: inline Content-Transfer-Encoding: quoted-printable MIME-Version: 1.0 X-Mailer: MIME-tools 5.509 (Entity 5.509) Content-Type: text/plain; charset=utf-8 From: bug#36555 <36555@debbugs.gnu.org> To: bug#36555 <36555@debbugs.gnu.org> Subject: Status: [PATCH 0/2] Refactor out common behavior for system reconfiguration. Reply-To: bug#36555 <36555@debbugs.gnu.org> Date: Thu, 19 Jun 2025 21:06:26 +0000 retitle 36555 [PATCH 0/2] Refactor out common behavior for system reconfigu= ration. reassign 36555 guix-patches submitter 36555 zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) severity 36555 normal tag 36555 patch thanks From debbugs-submit-bounces@debbugs.gnu.org Mon Jul 08 15:52:28 2019 Received: (at submit) by debbugs.gnu.org; 8 Jul 2019 19:52:28 +0000 Received: from localhost ([127.0.0.1]:59604 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hkZga-00046v-F7 for submit@debbugs.gnu.org; Mon, 08 Jul 2019 15:52:28 -0400 Received: from lists.gnu.org ([209.51.188.17]:43322) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hkZgX-00046k-OR for submit@debbugs.gnu.org; Mon, 08 Jul 2019 15:52:27 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:42356) by lists.gnu.org with esmtp (Exim 4.86_2) (envelope-from ) id 1hkZgV-0004Y2-Pw for guix-patches@gnu.org; Mon, 08 Jul 2019 15:52:25 -0400 X-Spam-Checker-Version: SpamAssassin 3.3.2 (2011-06-06) on eggs.gnu.org X-Spam-Level: X-Spam-Status: No, score=0.0 required=5.0 tests=BAYES_40,RCVD_IN_DNSWL_NONE, URIBL_BLOCKED autolearn=disabled version=3.3.2 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1hkZgT-00018N-JR for guix-patches@gnu.org; Mon, 08 Jul 2019 15:52:23 -0400 Received: from mx.sdf.org ([205.166.94.20]:60162) by eggs.gnu.org with esmtps (TLS1.0:DHE_RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1hkZgS-000174-Lj for guix-patches@gnu.org; Mon, 08 Jul 2019 15:52:21 -0400 Received: from Upsilon (mobile-166-171-186-40.mycingular.net [166.171.186.40]) (authenticated (0 bits)) by mx.sdf.org (8.15.2/8.14.5) with ESMTPSA id x68JqGPE004411 (using TLSv1.2 with cipher AES256-GCM-SHA384 (256 bits) verified NO) for ; Mon, 8 Jul 2019 19:52:18 GMT From: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) To: guix-patches@gnu.org Subject: [PATCH 0/2] Refactor out common behavior for system reconfiguration. Date: Mon, 08 Jul 2019 15:52:12 -0400 Message-ID: <87imsci9sj.fsf@sdf.lonestar.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha256; protocol="application/pgp-signature" X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-Received-From: 205.166.94.20 X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: submit X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) --=-=-= Content-Type: text/plain Hello, Guix! This is the preliminary version of a patch series to turn the behavior common between 'guix deploy' and 'guix system reconfigure' into a module that both can use. I am submitting it as-is both for comments and for tracking the refactoring effort. Note that this is _not_ ready to be merged. There are several things that I need to do before I would consider it ready for upstream Guix: - This passes my old test suite for 'guix deploy', but I haven't dared to run the new 'guix system reconfigure'. I'll set up a new virtual machine so I don't put myself out of a working laptop. - 'switch-system-program', 'upgrade-services-program', and 'install-bootloader-program' omit some of the features that were present in the procedures they replace. For example, 'install-bootloader' previously supported installing the bootloader configuration without actually running the installation script. This was fine for 'guix deploy', but I'll need to add it back in for 'guix system reconfigure'. - I plan to implement system tests for '(guix scripts system reconfigure)'. I suppose I can always submit them as a separate patch, but I'll likely finish them before we're through with code review, so it may make sense to include them with as part of this patch series, albeit as a distinct commit. - I suspect that some of the effectful procedures in 'system.scm' could be refactored out in a similar fashion. Not that 'guix deploy' would necessarily be using them, but it would be more consistent to have them as 'program-file' objects, and those procedures could then also be tested. I look forward to your comments. Regards, Jakob Jakob L. Kreuze (2): guix system: Add 'reconfigure' module. guix system: Reimplement 'reconfigure'. Makefile.am | 1 + gnu/machine/ssh.scm | 235 ++++++++-------------------- guix/scripts/system.scm | 140 +++++------------ guix/scripts/system/reconfigure.scm | 158 +++++++++++++++++++ 4 files changed, 255 insertions(+), 279 deletions(-) create mode 100644 guix/scripts/system/reconfigure.scm -- 2.22.0 --=-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQIzBAEBCAAdFiEEa1VJLOiXAjQ2BGSm9Qb9Fp2P2VoFAl0jnuwACgkQ9Qb9Fp2P 2VqbpA/6AzY1X0XDF2dfGAjhaNqbU4jxAdGB3vFQzOBsZbxatDyLicV951Es7fx9 dliFCylCXw1qdnfyBOGOtXOgNeeAZredRoEMVvxkPbDu3PiJ4z0bXe8bgtearNYS x7l+tUWrEULtlUiSvR3t21Wenb9p7p3X8wxK0lRoGE4+gc/s0G9NYFyPW277Uy1E ojcmvVANiEgbQU1amWSuXz4AZaxsy3mzcZoULyt+9NnpUUXzWyHj05T/ElpsIm5R DvyeA6ahD+L2Xp+QaSua1r8MfEApGgsmvIQknYo9xQcM4fWR04ar4PCXE+FGuvm6 QPQrc566D3OBQpJJToom+37x2/zluRokiy84Zg8yueAJGOk/Qzdpn2ALsn4B6WGb r2GLcwOmvHT11X14DpGwBpEncd23cLu5VQidZniiZ/Ek+DNpiyL/6TjgwcXrx3pW eyveU9dMSmuQ6Zenr19e6KX0HHvtnldkL/EcOXbUjyQYr1WCfrursoigiYCvSeDa LT8B76Mi+Jc6/Jq9rQoHG6DldNpLR9YLGt6wPJ8vMVW/rTwn0pjgm8t/rghkMM/t zJdhGdkQ8yUo7hDJ5kd1v8gtDG6DHG5QdukWh608Da9pDJ8uqClnQyoxw/ejpY1o zkBIRNJzSNu5aX2Kf8B15Wso1pFq9BJnJrkGPdL5HwIdymRFJCE= =6Fog -----END PGP SIGNATURE----- --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Mon Jul 08 16:00:20 2019 Received: (at 36555) by debbugs.gnu.org; 8 Jul 2019 20:00:20 +0000 Received: from localhost ([127.0.0.1]:59617 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hkZo7-0004L4-Kk for submit@debbugs.gnu.org; Mon, 08 Jul 2019 16:00:20 -0400 Received: from mx.sdf.org ([205.166.94.20]:58867) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hkZo4-0004Kt-CD for 36555@debbugs.gnu.org; Mon, 08 Jul 2019 16:00:13 -0400 Received: from Upsilon (mobile-166-171-186-40.mycingular.net [166.171.186.40]) (authenticated (0 bits)) by mx.sdf.org (8.15.2/8.14.5) with ESMTPSA id x68K00c7007484 (using TLSv1.2 with cipher AES256-GCM-SHA384 (256 bits) verified NO) for <36555@debbugs.gnu.org>; Mon, 8 Jul 2019 20:00:05 GMT From: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) To: 36555@debbugs.gnu.org Subject: Re: [bug#36555] [PATCH 1/2] guix system: Add 'reconfigure' module. References: <87imsci9sj.fsf@sdf.lonestar.org> Date: Mon, 08 Jul 2019 15:59:58 -0400 In-Reply-To: <87imsci9sj.fsf@sdf.lonestar.org> (Jakob L. Kreuze's message of "Mon, 08 Jul 2019 15:52:12 -0400") Message-ID: <87ef30i9fl.fsf@sdf.lonestar.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha256; protocol="application/pgp-signature" X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 36555 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable * guix/scripts/system/reconfigure.scm: New file. * Makefile.am (MODULES): Add it. * guix/scripts/system.scm (bootloader-installer-script): Export variable. * gnu/machine/ssh.scm (switch-to-system, upgrade-shepherd-services) (install-bootloader): Delete variable. * gnu/machine/ssh.scm (deploy-managed-host): Rewrite procedure. =2D-- Makefile.am | 1 + gnu/machine/ssh.scm | 232 +++++++--------------------- guix/scripts/system.scm | 1 + guix/scripts/system/reconfigure.scm | 158 +++++++++++++++++++ 4 files changed, 219 insertions(+), 173 deletions(-) create mode 100644 guix/scripts/system/reconfigure.scm diff --git a/Makefile.am b/Makefile.am index dd7720e87..58a96d348 100644 =2D-- a/Makefile.am +++ b/Makefile.am @@ -245,6 +245,7 @@ MODULES =3D \ guix/scripts/describe.scm \ guix/scripts/system.scm \ guix/scripts/system/search.scm \ + guix/scripts/system/reconfigure.scm \ guix/scripts/lint.scm \ guix/scripts/challenge.scm \ guix/scripts/import/crate.scm \ diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm index a7d1a967a..95198bb2a 100644 =2D-- a/gnu/machine/ssh.scm +++ b/gnu/machine/ssh.scm @@ -30,10 +30,13 @@ #:use-module (guix monads) #:use-module (guix records) #:use-module (guix remote) + #:use-module (guix scripts system) + #:use-module (guix scripts system reconfigure) #:use-module (guix ssh) #:use-module (guix store) #:use-module (ice-9 match) #:use-module (srfi srfi-19) + #:use-module (srfi srfi-26) #:use-module (srfi srfi-35) #:export (managed-host-environment-type =20 @@ -105,118 +108,6 @@ an environment type of 'managed-host." ;;; System deployment. ;;; =20 =2D(define (switch-to-system machine) =2D "Monadic procedure creating a new generation on MACHINE and execute the =2Dactivation script for the new system configuration." =2D (define (remote-exp drv script) =2D (with-extensions (list guile-gcrypt) =2D (with-imported-modules (source-module-closure '((guix config) =2D (guix profiles) =2D (guix utils))) =2D #~(begin =2D (use-modules (guix config) =2D (guix profiles) =2D (guix utils)) =2D =2D (define %system-profile =2D (string-append %state-directory "/profiles/system")) =2D =2D (let* ((system #$drv) =2D (number (1+ (generation-number %system-profile))) =2D (generation (generation-file-name %system-profile num= ber))) =2D (switch-symlinks generation system) =2D (switch-symlinks %system-profile generation) =2D ;; The implementation of 'guix system reconfigure' saves t= he =2D ;; load path and environment here. This is unnecessary here =2D ;; because each invocation of 'remote-eval' runs in a dist= inct =2D ;; Guile REPL. =2D (setenv "GUIX_NEW_SYSTEM" system) =2D ;; The activation script may write to stdout, which confus= es =2D ;; 'remote-eval' when it attempts to read a result from the =2D ;; remote REPL. We work around this by forcing the output = to a =2D ;; string. =2D (with-output-to-string =2D (lambda () =2D (primitive-load #$script)))))))) =2D =2D (let* ((os (machine-system machine)) =2D (script (operating-system-activation-script os))) =2D (mlet* %store-monad ((drv (operating-system-derivation os))) =2D (machine-remote-eval machine (remote-exp drv script))))) =2D =2D;; XXX: Currently, this does NOT attempt to restart running services. Th= is is =2D;; also the case with 'guix system reconfigure'. =2D;; =2D;; See . =2D(define (upgrade-shepherd-services machine) =2D "Monadic procedure unloading and starting services on the remote as ne= eded =2Dto realize the MACHINE's system configuration." =2D (define target-services =2D ;; Monadic expression evaluating to a list of (name output-path) pai= rs for =2D ;; all of MACHINE's services. =2D (mapm %store-monad =2D (lambda (service) =2D (mlet %store-monad ((file ((compose lower-object =2D shepherd-service-file) =2D service))) =2D (return (list (shepherd-service-canonical-name service) =2D (derivation->output-path file))))) =2D (service-value =2D (fold-services (operating-system-services (machine-system mac= hine)) =2D #:target-type shepherd-root-service-type)))) =2D =2D (define (remote-exp target-services) =2D (with-imported-modules '((gnu services herd)) =2D #~(begin =2D (use-modules (gnu services herd) =2D (srfi srfi-1)) =2D =2D (define running =2D (filter live-service-running (current-services))) =2D =2D (define (essential? service) =2D ;; Return #t if SERVICE is essential and should not be unloa= ded =2D ;; under any circumstance. =2D (memq (first (live-service-provision service)) =2D '(root shepherd))) =2D =2D (define (obsolete? service) =2D ;; Return #t if SERVICE can be safely unloaded. =2D (and (not (essential? service)) =2D (every (lambda (requirements) =2D (not (memq (first (live-service-provision serv= ice)) =2D requirements))) =2D (map live-service-requirement running)))) =2D =2D (define to-unload =2D (filter obsolete? =2D (remove (lambda (service) =2D (memq (first (live-service-provision servi= ce)) =2D (map first '#$target-services))) =2D running))) =2D =2D (define to-start =2D (remove (lambda (service-pair) =2D (memq (first service-pair) =2D (map (compose first live-service-provision) =2D running))) =2D '#$target-services)) =2D =2D ;; Unload obsolete services. =2D (for-each (lambda (service) =2D (false-if-exception =2D (unload-service service))) =2D to-unload) =2D =2D ;; Load the service files for any new services and start them. =2D (load-services/safe (map second to-start)) =2D (for-each start-service (map first to-start)) =2D =2D #t))) =2D =2D (mlet %store-monad ((target-services target-services)) =2D (machine-remote-eval machine (remote-exp target-services)))) =2D (define (machine-boot-parameters machine) "Monadic procedure returning a list of 'boot-parameters' for the generat= ions of MACHINE's system profile, ordered from most recent to oldest." @@ -275,71 +166,66 @@ of MACHINE's system profile, ordered from most recent= to oldest." (boot-parameters-kernel-arguments params)))))))) generations)))) =20 =2D(define (install-bootloader machine) =2D "Create a bootloader entry for the new system generation on MACHINE, a= nd =2Dconfigure the bootloader to boot that generation by default." =2D (define bootloader-installer-script =2D (@@ (guix scripts system) bootloader-installer-script)) =2D =2D (define (remote-exp installer bootcfg bootcfg-file) =2D (with-extensions (list guile-gcrypt) =2D (with-imported-modules (source-module-closure '((gnu build install) =2D (guix store) =2D (guix utils))) =2D #~(begin =2D (use-modules (gnu build install) =2D (guix store) =2D (guix utils)) =2D (let* ((gc-root (string-append "/" %gc-roots-directory "/boo= tcfg")) =2D (temp-gc-root (string-append gc-root ".new"))) =2D =2D (switch-symlinks temp-gc-root gc-root) =2D =2D (unless (false-if-exception =2D (begin =2D ;; The implementation of 'guix system reconfigu= re' =2D ;; saves the load path here. This is unnecessar= y here =2D ;; because each invocation of 'remote-eval' run= s in a =2D ;; distinct Guile REPL. =2D (install-boot-config #$bootcfg #$bootcfg-file "= /") =2D ;; The installation script may write to stdout,= which =2D ;; confuses 'remote-eval' when it attempts to r= ead a =2D ;; result from the remote REPL. We work around = this =2D ;; by forcing the output to a string. =2D (with-output-to-string =2D (lambda () =2D (primitive-load #$installer))))) =2D (delete-file temp-gc-root) =2D (error "failed to install bootloader")) =2D =2D (rename-file temp-gc-root gc-root) =2D #t))))) =2D =2D (mlet* %store-monad ((boot-parameters (machine-boot-parameters machine= ))) =2D (let* ((os (machine-system machine)) =2D (bootloader ((compose bootloader-configuration-bootloader =2D operating-system-bootloader) =2D os)) =2D (bootloader-target (bootloader-configuration-target =2D (operating-system-bootloader os))) =2D (installer (bootloader-installer-script =2D (bootloader-installer bootloader) =2D (bootloader-package bootloader) =2D bootloader-target =2D "/")) =2D (menu-entries (map boot-parameters->menu-entry boot-parameter= s)) =2D (bootcfg (operating-system-bootcfg os menu-entries)) =2D (bootcfg-file (bootloader-configuration-file bootloader))) =2D (machine-remote-eval machine (remote-exp installer bootcfg bootcfg= -file))))) =2D (define (deploy-managed-host machine) "Internal implementation of 'deploy-machine' for MACHINE instances with = an environment type of 'managed-host." + (define target-services + ;; Monadic expression evaluating to a list of + ;; (shepherd-service-canonical-name, shepherd-service-file) pairs for = the + ;; services in MACHINE's operating system configuration. + (mapm %store-monad + (lambda (service) + (mlet %store-monad ((file ((compose lower-object + shepherd-service-file) + service))) + (return (list (shepherd-service-canonical-name service) + (derivation->output-path file))))) + (service-value + (fold-services (operating-system-services (machine-system machi= ne)) + #:target-type shepherd-root-service-type)))) + + (define (run-switch-to-system machine) + "Monadic procedure serializing the items in MACHINE necessary to build= a +G-Expression with 'switch-to-system'." + (mlet %store-monad ((script (switch-system-program (machine-system mac= hine)))) + (machine-remote-eval machine #~(primitive-load #$script)))) + + (define (run-upgrade-shepherd-services machine) + "Monadic procedure serializing the items in MACHINE necessary to build= a +G-Expression with 'upgrade-shepherd-services'." + (mlet* %store-monad ((target-services target-services) + (script (upgrade-services-program target-services= ))) + (machine-remote-eval machine #~(primitive-load #$script)))) + + (define (run-install-bootloader machine) + "Monadic procedure serializing the items in MACHINE necessary to build= a +G-Expression with 'install-bootloader'." + (mlet %store-monad ((boot-parameters (machine-boot-parameters machine)= )) + (let* ((os (machine-system machine)) + (bootloader ((compose bootloader-configuration-bootloader + operating-system-bootloader) + os)) + (target (bootloader-configuration-target + (operating-system-bootloader os))) + (installer (bootloader-installer-script + (bootloader-installer bootloader) + (bootloader-package bootloader) + target + "/")) + (menu-entries (map boot-parameters->menu-entry boot-parameter= s)) + (bootcfg (operating-system-bootcfg os menu-entries)) + (bootcfg-file (bootloader-configuration-file bootloader))) + (mlet %store-monad ((script (install-bootloader-program installer + bootcfg + bootcfg-fi= le + "/"))) + (machine-remote-eval machine #~(primitive-load #$script)))))) + (maybe-raise-unsupported-configuration-error machine) =2D (mbegin %store-monad =2D (switch-to-system machine) =2D (upgrade-shepherd-services machine) =2D (install-bootloader machine))) + (mapm %store-monad (cut <> machine) + (list run-switch-to-system + run-upgrade-shepherd-services + run-install-bootloader))) =20 ;;; diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 60c1ca5c9..21858ee7d 100644 =2D-- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -70,6 +70,7 @@ #:use-module (ice-9 match) #:use-module (rnrs bytevectors) #:export (guix-system + bootloader-installer-script read-operating-system)) =20 diff --git a/guix/scripts/system/reconfigure.scm b/guix/scripts/system/reco= nfigure.scm new file mode 100644 index 000000000..e14ea4f2f =2D-- /dev/null +++ b/guix/scripts/system/reconfigure.scm @@ -0,0 +1,158 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright =C2=A9 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Court=C3= =A8s +;;; Copyright =C2=A9 2016 Alex Kost +;;; Copyright =C2=A9 2016, 2017, 2018 Chris Marusich +;;; Copyright =C2=A9 2017 Mathieu Othacehe +;;; Copyright =C2=A9 2018 Ricardo Wurmus +;;; Copyright =C2=A9 2019 Christopher Baines +;;; 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 (guix scripts system reconfigure) + #:autoload (gnu packages gnupg) (guile-gcrypt) + #:use-module (gnu system) + #:use-module (guix gexp) + #:use-module (guix modules) + #:export (switch-system-program + upgrade-services-program + install-bootloader-program)) + +;;; Commentary: +;;; +;;; This module implements the "effectful" parts of system +;;; reconfiguration. Although building a system derivation is a pure +;;; operation, a number of impure operations must be carried out for the +;;; system configuration to be realized -- chiefly, creation of generation +;;; symlinks and invocation of activation scripts. +;;; +;;; Code: + +(define (switch-system-program os) + "Return as a monadic value a derivation to build a scheme file that, upon +being evaluated, will create a new generation for SYSTEM-DERIVATION and +execute ACTIVATION-SCRIPT." + (gexp->script + "switch-to-system.scm" + (with-extensions (list guile-gcrypt) + (with-imported-modules (source-module-closure '((guix config) + (guix profiles) + (guix utils))) + #~(begin + (use-modules (guix config) + (guix profiles) + (guix utils)) + + (define %system-profile + (string-append %state-directory "/profiles/system")) + + (let* ((number (1+ (generation-number %system-profile))) + (generation (generation-file-name %system-profile number= ))) + (switch-symlinks generation #$os) + (switch-symlinks %system-profile generation) + (setenv "GUIX_NEW_SYSTEM" #$os) + (with-output-to-string + (lambda () + (primitive-load + #$(operating-system-activation-script os)))))))))) + +;; XXX: Currently, this does NOT attempt to restart running services. See +;; for details. +(define (upgrade-services-program target-services) + "Return as a monadic value a derivation to build a scheme file that, upon +being evaluated, will use TARGET-SERVICES, a list +of (shepherd-service-canonical-name, shepherd-service-file) pairs to deter= mine +which services are obsolete and need to be unloaded, as well as which serv= ices +are new and need to be started." + (gexp->script + "upgrade-shepherd-services.scm" + (with-imported-modules '((gnu services herd)) + #~(begin + (use-modules (gnu services herd) + (srfi srfi-1)) + + (define running + (filter live-service-running (current-services))) + + (define (essential? service) + ;; Return #t if SERVICE is essential and should not be unloaded + ;; under any circumstance. + (memq (first (live-service-provision service)) + '(root shepherd))) + + (define (obsolete? service) + ;; Return #t if SERVICE can be safely unloaded. + (and (not (essential? service)) + (every (lambda (requirements) + (not (memq (first (live-service-provision service)) + requirements))) + (map live-service-requirement running)))) + + (define to-unload + (filter obsolete? + (remove (lambda (service) + (memq (first (live-service-provision service)) + (map first '#$target-services))) + running))) + + (define to-start + (remove (lambda (service-pair) + (memq (first service-pair) + (map (compose first live-service-provision) + running))) + '#$target-services)) + + ;; Unload obsolete services. + (for-each (lambda (service) + (false-if-exception + (unload-service service))) + to-unload) + + ;; Load the service files for any new services and start them. + (load-services/safe (map second to-start)) + (for-each start-service (map first to-start)))))) + +(define (install-bootloader-program installer-script bootcfg bootcfg-file = target) + "Return as a monadic value a derivation to build a scheme file that, upon +being evaluated, will install BOOTCFG to BOOTCFG-FILE, a target path, on +TARGET, a mount point, and subsequently run INSTALLER-SCRIPT." + (gexp->script + "install-bootloader.scm" + (with-extensions (list guile-gcrypt) + (with-imported-modules (source-module-closure '((gnu build install) + (guix store) + (guix utils))) + #~(begin + (use-modules (gnu build install) + (guix store) + (guix utils)) + (let* ((gc-root (string-append "/" %gc-roots-directory "/bootcf= g")) + (temp-gc-root (string-append gc-root ".new"))) + + (switch-symlinks temp-gc-root gc-root) + + (let ((installer-result + (false-if-exception + (begin + (install-boot-config #$bootcfg #$bootcfg-file #$tar= get) + (with-output-to-string + (lambda () + (primitive-load #$installer-script))))))) + (unless installer-result + (delete-file temp-gc-root) + (error "failed to install bootloader")) + (rename-file temp-gc-root gc-root) + installer-result))))))) =2D-=20 2.22.0 --=-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQIzBAEBCAAdFiEEa1VJLOiXAjQ2BGSm9Qb9Fp2P2VoFAl0joL4ACgkQ9Qb9Fp2P 2VqR6w/7BOlGlId26SRb5TMH7VBflkt9ev7WZpNK61hpR7dpqGZNFAUTEPBRhtYe QmQKRm5myq/i36O536Bp5O9uNue0xLs/gsDQ+ZLcjPYN9uBJk/iFknO4ogJM2px5 isSBDsYByxavJIB+W2+QHYLwSXSPFpqfyIsY6oOo+3VANNnmwq3V6mb5TSaamEYg zDjo2h4AV9T0fnRGBjy+CfDXytSQB+RwOAi8IP2rFUmvMFZPcjgJa79NeZNnVnRz oXU8Lw4ggx3IiK1jistdQVmk9UjFiCGEv+mrjr060/idGSYbbJN8fi81iA6ZQasT uPLqknvAQsyDnmznoCzSKGsNOgnsz0K7ZarFAy8Vf/xQlrhto14NBPnhgtXNBbUD Ip8e/FpRXT+UHq4q6Au5dCe7FUN16njPFi4gU/ADLfpASHCF/MxaUPEn85flrZya BaKsPSYsUEF21sJ0zoGIFrVdPZ4nJtauYFgwUeBlf2b0HIbr3MKhY23FGlpJm8ct MOyjRvpBB2YqV1mem3PEPAe3zio2apTAn2ig1GCRBBe8MrucjxHllWjYKA2XQUev C3So8UkfHKc1GlKL5vmWt8On3I5T2PjaV7oNiu0Bpo3oj2sS51qLKM5+YW6gHRR3 hCHssHnz+G8/2PUvdnUqGJv95uy2EThcYOG9pz4sUZC/TCeDY2s= =1ejH -----END PGP SIGNATURE----- --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Mon Jul 08 16:01:33 2019 Received: (at 36555) by debbugs.gnu.org; 8 Jul 2019 20:01:33 +0000 Received: from localhost ([127.0.0.1]:59624 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hkZpN-0004NS-Bx for submit@debbugs.gnu.org; Mon, 08 Jul 2019 16:01:33 -0400 Received: from mx.sdf.org ([205.166.94.20]:58676) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hkZpL-0004NK-CR for 36555@debbugs.gnu.org; Mon, 08 Jul 2019 16:01:32 -0400 Received: from Upsilon (mobile-166-171-186-40.mycingular.net [166.171.186.40]) (authenticated (0 bits)) by mx.sdf.org (8.15.2/8.14.5) with ESMTPSA id x68K1SrL008519 (using TLSv1.2 with cipher AES256-GCM-SHA384 (256 bits) verified NO) for <36555@debbugs.gnu.org>; Mon, 8 Jul 2019 20:01:29 GMT From: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) To: 36555@debbugs.gnu.org Subject: Re: [bug#36555] [PATCH 2/2] guix system: Reimplement 'reconfigure'. References: <87imsci9sj.fsf@sdf.lonestar.org> <87ef30i9fl.fsf@sdf.lonestar.org> Date: Mon, 08 Jul 2019 16:01:27 -0400 In-Reply-To: <87ef30i9fl.fsf@sdf.lonestar.org> (Jakob L. Kreuze's message of "Mon, 08 Jul 2019 15:59:58 -0400") Message-ID: <87a7doi9d4.fsf_-_@sdf.lonestar.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha256; protocol="application/pgp-signature" X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 36555 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= Content-Type: text/plain Content-Transfer-Encoding: quoted-printable * guix/scripts/system.scm (switch-to-system) (upgrade-shepherd-services, install-bootloader): Delete variable. * guix/scripts/system.scm (%switch-to-system) (%upgrade-shepherd-services, %install-bootloader): New variable. =2D-- guix/scripts/system.scm | 139 ++++++++++------------------------------ 1 file changed, 34 insertions(+), 105 deletions(-) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 21858ee7d..c58fc0284 100644 =2D-- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -41,6 +41,7 @@ delete-matching-generations) #:use-module (guix graph) #:use-module (guix scripts graph) + #:use-module (guix scripts system reconfigure) #:use-module (guix build utils) #:use-module (guix progress) #:use-module ((guix build syscalls) #:select (terminal-columns)) @@ -179,38 +180,14 @@ TARGET, and register them." =20 (return *unspecified*))) =20 =2D(define* (install-bootloader installer =2D #:key =2D bootcfg bootcfg-file =2D target) +(define (install-bootloader installer bootcfg bootcfg-file target) "Run INSTALLER, a bootloader installation script, with error handling, in %STORE-MONAD." =2D (mlet %store-monad ((installer-drv (if installer =2D (lower-object installer) =2D (return #f))) =2D (bootcfg (lower-object bootcfg))) =2D (let* ((gc-root (string-append target %gc-roots-directory =2D "/bootcfg")) =2D (temp-gc-root (string-append gc-root ".new")) =2D (install (and installer-drv =2D (derivation->output-path installer-drv))) =2D (bootcfg (derivation->output-path bootcfg))) =2D ;; Prepare the symlink to bootloader config file to make sure that= it's =2D ;; a GC root when 'installer-drv' completes (being a bit paranoid.) =2D (switch-symlinks temp-gc-root bootcfg) =2D =2D (unless (false-if-exception =2D (begin =2D (install-boot-config bootcfg bootcfg-file target) =2D (when install =2D (save-load-path-excursion (primitive-load install))))) =2D (delete-file temp-gc-root) =2D (leave (G_ "failed to install bootloader ~a~%") install)) =2D =2D ;; Register bootloader config file as a GC root so that its depend= encies =2D ;; (background image, font, etc.) are not reclaimed. =2D (rename-file temp-gc-root gc-root) =2D (return #t)))) + (mlet* %store-monad ((script (install-bootloader-program installer bootc= fg + bootcfg-file ta= rget)) + (file (lower-object script)) + (_ (built-derivations (list file)))) + (primitive-load (derivation->output-path file)))) =20 (define* (install os-drv target #:key (log-port (current-output-port)) @@ -266,10 +243,8 @@ the ownership of '~a' may be incorrect!~%") (populate os-dir target) =20 (mwhen install-bootloader? =2D (install-bootloader bootloader-installer =2D #:bootcfg bootcfg =2D #:bootcfg-file bootcfg-file =2D #:target target)))))) + (install-bootloader bootloader-installer bootcfg + bootcfg-file target)))))) =20 ;;; @@ -348,69 +323,27 @@ bring the system down." (fold-services (operating-system-services os) #:target-type shepherd-root-service-type))) =20 =2D ;; Arrange to simply emit a warning if the service upgrade fails. =2D (with-shepherd-error-handling =2D (call-with-service-upgrade-info new-services =2D (lambda (to-restart to-unload) =2D (for-each (lambda (unload) =2D (info (G_ "unloading service '~a'...~%") unload) =2D (unload-service unload)) =2D to-unload) =2D =2D (with-monad %store-monad =2D (munless (null? new-services) =2D (let ((new-service-names (map shepherd-service-canonical-na= me new-services)) =2D (to-restart-names (map shepherd-service-canonical-na= me to-restart)) =2D (to-start (filter shepherd-service-auto-star= t? new-services))) =2D (info (G_ "loading new services:~{ ~a~}...~%") new-service= -names) =2D (unless (null? to-restart-names) =2D ;; Listing TO-RESTART-NAMES in the message below wouldn'= t help =2D ;; because many essential services cannot be meaningfully =2D ;; restarted. See . =2D (format #t (G_ "To complete the upgrade, run 'herd resta= rt SERVICE' to stop, =2Dupgrade, and restart each service that was not automatically restarted.\= n"))) =2D (mlet %store-monad ((files (mapm %store-monad =2D (compose lower-object =2D shepherd-service= -file) =2D new-services))) =2D ;; Here we assume that FILES are exactly those that were= computed =2D ;; as part of the derivation that built OS, which is nor= mally the =2D ;; case. =2D (load-services/safe (map derivation->output-path files)) =2D =2D (for-each start-service =2D (map shepherd-service-canonical-name to-start)) =2D (return #t))))))))) =2D =2D(define* (switch-to-system os =2D #:optional (profile %system-profile)) =2D "Make a new generation of PROFILE pointing to the directory of OS, swi= tch to =2Dit atomically, and then run OS's activation script." =2D (mlet* %store-monad ((drv (operating-system-derivation os)) =2D (script (lower-object (operating-system-activatio= n-script os)))) =2D (let* ((system (derivation->output-path drv)) =2D (number (+ 1 (generation-number profile))) =2D (generation (generation-file-name profile number))) =2D (switch-symlinks generation system) =2D (switch-symlinks profile generation) =2D =2D (format #t (G_ "activating system...~%")) =2D =2D ;; The activation script may change $PATH, among others, so protect =2D ;; against that. =2D (save-environment-excursion =2D ;; Tell 'activate-current-system' what the new system is. =2D (setenv "GUIX_NEW_SYSTEM" system) =2D =2D ;; The activation script may modify '%load-path' & co., so protect =2D ;; against that. This is necessary to ensure that =2D ;; 'upgrade-shepherd-services' gets to see the right modules when= it =2D ;; computes derivations with 'gexp->derivation'. =2D (save-load-path-excursion =2D (primitive-load (derivation->output-path script)))) =2D =2D ;; Finally, try to update system services. =2D (upgrade-shepherd-services os)))) + (define (serialize-service service) + (mlet %store-monad ((file (lower-object (shepherd-service-file service= )))) + (return (list (shepherd-service-canonical-name service) + (derivation->output-path file))))) + + (call-with-service-upgrade-info new-services + (lambda (new-services) + (mlet* %store-monad ((target-services (mapm %store-monad serialize-s= ervice + new-services)) + (script (upgrade-services-program target-servic= es)) + (file (lower-object script)) + (_ (built-derivations (list file)))) + (primitive-load (derivation->output-path file)))))) + +(define (switch-to-system os) + "Make a new generation of PROFILE pointing to the directory of OS, switch +to it atomically, and then run OS's activation script." + (mlet* %store-monad ((script (switch-system-program os)) + (file (lower-object script)) + (_ (built-derivations (list file)))) + (primitive-load (derivation->output-path file)))) =20 (define-syntax-rule (unless-file-not-found exp) (catch 'system-error @@ -514,10 +447,7 @@ STORE is an open connection to the store." (built-derivations drvs) ;; Only install bootloader configuration file. Thus, no installe= r is ;; provided here. =2D (install-bootloader #f =2D #:bootcfg bootcfg =2D #:bootcfg-file bootcfg-file =2D #:target target)))))) + (install-bootloader #f bootcfg bootcfg-file target)))))) =20 ;;; @@ -920,11 +850,10 @@ static checks." ((reconfigure) (mbegin %store-monad (switch-to-system os) + (upgrade-shepherd-services os) (mwhen install-bootloader? =2D (install-bootloader bootloader-script =2D #:bootcfg bootcfg =2D #:bootcfg-file bootcfg-file =2D #:target "/")))) + (install-bootloader bootloader-script bootcfg + bootcfg-file (or target "/"))))) ((init) (newline) (format #t (G_ "initializing operating system under '~a'...~%= ") =2D-=20 2.22.0 --=-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQIzBAEBCAAdFiEEa1VJLOiXAjQ2BGSm9Qb9Fp2P2VoFAl0joRcACgkQ9Qb9Fp2P 2Vq3Lg/+NkIh8SdaBViq3A/XpLwYdDNfD9BqHmPMs+WTwdFJ9vsAZ7Yt0HlL5rEM FqOJKvsF0OkUqMysvkT+dqZHlHAmrEzYV4FGdNxDoYGhFi1tNUks93jKvp5nneSr K2iMSgREfeCOZhRbjVzHM4n/zpUQxVIj7ZzWt2PBQGht0HNY+ev4hhcWNd50G1y/ Gng1atSeeKXqczbOqlBSCuaksRMnB8WpO8+C7ngev3XQEOyedPZVi35F6+frshr4 4mgnbDd7e7x9BjC9VEFx629pKY4iRA6dP2Ekhzz+gl92+PPmQDf22asVQy3QR23Q /AYbkPxSS7ix3ehcT9ajane2wrhl4Ld9RlEuLpje2qn9C34GD5YUA4Pn6OF1m2/t 6GoJK74t7WXdGiY8GayeOpWswxMB2sJIdtW4iipfFqzHza+29+DxBZBnZ33Hp0B2 /oA8xF4A/Vpt6pjz/HSDhonTRw4F2V7fcrwHZnM/FH0zjGOpfvTYsM++pWFRuhrQ Kw9kxNkPRLRrgAlFey6rsu/y8MrVqKAwzhssMlidsfXwe1ipXAjaOxstVYfH7lIr sf4GeI/V4Tgxifa+YLTdrv/s3JvEqxIEMgK3cdieExbPNQuRWhTnVJGmS/ldOH12 5bjq1j1DJaM8H6Uovd7uaduz9kS2ci7FOwyBSUVQI0IvulDfnkQ= =vKSc -----END PGP SIGNATURE----- --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Tue Jul 09 09:26:28 2019 Received: (at submit) by debbugs.gnu.org; 9 Jul 2019 13:26:28 +0000 Received: from localhost ([127.0.0.1]:60476 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hkq8a-0006ZD-B6 for submit@debbugs.gnu.org; Tue, 09 Jul 2019 09:26:28 -0400 Received: from lists.gnu.org ([209.51.188.17]:56750) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hkq8X-0006Yr-SC for submit@debbugs.gnu.org; Tue, 09 Jul 2019 09:26:26 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:44028) by lists.gnu.org with esmtp (Exim 4.86_2) (envelope-from ) id 1hkq8W-0002Ib-Vf for guix-patches@gnu.org; Tue, 09 Jul 2019 09:26:25 -0400 X-Spam-Checker-Version: SpamAssassin 3.3.2 (2011-06-06) on eggs.gnu.org X-Spam-Level: X-Spam-Status: No, score=0.8 required=5.0 tests=BAYES_50 autolearn=disabled version=3.3.2 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1hkq8W-0008H0-1G for guix-patches@gnu.org; Tue, 09 Jul 2019 09:26:24 -0400 Received: from dustycloud.org ([2600:3c02::f03c:91ff:feae:cb51]:58532) by eggs.gnu.org with esmtps (TLS1.0:DHE_RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1hkq8V-0008EV-Ss for guix-patches@gnu.org; Tue, 09 Jul 2019 09:26:23 -0400 Received: from twig (localhost [127.0.0.1]) by dustycloud.org (Postfix) with ESMTPS id 9254026698; Tue, 9 Jul 2019 09:26:20 -0400 (EDT) References: <87imsci9sj.fsf@sdf.lonestar.org> User-agent: mu4e 1.2.0; emacs 26.2 From: Christopher Lemmer Webber To: guix-patches@gnu.org Subject: Re: [bug#36555] [PATCH 0/2] Refactor out common behavior for system reconfiguration. In-reply-to: <87imsci9sj.fsf@sdf.lonestar.org> Date: Tue, 09 Jul 2019 09:26:19 -0400 Message-ID: <87imsbtk3o.fsf@dustycloud.org> MIME-Version: 1.0 Content-Type: text/plain X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-Received-From: 2600:3c02::f03c:91ff:feae:cb51 X-Spam-Score: -1.3 (-) X-Debbugs-Envelope-To: submit Cc: 36555@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -2.3 (--) Jakob L. Kreuze writes: > Hello, Guix! > > This is the preliminary version of a patch series to turn the behavior > common between 'guix deploy' and 'guix system reconfigure' into a module > that both can use. I am submitting it as-is both for comments and for > tracking the refactoring effort. > > Note that this is _not_ ready to be merged. There are several things > that I need to do before I would consider it ready for upstream Guix: I just did a brief scan of the patches you submitted. I don't have any comments beyond your TODO list. It's much clearer to me what's going on with those commits beings quashed now, horray! Look forward to more updates, keep it up Jakob! :) From debbugs-submit-bounces@debbugs.gnu.org Tue Jul 09 15:07:36 2019 Received: (at 36555) by debbugs.gnu.org; 9 Jul 2019 19:07:36 +0000 Received: from localhost ([127.0.0.1]:34264 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hkvSh-00044U-Sj for submit@debbugs.gnu.org; Tue, 09 Jul 2019 15:07:36 -0400 Received: from ol.sdf.org ([205.166.94.20]:58342 helo=mx.sdf.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hkvSe-00044J-A4 for 36555@debbugs.gnu.org; Tue, 09 Jul 2019 15:07:33 -0400 Received: from Upsilon (mobile-166-171-185-38.mycingular.net [166.171.185.38]) (authenticated (0 bits)) by mx.sdf.org (8.15.2/8.14.5) with ESMTPSA id x69J7MLs003653 (using TLSv1.2 with cipher AES256-GCM-SHA384 (256 bits) verified NO); Tue, 9 Jul 2019 19:07:30 GMT From: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) To: Christopher Lemmer Webber Subject: Re: [bug#36555] [PATCH v2 0/3] Refactor out common behavior for system reconfiguration. In-Reply-To: <87imsbtk3o.fsf@dustycloud.org> (Christopher Lemmer Webber's message of "Tue, 09 Jul 2019 09:26:19 -0400") References: <87imsci9sj.fsf@sdf.lonestar.org> <87imsbtk3o.fsf@dustycloud.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2 (gnu/linux) Date: Tue, 09 Jul 2019 15:07:20 -0400 Message-ID: <875zobvxg7.fsf_-_@sdf.lonestar.org> MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha256; protocol="application/pgp-signature" X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 36555 Cc: 36555@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= Content-Type: text/plain Content-Transfer-Encoding: quoted-printable I've implemented the features missing from 'switch-system-program', 'upgrade-services-program', and 'install-bootloader-program' and successful= ly ran the new 'guix system reconfigure' in a virtual machine. Also tests for 'switch-system-program' have been implement, but I realized = that I'll need to be a bit more clever to test 'upgrade-services-program' and 'install-bootloader-program' -- the latter, in particular, requires boot parameters from the machine being tested at build time, so I suspect I'll h= ave to provide some constant boot parameters to avoid spinning up the virtual machine outside of the test derivation. Anyway, I've reverted a change in my previous patch series that updated 'upgrade-shepherd-services' to use 'call-with-service-upgrade-info', since = I'd neglected to check the parameters that it passes to 'mproc'. Basically, it = _has_ to be called from 'upgrade-services-program', which already has some functionality comparible to 'shepherd-service-upgrade'. If someone could ta= ke a look and ensure that it sufficiently implements 'shepherd-service-upgrade',= that would be greatly appreciated. On that note, I've changed 'upgrade-services-program' to collect Shepherd e= rror messages as it goes. Is this the right way to go about it? My thinking is t= hat, this way, both 'guix system reconfigure' and 'guix deploy' will be able to report Shepherd errors without stopping half-way through because Shepherd e= rrors out. Either way, I believe this fixes the issue that Ricardo was having with 'guix deploy'. Regards, Jakob Jakob L. Kreuze (3): guix system: Add 'reconfigure' module. guix system: Reimplement 'reconfigure'. tests: Add reconfigure system test. Makefile.am | 1 + gnu/local.mk | 1 + gnu/machine/ssh.scm | 229 +++++++--------------------- gnu/tests/reconfigure.scm | 99 ++++++++++++ guix/scripts/system.scm | 143 +++++------------ guix/scripts/system/reconfigure.scm | 170 +++++++++++++++++++++ 6 files changed, 364 insertions(+), 279 deletions(-) create mode 100644 gnu/tests/reconfigure.scm create mode 100644 guix/scripts/system/reconfigure.scm =2D-=20 2.22.0 --=-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQIzBAEBCAAdFiEEa1VJLOiXAjQ2BGSm9Qb9Fp2P2VoFAl0k5egACgkQ9Qb9Fp2P 2VrBpw//ch4SAJzvHIlDoVkygwlH/WuX/FeAQQZujDcgwj/m86sx4Vtq//FyD9oH g53lI4AONVAVvURmVbcHTzimArSQvpK12iJe1HC5iEFMogsLQAK/esHtDFOC60CQ u1JyWlYdyeAkQOM9gbFUaN9FOlSFk4pfP4NJMGatqi/2OnRQpCT6v66pPF1rXAb+ MYq3aj/XGNMwTVx98IvT762RBbb7tjEoMmaUUemF5D8EIGm8chzQgApQx5LwJpKL KQOOL8AHcZJE+5mAN+0WI3AytJlZQAxgUmihcgdmbqxypgRvwgk8y+GOdbXjAagH C9bv0r1AkucAhwaNm97KFNPDAThqZQJeRPmAk1fwKkA4i9u1saCt1GYf5tCCyQb1 Jm0a7qjzmnMQjzbt/RZGY/jwgj2UNqoAnZYbTpmQSij8z2kSj2D/qmvFeSfhz8RX c4+Dfvseo75KIVeLA9ao1M6PkNUPTFkdJsM8HZFcPWPh6jCPHN//Tg06FKSvy5QZ bcoscowpie6PpA0yz0AupVBUObpi4ZHTIPoUdYr4mwvUXRGqBd5DxQC3r3zqkbvN I1cvSUwWhJazdHsM9QzwRPOmbpfpExjB0uI63JroQVMCkmBoXrG+fqmtWN19H49z AXKZ3i/NQaFbKmAWxZK8/zxvGFm6PU97mbh+LygJW57Cjl4hCI4= =qOlU -----END PGP SIGNATURE----- --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Tue Jul 09 15:08:26 2019 Received: (at 36555) by debbugs.gnu.org; 9 Jul 2019 19:08:26 +0000 Received: from localhost ([127.0.0.1]:34275 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hkvTQ-00046I-S6 for submit@debbugs.gnu.org; Tue, 09 Jul 2019 15:08:25 -0400 Received: from ol.sdf.org ([205.166.94.20]:58119 helo=mx.sdf.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hkvTO-00046A-Bu for 36555@debbugs.gnu.org; Tue, 09 Jul 2019 15:08:20 -0400 Received: from Upsilon (mobile-166-171-185-38.mycingular.net [166.171.185.38]) (authenticated (0 bits)) by mx.sdf.org (8.15.2/8.14.5) with ESMTPSA id x69J8DEM029743 (using TLSv1.2 with cipher AES256-GCM-SHA384 (256 bits) verified NO); Tue, 9 Jul 2019 19:08:15 GMT From: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) To: Christopher Lemmer Webber Subject: Re: [bug#36555] [PATCH v2 1/3] guix system: Add 'reconfigure' module. References: <87imsci9sj.fsf@sdf.lonestar.org> <87imsbtk3o.fsf@dustycloud.org> <875zobvxg7.fsf_-_@sdf.lonestar.org> Date: Tue, 09 Jul 2019 15:08:11 -0400 In-Reply-To: <875zobvxg7.fsf_-_@sdf.lonestar.org> (Jakob L. Kreuze's message of "Tue, 09 Jul 2019 15:07:20 -0400") Message-ID: <871ryzvxes.fsf_-_@sdf.lonestar.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha256; protocol="application/pgp-signature" X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 36555 Cc: 36555@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable * guix/scripts/system/reconfigure.scm: New file. * Makefile.am (MODULES): Add it. * guix/scripts/system.scm (bootloader-installer-script): Export variable. * gnu/machine/ssh.scm (switch-to-system, upgrade-shepherd-services) (install-bootloader): Delete variable. * gnu/machine/ssh.scm (deploy-managed-host): Rewrite procedure. =2D-- Makefile.am | 1 + gnu/machine/ssh.scm | 229 +++++++--------------------- guix/scripts/system.scm | 1 + guix/scripts/system/reconfigure.scm | 170 +++++++++++++++++++++ 4 files changed, 228 insertions(+), 173 deletions(-) create mode 100644 guix/scripts/system/reconfigure.scm diff --git a/Makefile.am b/Makefile.am index dd7720e87..58a96d348 100644 =2D-- a/Makefile.am +++ b/Makefile.am @@ -245,6 +245,7 @@ MODULES =3D \ guix/scripts/describe.scm \ guix/scripts/system.scm \ guix/scripts/system/search.scm \ + guix/scripts/system/reconfigure.scm \ guix/scripts/lint.scm \ guix/scripts/challenge.scm \ guix/scripts/import/crate.scm \ diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm index a7d1a967a..5bac966ad 100644 =2D-- a/gnu/machine/ssh.scm +++ b/gnu/machine/ssh.scm @@ -30,10 +30,13 @@ #:use-module (guix monads) #:use-module (guix records) #:use-module (guix remote) + #:use-module (guix scripts system) + #:use-module (guix scripts system reconfigure) #:use-module (guix ssh) #:use-module (guix store) #:use-module (ice-9 match) #:use-module (srfi srfi-19) + #:use-module (srfi srfi-26) #:use-module (srfi srfi-35) #:export (managed-host-environment-type =20 @@ -105,118 +108,6 @@ an environment type of 'managed-host." ;;; System deployment. ;;; =20 =2D(define (switch-to-system machine) =2D "Monadic procedure creating a new generation on MACHINE and execute the =2Dactivation script for the new system configuration." =2D (define (remote-exp drv script) =2D (with-extensions (list guile-gcrypt) =2D (with-imported-modules (source-module-closure '((guix config) =2D (guix profiles) =2D (guix utils))) =2D #~(begin =2D (use-modules (guix config) =2D (guix profiles) =2D (guix utils)) =2D =2D (define %system-profile =2D (string-append %state-directory "/profiles/system")) =2D =2D (let* ((system #$drv) =2D (number (1+ (generation-number %system-profile))) =2D (generation (generation-file-name %system-profile num= ber))) =2D (switch-symlinks generation system) =2D (switch-symlinks %system-profile generation) =2D ;; The implementation of 'guix system reconfigure' saves t= he =2D ;; load path and environment here. This is unnecessary here =2D ;; because each invocation of 'remote-eval' runs in a dist= inct =2D ;; Guile REPL. =2D (setenv "GUIX_NEW_SYSTEM" system) =2D ;; The activation script may write to stdout, which confus= es =2D ;; 'remote-eval' when it attempts to read a result from the =2D ;; remote REPL. We work around this by forcing the output = to a =2D ;; string. =2D (with-output-to-string =2D (lambda () =2D (primitive-load #$script)))))))) =2D =2D (let* ((os (machine-system machine)) =2D (script (operating-system-activation-script os))) =2D (mlet* %store-monad ((drv (operating-system-derivation os))) =2D (machine-remote-eval machine (remote-exp drv script))))) =2D =2D;; XXX: Currently, this does NOT attempt to restart running services. Th= is is =2D;; also the case with 'guix system reconfigure'. =2D;; =2D;; See . =2D(define (upgrade-shepherd-services machine) =2D "Monadic procedure unloading and starting services on the remote as ne= eded =2Dto realize the MACHINE's system configuration." =2D (define target-services =2D ;; Monadic expression evaluating to a list of (name output-path) pai= rs for =2D ;; all of MACHINE's services. =2D (mapm %store-monad =2D (lambda (service) =2D (mlet %store-monad ((file ((compose lower-object =2D shepherd-service-file) =2D service))) =2D (return (list (shepherd-service-canonical-name service) =2D (derivation->output-path file))))) =2D (service-value =2D (fold-services (operating-system-services (machine-system mac= hine)) =2D #:target-type shepherd-root-service-type)))) =2D =2D (define (remote-exp target-services) =2D (with-imported-modules '((gnu services herd)) =2D #~(begin =2D (use-modules (gnu services herd) =2D (srfi srfi-1)) =2D =2D (define running =2D (filter live-service-running (current-services))) =2D =2D (define (essential? service) =2D ;; Return #t if SERVICE is essential and should not be unloa= ded =2D ;; under any circumstance. =2D (memq (first (live-service-provision service)) =2D '(root shepherd))) =2D =2D (define (obsolete? service) =2D ;; Return #t if SERVICE can be safely unloaded. =2D (and (not (essential? service)) =2D (every (lambda (requirements) =2D (not (memq (first (live-service-provision serv= ice)) =2D requirements))) =2D (map live-service-requirement running)))) =2D =2D (define to-unload =2D (filter obsolete? =2D (remove (lambda (service) =2D (memq (first (live-service-provision servi= ce)) =2D (map first '#$target-services))) =2D running))) =2D =2D (define to-start =2D (remove (lambda (service-pair) =2D (memq (first service-pair) =2D (map (compose first live-service-provision) =2D running))) =2D '#$target-services)) =2D =2D ;; Unload obsolete services. =2D (for-each (lambda (service) =2D (false-if-exception =2D (unload-service service))) =2D to-unload) =2D =2D ;; Load the service files for any new services and start them. =2D (load-services/safe (map second to-start)) =2D (for-each start-service (map first to-start)) =2D =2D #t))) =2D =2D (mlet %store-monad ((target-services target-services)) =2D (machine-remote-eval machine (remote-exp target-services)))) =2D (define (machine-boot-parameters machine) "Monadic procedure returning a list of 'boot-parameters' for the generat= ions of MACHINE's system profile, ordered from most recent to oldest." @@ -275,71 +166,63 @@ of MACHINE's system profile, ordered from most recent= to oldest." (boot-parameters-kernel-arguments params)))))))) generations)))) =20 =2D(define (install-bootloader machine) =2D "Create a bootloader entry for the new system generation on MACHINE, a= nd =2Dconfigure the bootloader to boot that generation by default." =2D (define bootloader-installer-script =2D (@@ (guix scripts system) bootloader-installer-script)) =2D =2D (define (remote-exp installer bootcfg bootcfg-file) =2D (with-extensions (list guile-gcrypt) =2D (with-imported-modules (source-module-closure '((gnu build install) =2D (guix store) =2D (guix utils))) =2D #~(begin =2D (use-modules (gnu build install) =2D (guix store) =2D (guix utils)) =2D (let* ((gc-root (string-append "/" %gc-roots-directory "/boo= tcfg")) =2D (temp-gc-root (string-append gc-root ".new"))) =2D =2D (switch-symlinks temp-gc-root gc-root) =2D =2D (unless (false-if-exception =2D (begin =2D ;; The implementation of 'guix system reconfigu= re' =2D ;; saves the load path here. This is unnecessar= y here =2D ;; because each invocation of 'remote-eval' run= s in a =2D ;; distinct Guile REPL. =2D (install-boot-config #$bootcfg #$bootcfg-file "= /") =2D ;; The installation script may write to stdout,= which =2D ;; confuses 'remote-eval' when it attempts to r= ead a =2D ;; result from the remote REPL. We work around = this =2D ;; by forcing the output to a string. =2D (with-output-to-string =2D (lambda () =2D (primitive-load #$installer))))) =2D (delete-file temp-gc-root) =2D (error "failed to install bootloader")) =2D =2D (rename-file temp-gc-root gc-root) =2D #t))))) =2D =2D (mlet* %store-monad ((boot-parameters (machine-boot-parameters machine= ))) =2D (let* ((os (machine-system machine)) =2D (bootloader ((compose bootloader-configuration-bootloader =2D operating-system-bootloader) =2D os)) =2D (bootloader-target (bootloader-configuration-target =2D (operating-system-bootloader os))) =2D (installer (bootloader-installer-script =2D (bootloader-installer bootloader) =2D (bootloader-package bootloader) =2D bootloader-target =2D "/")) =2D (menu-entries (map boot-parameters->menu-entry boot-parameter= s)) =2D (bootcfg (operating-system-bootcfg os menu-entries)) =2D (bootcfg-file (bootloader-configuration-file bootloader))) =2D (machine-remote-eval machine (remote-exp installer bootcfg bootcfg= -file))))) =2D (define (deploy-managed-host machine) "Internal implementation of 'deploy-machine' for MACHINE instances with = an environment type of 'managed-host." + (define target-services + (service-value + (fold-services (operating-system-services (machine-system machine)) + #:target-type shepherd-root-service-type))) + + (define (serialize-service service) + "Monadic procedure serializing SERVICE, a ." + (mlet %store-monad ((file (lower-object (shepherd-service-file service= )))) + (return (list (shepherd-service-canonical-name service) + (derivation->output-path file))))) + + (define (run-switch-to-system machine) + "Monadic procedure serializing the items in MACHINE necessary to build= a +G-Expression with 'switch-to-system'." + (mlet %store-monad ((script (switch-system-program (machine-system mac= hine)))) + (machine-remote-eval machine #~(primitive-load #$script)))) + + (define (run-upgrade-shepherd-services machine) + "Monadic procedure serializing the items in MACHINE necessary to build= a +G-Expression with 'upgrade-shepherd-services'." + (mlet* %store-monad ((services (mapm %store-monad serialize-service + target-services)) + (script (upgrade-services-program services))) + (machine-remote-eval machine #~(primitive-load #$script)))) + + (define (run-install-bootloader machine) + "Monadic procedure serializing the items in MACHINE necessary to build= a +G-Expression with 'install-bootloader'." + (mlet %store-monad ((boot-parameters (machine-boot-parameters machine)= )) + (let* ((os (machine-system machine)) + (bootloader ((compose bootloader-configuration-bootloader + operating-system-bootloader) + os)) + (target (bootloader-configuration-target + (operating-system-bootloader os))) + (installer (bootloader-installer-script + (bootloader-installer bootloader) + (bootloader-package bootloader) + target + "/")) + (menu-entries (map boot-parameters->menu-entry boot-parameter= s)) + (bootcfg (operating-system-bootcfg os menu-entries)) + (bootcfg-file (bootloader-configuration-file bootloader))) + (mlet %store-monad ((script (install-bootloader-program installer + bootcfg + bootcfg-fi= le + "/"))) + (machine-remote-eval machine #~(primitive-load #$script)))))) + (maybe-raise-unsupported-configuration-error machine) =2D (mbegin %store-monad =2D (switch-to-system machine) =2D (upgrade-shepherd-services machine) =2D (install-bootloader machine))) + (mapm %store-monad (cut <> machine) + (list run-switch-to-system + run-upgrade-shepherd-services + run-install-bootloader))) =20 ;;; diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 60c1ca5c9..21858ee7d 100644 =2D-- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -70,6 +70,7 @@ #:use-module (ice-9 match) #:use-module (rnrs bytevectors) #:export (guix-system + bootloader-installer-script read-operating-system)) =20 diff --git a/guix/scripts/system/reconfigure.scm b/guix/scripts/system/reco= nfigure.scm new file mode 100644 index 000000000..9491bde34 =2D-- /dev/null +++ b/guix/scripts/system/reconfigure.scm @@ -0,0 +1,170 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright =C2=A9 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Court=C3= =A8s +;;; Copyright =C2=A9 2016 Alex Kost +;;; Copyright =C2=A9 2016, 2017, 2018 Chris Marusich +;;; Copyright =C2=A9 2017 Mathieu Othacehe +;;; Copyright =C2=A9 2018 Ricardo Wurmus +;;; Copyright =C2=A9 2019 Christopher Baines +;;; 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 (guix scripts system reconfigure) + #:autoload (gnu packages gnupg) (guile-gcrypt) + #:use-module (gnu system) + #:use-module (guix gexp) + #:use-module (guix modules) + #:export (switch-system-program + upgrade-services-program + install-bootloader-program)) + +;;; Commentary: +;;; +;;; This module implements the "effectful" parts of system +;;; reconfiguration. Although building a system derivation is a pure +;;; operation, a number of impure operations must be carried out for the +;;; system configuration to be realized -- chiefly, creation of generation +;;; symlinks and invocation of activation scripts. +;;; +;;; Code: + +(define* (switch-system-program os #:optional profile) + "Return as a monadic value a derivation to build a scheme file that, upon +being evaluated, will create a new generation of PROFILE pointing to the +directory of OS, switch to it atomically, and run OS's activation script, +returning any textual output produced by the activation script as a string= ." + (gexp->script + "switch-to-system.scm" + (with-extensions (list guile-gcrypt) + (with-imported-modules (source-module-closure '((guix config) + (guix profiles) + (guix utils))) + #~(begin + (use-modules (guix config) + (guix profiles) + (guix utils)) + + (define profile + (or #$profile (string-append %state-directory "/profiles/syst= em"))) + + (let* ((number (1+ (generation-number profile))) + (generation (generation-file-name profile number))) + (switch-symlinks generation #$os) + (switch-symlinks profile generation) + (setenv "GUIX_NEW_SYSTEM" #$os) + (with-output-to-string + (lambda () + (primitive-load + #$(operating-system-activation-script os)))))))))) + +;; XXX: Currently, this does NOT attempt to restart running services. See +;; for details. +(define (upgrade-services-program target-services) + "Return as a monadic value a derivation to build a scheme file that, upon +being evaluated, will upgrade the Shepherd (PID 1) by unloading obsolete +services and loading new services. TARGET-SERVICES is a list +of (shepherd-service-canonical-name, shepherd-service-file) pairs used for +determining which services are obsolete, as well as which are new." + (gexp->script + "upgrade-shepherd-services.scm" + (with-imported-modules '((gnu services herd)) + #~(begin + (use-modules (gnu services herd) + (srfi srfi-1)) + + (define (call-with-shepherd-error-handling proc) + (lambda (service) + (catch 'system-error + (lambda () + (proc service) + #f) + (lambda (key proc format-string format-args errno . rest) + (apply format #f format-string format-args))))) + + (define running + (filter live-service-running (current-services))) + + (define (essential? service) + ;; Return #t if SERVICE is essential and should not be unloaded + ;; under any circumstance. + (memq (first (live-service-provision service)) + '(root shepherd))) + + (define (obsolete? service) + ;; Return #t if SERVICE can be safely unloaded. + (and (not (essential? service)) + (every (lambda (requirements) + (not (memq (first (live-service-provision service)) + requirements))) + (map live-service-requirement running)))) + + (define to-unload + (filter obsolete? + (remove (lambda (service) + (memq (first (live-service-provision service)) + (map first '#$target-services))) + running))) + + (define to-start + (remove (lambda (service-pair) + (memq (first service-pair) + (map (compose first live-service-provision) + running))) + '#$target-services)) + + ;; Load the service files for any new services. + (load-services/safe (map second to-start)) + + ;; Unload obsolete services and start new services. + (filter string? + (append (map (call-with-shepherd-error-handling unload-ser= vice) + to-unload) + (map (call-with-shepherd-error-handling start-serv= ice) + (map first to-start)))))))) + +(define (install-bootloader-program installer-script bootcfg bootcfg-file = target) + "Return as a monadic value a derivation to build a scheme file that, upon +being evaluated, will install BOOTCFG to BOOTCFG-FILE, a target file name,= on +TARGET, a mount point, and subsequently run INSTALLER-SCRIPT, returning any +textual output produced by the installer script as a string." + (gexp->script + "install-bootloader.scm" + (with-extensions (list guile-gcrypt) + (with-imported-modules (source-module-closure '((gnu build install) + (guix store) + (guix utils))) + #~(begin + (use-modules (gnu build install) + (guix store) + (guix utils)) + (let* ((gc-root (string-append #$target %gc-roots-directory "/b= ootcfg")) + (temp-gc-root (string-append gc-root ".new"))) + + (switch-symlinks temp-gc-root gc-root) + + (let ((installer-result + (false-if-exception + (begin + (install-boot-config #$bootcfg #$bootcfg-file #$tar= get) + (with-output-to-string + (lambda () + (when #$installer-script + (primitive-load #$installer-script)))))))) + (unless installer-result + (delete-file temp-gc-root) + (error "failed to install bootloader")) + (rename-file temp-gc-root gc-root) + installer-result))))))) =2D-=20 2.22.0 --=-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQIzBAEBCAAdFiEEa1VJLOiXAjQ2BGSm9Qb9Fp2P2VoFAl0k5hwACgkQ9Qb9Fp2P 2VoclhAAlpMV2G3qhL4/IUEyMK0sqzTLwWplx5YzvAjOYIDf7aJ2tEWPkG4TJmZM A+04y7MqAcJMPQepxETenRCUi8QkLv7GxqIFZdU0YX4Dv8GNH+YfefqlkvLsvCQF Z5jTvYgqnkPZxuXXKrBUGgp0hdCphpf84uM/yJc28B17Y74byC4shZObmA9G0G89 5I14mkcK70blOmDDxA0egrdEuuxONTi8kdVPam4AxDim9ju/kojnyaguzLhl6sI4 6Z2agT0HmwE8RP7CgTIPPUL/jSFOf8MIvPRcvHOaVfznxYDQnZ3IdmVJKR7N+xz8 Ys0pCBmp0uZr+cUMczFaLSQeZbrF/OazE3QhdY3XBb7MpsoJqycUGiYkgfd/ALd/ +xDi/LTMlCuBENYnPJqSb5LZ0XXjnBFyoZYfE+4c9J2Q3yOTVObIQXKfyWOxFNw/ G8ti8g7SQW2rYV/B7o05biA5ZRSlLKRSFPdj3/5iJIis3ZkZBAj9mPwj8+LPkBG3 uRtiEndzodiBI2IRx0ju2JkeeRDiEVjk2fefTIE2clkD20hj7kGrVGz/D0JnoFEC V7UZ8cyBEzTZBtJ/F8sz5yfVgWhscJKf/AscYMjJ12EWh5/gJjcEvr9zK5HUy7uc LZokuhDhTc8AQWhgO8gjmcIggJTAELVkK23iIvXe3izD2vKDy9Q= =jONW -----END PGP SIGNATURE----- --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Tue Jul 09 15:09:08 2019 Received: (at 36555) by debbugs.gnu.org; 9 Jul 2019 19:09:08 +0000 Received: from localhost ([127.0.0.1]:34279 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hkvUC-00047i-2Y for submit@debbugs.gnu.org; Tue, 09 Jul 2019 15:09:08 -0400 Received: from ol.sdf.org ([205.166.94.20]:57869 helo=mx.sdf.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hkvUA-00047Z-QX for 36555@debbugs.gnu.org; Tue, 09 Jul 2019 15:09:07 -0400 Received: from Upsilon (mobile-166-171-185-38.mycingular.net [166.171.185.38]) (authenticated (0 bits)) by mx.sdf.org (8.15.2/8.14.5) with ESMTPSA id x69J92WA002169 (using TLSv1.2 with cipher AES256-GCM-SHA384 (256 bits) verified NO); Tue, 9 Jul 2019 19:09:03 GMT From: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) To: Christopher Lemmer Webber Subject: Re: [bug#36555] [PATCH v2 2/3] guix system: Reimplement 'reconfigure'. References: <87imsci9sj.fsf@sdf.lonestar.org> <87imsbtk3o.fsf@dustycloud.org> <875zobvxg7.fsf_-_@sdf.lonestar.org> <871ryzvxes.fsf_-_@sdf.lonestar.org> Date: Tue, 09 Jul 2019 15:09:00 -0400 In-Reply-To: <871ryzvxes.fsf_-_@sdf.lonestar.org> (Jakob L. Kreuze's message of "Tue, 09 Jul 2019 15:08:11 -0400") Message-ID: <87wogruisz.fsf_-_@sdf.lonestar.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha256; protocol="application/pgp-signature" X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 36555 Cc: 36555@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= Content-Type: text/plain Content-Transfer-Encoding: quoted-printable * guix/scripts/system.scm (switch-to-system) (upgrade-shepherd-services, install-bootloader): Delete variable. * guix/scripts/system.scm (%switch-to-system) (%upgrade-shepherd-services, %install-bootloader): New variable. =2D-- guix/scripts/system.scm | 142 ++++++++++------------------------------ 1 file changed, 36 insertions(+), 106 deletions(-) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 21858ee7d..a1807c39c 100644 =2D-- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -41,6 +41,7 @@ delete-matching-generations) #:use-module (guix graph) #:use-module (guix scripts graph) + #:use-module (guix scripts system reconfigure) #:use-module (guix build utils) #:use-module (guix progress) #:use-module ((guix build syscalls) #:select (terminal-columns)) @@ -179,38 +180,14 @@ TARGET, and register them." =20 (return *unspecified*))) =20 =2D(define* (install-bootloader installer =2D #:key =2D bootcfg bootcfg-file =2D target) +(define (install-bootloader installer bootcfg bootcfg-file target) "Run INSTALLER, a bootloader installation script, with error handling, in %STORE-MONAD." =2D (mlet %store-monad ((installer-drv (if installer =2D (lower-object installer) =2D (return #f))) =2D (bootcfg (lower-object bootcfg))) =2D (let* ((gc-root (string-append target %gc-roots-directory =2D "/bootcfg")) =2D (temp-gc-root (string-append gc-root ".new")) =2D (install (and installer-drv =2D (derivation->output-path installer-drv))) =2D (bootcfg (derivation->output-path bootcfg))) =2D ;; Prepare the symlink to bootloader config file to make sure that= it's =2D ;; a GC root when 'installer-drv' completes (being a bit paranoid.) =2D (switch-symlinks temp-gc-root bootcfg) =2D =2D (unless (false-if-exception =2D (begin =2D (install-boot-config bootcfg bootcfg-file target) =2D (when install =2D (save-load-path-excursion (primitive-load install))))) =2D (delete-file temp-gc-root) =2D (leave (G_ "failed to install bootloader ~a~%") install)) =2D =2D ;; Register bootloader config file as a GC root so that its depend= encies =2D ;; (background image, font, etc.) are not reclaimed. =2D (rename-file temp-gc-root gc-root) =2D (return #t)))) + (mlet* %store-monad ((script (install-bootloader-program installer bootc= fg + bootcfg-file ta= rget)) + (file (lower-object script)) + (_ (built-derivations (list file)))) + (return (primitive-load (derivation->output-path file))))) =20 (define* (install os-drv target #:key (log-port (current-output-port)) @@ -266,10 +243,8 @@ the ownership of '~a' may be incorrect!~%") (populate os-dir target) =20 (mwhen install-bootloader? =2D (install-bootloader bootloader-installer =2D #:bootcfg bootcfg =2D #:bootcfg-file bootcfg-file =2D #:target target)))))) + (install-bootloader bootloader-installer bootcfg + bootcfg-file target)))))) =20 ;;; @@ -343,74 +318,31 @@ services specified in OS and not currently running. This is currently very conservative in that it does not stop or unload any running service. Unloading or stopping the wrong service ('udev', say) co= uld bring the system down." =2D (define new-services + (define target-services (service-value (fold-services (operating-system-services os) #:target-type shepherd-root-service-type))) =20 =2D ;; Arrange to simply emit a warning if the service upgrade fails. =2D (with-shepherd-error-handling =2D (call-with-service-upgrade-info new-services =2D (lambda (to-restart to-unload) =2D (for-each (lambda (unload) =2D (info (G_ "unloading service '~a'...~%") unload) =2D (unload-service unload)) =2D to-unload) =2D =2D (with-monad %store-monad =2D (munless (null? new-services) =2D (let ((new-service-names (map shepherd-service-canonical-na= me new-services)) =2D (to-restart-names (map shepherd-service-canonical-na= me to-restart)) =2D (to-start (filter shepherd-service-auto-star= t? new-services))) =2D (info (G_ "loading new services:~{ ~a~}...~%") new-service= -names) =2D (unless (null? to-restart-names) =2D ;; Listing TO-RESTART-NAMES in the message below wouldn'= t help =2D ;; because many essential services cannot be meaningfully =2D ;; restarted. See . =2D (format #t (G_ "To complete the upgrade, run 'herd resta= rt SERVICE' to stop, =2Dupgrade, and restart each service that was not automatically restarted.\= n"))) =2D (mlet %store-monad ((files (mapm %store-monad =2D (compose lower-object =2D shepherd-service= -file) =2D new-services))) =2D ;; Here we assume that FILES are exactly those that were= computed =2D ;; as part of the derivation that built OS, which is nor= mally the =2D ;; case. =2D (load-services/safe (map derivation->output-path files)) =2D =2D (for-each start-service =2D (map shepherd-service-canonical-name to-start)) =2D (return #t))))))))) =2D =2D(define* (switch-to-system os =2D #:optional (profile %system-profile)) =2D "Make a new generation of PROFILE pointing to the directory of OS, swi= tch to =2Dit atomically, and then run OS's activation script." =2D (mlet* %store-monad ((drv (operating-system-derivation os)) =2D (script (lower-object (operating-system-activatio= n-script os)))) =2D (let* ((system (derivation->output-path drv)) =2D (number (+ 1 (generation-number profile))) =2D (generation (generation-file-name profile number))) =2D (switch-symlinks generation system) =2D (switch-symlinks profile generation) =2D =2D (format #t (G_ "activating system...~%")) =2D =2D ;; The activation script may change $PATH, among others, so protect =2D ;; against that. =2D (save-environment-excursion =2D ;; Tell 'activate-current-system' what the new system is. =2D (setenv "GUIX_NEW_SYSTEM" system) =2D =2D ;; The activation script may modify '%load-path' & co., so protect =2D ;; against that. This is necessary to ensure that =2D ;; 'upgrade-shepherd-services' gets to see the right modules when= it =2D ;; computes derivations with 'gexp->derivation'. =2D (save-load-path-excursion =2D (primitive-load (derivation->output-path script)))) =2D =2D ;; Finally, try to update system services. =2D (upgrade-shepherd-services os)))) + (define (serialize-service service) + "Monadic procedure serializing SERVICE, a ." + (mlet %store-monad ((file (lower-object (shepherd-service-file service= )))) + (return (list (shepherd-service-canonical-name service) + (derivation->output-path file))))) + + (mlet* %store-monad ((services (mapm %store-monad serialize-service + target-services)) + (script (upgrade-services-program services)) + (file (lower-object script)) + (_ (built-derivations (list file)))) + (return (primitive-load (derivation->output-path file))))) + +(define (switch-to-system os) + "Make a new generation of PROFILE pointing to the directory of OS, switch +to it atomically, and then run OS's activation script." + (mlet* %store-monad ((script (switch-system-program os)) + (file (lower-object script)) + (_ (built-derivations (list file)))) + (return (primitive-load (derivation->output-path file))))) =20 (define-syntax-rule (unless-file-not-found exp) (catch 'system-error @@ -514,10 +446,7 @@ STORE is an open connection to the store." (built-derivations drvs) ;; Only install bootloader configuration file. Thus, no installe= r is ;; provided here. =2D (install-bootloader #f =2D #:bootcfg bootcfg =2D #:bootcfg-file bootcfg-file =2D #:target target)))))) + (install-bootloader #f bootcfg bootcfg-file target)))))) =20 ;;; @@ -918,13 +847,14 @@ static checks." =20 (case action ((reconfigure) + (newline) + (format #t (G_ "activating system...~%")) (mbegin %store-monad (switch-to-system os) + (upgrade-shepherd-services os) (mwhen install-bootloader? =2D (install-bootloader bootloader-script =2D #:bootcfg bootcfg =2D #:bootcfg-file bootcfg-file =2D #:target "/")))) + (install-bootloader bootloader-script bootcfg + bootcfg-file (or target "/"))))) ((init) (newline) (format #t (G_ "initializing operating system under '~a'...~%= ") =2D-=20 2.22.0 --=-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQIzBAEBCAAdFiEEa1VJLOiXAjQ2BGSm9Qb9Fp2P2VoFAl0k5kwACgkQ9Qb9Fp2P 2Vp13A//Yqi1YnqOAKoTZj9mZMwHm+3b9YQtTArupj7Kl7PKT69umYlCdJ2+5XEh 5GlmZzC9iZoe0Ni+2HMUxvaX4WnYzC1OVK2oCbEtd+1vuHz7rKuwF9oraJXQa7rD 45P2Nw1O8P6R2874Jtr5gfcA1URAqkadjvpjVszLS5CMxF8xH1/0X49U1wGO4pPS gICrmpfvy7atRD8oSBAHXbhyMS9hM3IQKvorB+T7r3SmIDFJnGGArzEa81pLUrsb kyCSGzVnmMo6omXYoR8nFIAKIWAa0Kba24tI7Cw7+SKNQRH1LAO7twxkZcfa8UWD clnIoF+nR9w2HSD49Fv3bXUYgzuTZuWPRXMMVxomwODfalkkJ7JrS0aVidN0Rr2k jwwKYOFqpiNwt63KsXa7oZdPOaAf6TIjfa7Kwojci1GRoPLPmE+lPPypxeW+7wuQ pnQuWh5mzYQxCdkStzrYzM/6R1tbKsmecJrHXEpDbn2q8Sst0A5kwL2bIddxIfmn DlegCSgdoOHKXYHiOeCUhfDnC29PN/gz89JeEdmk9Z7vs0f3cW7uT7Dtb1if0zgp 0tDCT1jWy0qUg/oUK+x+fJ+izxxeFIN8pIMeJsTgMTLYGYKcN6mZWy4RtAg8T+ek Yfvy60WB18mqlj2NTJjd9oYRKnhO4QWBg9MLulmh9pWuZozeqIk= =DXPW -----END PGP SIGNATURE----- --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Tue Jul 09 15:09:54 2019 Received: (at 36555) by debbugs.gnu.org; 9 Jul 2019 19:09:54 +0000 Received: from localhost ([127.0.0.1]:34282 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hkvUv-00048n-ML for submit@debbugs.gnu.org; Tue, 09 Jul 2019 15:09:54 -0400 Received: from ol.sdf.org ([205.166.94.20]:57648 helo=mx.sdf.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hkvUu-00048f-1U for 36555@debbugs.gnu.org; Tue, 09 Jul 2019 15:09:52 -0400 Received: from Upsilon (mobile-166-171-185-38.mycingular.net [166.171.185.38]) (authenticated (0 bits)) by mx.sdf.org (8.15.2/8.14.5) with ESMTPSA id x69J9l72015496 (using TLSv1.2 with cipher AES256-GCM-SHA384 (256 bits) verified NO); Tue, 9 Jul 2019 19:09:50 GMT From: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) To: Christopher Lemmer Webber Subject: Re: [bug#36555] [PATCH v2 3/3] tests: Add reconfigure system test. References: <87imsci9sj.fsf@sdf.lonestar.org> <87imsbtk3o.fsf@dustycloud.org> <875zobvxg7.fsf_-_@sdf.lonestar.org> <871ryzvxes.fsf_-_@sdf.lonestar.org> <87wogruisz.fsf_-_@sdf.lonestar.org> Date: Tue, 09 Jul 2019 15:09:46 -0400 In-Reply-To: <87wogruisz.fsf_-_@sdf.lonestar.org> (Jakob L. Kreuze's message of "Tue, 09 Jul 2019 15:09:00 -0400") Message-ID: <87sgrfuirp.fsf_-_@sdf.lonestar.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha256; protocol="application/pgp-signature" X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 36555 Cc: 36555@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= 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 | 99 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 100 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..bb8c33bf5 =2D-- /dev/null +++ b/gnu/tests/reconfigure.scm @@ -0,0 +1,99 @@ +;;; 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 tests) + #:use-module (gnu system) + #:use-module (gnu system vm) + #:use-module (gnu services) + #:use-module (gnu services networking) + #:use-module (gnu services shepherd) + #: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)) + +;;; 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 "capture activation script output" + (string? + (marionette-eval + '(primitive-load #$script) + marionette))) + + (test-equal "deployment created new generation" + (length (system-generations marionette)) + (1+ (length generations-prior)))) + + (test-end) + (exit (=3D (test-runner-fail-count (test-runner-current)) 0))))) + + (mlet %store-monad ((script (switch-system-program os))) + (gexp->derivation "switch-to-system" (test script)))) + +(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)))) =2D-=20 2.22.0 --=-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQIzBAEBCAAdFiEEa1VJLOiXAjQ2BGSm9Qb9Fp2P2VoFAl0k5noACgkQ9Qb9Fp2P 2VoGShAAslLmiT6+TFpQjMcEgOGVctrP6kyFP4FwHeaugMo7X28SJ4pzSuoohl4a ofsfZgY8HJ7dM8/pHY7Q0x6GiRreZKZCqRR28PhjRw6ebEAQGdlXvRRgtVg8kBhw vvXmbY0EKDcJy7nFUZut3b8HrMqXBornKo7q2t1+OUeVLssODVVckPLSKCCFCxOK ilkcwD6a4sddIHcuACPtJ3VZp+OCW8zX9EgROUPnm+ijM63Rx4C04ouUF/NaOOcn obMHWgbL18DsCeuI4BbKtEbFhKtI97RmkoTwDJvEDvrpbB6IeceytCoxSmB+5p3/ li7e9jRkszoF68SYpmHx4AzYk3x65zKaHFIgMcdktj2kP7hmIRL2ON2ayMIZ2wT5 QE5cOhSd5eYKaUVxu5uQadQDtOqOpIrLRyv4ZEYzJyJ/Rka7Q6EHznQ5hB8GpPTv VnA5QFccRka2LXFJmMYjXzIlheSLk62HsMbQ46t/OMqwZqrHDLDQkrfdtrCRto1l /dgdm6aS7ByH7MTp/XC26XYK4pWgZ1+ciClb5lsXS0Ad+4kCqDArzcsgrlQf6KRG CRsMxb6fUBZXEQbmOJf//mwV+raQGGpvvoox6eofhNfpVzSiyhO5KomhUkTMJ23B io5aSx5ojAcXUlvTLazxPMSrWZvPC/f+TEYqrcDb8nGqMnl10ZM= =5DFu -----END PGP SIGNATURE----- --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Sat Jul 13 06:23:34 2019 Received: (at 36555) by debbugs.gnu.org; 13 Jul 2019 10:23:34 +0000 Received: from localhost ([127.0.0.1]:41494 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hmFBl-00022x-3D for submit@debbugs.gnu.org; Sat, 13 Jul 2019 06:23:33 -0400 Received: from eggs.gnu.org ([209.51.188.92]:53444) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hmFBh-00022j-G8 for 36555@debbugs.gnu.org; Sat, 13 Jul 2019 06:23:31 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:60305) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1hmFBa-00048H-Le; Sat, 13 Jul 2019 06:23:22 -0400 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=56016 helo=ribbon) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1hmFBa-0005Tr-5u; Sat, 13 Jul 2019 06:23:22 -0400 From: =?utf-8?Q?Ludovic_Court=C3=A8s?= To: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) Subject: Re: [bug#36555] [PATCH 1/2] guix system: Add 'reconfigure' module. References: <87imsci9sj.fsf@sdf.lonestar.org> <87ef30i9fl.fsf@sdf.lonestar.org> Date: Sat, 13 Jul 2019 12:23:20 +0200 In-Reply-To: <87ef30i9fl.fsf@sdf.lonestar.org> (Jakob L. Kreuze's message of "Mon, 08 Jul 2019 15:59:58 -0400") Message-ID: <87y3129qsn.fsf@gnu.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2 (gnu/linux) MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 36555 Cc: 36555@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) Hello! zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) skribis: > * guix/scripts/system/reconfigure.scm: New file. > * Makefile.am (MODULES): Add it. > * guix/scripts/system.scm (bootloader-installer-script): Export variable. > * gnu/machine/ssh.scm (switch-to-system, upgrade-shepherd-services) > (install-bootloader): Delete variable. > * gnu/machine/ssh.scm (deploy-managed-host): Rewrite procedure. [...] > + (define (run-switch-to-system machine) > + "Monadic procedure serializing the items in MACHINE necessary to bui= ld a > +G-Expression with 'switch-to-system'." > + (mlet %store-monad ((script (switch-system-program (machine-system m= achine)))) > + (machine-remote-eval machine #~(primitive-load #$script)))) > + > + (define (run-upgrade-shepherd-services machine) > + "Monadic procedure serializing the items in MACHINE necessary to bui= ld a > +G-Expression with 'upgrade-shepherd-services'." > + (mlet* %store-monad ((target-services target-services) > + (script (upgrade-services-program target-servic= es))) > + (machine-remote-eval machine #~(primitive-load #$script)))) These would look nicer if =E2=80=98switch-system-program=E2=80=99 and =E2=80=98upgrade-services-program=E2=80=99 returns a because= you could just write: (machine-remote-eval #~(primitive-load #$(switch-system-program =E2=80=A6= )) machine) (I realize the order of arguments is reversed; to stick to what =E2=80=98ev= al=E2=80=99 does, I=E2=80=99d tend to put the =E2=80=98machine=E2=80=99 argument second= =E2=80=94but that=E2=80=99s a separate issue. :-)) > +(define (switch-system-program os) > + "Return as a monadic value a derivation to build a scheme file that, u= pon > +being evaluated, will create a new generation for SYSTEM-DERIVATION and > +execute ACTIVATION-SCRIPT." > + (gexp->script > + "switch-to-system.scm" > + (with-extensions (list guile-gcrypt) > + (with-imported-modules (source-module-closure '((guix config) > + (guix profiles) > + (guix utils))) > + #~(begin > + (use-modules (guix config) > + (guix profiles) > + (guix utils)) > + > + (define %system-profile > + (string-append %state-directory "/profiles/system")) > + > + (let* ((number (1+ (generation-number %system-profile))) > + (generation (generation-file-name %system-profile numb= er))) > + (switch-symlinks generation #$os) > + (switch-symlinks %system-profile generation) > + (setenv "GUIX_NEW_SYSTEM" #$os) > + (with-output-to-string > + (lambda () > + (primitive-load > + #$(operating-system-activation-script os)))))))))) Can we remove =E2=80=98with-output-to-string=E2=80=99? I=E2=80=99d rather = see what=E2=80=99s going on. :-) If that=E2=80=99s too verbose, we can use =E2=80=98invoke/quiet=E2=80=99. > +;; XXX: Currently, this does NOT attempt to restart running services. See > +;; for details. > +(define (upgrade-services-program target-services) > + "Return as a monadic value a derivation to build a scheme file that, u= pon > +being evaluated, will use TARGET-SERVICES, a list > +of (shepherd-service-canonical-name, shepherd-service-file) pairs to det= ermine > +which services are obsolete and need to be unloaded, as well as which se= rvices > +are new and need to be started." > + (gexp->script > + "upgrade-shepherd-services.scm" > + (with-imported-modules '((gnu services herd)) > + #~(begin > + (use-modules (gnu services herd) > + (srfi srfi-1)) > + > + (define running > + (filter live-service-running (current-services))) > + > + (define (essential? service) > + ;; Return #t if SERVICE is essential and should not be unloaded > + ;; under any circumstance. > + (memq (first (live-service-provision service)) > + '(root shepherd))) > + > + (define (obsolete? service) > + ;; Return #t if SERVICE can be safely unloaded. > + (and (not (essential? service)) > + (every (lambda (requirements) > + (not (memq (first (live-service-provision servic= e)) > + requirements))) > + (map live-service-requirement running)))) > + > + (define to-unload > + (filter obsolete? > + (remove (lambda (service) > + (memq (first (live-service-provision service= )) > + (map first '#$target-services))) > + running))) > + > + (define to-start > + (remove (lambda (service-pair) > + (memq (first service-pair) > + (map (compose first live-service-provision) > + running))) > + '#$target-services)) > + > + ;; Unload obsolete services. > + (for-each (lambda (service) > + (false-if-exception > + (unload-service service))) > + to-unload) > + > + ;; Load the service files for any new services and start them. > + (load-services/safe (map second to-start)) > + (for-each start-service (map first to-start)))))) It seems that this sort-of inlines parts of =E2=80=98shepherd-service-upgra= de=E2=80=99 but without traversing the service dependency graph to determine the compilete set of obsolete services, no? I feel that we should be reusing =E2=80=98shepherd-service-upgrade=E2=80=99 or similar bits. (I rea= lize this is already in =E2=80=98master=E2=80=99 for =E2=80=98guix deploy=E2=80=99, but = since this is going to be shared with =E2=80=98guix system=E2=80=99, we=E2=80=99d rather be extra cau= tious.) Also, I think we should remove =E2=80=98false-if-exception=E2=80=99 around =E2=80=98unload-service=E2=80=99. > +(define (install-bootloader-program installer-script bootcfg bootcfg-fil= e target) > + "Return as a monadic value a derivation to build a scheme file that, u= pon > +being evaluated, will install BOOTCFG to BOOTCFG-FILE, a target path, on > +TARGET, a mount point, and subsequently run INSTALLER-SCRIPT." > + (gexp->script > + "install-bootloader.scm" > + (with-extensions (list guile-gcrypt) > + (with-imported-modules (source-module-closure '((gnu build install) > + (guix store) > + (guix utils))) > + #~(begin > + (use-modules (gnu build install) > + (guix store) > + (guix utils)) > + (let* ((gc-root (string-append "/" %gc-roots-directory "/boot= cfg")) > + (temp-gc-root (string-append gc-root ".new"))) > + > + (switch-symlinks temp-gc-root gc-root) > + > + (let ((installer-result > + (false-if-exception > + (begin > + (install-boot-config #$bootcfg #$bootcfg-file #$t= arget) > + (with-output-to-string > + (lambda () > + (primitive-load #$installer-script))))))) > + (unless installer-result > + (delete-file temp-gc-root) > + (error "failed to install bootloader")) > + (rename-file temp-gc-root gc-root) > + installer-result))))))) I=E2=80=99d rather not swallow stdout and not use =E2=80=98error=E2=80=99. = Or at least, code that runs =E2=80=98install-bootloader-program=E2=80=99 should be able to pr= oduce a meaningful (and i18n=E2=80=99d) error message. So the caller could do some= thing like: (define result (machine-eval #~(=E2=80=A6 (guard (c ((message-condition? c) (cons 'error (condition-message c)))) (invoke/quiet #$(install-bootloader-program =E2=80= =A6)) '(success))) machine)) (match result (('error message) (leave (G_ "failed to install bootloader:~%~a~%") message)) (('success) #t)) Does that make sense? That=E2=80=99s quite some boilerplate to the challenge will be to factorize= it. Ultimately, the code in (guix scripts system reconfigure) should be parameterized by an evaluation procedure that would be either =E2=80=98machine-eval=E2=80=99 or some hypothetical =E2=80=98local-eval=E2= =80=99 procedure to evaluate things locally. Thanks, Ludo=E2=80=99. From debbugs-submit-bounces@debbugs.gnu.org Sat Jul 13 13:44:30 2019 Received: (at 36555) by debbugs.gnu.org; 13 Jul 2019 17:44:30 +0000 Received: from localhost ([127.0.0.1]:43324 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hmM4T-0005u6-Oo for submit@debbugs.gnu.org; Sat, 13 Jul 2019 13:44:30 -0400 Received: from mx.sdf.org ([205.166.94.20]:60731) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hmM4Q-0005tu-Mv for 36555@debbugs.gnu.org; Sat, 13 Jul 2019 13:44:28 -0400 Received: from Upsilon (mobile-166-172-63-162.mycingular.net [166.172.63.162]) (authenticated (0 bits)) by mx.sdf.org (8.15.2/8.14.5) with ESMTPSA id x6DHiJev028807 (using TLSv1.2 with cipher AES256-GCM-SHA384 (256 bits) verified NO); Sat, 13 Jul 2019 17:44:23 GMT From: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) To: Ludovic =?utf-8?Q?Court=C3=A8s?= Subject: Re: [bug#36555] [PATCH 1/2] guix system: Add 'reconfigure' module. References: <87imsci9sj.fsf@sdf.lonestar.org> <87ef30i9fl.fsf@sdf.lonestar.org> <87y3129qsn.fsf@gnu.org> Date: Sat, 13 Jul 2019 13:44:13 -0400 In-Reply-To: <87y3129qsn.fsf@gnu.org> ("Ludovic \=\?utf-8\?Q\?Court\=C3\=A8s\=22'\?\= \=\?utf-8\?Q\?s\?\= message of "Sat, 13 Jul 2019 12:23:20 +0200") Message-ID: <87sgr9bziq.fsf@sdf.lonestar.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha256; protocol="application/pgp-signature" X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 36555 Cc: 36555@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Hi, Ludovic! Ludovic Court=C3=A8s writes: > These would look nicer if =E2=80=98switch-system-program=E2=80=99 and > =E2=80=98upgrade-services-program=E2=80=99 returns a becau= se you could > just write: > > (machine-remote-eval #~(primitive-load #$(switch-system-program =E2=80= =A6)) > machine) > > (I realize the order of arguments is reversed; to stick to what =E2=80=98= eval=E2=80=99 > does, I=E2=80=99d tend to put the =E2=80=98machine=E2=80=99 argument seco= nd=E2=80=94but that=E2=80=99s a > separate issue. :-)) I'm using 'gexp->script', so they should be returning a 'program-file'. I've just neglected the conveniences I'm afforded with ungexp, it seems. #~(primitive-load #$(switch-system-program =E2=80=A6)) is, indeed, quite a = bit cleaner :) > Can we remove =E2=80=98with-output-to-string=E2=80=99? I=E2=80=99d rather= see what=E2=80=99s going on. > :-) > > If that=E2=80=99s too verbose, we can use =E2=80=98invoke/quiet=E2=80=99. I'm not too concerned with verbosity; rather, in the case for 'guix deploy', the script's output mixes with the REPL output and that causes 'remote-eval' to fail with a match error. I think it would be better to continue using 'with-output-to-string', but to preseve its return value so we can show it to the user from 'guix deploy' or 'guix system reconfigure'. Users of 'guix deploy' would also be able to see the script's output this way. > It seems that this sort-of inlines parts of =E2=80=98shepherd-service-upg= rade=E2=80=99 > but without traversing the service dependency graph to determine the > compilete set of obsolete services, no? I feel that we should be > reusing =E2=80=98shepherd-service-upgrade=E2=80=99 or similar bits. (I re= alize this is > already in =E2=80=98master=E2=80=99 for =E2=80=98guix deploy=E2=80=99, bu= t since this is going to be > shared with =E2=80=98guix system=E2=80=99, we=E2=80=99d rather be extra c= autious.) Does 'live-service-requirement' not encompass the full service dependency graph? Regardless, I'll look into reusing 'shepherd-service-upgrade' as it's well-testsed. > Also, I think we should remove =E2=80=98false-if-exception=E2=80=99 around > =E2=80=98unload-service=E2=80=99. Agreed. When you have time to look at it, I've raised a few questions about this in v2 of this series. > I=E2=80=99d rather not swallow stdout and not use =E2=80=98error=E2=80=99= . Or at least, code > that runs =E2=80=98install-bootloader-program=E2=80=99 should be able to = produce a > meaningful (and i18n=E2=80=99d) error message. So the caller could do > something like: > > (define result > (machine-eval #~(=E2=80=A6 > (guard (c ((message-condition? c) > (cons 'error (condition-message c)))) > (invoke/quiet #$(install-bootloader-program =E2=80= =A6)) > '(success))) > machine)) > > (match result > (('error message) > (leave (G_ "failed to install bootloader:~%~a~%") message)) > (('success) > #t)) > > Does that make sense? Yes, and thank you for providing that snippet :) > That=E2=80=99s quite some boilerplate to the challenge will be to factori= ze > it. > > Ultimately, the code in (guix scripts system reconfigure) should be > parameterized by an evaluation procedure that would be either > =E2=80=98machine-eval=E2=80=99 or some hypothetical =E2=80=98local-eval= =E2=80=99 procedure to evaluate > things locally. Noted. That should be a relatively small change, so I'll see about tackling that in my next revision for this series. Regards, Jakob --=-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQIzBAEBCAAdFiEEa1VJLOiXAjQ2BGSm9Qb9Fp2P2VoFAl0qGG4ACgkQ9Qb9Fp2P 2Vo/IA/+P4XQkXT6NwI8EX2XDj61ucNFUUElG3dDavbHN2PcNxX5JnD5JPZvvb1O GyQEiRb9KOoiM4HgT+4FA+Pb6+YedlenZuQn5Hxd/msGabrw7L8E/yaodgPvPZUU 0S0W7m04xg9SBSvVbIWiF9JviRK8PzigOHGvud7Hexm/AcxcyZFjtn1OHnt4ovZp abcI2ZD/76FSN3yTWaL/Kl+vz7dR4cbQPzjEXPWRCV2VOYDJ3F1iaGAr1FK9odZZ IvKoixUEqJOw995ksgzIQhfJ5/dsf92zIr57T9rw0pjubPNuNtFnG1PGCLYBd0y0 AKWMwkILc1whrCFiWoOe5wqjZxlXsr5l8Y46SNBsvWrsGPtqLlOIZWm7ZMEP48kd qegWv9LevlfF7vueqWzXykfgGfgwn5xjuZhkyyvpyGPbBTWxwetstGznlodY8T/s akqk/v4Zg1gwYA76PG94ZEb3haFaAVMve9gDaJCi6W8KD0KAyDPRJIHMjYUJ4aZd yBIs4qTWh4B2Qg0cH1H33v8M0uAYgx30FabG0qhz5SOxVJpJouWHBEPZlpLMbL3X Z2YHHWaTWeFj+Tm0ZUP/6hofJP0mG1W7N/JD5sPGI1qC6ulsGqeNonqEGfvvCkXQ /9hOeH2WXDP3nXjlFqVgtlPZlKMZ7cBJE5VCJd6Gg74VMZ5xDCI= =m3I+ -----END PGP SIGNATURE----- --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Sun Jul 14 09:23:23 2019 Received: (at 36555) by debbugs.gnu.org; 14 Jul 2019 13:23:23 +0000 Received: from localhost ([127.0.0.1]:43994 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hmeTJ-0002b7-Ea for submit@debbugs.gnu.org; Sun, 14 Jul 2019 09:23:22 -0400 Received: from eggs.gnu.org ([209.51.188.92]:50206) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hmeTG-0002ao-DT for 36555@debbugs.gnu.org; Sun, 14 Jul 2019 09:23:20 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:51418) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1hmeTB-0000xl-2A; Sun, 14 Jul 2019 09:23:13 -0400 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=59958 helo=ribbon) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1hmeTA-0006k9-Js; Sun, 14 Jul 2019 09:23:12 -0400 From: =?utf-8?Q?Ludovic_Court=C3=A8s?= To: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) Subject: Re: [bug#36555] [PATCH 1/2] guix system: Add 'reconfigure' module. References: <87imsci9sj.fsf@sdf.lonestar.org> <87ef30i9fl.fsf@sdf.lonestar.org> <87y3129qsn.fsf@gnu.org> <87sgr9bziq.fsf@sdf.lonestar.org> X-URL: http://www.fdn.fr/~lcourtes/ X-Revolutionary-Date: 26 Messidor an 227 de la =?utf-8?Q?R=C3=A9volution?= X-PGP-Key-ID: 0x090B11993D9AEBB5 X-PGP-Key: http://www.fdn.fr/~lcourtes/ludovic.asc X-PGP-Fingerprint: 3CE4 6455 8A84 FDC6 9DB4 0CFB 090B 1199 3D9A EBB5 X-OS: x86_64-pc-linux-gnu Date: Sun, 14 Jul 2019 15:23:06 +0200 In-Reply-To: <87sgr9bziq.fsf@sdf.lonestar.org> (Jakob L. Kreuze's message of "Sat, 13 Jul 2019 13:44:13 -0400") Message-ID: <87pnmc7nt1.fsf@gnu.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 36555 Cc: 36555@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Hello! zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) skribis: > Ludovic Court=C3=A8s writes: [...] >> Can we remove =E2=80=98with-output-to-string=E2=80=99? I=E2=80=99d rathe= r see what=E2=80=99s going on. >> :-) >> >> If that=E2=80=99s too verbose, we can use =E2=80=98invoke/quiet=E2=80=99. > > I'm not too concerned with verbosity; rather, in the case for 'guix > deploy', the script's output mixes with the REPL output and that causes > 'remote-eval' to fail with a match error. I think it would be better to > continue using 'with-output-to-string', but to preseve its return value > so we can show it to the user from 'guix deploy' or 'guix system > reconfigure'. Users of 'guix deploy' would also be able to see the > script's output this way. Oh, I see. So in a way the problem is that =E2=80=98remote-eval=E2=80=99 d= oesn=E2=80=99t do anything sensible with the output and error ports of that remote evaluation. Ultimately we should probably fix (guix inferior) and (guix remote) so that stdout and stderr are properly transmitted. In the meantime, what about this patch? --=-=-= Content-Type: text/x-patch Content-Disposition: inline diff --git a/guix/remote.scm b/guix/remote.scm index e503c76167..8ada5c0957 100644 --- a/guix/remote.scm +++ b/guix/remote.scm @@ -76,8 +76,14 @@ result to the current output port using the (guix repl) protocol." (with-imported-modules (source-module-closure '((guix repl))) #~(begin (use-modules (guix repl)) - (send-repl-response '(primitive-load #$program) + + ;; We use CURRENT-OUTPUT-PORT for REPL messages, so redirect PROGRAM's + ;; output to CURRENT-ERROR-PORT so that it does not interfere. + (send-repl-response '(with-output-to-port (current-error-port) + (lambda () + (primitive-load #$program))) (current-output-port)) + (force-output)))) (define* (remote-eval exp session --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable >> It seems that this sort-of inlines parts of =E2=80=98shepherd-service-up= grade=E2=80=99 >> but without traversing the service dependency graph to determine the >> compilete set of obsolete services, no? I feel that we should be >> reusing =E2=80=98shepherd-service-upgrade=E2=80=99 or similar bits. (I r= ealize this is >> already in =E2=80=98master=E2=80=99 for =E2=80=98guix deploy=E2=80=99, b= ut since this is going to be >> shared with =E2=80=98guix system=E2=80=99, we=E2=80=99d rather be extra = cautious.) > > Does 'live-service-requirement' not encompass the full service > dependency graph? Regardless, I'll look into reusing > 'shepherd-service-upgrade' as it's well-testsed. =E2=80=98live-service-requirement=E2=80=99 gives you the graph of the curre= ntly loaded services, but you also need the target service graph to determine what to upgrade; that seems to be missing currently. Thanks, Ludo=E2=80=99. --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Mon Jul 15 11:36:54 2019 Received: (at 36555) by debbugs.gnu.org; 15 Jul 2019 15:36:54 +0000 Received: from localhost ([127.0.0.1]:48802 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hn325-0006me-SD for submit@debbugs.gnu.org; Mon, 15 Jul 2019 11:36:54 -0400 Received: from ol.sdf.org ([205.166.94.20]:49500 helo=mx.sdf.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hn322-0006mS-0s for 36555@debbugs.gnu.org; Mon, 15 Jul 2019 11:36:52 -0400 Received: from Upsilon (mobile-107-107-62-166.mycingular.net [107.107.62.166]) (authenticated (0 bits)) by mx.sdf.org (8.15.2/8.14.5) with ESMTPSA id x6FFad6R015441 (using TLSv1.2 with cipher AES256-GCM-SHA384 (256 bits) verified NO); Mon, 15 Jul 2019 15:36:42 GMT From: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) To: Ludovic =?utf-8?Q?Court=C3=A8s?= Subject: Re: [bug#36555] [PATCH 1/2] guix system: Add 'reconfigure' module. References: <87imsci9sj.fsf@sdf.lonestar.org> <87ef30i9fl.fsf@sdf.lonestar.org> <87y3129qsn.fsf@gnu.org> <87sgr9bziq.fsf@sdf.lonestar.org> <87pnmc7nt1.fsf@gnu.org> Date: Mon, 15 Jul 2019 11:36:36 -0400 In-Reply-To: <87pnmc7nt1.fsf@gnu.org> ("Ludovic \=\?utf-8\?Q\?Court\=C3\=A8s\=22'\?\= \=\?utf-8\?Q\?s\?\= message of "Sun, 14 Jul 2019 15:23:06 +0200") Message-ID: <8736j7nwcb.fsf@sdf.lonestar.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha256; protocol="application/pgp-signature" X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 36555 Cc: 36555@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Ludovic Court=C3=A8s writes: > Oh, I see. So in a way the problem is that =E2=80=98remote-eval=E2=80=99 = doesn=E2=80=99t do > anything sensible with the output and error ports of that remote > evaluation. > > Ultimately we should probably fix (guix inferior) and (guix remote) so > that stdout and stderr are properly transmitted. Thinking about it now, that could make error reporting for 'guix deploy' less complicated. We'd be able to output the remote's stdout/stderr to the host's stdout/stderr and be done with it. > In the meantime, what about this patch? > > diff --git a/guix/remote.scm b/guix/remote.scm > index e503c76167..8ada5c0957 100644 > --- a/guix/remote.scm > +++ b/guix/remote.scm > @@ -76,8 +76,14 @@ result to the current output port using the (guix repl= ) protocol." > (with-imported-modules (source-module-closure '((guix repl))) > #~(begin > (use-modules (guix repl)) > - (send-repl-response '(primitive-load #$program) > + > + ;; We use CURRENT-OUTPUT-PORT for REPL messages, so redirect PRO= GRAM's > + ;; output to CURRENT-ERROR-PORT so that it does not interfere. > + (send-repl-response '(with-output-to-port (current-error-port) > + (lambda () > + (primitive-load #$program))) > (current-output-port)) > + > (force-output)))) >=20=20 > (define* (remote-eval exp session LGTM, thanks! > =E2=80=98live-service-requirement=E2=80=99 gives you the graph of the cur= rently loaded > services, but you also need the target service graph to determine what > to upgrade; that seems to be missing currently. Oh, good catch. Reusing 'shepherd-service-upgrade' is certainly the way to go, then. Regards, Jakob --=-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQIzBAEBCAAdFiEEa1VJLOiXAjQ2BGSm9Qb9Fp2P2VoFAl0snYQACgkQ9Qb9Fp2P 2Vp3GBAAo9/SqB5Gl4m+FBv8WISgUPioVXp3wWWmCjiZ/yF2BC7lMJrnTjP/bUta Mxt3xmqWVj8I3tK4SjSbrWq4LuGnYe09kyJpgIol+/HYMYVjaWz3xy1dbnLNvaRE XjPI19QiZapsxdP9yYPQp4Yse3bugLQ5tnp7J5FfEiiIb1Pu1+wtFoTDKShJYUFG WyeR4PS4H2jotc4phOqi9ntMCcYrDJKMDfjx3ugFLGNF7YircypSw/fesjrABbwI kZ8LS2s7UTutH5EZ0q3vlz2iK+s7Z7dkjJlj/ZE6iVLaxXT2UlzF3VYkyI8aen6P gWkew8bDLUSVkZjMk+NMitBceM3nvjU94qSJ0a7ML2LdqxgcXBAtrgzoOuAX9UpX eCFVyGjPvQrsafCHtEIY1ccZ+9/nZlNgtmx52Pkr0q4s2mH6caSfsYHV7+FVmTbp jeS0W2mvBokkOX3AlZOQDwKxR/JBRoZZ9uapcZ+jzNS+jlHgQLOMqA8THDK7+Hfj JrGCwVKqnzztx0l3pP5LVtfnVUAS4KVjjUKiDmbO6N3WRmwTdGvqnod3oqBvnfwk czIXt3d+nQonwv3VfomYvq8mB5VZa0nEye+Iy2qRQxfTrTfOGY4DO+jmVmXoFUVc bIf183IR//ntFbWwhc8QZpSz9T3yOAmEBU9OHbvpAJzNQ89a1C8= =rQ3H -----END PGP SIGNATURE----- --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Mon Jul 15 12:33:11 2019 Received: (at 36555) by debbugs.gnu.org; 15 Jul 2019 16:33:11 +0000 Received: from localhost ([127.0.0.1]:48891 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hn3uY-0008Kn-S0 for submit@debbugs.gnu.org; Mon, 15 Jul 2019 12:33:11 -0400 Received: from eggs.gnu.org ([209.51.188.92]:49073) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hn3uX-0008KY-3G for 36555@debbugs.gnu.org; Mon, 15 Jul 2019 12:33:09 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:51794) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1hn3uR-0002lZ-7Y; Mon, 15 Jul 2019 12:33:03 -0400 Received: from [2001:660:6102:320:e120:2c8f:8909:cdfe] (port=40946 helo=ribbon) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1hn3uK-00031l-OF; Mon, 15 Jul 2019 12:33:00 -0400 From: =?utf-8?Q?Ludovic_Court=C3=A8s?= To: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) Subject: Re: [bug#36555] [PATCH 1/2] guix system: Add 'reconfigure' module. 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> Date: Mon, 15 Jul 2019 18:32:55 +0200 In-Reply-To: <8736j7nwcb.fsf@sdf.lonestar.org> (Jakob L. Kreuze's message of "Mon, 15 Jul 2019 11:36:36 -0400") Message-ID: <87muhfjm14.fsf@gnu.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2 (gnu/linux) MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 36555 Cc: 36555@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) skribis: > Ludovic Court=C3=A8s writes: [...] >> In the meantime, what about this patch? >> >> diff --git a/guix/remote.scm b/guix/remote.scm >> index e503c76167..8ada5c0957 100644 >> --- a/guix/remote.scm >> +++ b/guix/remote.scm >> @@ -76,8 +76,14 @@ result to the current output port using the (guix rep= l) protocol." >> (with-imported-modules (source-module-closure '((guix repl))) >> #~(begin >> (use-modules (guix repl)) >> - (send-repl-response '(primitive-load #$program) >> + >> + ;; We use CURRENT-OUTPUT-PORT for REPL messages, so redirect PR= OGRAM's >> + ;; output to CURRENT-ERROR-PORT so that it does not interfere. >> + (send-repl-response '(with-output-to-port (current-error-port) >> + (lambda () >> + (primitive-load #$program))) >> (current-output-port)) >> + >> (force-output)))) >>=20=20 >> (define* (remote-eval exp session > > LGTM, thanks! Cool, pushed as 6f8eb9f1d8bc8660349658602698db36965bba5d. >> =E2=80=98live-service-requirement=E2=80=99 gives you the graph of the cu= rrently loaded >> services, but you also need the target service graph to determine what >> to upgrade; that seems to be missing currently. > > Oh, good catch. Reusing 'shepherd-service-upgrade' is certainly the way > to go, then. I think so, which brings us back to the need to de-monadify (guix graph). :-) Ludo=E2=80=99. From debbugs-submit-bounces@debbugs.gnu.org Mon Jul 15 19:57:38 2019 Received: (at 36555) by debbugs.gnu.org; 15 Jul 2019 23:57:38 +0000 Received: from localhost ([127.0.0.1]:49407 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hnAqg-0000an-EI for submit@debbugs.gnu.org; Mon, 15 Jul 2019 19:57:38 -0400 Received: from ol.sdf.org ([205.166.94.20]:65231 helo=mx.sdf.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hnAqb-0000aW-Jm for 36555@debbugs.gnu.org; Mon, 15 Jul 2019 19:57:36 -0400 Received: from Upsilon (mobile-107-107-60-193.mycingular.net [107.107.60.193]) (authenticated (0 bits)) by mx.sdf.org (8.15.2/8.14.5) with ESMTPSA id x6FNvS5v012698 (using TLSv1.2 with cipher AES256-GCM-SHA384 (256 bits) verified NO); Mon, 15 Jul 2019 23:57:30 GMT From: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) To: Ludovic =?utf-8?Q?Court=C3=A8s?= Subject: Re: [bug#36555] [PATCH 1/2] guix system: Add 'reconfigure' module. 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> Date: Mon, 15 Jul 2019 19:57:26 -0400 In-Reply-To: <87muhfjm14.fsf@gnu.org> ("Ludovic \=\?utf-8\?Q\?Court\=C3\=A8s\=22'\?\= \=\?utf-8\?Q\?s\?\= message of "Mon, 15 Jul 2019 18:32:55 +0200") Message-ID: <87ftn63l7d.fsf@sdf.lonestar.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha256; protocol="application/pgp-signature" X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 36555 Cc: 36555@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Ludovic Court=C3=A8s writes: > I think so, which brings us back to the need to de-monadify (guix > graph). :-) Good news, I came up with a way of using 'shepherd-service-upgrade' on the host side. Stay tuned for v3 of this patch series ;) Though, I suppose cleaning up the dependencies of '(guix graph)' may be a good goal to have regardless. Regards, Jakob --=-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQIzBAEBCAAdFiEEa1VJLOiXAjQ2BGSm9Qb9Fp2P2VoFAl0tEuYACgkQ9Qb9Fp2P 2VrdIg/8CMXYNA5tuPuJ1FCFSIJLBo6J2a030vrJnIO1WDWGS/iJwP6CvZ9Fen65 bSlBLvuXCPB1HK9a27fK/3DRVzfrX8KXJ8PXG35B2OS31CpwnBwadcb0pX3o+r72 GkUkl1Ey3MiVximQMNu2IB9/3Ihp5SHdVPy7wzfDhLClz/DhHmYKAcfXs0KUCkCL Rnwa360hZNIePLOVTK6pcglDTXoxJ37Oe4nv6NPSsb8Q055BDnG3K1W77FhYtm+9 OqRi3IDplFfsg7CKWUzruJSEf5icFRUQ/AF0I3xxuSy3ydwmDSzAgRGa4WBEy7ZZ 9+1W7loWpnlcpb2gwHwAjMK2Jiz/jmIU5sBhsnLu1XakglFL8fBi6OO1ZCq2Cj8+ q/ZmneIka98/wslCyggFJLt4LCMS3uzzP0TMdKuDfSi9kl2AxgoU/CZ9bO7DD6wk nxMmKBBV5oUpmiMa36rXqT79vknmoUtp3owKwQzv3RDBVPU+lyezOiIqHa4W/Xst lC7aFTOkXDqbsmhcagpKaERt78qdVGytEMUydQGM0rhcOM/OqfdTIxGSceKoMoAI m0J7PbpKsZBLKDxVzN+gSz2SQFu7lbGeMx9kahse/d95cLJ9ZRYtogg/YOYnldKK ZvD4i00PLKmd7lF+ykeBj/AY9/fJF0WRjK3NaEW9+q0oWw+PQ1o= =FL3L -----END PGP SIGNATURE----- --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Tue Jul 16 19:46:35 2019 Received: (at 36555) by debbugs.gnu.org; 16 Jul 2019 23:46:35 +0000 Received: from localhost ([127.0.0.1]:51332 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hnX9V-00040g-HF for submit@debbugs.gnu.org; Tue, 16 Jul 2019 19:46:33 -0400 Received: from mx.sdf.org ([205.166.94.20]:54788) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hnX9R-00040U-LL for 36555@debbugs.gnu.org; Tue, 16 Jul 2019 19:46:32 -0400 Received: from Upsilon (mobile-107-107-59-57.mycingular.net [107.107.59.57]) (authenticated (0 bits)) by mx.sdf.org (8.15.2/8.14.5) with ESMTPSA id x6GNkKf9028996 (using TLSv1.2 with cipher AES256-GCM-SHA384 (256 bits) verified NO); Tue, 16 Jul 2019 23:46:25 GMT From: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) To: 36555@debbugs.gnu.org Subject: Re: [bug#36555] [PATCH v3 0/3] Refactor out common behavior for system reconfiguration. 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> Date: Tue, 16 Jul 2019 19:46:16 -0400 In-Reply-To: <87ftn63l7d.fsf@sdf.lonestar.org> (Jakob L. Kreuze's message of "Mon, 15 Jul 2019 19:57:26 -0400") Message-ID: <87v9w1zgon.fsf_-_@sdf.lonestar.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha256; protocol="application/pgp-signature" X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 36555 Cc: Ludovic =?utf-8?Q?Court=C3=A8s?= X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Hi, all. Submitting this reroll to ask for some further feedback. Here's a summary of the more significant changes since v2: =2D All of the system tests for the reconfiguration procedures have been implemented. =2D 'upgrade-services-program' has been completely reimplemented; '(gnu machine ssh)' is now capable of (partially) serializing the objects returned by 'current-services', so we can use 'shepherd-service-upgrade' to traverse the service dependency graph. =2D Procedures in '(guix scripts system reconfigure)' now use 'program-file' instead of 'gexp->script'. I hadn't realized the difference, but this makes invocations of 'remote-eval' a bit cleaner. =2D Thanks to Ludovic's patches to '(guix remote)', the reconfiguration procedures no longer need to capture output from the activation/installation scripts. =2D I've removed my awful hack of a solution for handling Shepherd errors in 'upgrade-services-program' in favor of handling exceptions on the host side. I have some questions about this. =2D 'upgrade-services-program' comes after 'install-bootloader-program' in 'guix deploy' and 'guix system reconfigure' now, as it's the procedure most likely to fail trivially. I still need to handle failed deployments in 'guix deploy'. I suspect that, for now, it would make sense to implement remote roll-backs and just roll-back the system on failure, at least until we've have some dialog about the proper way to do atomic deployments. My biggest concern at the moment is error handling reporting in the new 'guix system reconfigure'. I'd like to emulate what was done with the previous version, but I'm at somewhat of a loss for how I'd go about that, since the error reporting was mixed with the reconfiguration code. So I'd like to ask for some suggestions: is the best way to catch errors in '%store-monad' to do what 'with-shepherd-error-handling' does, and then 'leave' on failure? Ludovic suggested guarding against 'message-condition' and having the expression I send to 'remote-eval' return either ('error message) or ('success). Would it make sense to just do this in all of the reconfiguration procedures? Or is raising exceptions in the reconfiguration procedures and catching them in the scripts' code the way to go? There's also a slight bug in the new 'guix system reconfigure' that I'll need to figure out. At the moment, it installs a bootloader entry for all but the newest generation. Jakob L. Kreuze writes: > Noted. That should be a relatively small change, so I'll see about > tackling that in my next revision for this series. Oh, how na=C3=AFve I was four days ago. This reroll doesn't address this. Having the procedures "parameterized by an evaluation procedure" can be done in so many ways, and I think it would be best I put some serious thought into which of those ways would be the best. A 'local-eval' would clearly be much better than what I'm doing at the present in 'system.scm', but the solution I came up with today involved three layers of 'primitive-load', which I doubt is the way to go about it. I had the idea to parameterize on a procedure that takes a '' rather than a G-Expression as I was making dinner tonight, which seems to me like a sound idea, but we'll see if it works tomorrow when I try to implement it. Also, it hit me today that the safety checks done in 'guix system reconfigure' -- 'check-mapped-devices', 'check-file-system-availability', and 'check-initrd-modules' -- should also be done in 'guix deploy'. It might make sense for me to submit that change as a separate patch series so the code review for this doesn't get too complicated, but since we're on the topic of unifying the code between 'guix deploy' and 'guix system reconfigure', should I perhaps reimplement those procedures as '' objects like everything else in '(guix scripts system reconfigure)'? They aren't really effectful, but they concern system reconfiguration. And, on the same note, should I go ahead and refactor the rest of the reconfiguration code in 'system.scm' out into '(guix scripts system reconfigure)'? I mean, this will probably be a separate patch series for the same reason that the safety checks would be a separate patch series, and I'll likely do this _after_ I come up with a decent way to parameterize on an evaluation procedure, but I'd like to know if it's a good idea or not before going ahead and ripping apart 'system.scm'. Regards, and TYIA for reviewing this. Jakob Jakob L. Kreuze (3): guix system: Add 'reconfigure' module. guix system: Reimplement 'reconfigure'. tests: Add reconfigure system test. Makefile.am | 1 + gnu/local.mk | 1 + gnu/machine/ssh.scm | 266 ++++++++++----------------- gnu/services/herd.scm | 6 + gnu/tests/reconfigure.scm | 268 ++++++++++++++++++++++++++++ guix/scripts/system.scm | 152 +++++----------- guix/scripts/system/reconfigure.scm | 122 +++++++++++++ tests/services.scm | 4 - 8 files changed, 538 insertions(+), 282 deletions(-) create mode 100644 gnu/tests/reconfigure.scm create mode 100644 guix/scripts/system/reconfigure.scm =2D-=20 2.22.0 --=-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQIzBAEBCAAdFiEEa1VJLOiXAjQ2BGSm9Qb9Fp2P2VoFAl0uYcoACgkQ9Qb9Fp2P 2Voapg//bgulhXfqZoX/pFy5gZCevHz02qOqQ5B4ziloFLcDbLpHa0BLUaX2Z0lm S5T2gXQzO/49CUPr0RLvMd3Jjx1RQqAQvsoIVKkHnw3HGqG+d/Qp2oxE5BsIEGlW IW1C+ZshRgHg4yi3mWUFVL0jkW2pr15bqvH3Q73pUS+++JdoAcYyRM8B8g4nMYud dKt1lpBpL2wKN/z3lhJgXOAWfgfG/3Jg9u53sX5+0Y2u1piVNk2GCUuS0UtR0B65 49L1W1Kw2OCH7bGUoGrUgcdDBEDcJphRPLg6RP3mxOB4u+gUqzl62dx2BU7T44+a O2HZ1IiePoIdVIGm0lGHJ+3dlGaA2FFbicLz1MWwIVtSteDjIWv45cVkgahZWhmK 7+nrivdq16sBGNKEUaKu7mHOx/QCfNml4pIRDolgEa1fqgRyPpQle/RXrKdLoHdR 3NmPepr+koQBrP9HO6qEjEeQCmSG0LS+P7mlFZ2IKnjNybZNZYwsoghQaJ51HwOb 0A55fwnXGpRTGxPQtL9TEbZZUNJmUhN3BQLEQosgNWyVXW+6ocxEIn4aE/j1CM6K kbdufckJeMUCxjPTcZz3xlYDhJ1CCfrsTK2/VycxCW/Qd0j7TV+r3jOGOh7ZZQCv 3tt8yy5NpwiCoWiwTJok8etQjspaNzuaoT9PORsqcL44i0gAE2s= =ZxSu -----END PGP SIGNATURE----- --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Tue Jul 16 19:47:35 2019 Received: (at 36555) by debbugs.gnu.org; 16 Jul 2019 23:47:36 +0000 Received: from localhost ([127.0.0.1]:51336 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hnXAQ-00042I-RM for submit@debbugs.gnu.org; Tue, 16 Jul 2019 19:47:35 -0400 Received: from mx.sdf.org ([205.166.94.20]:54579) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hnXAN-000424-Lo for 36555@debbugs.gnu.org; Tue, 16 Jul 2019 19:47:29 -0400 Received: from Upsilon (mobile-107-107-59-57.mycingular.net [107.107.59.57]) (authenticated (0 bits)) by mx.sdf.org (8.15.2/8.14.5) with ESMTPSA id x6GNlMSk008403 (using TLSv1.2 with cipher AES256-GCM-SHA384 (256 bits) verified NO); Tue, 16 Jul 2019 23:47:25 GMT From: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) To: 36555@debbugs.gnu.org Subject: Re: [bug#36555] [PATCH v3 1/3] guix system: Add 'reconfigure' module. 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> Date: Tue, 16 Jul 2019 19:47:18 -0400 In-Reply-To: <87v9w1zgon.fsf_-_@sdf.lonestar.org> (Jakob L. Kreuze's message of "Tue, 16 Jul 2019 19:46:16 -0400") Message-ID: <87r26pzgmx.fsf_-_@sdf.lonestar.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha256; protocol="application/pgp-signature" X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 36555 Cc: Ludovic =?utf-8?Q?Court=C3=A8s?= X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable * guix/scripts/system/reconfigure.scm: New file. * Makefile.am (MODULES): Add it. * guix/scripts/system.scm (bootloader-installer-script): Export variable. * gnu/machine/ssh.scm (switch-to-system, upgrade-shepherd-services) (install-bootloader): Delete variable. * gnu/machine/ssh.scm (deploy-managed-host): Rewrite procedure. * gnu/services/herd.scm (live-service): Export variable. * gnu/services/herd.scm (live-service-canonical-name): New variable. * tests/services.scm (live-service): Delete variable. =2D-- Makefile.am | 1 + gnu/machine/ssh.scm | 266 ++++++++++------------------ gnu/services/herd.scm | 6 + guix/scripts/system.scm | 1 + guix/scripts/system/reconfigure.scm | 170 ++++++++++++++++++ tests/services.scm | 4 - 6 files changed, 272 insertions(+), 176 deletions(-) create mode 100644 guix/scripts/system/reconfigure.scm diff --git a/Makefile.am b/Makefile.am index dd7720e87..58a96d348 100644 =2D-- a/Makefile.am +++ b/Makefile.am @@ -245,6 +245,7 @@ MODULES =3D \ guix/scripts/describe.scm \ guix/scripts/system.scm \ guix/scripts/system/search.scm \ + guix/scripts/system/reconfigure.scm \ guix/scripts/lint.scm \ guix/scripts/challenge.scm \ guix/scripts/import/crate.scm \ diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm index a7d1a967a..a5c5c6b39 100644 =2D-- a/gnu/machine/ssh.scm +++ b/gnu/machine/ssh.scm @@ -21,6 +21,7 @@ #:use-module (gnu machine) #:autoload (gnu packages gnupg) (guile-gcrypt) #:use-module (gnu services) + #:use-module (gnu services herd) #:use-module (gnu services shepherd) #:use-module (gnu system) #:use-module (guix derivations) @@ -30,10 +31,15 @@ #:use-module (guix monads) #:use-module (guix records) #:use-module (guix remote) + #:use-module (guix scripts system) + #:use-module (guix scripts system reconfigure) #:use-module (guix ssh) #:use-module (guix store) #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) #:use-module (srfi srfi-19) + #:use-module (srfi srfi-26) #:use-module (srfi srfi-35) #:export (managed-host-environment-type =20 @@ -105,118 +111,6 @@ an environment type of 'managed-host." ;;; System deployment. ;;; =20 =2D(define (switch-to-system machine) =2D "Monadic procedure creating a new generation on MACHINE and execute the =2Dactivation script for the new system configuration." =2D (define (remote-exp drv script) =2D (with-extensions (list guile-gcrypt) =2D (with-imported-modules (source-module-closure '((guix config) =2D (guix profiles) =2D (guix utils))) =2D #~(begin =2D (use-modules (guix config) =2D (guix profiles) =2D (guix utils)) =2D =2D (define %system-profile =2D (string-append %state-directory "/profiles/system")) =2D =2D (let* ((system #$drv) =2D (number (1+ (generation-number %system-profile))) =2D (generation (generation-file-name %system-profile num= ber))) =2D (switch-symlinks generation system) =2D (switch-symlinks %system-profile generation) =2D ;; The implementation of 'guix system reconfigure' saves t= he =2D ;; load path and environment here. This is unnecessary here =2D ;; because each invocation of 'remote-eval' runs in a dist= inct =2D ;; Guile REPL. =2D (setenv "GUIX_NEW_SYSTEM" system) =2D ;; The activation script may write to stdout, which confus= es =2D ;; 'remote-eval' when it attempts to read a result from the =2D ;; remote REPL. We work around this by forcing the output = to a =2D ;; string. =2D (with-output-to-string =2D (lambda () =2D (primitive-load #$script)))))))) =2D =2D (let* ((os (machine-system machine)) =2D (script (operating-system-activation-script os))) =2D (mlet* %store-monad ((drv (operating-system-derivation os))) =2D (machine-remote-eval machine (remote-exp drv script))))) =2D =2D;; XXX: Currently, this does NOT attempt to restart running services. Th= is is =2D;; also the case with 'guix system reconfigure'. =2D;; =2D;; See . =2D(define (upgrade-shepherd-services machine) =2D "Monadic procedure unloading and starting services on the remote as ne= eded =2Dto realize the MACHINE's system configuration." =2D (define target-services =2D ;; Monadic expression evaluating to a list of (name output-path) pai= rs for =2D ;; all of MACHINE's services. =2D (mapm %store-monad =2D (lambda (service) =2D (mlet %store-monad ((file ((compose lower-object =2D shepherd-service-file) =2D service))) =2D (return (list (shepherd-service-canonical-name service) =2D (derivation->output-path file))))) =2D (service-value =2D (fold-services (operating-system-services (machine-system mac= hine)) =2D #:target-type shepherd-root-service-type)))) =2D =2D (define (remote-exp target-services) =2D (with-imported-modules '((gnu services herd)) =2D #~(begin =2D (use-modules (gnu services herd) =2D (srfi srfi-1)) =2D =2D (define running =2D (filter live-service-running (current-services))) =2D =2D (define (essential? service) =2D ;; Return #t if SERVICE is essential and should not be unloa= ded =2D ;; under any circumstance. =2D (memq (first (live-service-provision service)) =2D '(root shepherd))) =2D =2D (define (obsolete? service) =2D ;; Return #t if SERVICE can be safely unloaded. =2D (and (not (essential? service)) =2D (every (lambda (requirements) =2D (not (memq (first (live-service-provision serv= ice)) =2D requirements))) =2D (map live-service-requirement running)))) =2D =2D (define to-unload =2D (filter obsolete? =2D (remove (lambda (service) =2D (memq (first (live-service-provision servi= ce)) =2D (map first '#$target-services))) =2D running))) =2D =2D (define to-start =2D (remove (lambda (service-pair) =2D (memq (first service-pair) =2D (map (compose first live-service-provision) =2D running))) =2D '#$target-services)) =2D =2D ;; Unload obsolete services. =2D (for-each (lambda (service) =2D (false-if-exception =2D (unload-service service))) =2D to-unload) =2D =2D ;; Load the service files for any new services and start them. =2D (load-services/safe (map second to-start)) =2D (for-each start-service (map first to-start)) =2D =2D #t))) =2D =2D (mlet %store-monad ((target-services target-services)) =2D (machine-remote-eval machine (remote-exp target-services)))) =2D (define (machine-boot-parameters machine) "Monadic procedure returning a list of 'boot-parameters' for the generat= ions of MACHINE's system profile, ordered from most recent to oldest." @@ -275,71 +169,99 @@ of MACHINE's system profile, ordered from most recent= to oldest." (boot-parameters-kernel-arguments params)))))))) generations)))) =20 =2D(define (install-bootloader machine) =2D "Create a bootloader entry for the new system generation on MACHINE, a= nd =2Dconfigure the bootloader to boot that generation by default." =2D (define bootloader-installer-script =2D (@@ (guix scripts system) bootloader-installer-script)) =2D =2D (define (remote-exp installer bootcfg bootcfg-file) =2D (with-extensions (list guile-gcrypt) =2D (with-imported-modules (source-module-closure '((gnu build install) =2D (guix store) =2D (guix utils))) =2D #~(begin =2D (use-modules (gnu build install) =2D (guix store) =2D (guix utils)) =2D (let* ((gc-root (string-append "/" %gc-roots-directory "/boo= tcfg")) =2D (temp-gc-root (string-append gc-root ".new"))) =2D =2D (switch-symlinks temp-gc-root gc-root) =2D =2D (unless (false-if-exception =2D (begin =2D ;; The implementation of 'guix system reconfigu= re' =2D ;; saves the load path here. This is unnecessar= y here =2D ;; because each invocation of 'remote-eval' run= s in a =2D ;; distinct Guile REPL. =2D (install-boot-config #$bootcfg #$bootcfg-file "= /") =2D ;; The installation script may write to stdout,= which =2D ;; confuses 'remote-eval' when it attempts to r= ead a =2D ;; result from the remote REPL. We work around = this =2D ;; by forcing the output to a string. =2D (with-output-to-string =2D (lambda () =2D (primitive-load #$installer))))) =2D (delete-file temp-gc-root) =2D (error "failed to install bootloader")) =2D =2D (rename-file temp-gc-root gc-root) =2D #t))))) =2D =2D (mlet* %store-monad ((boot-parameters (machine-boot-parameters machine= ))) =2D (let* ((os (machine-system machine)) =2D (bootloader ((compose bootloader-configuration-bootloader =2D operating-system-bootloader) =2D os)) =2D (bootloader-target (bootloader-configuration-target =2D (operating-system-bootloader os))) =2D (installer (bootloader-installer-script =2D (bootloader-installer bootloader) =2D (bootloader-package bootloader) =2D bootloader-target =2D "/")) =2D (menu-entries (map boot-parameters->menu-entry boot-parameter= s)) =2D (bootcfg (operating-system-bootcfg os menu-entries)) =2D (bootcfg-file (bootloader-configuration-file bootloader))) =2D (machine-remote-eval machine (remote-exp installer bootcfg bootcfg= -file))))) +(define (machine-current-services machine) + "Return the objects that are currently running on MACHINE= ." + (define remote-exp + (with-imported-modules '((gnu services herd)) + #~(begin + (use-modules (gnu services herd)) + (let ((services (current-services))) + (and services + ;; 'live-service-running' is ignored, as we can't necessa= rily + ;; serialize arbitrary objects. This should be fine for n= ow, + ;; since 'machine-current-services' is not exposed public= ly, + ;; and the resultant objects are only used= for + ;; resolving service dependencies. + (map (lambda (service) + (list (live-service-provision service) + (live-service-requirement service))) + services)))))) + (mlet %store-monad ((services (machine-remote-eval machine remote-exp))) + (return (map (match-lambda + ((provision requirement) + (live-service provision requirement #f))) + services)))) =20 (define (deploy-managed-host machine) "Internal implementation of 'deploy-machine' for MACHINE instances with = an environment type of 'managed-host." + (define target-services + (service-value + (fold-services (operating-system-services (machine-system machine)) + #:target-type shepherd-root-service-type))) + + (define (run-switch-to-system machine) + "Monadic procedure serializing the items in MACHINE necessary to build= a +G-Expression with 'switch-to-system'." + (machine-remote-eval machine #~(primitive-load + #$(switch-system-program + (machine-system machine))))) + + (define (run-upgrade-shepherd-services machine) + "Monadic procedure serializing the items in MACHINE necessary to build= a +G-Expression with 'upgrade-shepherd-services'." + (mlet* %store-monad ((live-services (machine-current-services machine)= )) + (let-values (((to-unload to-restart) + (shepherd-service-upgrade live-services target-service= s))) + (let* ((to-unload (map live-service-canonical-name to-unload)) + (to-restart (map shepherd-service-canonical-name to-restart= )) + (to-start (lset-difference + eqv? + (map shepherd-service-canonical-name target-serv= ices) + (map live-service-canonical-name live-services))) + (service-files + (map shepherd-service-file + (filter (lambda (service) + (memq (shepherd-service-canonical-name serv= ice) + to-start)) + target-services)))) + (machine-remote-eval machine + #~(primitive-load + #$(upgrade-services-program service-files + to-start + to-unload + to-restart))= ))))) + + (define (run-install-bootloader machine) + "Monadic procedure serializing the items in MACHINE necessary to build= a +G-Expression with 'install-bootloader'." + (mlet %store-monad ((boot-parameters (machine-boot-parameters machine)= )) + (let* ((os (machine-system machine)) + (bootloader ((compose bootloader-configuration-bootloader + operating-system-bootloader) + os)) + (target (bootloader-configuration-target + (operating-system-bootloader os))) + (installer (bootloader-installer-script + (bootloader-installer bootloader) + (bootloader-package bootloader) + target + "/")) + (menu-entries (map boot-parameters->menu-entry boot-parameter= s)) + (bootcfg (operating-system-bootcfg os menu-entries)) + (bootcfg-file (bootloader-configuration-file bootloader))) + (machine-remote-eval machine + #~(primitive-load + #$(install-bootloader-program installer + bootcfg + bootcfg-file + "/")))))) + (maybe-raise-unsupported-configuration-error machine) =2D (mbegin %store-monad =2D (switch-to-system machine) =2D (upgrade-shepherd-services machine) =2D (install-bootloader machine))) + (mapm %store-monad (cut <> machine) + (list run-switch-to-system + run-install-bootloader + run-upgrade-shepherd-services))) =20 ;;; diff --git a/gnu/services/herd.scm b/gnu/services/herd.scm index 0008746fe..2207b2d34 100644 =2D-- a/gnu/services/herd.scm +++ b/gnu/services/herd.scm @@ -40,10 +40,12 @@ unknown-shepherd-error? unknown-shepherd-error-sexp =20 + live-service live-service? live-service-provision live-service-requirement live-service-running + live-service-canonical-name =20 with-shepherd-action current-services @@ -192,6 +194,10 @@ of pairs." (requirement live-service-requirement) ;list of symbols (running live-service-running)) ;#f | object =20 +(define (live-service-canonical-name service) + "Return the 'canonical name' of SERVICE." + (first (live-service-provision service))) + (define (current-services) "Return the list of currently defined Shepherd services, represented as objects. Return #f if the list of services could not be diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 60c1ca5c9..21858ee7d 100644 =2D-- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -70,6 +70,7 @@ #:use-module (ice-9 match) #:use-module (rnrs bytevectors) #:export (guix-system + bootloader-installer-script read-operating-system)) =20 diff --git a/guix/scripts/system/reconfigure.scm b/guix/scripts/system/reco= nfigure.scm new file mode 100644 index 000000000..9491bde34 =2D-- /dev/null +++ b/guix/scripts/system/reconfigure.scm @@ -0,0 +1,170 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright =C2=A9 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Court=C3= =A8s +;;; Copyright =C2=A9 2016 Alex Kost +;;; Copyright =C2=A9 2016, 2017, 2018 Chris Marusich +;;; Copyright =C2=A9 2017 Mathieu Othacehe +;;; Copyright =C2=A9 2018 Ricardo Wurmus +;;; Copyright =C2=A9 2019 Christopher Baines +;;; 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 (guix scripts system reconfigure) + #:autoload (gnu packages gnupg) (guile-gcrypt) + #:use-module (gnu system) + #:use-module (guix gexp) + #:use-module (guix modules) + #:export (switch-system-program + upgrade-services-program + install-bootloader-program)) + +;;; Commentary: +;;; +;;; This module implements the "effectful" parts of system +;;; reconfiguration. Although building a system derivation is a pure +;;; operation, a number of impure operations must be carried out for the +;;; system configuration to be realized -- chiefly, creation of generation +;;; symlinks and invocation of activation scripts. +;;; +;;; Code: + +(define* (switch-system-program os #:optional profile) + "Return as a monadic value a derivation to build a scheme file that, upon +being evaluated, will create a new generation of PROFILE pointing to the +directory of OS, switch to it atomically, and run OS's activation script, +returning any textual output produced by the activation script as a string= ." + (gexp->script + "switch-to-system.scm" + (with-extensions (list guile-gcrypt) + (with-imported-modules (source-module-closure '((guix config) + (guix profiles) + (guix utils))) + #~(begin + (use-modules (guix config) + (guix profiles) + (guix utils)) + + (define profile + (or #$profile (string-append %state-directory "/profiles/syst= em"))) + + (let* ((number (1+ (generation-number profile))) + (generation (generation-file-name profile number))) + (switch-symlinks generation #$os) + (switch-symlinks profile generation) + (setenv "GUIX_NEW_SYSTEM" #$os) + (with-output-to-string + (lambda () + (primitive-load + #$(operating-system-activation-script os)))))))))) + +;; XXX: Currently, this does NOT attempt to restart running services. See +;; for details. +(define (upgrade-services-program target-services) + "Return as a monadic value a derivation to build a scheme file that, upon +being evaluated, will upgrade the Shepherd (PID 1) by unloading obsolete +services and loading new services. TARGET-SERVICES is a list +of (shepherd-service-canonical-name, shepherd-service-file) pairs used for +determining which services are obsolete, as well as which are new." + (gexp->script + "upgrade-shepherd-services.scm" + (with-imported-modules '((gnu services herd)) + #~(begin + (use-modules (gnu services herd) + (srfi srfi-1)) + + (define (call-with-shepherd-error-handling proc) + (lambda (service) + (catch 'system-error + (lambda () + (proc service) + #f) + (lambda (key proc format-string format-args errno . rest) + (apply format #f format-string format-args))))) + + (define running + (filter live-service-running (current-services))) + + (define (essential? service) + ;; Return #t if SERVICE is essential and should not be unloaded + ;; under any circumstance. + (memq (first (live-service-provision service)) + '(root shepherd))) + + (define (obsolete? service) + ;; Return #t if SERVICE can be safely unloaded. + (and (not (essential? service)) + (every (lambda (requirements) + (not (memq (first (live-service-provision service)) + requirements))) + (map live-service-requirement running)))) + + (define to-unload + (filter obsolete? + (remove (lambda (service) + (memq (first (live-service-provision service)) + (map first '#$target-services))) + running))) + + (define to-start + (remove (lambda (service-pair) + (memq (first service-pair) + (map (compose first live-service-provision) + running))) + '#$target-services)) + + ;; Load the service files for any new services. + (load-services/safe (map second to-start)) + + ;; Unload obsolete services and start new services. + (filter string? + (append (map (call-with-shepherd-error-handling unload-ser= vice) + to-unload) + (map (call-with-shepherd-error-handling start-serv= ice) + (map first to-start)))))))) + +(define (install-bootloader-program installer-script bootcfg bootcfg-file = target) + "Return as a monadic value a derivation to build a scheme file that, upon +being evaluated, will install BOOTCFG to BOOTCFG-FILE, a target file name,= on +TARGET, a mount point, and subsequently run INSTALLER-SCRIPT, returning any +textual output produced by the installer script as a string." + (gexp->script + "install-bootloader.scm" + (with-extensions (list guile-gcrypt) + (with-imported-modules (source-module-closure '((gnu build install) + (guix store) + (guix utils))) + #~(begin + (use-modules (gnu build install) + (guix store) + (guix utils)) + (let* ((gc-root (string-append #$target %gc-roots-directory "/b= ootcfg")) + (temp-gc-root (string-append gc-root ".new"))) + + (switch-symlinks temp-gc-root gc-root) + + (let ((installer-result + (false-if-exception + (begin + (install-boot-config #$bootcfg #$bootcfg-file #$tar= get) + (with-output-to-string + (lambda () + (when #$installer-script + (primitive-load #$installer-script)))))))) + (unless installer-result + (delete-file temp-gc-root) + (error "failed to install bootloader")) + (rename-file temp-gc-root gc-root) + installer-result))))))) diff --git a/tests/services.scm b/tests/services.scm index 44ad0022c..572fe3816 100644 =2D-- a/tests/services.scm +++ b/tests/services.scm @@ -26,10 +26,6 @@ #:use-module (srfi srfi-64) #:use-module (ice-9 match)) =20 =2D(define live-service =2D (@@ (gnu services herd) live-service)) =2D =2D (test-begin "services") =20 (test-equal "services, default value" =2D-=20 2.22.0 --=-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQIzBAEBCAAdFiEEa1VJLOiXAjQ2BGSm9Qb9Fp2P2VoFAl0uYggACgkQ9Qb9Fp2P 2Vrkig/9G3FfHz/uhPF7b9mBBJYAm2ei1Yo5xxkx0VPIi3uqhXniW1N2ub4GiSOP QWf1JYNH7lh1simm0bXBUqalsOwuyliGgzzRIsDFF4YoBQ4iDQytKwnlRrKAjbNn 2hiSpQqkp7qgJBXtNJb3+/u1SBRXq/R6X/gf+ha2/f7rzOn8SR1LuPMxoQ38leOG QnDV8F5hrdydyX2XPqsX7/5r5kGx9ueSg4iapYtu+roynQE33SX77ZWhs/dD+nVK RgZhhys4z6VjgRCvtOy0jLLIRXkNCRrehCXy9ZKs55dNtYuCci7PHPdf1R+8zp31 ofYqc3b8feMOUYKqHQYsG5dmwnpWWTZ6+5PrmzG+XEjQ1KG+HoAMisr4yncQY1jg oWdwJedm4GEBQRQ+WUm6NtxCHgXr6fkmG6/bOYbqop7VB2AbH3HAvdaxCowvyhwM ClzKF/0iJ0IeNjlAKSWKOIucXgjG9ymOa3pwCIjXm7Zz9lZzwO23zve00jL2LKMw oDRQCrBwZKlivLlA9FU4IhE3JM7sXt9getLqwnswloL/AAObDOecie2m9hJPCVZc tuKqosiz03Y0VhIG9g8ZFB1g3h1iYjnUH7dg8g4xqd4XDsKrGKFkgzSMWHme0aW1 7retDzfYU44F4qhkzIq/0FwWku+xTZHgMv4AANyPPqfnAFi9Wx0= =nxZS -----END PGP SIGNATURE----- --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Tue Jul 16 19:48:20 2019 Received: (at 36555) by debbugs.gnu.org; 16 Jul 2019 23:48:20 +0000 Received: from localhost ([127.0.0.1]:51348 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hnXBD-00044R-C0 for submit@debbugs.gnu.org; Tue, 16 Jul 2019 19:48:20 -0400 Received: from mx.sdf.org ([205.166.94.20]:54395) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hnXBA-00044H-17 for 36555@debbugs.gnu.org; Tue, 16 Jul 2019 19:48:17 -0400 Received: from Upsilon (mobile-107-107-59-57.mycingular.net [107.107.59.57]) (authenticated (0 bits)) by mx.sdf.org (8.15.2/8.14.5) with ESMTPSA id x6GNmAje022067 (using TLSv1.2 with cipher AES256-GCM-SHA384 (256 bits) verified NO); Tue, 16 Jul 2019 23:48:13 GMT From: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) To: 36555@debbugs.gnu.org Subject: Re: [bug#36555] [PATCH v3 2/3] guix system: Reimplement 'reconfigure'. 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> <87r26pzgmx.fsf_-_@sdf.lonestar.org> Date: Tue, 16 Jul 2019 19:48:09 -0400 In-Reply-To: <87r26pzgmx.fsf_-_@sdf.lonestar.org> (Jakob L. Kreuze's message of "Tue, 16 Jul 2019 19:47:18 -0400") Message-ID: <87muhdzgli.fsf_-_@sdf.lonestar.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha256; protocol="application/pgp-signature" X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 36555 Cc: Ludovic =?utf-8?Q?Court=C3=A8s?= X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= Content-Type: text/plain Content-Transfer-Encoding: quoted-printable * guix/scripts/system.scm (switch-to-system) (upgrade-shepherd-services, install-bootloader): Delete variable. * guix/scripts/system.scm (%switch-to-system) (%upgrade-shepherd-services, %install-bootloader): New variable. =2D-- guix/scripts/system.scm | 151 +++++++++------------------- guix/scripts/system/reconfigure.scm | 116 +++++++-------------- 2 files changed, 79 insertions(+), 188 deletions(-) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 21858ee7d..b59818577 100644 =2D-- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -41,6 +41,7 @@ delete-matching-generations) #:use-module (guix graph) #:use-module (guix scripts graph) + #:use-module (guix scripts system reconfigure) #:use-module (guix build utils) #:use-module (guix progress) #:use-module ((guix build syscalls) #:select (terminal-columns)) @@ -179,38 +180,14 @@ TARGET, and register them." =20 (return *unspecified*))) =20 =2D(define* (install-bootloader installer =2D #:key =2D bootcfg bootcfg-file =2D target) +(define (install-bootloader installer bootcfg bootcfg-file target) "Run INSTALLER, a bootloader installation script, with error handling, in %STORE-MONAD." =2D (mlet %store-monad ((installer-drv (if installer =2D (lower-object installer) =2D (return #f))) =2D (bootcfg (lower-object bootcfg))) =2D (let* ((gc-root (string-append target %gc-roots-directory =2D "/bootcfg")) =2D (temp-gc-root (string-append gc-root ".new")) =2D (install (and installer-drv =2D (derivation->output-path installer-drv))) =2D (bootcfg (derivation->output-path bootcfg))) =2D ;; Prepare the symlink to bootloader config file to make sure that= it's =2D ;; a GC root when 'installer-drv' completes (being a bit paranoid.) =2D (switch-symlinks temp-gc-root bootcfg) =2D =2D (unless (false-if-exception =2D (begin =2D (install-boot-config bootcfg bootcfg-file target) =2D (when install =2D (save-load-path-excursion (primitive-load install))))) =2D (delete-file temp-gc-root) =2D (leave (G_ "failed to install bootloader ~a~%") install)) =2D =2D ;; Register bootloader config file as a GC root so that its depend= encies =2D ;; (background image, font, etc.) are not reclaimed. =2D (rename-file temp-gc-root gc-root) =2D (return #t)))) + (mlet* %store-monad ((file (lower-object + (install-bootloader-program installer bootcfg + bootcfg-file tar= get))) + (_ (built-derivations (list file)))) + (return (primitive-load (derivation->output-path file))))) =20 (define* (install os-drv target #:key (log-port (current-output-port)) @@ -266,10 +243,8 @@ the ownership of '~a' may be incorrect!~%") (populate os-dir target) =20 (mwhen install-bootloader? =2D (install-bootloader bootloader-installer =2D #:bootcfg bootcfg =2D #:bootcfg-file bootcfg-file =2D #:target target)))))) + (install-bootloader bootloader-installer bootcfg + bootcfg-file target)))))) =20 ;;; @@ -343,74 +318,39 @@ services specified in OS and not currently running. This is currently very conservative in that it does not stop or unload any running service. Unloading or stopping the wrong service ('udev', say) co= uld bring the system down." =2D (define new-services + (define target-services (service-value (fold-services (operating-system-services os) #:target-type shepherd-root-service-type))) =20 =2D ;; Arrange to simply emit a warning if the service upgrade fails. =2D (with-shepherd-error-handling =2D (call-with-service-upgrade-info new-services =2D (lambda (to-restart to-unload) =2D (for-each (lambda (unload) =2D (info (G_ "unloading service '~a'...~%") unload) =2D (unload-service unload)) =2D to-unload) =2D =2D (with-monad %store-monad =2D (munless (null? new-services) =2D (let ((new-service-names (map shepherd-service-canonical-na= me new-services)) =2D (to-restart-names (map shepherd-service-canonical-na= me to-restart)) =2D (to-start (filter shepherd-service-auto-star= t? new-services))) =2D (info (G_ "loading new services:~{ ~a~}...~%") new-service= -names) =2D (unless (null? to-restart-names) =2D ;; Listing TO-RESTART-NAMES in the message below wouldn'= t help =2D ;; because many essential services cannot be meaningfully =2D ;; restarted. See . =2D (format #t (G_ "To complete the upgrade, run 'herd resta= rt SERVICE' to stop, =2Dupgrade, and restart each service that was not automatically restarted.\= n"))) =2D (mlet %store-monad ((files (mapm %store-monad =2D (compose lower-object =2D shepherd-service= -file) =2D new-services))) =2D ;; Here we assume that FILES are exactly those that were= computed =2D ;; as part of the derivation that built OS, which is nor= mally the =2D ;; case. =2D (load-services/safe (map derivation->output-path files)) =2D =2D (for-each start-service =2D (map shepherd-service-canonical-name to-start)) =2D (return #t))))))))) =2D =2D(define* (switch-to-system os =2D #:optional (profile %system-profile)) =2D "Make a new generation of PROFILE pointing to the directory of OS, swi= tch to =2Dit atomically, and then run OS's activation script." =2D (mlet* %store-monad ((drv (operating-system-derivation os)) =2D (script (lower-object (operating-system-activatio= n-script os)))) =2D (let* ((system (derivation->output-path drv)) =2D (number (+ 1 (generation-number profile))) =2D (generation (generation-file-name profile number))) =2D (switch-symlinks generation system) =2D (switch-symlinks profile generation) =2D =2D (format #t (G_ "activating system...~%")) =2D =2D ;; The activation script may change $PATH, among others, so protect =2D ;; against that. =2D (save-environment-excursion =2D ;; Tell 'activate-current-system' what the new system is. =2D (setenv "GUIX_NEW_SYSTEM" system) =2D =2D ;; The activation script may modify '%load-path' & co., so protect =2D ;; against that. This is necessary to ensure that =2D ;; 'upgrade-shepherd-services' gets to see the right modules when= it =2D ;; computes derivations with 'gexp->derivation'. =2D (save-load-path-excursion =2D (primitive-load (derivation->output-path script)))) =2D =2D ;; Finally, try to update system services. =2D (upgrade-shepherd-services os)))) + (let-values (((to-unload to-restart) + (shepherd-service-upgrade (current-services) target-servic= es))) + (let* ((to-unload (map live-service-canonical-name to-unload)) + (to-restart (map shepherd-service-canonical-name to-restart)) + (to-start (lset-difference + eqv? + (map shepherd-service-canonical-name target-services) + (map live-service-canonical-name (current-services))= )) + (service-files + (map shepherd-service-file + (filter (lambda (service) + (memq (shepherd-service-canonical-name service) + to-start)) + target-services)))) + (mlet* %store-monad ((file (lower-object + (upgrade-services-program service-files + to-start + to-unload + to-restart))) + (_ (built-derivations (list file)))) + (return (primitive-load (derivation->output-path file))))))) + +(define (switch-to-system os) + "Make a new generation of PROFILE pointing to the directory of OS, switch +to it atomically, and then run OS's activation script." + (mlet* %store-monad ((file (lower-object (switch-system-program os))) + (_ (built-derivations (list file)))) + (return (primitive-load (derivation->output-path file))))) =20 (define-syntax-rule (unless-file-not-found exp) (catch 'system-error @@ -514,10 +454,7 @@ STORE is an open connection to the store." (built-derivations drvs) ;; Only install bootloader configuration file. Thus, no installe= r is ;; provided here. =2D (install-bootloader #f =2D #:bootcfg bootcfg =2D #:bootcfg-file bootcfg-file =2D #:target target)))))) + (install-bootloader #f bootcfg bootcfg-file target)))))) =20 ;;; @@ -918,13 +855,15 @@ static checks." =20 (case action ((reconfigure) + (newline) + (format #t (G_ "activating system...~%")) (mbegin %store-monad (switch-to-system os) (mwhen install-bootloader? =2D (install-bootloader bootloader-script =2D #:bootcfg bootcfg =2D #:bootcfg-file bootcfg-file =2D #:target "/")))) + (install-bootloader bootloader-script bootcfg + bootcfg-file (or target "/"))) + (with-shepherd-error-handling + (upgrade-shepherd-services os)))) ((init) (newline) (format #t (G_ "initializing operating system under '~a'...~%= ") diff --git a/guix/scripts/system/reconfigure.scm b/guix/scripts/system/reco= nfigure.scm index 9491bde34..1ef656f0c 100644 =2D-- a/guix/scripts/system/reconfigure.scm +++ b/guix/scripts/system/reconfigure.scm @@ -42,11 +42,11 @@ ;;; Code: =20 (define* (switch-system-program os #:optional profile) =2D "Return as a monadic value a derivation to build a scheme file that, u= pon =2Dbeing evaluated, will create a new generation of PROFILE pointing to the =2Ddirectory of OS, switch to it atomically, and run OS's activation script, =2Dreturning any textual output produced by the activation script as a stri= ng." =2D (gexp->script + "Return an executable store item that, upon being evaluated, will create= a +new generation of PROFILE pointing to the directory of OS, switch to it +atomically, and run OS's activation script, returning any textual output +produced by the activation script as a string." + (program-file "switch-to-system.scm" (with-extensions (list guile-gcrypt) (with-imported-modules (source-module-closure '((guix config) @@ -65,82 +65,36 @@ returning any textual output produced by the activation= script as a string." (switch-symlinks generation #$os) (switch-symlinks profile generation) (setenv "GUIX_NEW_SYSTEM" #$os) =2D (with-output-to-string =2D (lambda () =2D (primitive-load =2D #$(operating-system-activation-script os)))))))))) + (primitive-load #$(operating-system-activation-script os)))))= ))) =20 ;; XXX: Currently, this does NOT attempt to restart running services. See ;; for details. =2D(define (upgrade-services-program target-services) =2D "Return as a monadic value a derivation to build a scheme file that, u= pon =2Dbeing evaluated, will upgrade the Shepherd (PID 1) by unloading obsolete =2Dservices and loading new services. TARGET-SERVICES is a list =2Dof (shepherd-service-canonical-name, shepherd-service-file) pairs used f= or =2Ddetermining which services are obsolete, as well as which are new." =2D (gexp->script +(define (upgrade-services-program service-files to-start to-unload to-rest= art) + "Return an executable store item that, upon being evaluated, will upgrade +the Shepherd (PID 1) by unloading obsolete services and loading new +services. SERVICE-FILES is a list of Shepherd service files to load, and +TO-START, TO-UNLOAD, and TO-RESTART are lists of the Shepherd services' +canonical names (symbols)." + (program-file "upgrade-shepherd-services.scm" (with-imported-modules '((gnu services herd)) #~(begin (use-modules (gnu services herd) (srfi srfi-1)) =20 =2D (define (call-with-shepherd-error-handling proc) =2D (lambda (service) =2D (catch 'system-error =2D (lambda () =2D (proc service) =2D #f) =2D (lambda (key proc format-string format-args errno . rest) =2D (apply format #f format-string format-args))))) =2D =2D (define running =2D (filter live-service-running (current-services))) =2D =2D (define (essential? service) =2D ;; Return #t if SERVICE is essential and should not be unloaded =2D ;; under any circumstance. =2D (memq (first (live-service-provision service)) =2D '(root shepherd))) =2D =2D (define (obsolete? service) =2D ;; Return #t if SERVICE can be safely unloaded. =2D (and (not (essential? service)) =2D (every (lambda (requirements) =2D (not (memq (first (live-service-provision servic= e)) =2D requirements))) =2D (map live-service-requirement running)))) =2D =2D (define to-unload =2D (filter obsolete? =2D (remove (lambda (service) =2D (memq (first (live-service-provision service= )) =2D (map first '#$target-services))) =2D running))) =2D =2D (define to-start =2D (remove (lambda (service-pair) =2D (memq (first service-pair) =2D (map (compose first live-service-provision) =2D running))) =2D '#$target-services)) =2D ;; Load the service files for any new services. =2D (load-services/safe (map second to-start)) + (load-services/safe '#$service-files) =20 ;; Unload obsolete services and start new services. =2D (filter string? =2D (append (map (call-with-shepherd-error-handling unload-s= ervice) =2D to-unload) =2D (map (call-with-shepherd-error-handling start-se= rvice) =2D (map first to-start)))))))) + (for-each unload-service '#$to-unload) + (for-each start-service '#$to-start))))) =20 (define (install-bootloader-program installer-script bootcfg bootcfg-file = target) =2D "Return as a monadic value a derivation to build a scheme file that, u= pon =2Dbeing evaluated, will install BOOTCFG to BOOTCFG-FILE, a target file nam= e, on =2DTARGET, a mount point, and subsequently run INSTALLER-SCRIPT, returning = any =2Dtextual output produced by the installer script as a string." =2D (gexp->script + "Return an executable store item that, upon being evaluated, will install +BOOTCFG to BOOTCFG-FILE, a target file name, on TARGET, a mount point, and +subsequently run INSTALLER-SCRIPT, returning any textual output produced by +the installer script as a string." + (program-file "install-bootloader.scm" (with-extensions (list guile-gcrypt) (with-imported-modules (source-module-closure '((gnu build install) @@ -152,19 +106,17 @@ textual output produced by the installer script as a = string." (guix utils)) (let* ((gc-root (string-append #$target %gc-roots-directory "/b= ootcfg")) (temp-gc-root (string-append gc-root ".new"))) =2D (switch-symlinks temp-gc-root gc-root) =2D =2D (let ((installer-result =2D (false-if-exception =2D (begin =2D (install-boot-config #$bootcfg #$bootcfg-file #$t= arget) =2D (with-output-to-string =2D (lambda () =2D (when #$installer-script =2D (primitive-load #$installer-script)))))))) =2D (unless installer-result =2D (delete-file temp-gc-root) =2D (error "failed to install bootloader")) =2D (rename-file temp-gc-root gc-root) =2D installer-result))))))) + (install-boot-config #$bootcfg #$bootcfg-file #$target) + ;; Preserve the previous activation's garbage collector root + ;; until the bootloader installer has run, so that a failure = in + ;; the bootloader's installer script doesn't leave the user w= ith + ;; a broken installation. + (when #$installer-script + (catch #t + (lambda () + (primitive-load #$installer-script)) + (lambda args + (delete-file temp-gc-root) + (apply throw args)))) + (rename-file temp-gc-root gc-root))))))) =2D-=20 2.22.0 --=-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQIzBAEBCAAdFiEEa1VJLOiXAjQ2BGSm9Qb9Fp2P2VoFAl0uYjkACgkQ9Qb9Fp2P 2VrF3A//QZIg17J8CNX0Q5rukZq9Y1X1tEV7z0BIFSOFUQQJN21gtYt+al+i4XaD 0ANzUy+fOW6/6/crQqRmBgyQkByENBm74SgZeT7tD6d56dI70pb40DWkvCDil7Uf wIlWRL1FLyuw5PeBBKC4yA87x/AqywNYJM8uPxu2ncXmTBBvZU5989fUa40y2Am/ g0pRJkhG3M9h3xsAM2cbmTxDbWBU0P93bZX+H2tCoRdLAzPM8VdM3jdVo623UNhQ hzBu9/rNdM+/Ty4ygYlhnP+1SjbbNMQsQDVBECPfRPcxJXWJV12fS3UxVbsOQxyV lTNhDWjona4EpLED2y9y0EAO3/llmoKIH/Hs0bdnKBACAy/qfyo91pvCZbt/N9IR 6mHzHujC/hWdogNZSaD/3GkTHhpM+Rp4X4VFBpJJ9tX/ZZOLwxyrAcVcw1j/zgFw 5u+HmL3QCZ56L6ZrtDTucfaq8nlQrfBFU1CMBHrQ8pOWtuaNJ62zDP6g3nmcL6zk r1Gxcrrh/nJReKvuRgx13i7R4C9lEQeWyQabhEtqK9lxxNMA5t4VBB7vUJj11FHF F9QhwspdgXVeRzKAMehakUM2X4Jsrl9x8lETve6UdSUt2vupOknVuI6P+WWonxgl GUame1vP1AYmZKJrGSBWevGJkX0+MmrNfKCvfsgJZDb/Z5buAHQ= =Vm52 -----END PGP SIGNATURE----- --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Tue Jul 16 19:49:09 2019 Received: (at 36555) by debbugs.gnu.org; 16 Jul 2019 23:49:10 +0000 Received: from localhost ([127.0.0.1]:51352 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hnXC1-000463-8u for submit@debbugs.gnu.org; Tue, 16 Jul 2019 19:49:09 -0400 Received: from mx.sdf.org ([205.166.94.20]:54162) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hnXBy-00045u-U4 for 36555@debbugs.gnu.org; Tue, 16 Jul 2019 19:49:07 -0400 Received: from Upsilon (mobile-107-107-59-57.mycingular.net [107.107.59.57]) (authenticated (0 bits)) by mx.sdf.org (8.15.2/8.14.5) with ESMTPSA id x6GNn1lR029387 (using TLSv1.2 with cipher AES256-GCM-SHA384 (256 bits) verified NO); Tue, 16 Jul 2019 23:49:03 GMT From: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) To: 36555@debbugs.gnu.org Subject: Re: [bug#36555] [PATCH v3 3/3] tests: Add reconfigure system test. 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> <87r26pzgmx.fsf_-_@sdf.lonestar.org> <87muhdzgli.fsf_-_@sdf.lonestar.org> Date: Tue, 16 Jul 2019 19:48:57 -0400 In-Reply-To: <87muhdzgli.fsf_-_@sdf.lonestar.org> (Jakob L. Kreuze's message of "Tue, 16 Jul 2019 19:48:09 -0400") Message-ID: <87ims1zgk6.fsf_-_@sdf.lonestar.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha256; protocol="application/pgp-signature" X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 36555 Cc: Ludovic =?utf-8?Q?Court=C3=A8s?= X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= 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 | 268 ++++++++++++++++++++++++++++++++++++++ 2 files changed, 269 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..251e96b3e =2D-- /dev/null +++ b/gnu/tests/reconfigure.scm @@ -0,0 +1,268 @@ +;;; 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 networking) + #:use-module (gnu services shepherd) + #:use-module (gnu services) + #: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) + #: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)) + (target (bootloader-configuration-target + (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 bootcfg bootcfg-file "/"))))) + +(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----- iQIzBAEBCAAdFiEEa1VJLOiXAjQ2BGSm9Qb9Fp2P2VoFAl0uYmsACgkQ9Qb9Fp2P 2Vom2w//bYTew5NWY+jY2PuSQGqAYUPO24Qz6yRxEP5kQdfU2Fkx9g9A6FjcopTd 29JkrJKWyu8r4p5U1SmR/XxHfERKVNo3sDK0LpGNbN4/JtBYhj+CPZu8BBpGRJme D/KQn/gSGPBQZA8peG/KyjBuHrHn6K1jJLFhgj6+bDQeqAQ4o7Q5z0I1Ebe8Ucph aW8zyh7IAH80YLJZD25L43K6EP7G2HNAlMQUybzLIx2qTZexgvKd3Jf4bnccLfLV iCguhSxqDfUa2sKhIyveNg1hZb8W1AzqOIkGM1uC7KtTYIL/dyxEsGuU4ZxDx/3X gkNwI4WEYzEXeo6FeTTHpJ8sY+CWm7vmqvo3sVmIVg2/NmZu2DFWJ/PZM80DbtDa +xYtmON9gpfKOiICgKkigA6XeGDJHiICotXmPkPV/XU5kSsXgNEgZi3Q2KgMSvnF beUFiMuJ+N8V+ixctPDlLaVHjQUVyQN65W+nwqCYVqKirRjNfoSXKbzvWsqYCtS2 Uzdatx8ollNI8Ah/y2oRDsVEcZMeFe4Pp17CYV+UbnC3vPOUGVV6IFQIjLn9AL+4 Ts9OlmF3X3SiELdSE4qXnN3Io9VZ3XaJdoa+Y119eZmZ63aPc2q2XRWXn9su0Sdc 391NN8QAjpKupPpMjMlWWpwCUzi9actyytTIWk+YCKaB6Og/+zI= =g31/ -----END PGP SIGNATURE----- --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Thu Jul 18 18:50:56 2019 Received: (at 36555) by debbugs.gnu.org; 18 Jul 2019 22:50:56 +0000 Received: from localhost ([127.0.0.1]:54812 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hoFEl-0002vO-Sg for submit@debbugs.gnu.org; Thu, 18 Jul 2019 18:50:56 -0400 Received: from mx.sdf.org ([205.166.94.20]:58784) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hoFEg-0002vD-PN for 36555@debbugs.gnu.org; Thu, 18 Jul 2019 18:50:54 -0400 Received: from Upsilon (mobile-166-172-61-60.mycingular.net [166.172.61.60]) (authenticated (0 bits)) by mx.sdf.org (8.15.2/8.14.5) with ESMTPSA id x6IMojgu005544 (using TLSv1.2 with cipher AES256-GCM-SHA384 (256 bits) verified NO); Thu, 18 Jul 2019 22:50:48 GMT From: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) To: Ludovic =?utf-8?Q?Court=C3=A8s?= Subject: Re: [bug#36555] [PATCH v3 0/3] Refactor out common behavior for system reconfiguration. In-Reply-To: <87v9w1zgon.fsf_-_@sdf.lonestar.org> (Jakob L. Kreuze's message of "Tue, 16 Jul 2019 19:46:16 -0400") 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> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2 (gnu/linux) Date: Thu, 18 Jul 2019 18:50:41 -0400 Message-ID: <87y30v3qke.fsf@sdf.lonestar.org> MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha256; protocol="application/pgp-signature" X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 36555 Cc: 36555@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Hello to anyone reviewing this patch, I probably should've held off on sending this reroll out. After taking some more time to experiment with possible solutions, I was able to figure most of this out. Comments would still be appreciated, but the points I specifically asked for comments on no longer need special treatment. Also, if you haven't already started reviewing this, v4 will likely hit the mailing list tomorrow; everything's there, it just needs to be cleaned up. zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) writes: > I still need to handle failed deployments in 'guix deploy'. I suspect > that, for now, it would make sense to implement remote roll-backs and > just roll-back the system on failure, at least until we've have some > dialog about the proper way to do atomic deployments. Well, except for this. I'll submit a separate patch series addressing this. > My biggest concern at the moment is error handling reporting in the > new 'guix system reconfigure'. I'd like to emulate what was done with > the previous version, but I'm at somewhat of a loss for how I'd go > about that, since the error reporting was mixed with the > reconfiguration code. So I'd like to ask for some suggestions: is the > best way to catch errors in '%store-monad' to do what > 'with-shepherd-error-handling' does, and then 'leave' on failure? > > Ludovic suggested guarding against 'message-condition' and having the > expression I send to 'remote-eval' return either ('error message) or > ('success). Would it make sense to just do this in all of the > reconfiguration procedures? Or is raising exceptions in the > reconfiguration procedures and catching them in the scripts' code the > way to go? Comments, if anyone has them, would be appreciated, but I feel that I'm in a good spot in terms of error handling now. > There's also a slight bug in the new 'guix system reconfigure' that > I'll need to figure out. At the moment, it installs a bootloader entry > for all but the newest generation. It wasn't actually a bug, I was misinterpreting the intended behavior of 'guix system reconfigure'. :) > Oh, how na=C3=AFve I was four days ago. This reroll doesn't address this. > Having the procedures "parameterized by an evaluation procedure" can > be done in so many ways, and I think it would be best I put some > serious thought into which of those ways would be the best. A > 'local-eval' would clearly be much better than what I'm doing at the > present in 'system.scm', but the solution I came up with today > involved three layers of 'primitive-load', which I doubt is the way to > go about it. I had the idea to parameterize on a procedure that takes > a '' rather than a G-Expression as I was making dinner > tonight, which seems to me like a sound idea, but we'll see if it > works tomorrow when I try to implement it. Actually, a more generalized 'eval' (taking a G-Expression) was the better way to go: it allowed me to simplify the interface to the reconfiguration procedures even further. And, thanks to Ludovic's recent patches with 'lower-gexp', I was able to collapse the Russian nesting doll of 'primitive-load' calls. > Also, it hit me today that the safety checks done in 'guix system > reconfigure' -- 'check-mapped-devices', > 'check-file-system-availability', and 'check-initrd-modules' -- should > also be done in 'guix deploy'. It might make sense for me to submit that > change as a separate patch series so the code review for this doesn't > get too complicated, but since we're on the topic of unifying the code > between 'guix deploy' and 'guix system reconfigure', should I perhaps > reimplement those procedures as '' objects like everything > else in '(guix scripts system reconfigure)'? They aren't really > effectful, but they concern system reconfiguration. Again, separate patch series. > And, on the same note, should I go ahead and refactor the rest of the > reconfiguration code in 'system.scm' out into '(guix scripts system > reconfigure)'? I mean, this will probably be a separate patch series for > the same reason that the safety checks would be a separate patch series, > and I'll likely do this _after_ I come up with a decent way to > parameterize on an evaluation procedure, but I'd like to know if it's a > good idea or not before going ahead and ripping apart 'system.scm'. I'd still like comments on this, though. Regards, Jakob --=-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQIzBAEBCAAdFiEEa1VJLOiXAjQ2BGSm9Qb9Fp2P2VoFAl0w98MACgkQ9Qb9Fp2P 2VrA9g//Y445+Sx64QH+6WfhyjDG/ojKPS7ZvhuLm2fWdpD0ClXp2M1dsrAMeOeD O5MUyBwLv/udXZlnNWCX236ybadfM6HZoDU/74p8cxGCDd5TV/ICNPENZqaHGjB8 8ZOJaRHDwjCqv/cn/mieNtjUNPCtJOAVK5uYQSV9mltsBxCAaNZzaZXAC0YPIc9Y KXrlwmWt8wIlocjJ5SqHyvF/F2eHxife61vVmtQyGfTUACARshZqnhodz1MGUYmq wVNcjipm2GGHr7kas+BQm0JqDMoagVSClFjsQcD6xpRGjJYgiWytlWj7IYLIHakb hmvNWk+kiSEMI5gcs3j63mGfC8YDti0el4i4ucd6bcC0qEXPn1dXFqXqyzgi8fHw /JEpIEnVSG6ao9E4dyEv6MPgwEhuM1tqXNl3F3svLn0PpajboUYIGvtnb33WMJIU o7aakRmIOhBM0VWdcLHdg4JgrgLsGBImWrBzNVWloxC7CdilzPLpbK5nfjLpLyKN KaoP6MEnuk+kWY0Uwkz3lfd61LQP1t5OdBBie5pF7t3uw6eOpDKqj+jHr9HYuTP7 BKLXBzH+YVKyGolm3vSH/zemYKb8ZmhbfWquCkFKNwN3VqItmDO53eW1Z7Pl879R SCoq4JKHBYfS3Pd0z8fTyJ3ZbqqGyHbWhS5xKEPPhs0ZeV8LOM4= =f6Y3 -----END PGP SIGNATURE----- --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Fri Jul 19 07:57:34 2019 Received: (at 36555) by debbugs.gnu.org; 19 Jul 2019 11:57:34 +0000 Received: from localhost ([127.0.0.1]:55254 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hoRW2-0004A5-GJ for submit@debbugs.gnu.org; Fri, 19 Jul 2019 07:57:34 -0400 Received: from eggs.gnu.org ([209.51.188.92]:59456) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hoRVz-00049s-2j for 36555@debbugs.gnu.org; Fri, 19 Jul 2019 07:57:32 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:55900) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1hoRVt-0000sj-Kk; Fri, 19 Jul 2019 07:57:25 -0400 Received: from [2001:660:6102:320:e120:2c8f:8909:cdfe] (port=60526 helo=ribbon) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1hoRVs-00075v-B3; Fri, 19 Jul 2019 07:57:25 -0400 From: =?utf-8?Q?Ludovic_Court=C3=A8s?= To: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) Subject: Re: [bug#36555] [PATCH v3 1/3] guix system: Add 'reconfigure' module. 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> <87r26pzgmx.fsf_-_@sdf.lonestar.org> X-URL: http://www.fdn.fr/~lcourtes/ X-Revolutionary-Date: 1 Thermidor an 227 de la =?utf-8?Q?R=C3=A9volution?= X-PGP-Key-ID: 0x090B11993D9AEBB5 X-PGP-Key: http://www.fdn.fr/~lcourtes/ludovic.asc X-PGP-Fingerprint: 3CE4 6455 8A84 FDC6 9DB4 0CFB 090B 1199 3D9A EBB5 X-OS: x86_64-pc-linux-gnu Date: Fri, 19 Jul 2019 13:57:22 +0200 In-Reply-To: <87r26pzgmx.fsf_-_@sdf.lonestar.org> (Jakob L. Kreuze's message of "Tue, 16 Jul 2019 19:47:18 -0400") Message-ID: <877e8eck4d.fsf@gnu.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2 (gnu/linux) MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 36555 Cc: 36555@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) Hello! I=E2=80=99m gladly waiting for v4, having read your latest message. :-) It seems to be going in a nice direction! zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) skribis: > * guix/scripts/system/reconfigure.scm: New file. > * Makefile.am (MODULES): Add it. > * guix/scripts/system.scm (bootloader-installer-script): Export variable. > * gnu/machine/ssh.scm (switch-to-system, upgrade-shepherd-services) > (install-bootloader): Delete variable. > * gnu/machine/ssh.scm (deploy-managed-host): Rewrite procedure. > * gnu/services/herd.scm (live-service): Export variable. > * gnu/services/herd.scm (live-service-canonical-name): New variable. > * tests/services.scm (live-service): Delete variable. I should have mentioned it before, but it would be nice if there could be one commit that moves things to guix/scripts/system/reconfigure.scm, and a second commit that actually modifies it. That would make it easier to visualize the changes made to that code. Thanks, Ludo=E2=80=99. From debbugs-submit-bounces@debbugs.gnu.org Fri Jul 19 13:55:27 2019 Received: (at 36555) by debbugs.gnu.org; 19 Jul 2019 17:55:27 +0000 Received: from localhost ([127.0.0.1]:56523 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hoX6M-0001EA-Tr for submit@debbugs.gnu.org; Fri, 19 Jul 2019 13:55:27 -0400 Received: from mx.sdf.org ([205.166.94.20]:51638) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hoX6I-0001Dx-4F for 36555@debbugs.gnu.org; Fri, 19 Jul 2019 13:55:25 -0400 Received: from Upsilon (mobile-107-107-62-64.mycingular.net [107.107.62.64]) (authenticated (0 bits)) by mx.sdf.org (8.15.2/8.14.5) with ESMTPSA id x6JHt4vW027667 (using TLSv1.2 with cipher AES256-GCM-SHA384 (256 bits) verified NO); Fri, 19 Jul 2019 17:55:17 GMT From: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) To: Ludovic =?utf-8?Q?Court=C3=A8s?= Subject: Re: [bug#36555] [PATCH v4 0/3] Refactor out common behavior for system reconfiguration. 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> Date: Fri, 19 Jul 2019 13:54:59 -0400 In-Reply-To: <87y30v3qke.fsf@sdf.lonestar.org> (Jakob L. Kreuze's message of "Thu, 18 Jul 2019 18:50:41 -0400") Message-ID: <871rylrjt8.fsf_-_@sdf.lonestar.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha256; protocol="application/pgp-signature" X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 36555 Cc: 36555@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= Content-Type: text/plain Content-Transfer-Encoding: quoted-printable This addresses nearly everything I mentioned in my v3 cover letter; we're now parameterizing on an 'eval' procedure and we've got error handling where it counts. Happy Friday! Jakob L. Kreuze (3): guix system: Add 'reconfigure' module. guix system: Reimplement 'reconfigure'. tests: Add reconfigure system test. Makefile.am | 1 + gnu/local.mk | 1 + gnu/machine/ssh.scm | 189 ++------------------ gnu/services/herd.scm | 6 + gnu/tests/reconfigure.scm | 263 ++++++++++++++++++++++++++++ guix/scripts/system.scm | 182 +++++-------------- guix/scripts/system/reconfigure.scm | 241 +++++++++++++++++++++++++ tests/services.scm | 4 - 8 files changed, 563 insertions(+), 324 deletions(-) create mode 100644 gnu/tests/reconfigure.scm create mode 100644 guix/scripts/system/reconfigure.scm =2D-=20 2.22.0 --=-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQIzBAEBCAAdFiEEa1VJLOiXAjQ2BGSm9Qb9Fp2P2VoFAl0yA/UACgkQ9Qb9Fp2P 2VrubQ/+Ixhet/gwrTz6GmRYsfDKUMnVaZBT6I3AAIU2nHmF4fEOrHo4GLuJKzPk mjk06fJuuQoF1mOwNRHT7neClo8Ke/+hx2ras7hsvAXXkBAs4yOfVszR/So3fSnK 1g1dV8e+TvLznXqxQJy0BLFHReQgsSBySw5KNgy0WEBaX0n8p6ZvKiBL0VKBQ4a4 H95zPjv5VTxvC9tT83btn7pjzeZzz22GCyWYvHSpSTcOV5EPzbEJVMLzieKl3qC1 3fgoND9Ql/KIlHouzAyZ3+khZVSmAbth8LUJrWCVysA0BwkhwMvNWTnJzTUBtfD8 vXRTImMxCvw9hnzm/d845QObswjZgWJaahFMCyIBd6KNfx24hp/U4TYoPo0kRdsy 2zSNZ5pPi5nf/jK6sYUIO0i91Z6CmT4m3Ga+/n2oJ8QB8JJtgmqflARX1RTnR/wu TafsN+OB9G/eBJdbqKKFa1H2gx+ymZ1W/3FQS+j1Q66xTrEH4W2rFivcIe3RcZo7 5hRxScoqiTqT+5RJn5A00ZTEGvlJ3hbStUNP0gzEtSMhVjICRw9R4lNnwsYXAgBN NjDrjFwvQ6oHOfB9qeoVPZUXTZo5eRiLFqKO2uOF7AzjIQH829C3Tp2xnGayErJI bAa28JQfBHdqL0g/30g30thIIAY1JMqrlS405fly7zt1aA0XqfA= =HXA6 -----END PGP SIGNATURE----- --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Fri Jul 19 13:56:39 2019 Received: (at 36555) by debbugs.gnu.org; 19 Jul 2019 17:56:39 +0000 Received: from localhost ([127.0.0.1]:56527 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hoX7S-0001G2-9V for submit@debbugs.gnu.org; Fri, 19 Jul 2019 13:56:39 -0400 Received: from mx.sdf.org ([205.166.94.20]:51443) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hoX7P-0001Ft-So for 36555@debbugs.gnu.org; Fri, 19 Jul 2019 13:56:33 -0400 Received: from Upsilon (mobile-107-107-62-64.mycingular.net [107.107.62.64]) (authenticated (0 bits)) by mx.sdf.org (8.15.2/8.14.5) with ESMTPSA id x6JHu1ut023786 (using TLSv1.2 with cipher AES256-GCM-SHA384 (256 bits) verified NO); Fri, 19 Jul 2019 17:56:03 GMT From: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) To: Ludovic =?utf-8?Q?Court=C3=A8s?= Subject: Re: [bug#36555] [PATCH v4 1/3] guix system: Add 'reconfigure' module. 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> Date: Fri, 19 Jul 2019 13:55:58 -0400 In-Reply-To: <871rylrjt8.fsf_-_@sdf.lonestar.org> (Jakob L. Kreuze's message of "Fri, 19 Jul 2019 13:54:59 -0400") Message-ID: <87wogdq575.fsf_-_@sdf.lonestar.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha256; protocol="application/pgp-signature" X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 36555 Cc: 36555@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable * guix/scripts/system/reconfigure.scm: New file. * Makefile.am (MODULES): Add it. * guix/scripts/system.scm (bootloader-installer-script): Export variable. * gnu/machine/ssh.scm (switch-to-system, upgrade-shepherd-services) (install-bootloader): Delete variable. * gnu/machine/ssh.scm (deploy-managed-host): Rewrite procedure. * gnu/services/herd.scm (live-service): Export variable. * gnu/services/herd.scm (live-service-canonical-name): New variable. * tests/services.scm (live-service): Delete variable. =2D-- Makefile.am | 1 + gnu/machine/ssh.scm | 189 ++-------------------- gnu/services/herd.scm | 6 + guix/scripts/system/reconfigure.scm | 241 ++++++++++++++++++++++++++++ tests/services.scm | 4 - 5 files changed, 260 insertions(+), 181 deletions(-) create mode 100644 guix/scripts/system/reconfigure.scm diff --git a/Makefile.am b/Makefile.am index dd7720e87..58a96d348 100644 =2D-- a/Makefile.am +++ b/Makefile.am @@ -245,6 +245,7 @@ MODULES =3D \ guix/scripts/describe.scm \ guix/scripts/system.scm \ guix/scripts/system/search.scm \ + guix/scripts/system/reconfigure.scm \ guix/scripts/lint.scm \ guix/scripts/challenge.scm \ guix/scripts/import/crate.scm \ diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm index a7d1a967a..64d92acc9 100644 =2D-- a/gnu/machine/ssh.scm +++ b/gnu/machine/ssh.scm @@ -17,23 +17,21 @@ ;;; along with GNU Guix. If not, see . =20 (define-module (gnu machine ssh) =2D #:use-module (gnu bootloader) #:use-module (gnu machine) #:autoload (gnu packages gnupg) (guile-gcrypt) =2D #:use-module (gnu services) =2D #:use-module (gnu services shepherd) #:use-module (gnu system) =2D #:use-module (guix derivations) #:use-module (guix gexp) #:use-module (guix i18n) #:use-module (guix modules) #:use-module (guix monads) #:use-module (guix records) #:use-module (guix remote) + #:use-module (guix scripts system reconfigure) #:use-module (guix ssh) #:use-module (guix store) #:use-module (ice-9 match) #:use-module (srfi srfi-19) + #:use-module (srfi srfi-26) #:use-module (srfi srfi-35) #:export (managed-host-environment-type =20 @@ -105,118 +103,6 @@ an environment type of 'managed-host." ;;; System deployment. ;;; =20 =2D(define (switch-to-system machine) =2D "Monadic procedure creating a new generation on MACHINE and execute the =2Dactivation script for the new system configuration." =2D (define (remote-exp drv script) =2D (with-extensions (list guile-gcrypt) =2D (with-imported-modules (source-module-closure '((guix config) =2D (guix profiles) =2D (guix utils))) =2D #~(begin =2D (use-modules (guix config) =2D (guix profiles) =2D (guix utils)) =2D =2D (define %system-profile =2D (string-append %state-directory "/profiles/system")) =2D =2D (let* ((system #$drv) =2D (number (1+ (generation-number %system-profile))) =2D (generation (generation-file-name %system-profile num= ber))) =2D (switch-symlinks generation system) =2D (switch-symlinks %system-profile generation) =2D ;; The implementation of 'guix system reconfigure' saves t= he =2D ;; load path and environment here. This is unnecessary here =2D ;; because each invocation of 'remote-eval' runs in a dist= inct =2D ;; Guile REPL. =2D (setenv "GUIX_NEW_SYSTEM" system) =2D ;; The activation script may write to stdout, which confus= es =2D ;; 'remote-eval' when it attempts to read a result from the =2D ;; remote REPL. We work around this by forcing the output = to a =2D ;; string. =2D (with-output-to-string =2D (lambda () =2D (primitive-load #$script)))))))) =2D =2D (let* ((os (machine-system machine)) =2D (script (operating-system-activation-script os))) =2D (mlet* %store-monad ((drv (operating-system-derivation os))) =2D (machine-remote-eval machine (remote-exp drv script))))) =2D =2D;; XXX: Currently, this does NOT attempt to restart running services. Th= is is =2D;; also the case with 'guix system reconfigure'. =2D;; =2D;; See . =2D(define (upgrade-shepherd-services machine) =2D "Monadic procedure unloading and starting services on the remote as ne= eded =2Dto realize the MACHINE's system configuration." =2D (define target-services =2D ;; Monadic expression evaluating to a list of (name output-path) pai= rs for =2D ;; all of MACHINE's services. =2D (mapm %store-monad =2D (lambda (service) =2D (mlet %store-monad ((file ((compose lower-object =2D shepherd-service-file) =2D service))) =2D (return (list (shepherd-service-canonical-name service) =2D (derivation->output-path file))))) =2D (service-value =2D (fold-services (operating-system-services (machine-system mac= hine)) =2D #:target-type shepherd-root-service-type)))) =2D =2D (define (remote-exp target-services) =2D (with-imported-modules '((gnu services herd)) =2D #~(begin =2D (use-modules (gnu services herd) =2D (srfi srfi-1)) =2D =2D (define running =2D (filter live-service-running (current-services))) =2D =2D (define (essential? service) =2D ;; Return #t if SERVICE is essential and should not be unloa= ded =2D ;; under any circumstance. =2D (memq (first (live-service-provision service)) =2D '(root shepherd))) =2D =2D (define (obsolete? service) =2D ;; Return #t if SERVICE can be safely unloaded. =2D (and (not (essential? service)) =2D (every (lambda (requirements) =2D (not (memq (first (live-service-provision serv= ice)) =2D requirements))) =2D (map live-service-requirement running)))) =2D =2D (define to-unload =2D (filter obsolete? =2D (remove (lambda (service) =2D (memq (first (live-service-provision servi= ce)) =2D (map first '#$target-services))) =2D running))) =2D =2D (define to-start =2D (remove (lambda (service-pair) =2D (memq (first service-pair) =2D (map (compose first live-service-provision) =2D running))) =2D '#$target-services)) =2D =2D ;; Unload obsolete services. =2D (for-each (lambda (service) =2D (false-if-exception =2D (unload-service service))) =2D to-unload) =2D =2D ;; Load the service files for any new services and start them. =2D (load-services/safe (map second to-start)) =2D (for-each start-service (map first to-start)) =2D =2D #t))) =2D =2D (mlet %store-monad ((target-services target-services)) =2D (machine-remote-eval machine (remote-exp target-services)))) =2D (define (machine-boot-parameters machine) "Monadic procedure returning a list of 'boot-parameters' for the generat= ions of MACHINE's system profile, ordered from most recent to oldest." @@ -275,71 +161,20 @@ of MACHINE's system profile, ordered from most recent= to oldest." (boot-parameters-kernel-arguments params)))))))) generations)))) =20 =2D(define (install-bootloader machine) =2D "Create a bootloader entry for the new system generation on MACHINE, a= nd =2Dconfigure the bootloader to boot that generation by default." =2D (define bootloader-installer-script =2D (@@ (guix scripts system) bootloader-installer-script)) =2D =2D (define (remote-exp installer bootcfg bootcfg-file) =2D (with-extensions (list guile-gcrypt) =2D (with-imported-modules (source-module-closure '((gnu build install) =2D (guix store) =2D (guix utils))) =2D #~(begin =2D (use-modules (gnu build install) =2D (guix store) =2D (guix utils)) =2D (let* ((gc-root (string-append "/" %gc-roots-directory "/boo= tcfg")) =2D (temp-gc-root (string-append gc-root ".new"))) =2D =2D (switch-symlinks temp-gc-root gc-root) =2D =2D (unless (false-if-exception =2D (begin =2D ;; The implementation of 'guix system reconfigu= re' =2D ;; saves the load path here. This is unnecessar= y here =2D ;; because each invocation of 'remote-eval' run= s in a =2D ;; distinct Guile REPL. =2D (install-boot-config #$bootcfg #$bootcfg-file "= /") =2D ;; The installation script may write to stdout,= which =2D ;; confuses 'remote-eval' when it attempts to r= ead a =2D ;; result from the remote REPL. We work around = this =2D ;; by forcing the output to a string. =2D (with-output-to-string =2D (lambda () =2D (primitive-load #$installer))))) =2D (delete-file temp-gc-root) =2D (error "failed to install bootloader")) =2D =2D (rename-file temp-gc-root gc-root) =2D #t))))) =2D =2D (mlet* %store-monad ((boot-parameters (machine-boot-parameters machine= ))) =2D (let* ((os (machine-system machine)) =2D (bootloader ((compose bootloader-configuration-bootloader =2D operating-system-bootloader) =2D os)) =2D (bootloader-target (bootloader-configuration-target =2D (operating-system-bootloader os))) =2D (installer (bootloader-installer-script =2D (bootloader-installer bootloader) =2D (bootloader-package bootloader) =2D bootloader-target =2D "/")) =2D (menu-entries (map boot-parameters->menu-entry boot-parameter= s)) =2D (bootcfg (operating-system-bootcfg os menu-entries)) =2D (bootcfg-file (bootloader-configuration-file bootloader))) =2D (machine-remote-eval machine (remote-exp installer bootcfg bootcfg= -file))))) =2D (define (deploy-managed-host machine) "Internal implementation of 'deploy-machine' for MACHINE instances with = an environment type of 'managed-host." (maybe-raise-unsupported-configuration-error machine) =2D (mbegin %store-monad =2D (switch-to-system machine) =2D (upgrade-shepherd-services machine) =2D (install-bootloader machine))) + (mlet %store-monad ((boot-parameters (machine-boot-parameters machine))) + (let* ((os (machine-system machine)) + (eval (cut machine-remote-eval machine <>)) + (menu-entries (map boot-parameters->menu-entry boot-parameters)) + (bootloader-configuration (operating-system-bootloader os)) + (bootcfg (operating-system-bootcfg os menu-entries))) + (mbegin %store-monad + (switch-to-system eval os) + (upgrade-shepherd-services eval os) + (install-bootloader eval bootloader-configuration bootcfg))))) =20 ;;; diff --git a/gnu/services/herd.scm b/gnu/services/herd.scm index 0008746fe..2207b2d34 100644 =2D-- a/gnu/services/herd.scm +++ b/gnu/services/herd.scm @@ -40,10 +40,12 @@ unknown-shepherd-error? unknown-shepherd-error-sexp =20 + live-service live-service? live-service-provision live-service-requirement live-service-running + live-service-canonical-name =20 with-shepherd-action current-services @@ -192,6 +194,10 @@ of pairs." (requirement live-service-requirement) ;list of symbols (running live-service-running)) ;#f | object =20 +(define (live-service-canonical-name service) + "Return the 'canonical name' of SERVICE." + (first (live-service-provision service))) + (define (current-services) "Return the list of currently defined Shepherd services, represented as objects. Return #f if the list of services could not be diff --git a/guix/scripts/system/reconfigure.scm b/guix/scripts/system/reco= nfigure.scm new file mode 100644 index 000000000..2c69ea727 =2D-- /dev/null +++ b/guix/scripts/system/reconfigure.scm @@ -0,0 +1,241 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright =C2=A9 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Court=C3= =A8s +;;; Copyright =C2=A9 2016 Alex Kost +;;; Copyright =C2=A9 2016, 2017, 2018 Chris Marusich +;;; Copyright =C2=A9 2017 Mathieu Othacehe +;;; Copyright =C2=A9 2018 Ricardo Wurmus +;;; Copyright =C2=A9 2019 Christopher Baines +;;; 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 (guix scripts system reconfigure) + #:autoload (gnu packages gnupg) (guile-gcrypt) + #:use-module (gnu bootloader) + #:use-module (gnu services) + #:use-module (gnu services herd) + #:use-module (gnu services shepherd) + #:use-module (gnu system) + #:use-module (guix gexp) + #:use-module (guix modules) + #:use-module (guix monads) + #:use-module (guix store) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:export (switch-system-program + switch-to-system + + upgrade-services-program + upgrade-shepherd-services + + install-bootloader-program + install-bootloader)) + +;;; Commentary: +;;; +;;; This module implements the "effectful" parts of system +;;; reconfiguration. Although building a system derivation is a pure +;;; operation, a number of impure operations must be carried out for the +;;; system configuration to be realized -- chiefly, creation of generation +;;; symlinks and invocation of activation scripts. +;;; +;;; Code: + + +;;; +;;; Profile creation. +;;; + +(define* (switch-system-program os #:optional profile) + "Return an executable store item that, upon being evaluated, will create= a +new generation of PROFILE pointing to the directory of OS, switch to it +atomically, and run OS's activation script." + (program-file + "switch-to-system.scm" + (with-extensions (list guile-gcrypt) + (with-imported-modules (source-module-closure '((guix config) + (guix profiles) + (guix utils))) + #~(begin + (use-modules (guix config) + (guix profiles) + (guix utils)) + + (define profile + (or #$profile (string-append %state-directory "/profiles/syst= em"))) + + (let* ((number (1+ (generation-number profile))) + (generation (generation-file-name profile number))) + (switch-symlinks generation #$os) + (switch-symlinks profile generation) + (setenv "GUIX_NEW_SYSTEM" #$os) + (primitive-load #$(operating-system-activation-script os)))))= ))) + +(define* (switch-to-system eval os #:optional profile) + "Using EVAL, a monadic procedure taking a single G-Expression as an argu= ment, +create a new generation of PROFILE pointing to the directory of OS, switch= to +it atomically, and run OS's activation script." + (eval #~(primitive-load #$(switch-system-program os profile)))) + + +;;; +;;; Services. +;;; + +(define (running-services eval) + "Using EVAL, a monadic procedure taking a single G-Expression as an argu= ment, +return the objects that are currently running on MACHINE." + (define remote-exp + (with-imported-modules '((gnu services herd)) + #~(begin + (use-modules (gnu services herd)) + (let ((services (current-services))) + (and services + ;; 'live-service-running' is ignored, as we can't necessa= rily + ;; serialize arbitrary objects. This should be fine for n= ow, + ;; since 'machine-current-services' is not exposed public= ly, + ;; and the resultant objects are only used= for + ;; resolving service dependencies. + (map (lambda (service) + (list (live-service-provision service) + (live-service-requirement service))) + services)))))) + (mlet %store-monad ((services (eval remote-exp))) + (return (map (match-lambda + ((provision requirement) + (live-service provision requirement #f))) + services)))) + +;; XXX: Currently, this does NOT attempt to restart running services. See +;; for details. +(define (upgrade-services-program service-files to-start to-unload to-rest= art) + "Return an executable store item that, upon being evaluated, will upgrade +the Shepherd (PID 1) by unloading obsolete services and loading new +services. SERVICE-FILES is a list of Shepherd service files to load, and +TO-START, TO-UNLOAD, and TO-RESTART are lists of the Shepherd services' +canonical names (symbols)." + (program-file + "upgrade-shepherd-services.scm" + (with-imported-modules '((gnu services herd)) + #~(begin + (use-modules (gnu services herd) + (srfi srfi-1)) + + ;; Load the service files for any new services. + (load-services/safe '#$service-files) + + ;; Unload obsolete services and start new services. + (for-each unload-service '#$to-unload) + (for-each start-service '#$to-start))))) + +(define* (upgrade-shepherd-services eval os) + "Using EVAL, a monadic procedure taking a single G-Expression as an argu= ment, +upgrade the Shepherd (PID 1) by unloading obsolete services and loading new +services as defined by OS." + (define target-services + (service-value + (fold-services (operating-system-services os) + #:target-type shepherd-root-service-type))) + + (mlet* %store-monad ((live-services (running-services eval))) + (let*-values (((to-unload to-restart) + (shepherd-service-upgrade live-services target-services= ))) + (let* ((to-unload (map live-service-canonical-name to-unload)) + (to-restart (map shepherd-service-canonical-name to-restart)) + (to-start (lset-difference eqv? + (map shepherd-service-canonical-na= me + target-services) + (map live-service-canonical-name + live-services))) + (service-files + (map shepherd-service-file + (filter (lambda (service) + (memq (shepherd-service-canonical-name servic= e) + to-start)) + target-services)))) + (eval #~(primitive-load #$(upgrade-services-program service-files + to-start + to-unload + to-restart))))= ))) + + +;;; +;;; Bootloader configuration. +;;; + +;; (format (current-error-port) "error: ~a~%" (condition-message c)) +;; (format #t "bootloader successfully installed on '~a'~%" +;; #$device) + +(define (install-bootloader-program installer bootloader-package bootcfg + bootcfg-file device target) + "Return an executable store item that, upon being evaluated, will install +BOOTCFG to BOOTCFG-FILE, a target file name, on DEVICE, a file system devi= ce, +at TARGET, a mount point, and subsequently run INSTALLER from +BOOTLOADER-PACKAGE." + (program-file + "install-bootloader.scm" + (with-extensions (list guile-gcrypt) + (with-imported-modules (source-module-closure '((gnu build bootloader) + (gnu build install) + (guix store) + (guix utils))) + #~(begin + (use-modules (gnu build bootloader) + (gnu build install) + (guix build utils) + (guix store) + (guix utils) + (ice-9 binary-ports) + (srfi srfi-34) + (srfi srfi-35)) + (let* ((gc-root (string-append #$target %gc-roots-directory "/b= ootcfg")) + (temp-gc-root (string-append gc-root ".new"))) + (switch-symlinks temp-gc-root gc-root) + (install-boot-config #$bootcfg #$bootcfg-file #$target) + ;; Preserve the previous activation's garbage collector root + ;; until the bootloader installer has run, so that a failure = in + ;; the bootloader's installer script doesn't leave the user w= ith + ;; a broken installation. + (when #$installer + (catch #t + (lambda () + (#$installer #$bootloader-package #$device #$target)) + (lambda args + (delete-file temp-gc-root) + (apply throw args)))) + (rename-file temp-gc-root gc-root))))))) + +(define* (install-bootloader eval configuration bootcfg + #:key + (run-installer? #t) + (target "/")) + "Using EVAL, a monadic procedure taking a single G-Expression as an argu= ment, +configure the bootloader on TARGET such that OS will be booted by default = and +additional configurations specified by MENU-ENTRIES can be selected." + (let* ((bootloader (bootloader-configuration-bootloader configuration)) + (installer (and run-installer? + (bootloader-installer bootloader))) + (package (bootloader-package bootloader)) + (device (bootloader-configuration-target configuration)) + (bootcfg-file (bootloader-configuration-file bootloader))) + (eval #~(primitive-load #$(install-bootloader-program installer + package + bootcfg + bootcfg-file + device + target))))) diff --git a/tests/services.scm b/tests/services.scm index 44ad0022c..572fe3816 100644 =2D-- a/tests/services.scm +++ b/tests/services.scm @@ -26,10 +26,6 @@ #:use-module (srfi srfi-64) #:use-module (ice-9 match)) =20 =2D(define live-service =2D (@@ (gnu services herd) live-service)) =2D =2D (test-begin "services") =20 (test-equal "services, default value" =2D-=20 2.22.0 --=-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQIzBAEBCAAdFiEEa1VJLOiXAjQ2BGSm9Qb9Fp2P2VoFAl0yBC4ACgkQ9Qb9Fp2P 2VqQtQ/9GtG7ubjhqPTZFIQRUkPgtOehl/uS2r68k2HJeuOHF1SBB4mNEJKTZc8g jz4ALx6d6D3XTeRmkaaV5FbzCq2BWnpeUD+Z1H3DUE+eUVPfCR6OV9UANTfMjvCb RdwNAXS2Z5cNslW1ztOtpaTNjeD+g0CY0goJVurI4q1arxImqWJQPpL4vZn9m2yD L6qI96bft/59fg7jVfsRuhFRemTdw1ROdZesq30bDQwAq/zR7N4gI+DMjW9QceZV bHxkno1jEsG5RK+ZWCeMHS+4PvXiabyk8LR6sNquaFsY9KxmraifTMbyn/pd6SDt Uh9/5Xzt4VuK/ngxF63x5fgfUtmuwtdufzm3xDoorWwQvUNgXChGhYhJPJQ8WcMA 2iS4tPi4tFGtNJiFSH6AN7MfohCXB5xlATNYPaipJ1YORt7MZ3goa9uFg8IPHCqc C9l7fvkH6CFTZUiQYD+gRlsxwN2a8G/Cw7IYwiWqVRaikm/rxsNhBidJAbn95C4E oqVX0rwB5dQduTK4UoSCmC3RyzuXWnkefN04xFnZ3veogmXD2R0UddF1ePSpQnj4 G++MqjOy1HoOhhMweS4W2VPpWl0gJroGOL//QFvoW619YtOXjLKH7W2DwwZ4HJ9J 6cYnSDRuOXM53Vu4qmlbPAxmGVpV9jraZCMd5FFGE2JlEC0Js6s= =d1I5 -----END PGP SIGNATURE----- --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Fri Jul 19 13:57:49 2019 Received: (at 36555) by debbugs.gnu.org; 19 Jul 2019 17:57:49 +0000 Received: from localhost ([127.0.0.1]:56531 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hoX8a-0001I8-Hb for submit@debbugs.gnu.org; Fri, 19 Jul 2019 13:57:49 -0400 Received: from mx.sdf.org ([205.166.94.20]:51214) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hoX8Y-0001I0-1r for 36555@debbugs.gnu.org; Fri, 19 Jul 2019 13:57:43 -0400 Received: from Upsilon (mobile-107-107-62-64.mycingular.net [107.107.62.64]) (authenticated (0 bits)) by mx.sdf.org (8.15.2/8.14.5) with ESMTPSA id x6JHv4hb015696 (using TLSv1.2 with cipher AES256-GCM-SHA384 (256 bits) verified NO); Fri, 19 Jul 2019 17:57:06 GMT From: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) To: Ludovic =?utf-8?Q?Court=C3=A8s?= Subject: Re: [bug#36555] [PATCH v4 1/3] guix system: Add 'reconfigure' module. In-Reply-To: <871rylrjt8.fsf_-_@sdf.lonestar.org> (Jakob L. Kreuze's message of "Fri, 19 Jul 2019 13:54:59 -0400") 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> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2 (gnu/linux) Date: Fri, 19 Jul 2019 13:56:58 -0400 Message-ID: <87v9vxq55h.fsf_-_@sdf.lonestar.org> MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha256; protocol="application/pgp-signature" X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 36555 Cc: 36555@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable * guix/scripts/system/reconfigure.scm: New file. * Makefile.am (MODULES): Add it. * guix/scripts/system.scm (bootloader-installer-script): Export variable. * gnu/machine/ssh.scm (switch-to-system, upgrade-shepherd-services) (install-bootloader): Delete variable. * gnu/machine/ssh.scm (deploy-managed-host): Rewrite procedure. * gnu/services/herd.scm (live-service): Export variable. * gnu/services/herd.scm (live-service-canonical-name): New variable. * tests/services.scm (live-service): Delete variable. =2D-- Makefile.am | 1 + gnu/machine/ssh.scm | 189 ++-------------------- gnu/services/herd.scm | 6 + guix/scripts/system/reconfigure.scm | 241 ++++++++++++++++++++++++++++ tests/services.scm | 4 - 5 files changed, 260 insertions(+), 181 deletions(-) create mode 100644 guix/scripts/system/reconfigure.scm diff --git a/Makefile.am b/Makefile.am index dd7720e87..58a96d348 100644 =2D-- a/Makefile.am +++ b/Makefile.am @@ -245,6 +245,7 @@ MODULES =3D \ guix/scripts/describe.scm \ guix/scripts/system.scm \ guix/scripts/system/search.scm \ + guix/scripts/system/reconfigure.scm \ guix/scripts/lint.scm \ guix/scripts/challenge.scm \ guix/scripts/import/crate.scm \ diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm index a7d1a967a..64d92acc9 100644 =2D-- a/gnu/machine/ssh.scm +++ b/gnu/machine/ssh.scm @@ -17,23 +17,21 @@ ;;; along with GNU Guix. If not, see . =20 (define-module (gnu machine ssh) =2D #:use-module (gnu bootloader) #:use-module (gnu machine) #:autoload (gnu packages gnupg) (guile-gcrypt) =2D #:use-module (gnu services) =2D #:use-module (gnu services shepherd) #:use-module (gnu system) =2D #:use-module (guix derivations) #:use-module (guix gexp) #:use-module (guix i18n) #:use-module (guix modules) #:use-module (guix monads) #:use-module (guix records) #:use-module (guix remote) + #:use-module (guix scripts system reconfigure) #:use-module (guix ssh) #:use-module (guix store) #:use-module (ice-9 match) #:use-module (srfi srfi-19) + #:use-module (srfi srfi-26) #:use-module (srfi srfi-35) #:export (managed-host-environment-type =20 @@ -105,118 +103,6 @@ an environment type of 'managed-host." ;;; System deployment. ;;; =20 =2D(define (switch-to-system machine) =2D "Monadic procedure creating a new generation on MACHINE and execute the =2Dactivation script for the new system configuration." =2D (define (remote-exp drv script) =2D (with-extensions (list guile-gcrypt) =2D (with-imported-modules (source-module-closure '((guix config) =2D (guix profiles) =2D (guix utils))) =2D #~(begin =2D (use-modules (guix config) =2D (guix profiles) =2D (guix utils)) =2D =2D (define %system-profile =2D (string-append %state-directory "/profiles/system")) =2D =2D (let* ((system #$drv) =2D (number (1+ (generation-number %system-profile))) =2D (generation (generation-file-name %system-profile num= ber))) =2D (switch-symlinks generation system) =2D (switch-symlinks %system-profile generation) =2D ;; The implementation of 'guix system reconfigure' saves t= he =2D ;; load path and environment here. This is unnecessary here =2D ;; because each invocation of 'remote-eval' runs in a dist= inct =2D ;; Guile REPL. =2D (setenv "GUIX_NEW_SYSTEM" system) =2D ;; The activation script may write to stdout, which confus= es =2D ;; 'remote-eval' when it attempts to read a result from the =2D ;; remote REPL. We work around this by forcing the output = to a =2D ;; string. =2D (with-output-to-string =2D (lambda () =2D (primitive-load #$script)))))))) =2D =2D (let* ((os (machine-system machine)) =2D (script (operating-system-activation-script os))) =2D (mlet* %store-monad ((drv (operating-system-derivation os))) =2D (machine-remote-eval machine (remote-exp drv script))))) =2D =2D;; XXX: Currently, this does NOT attempt to restart running services. Th= is is =2D;; also the case with 'guix system reconfigure'. =2D;; =2D;; See . =2D(define (upgrade-shepherd-services machine) =2D "Monadic procedure unloading and starting services on the remote as ne= eded =2Dto realize the MACHINE's system configuration." =2D (define target-services =2D ;; Monadic expression evaluating to a list of (name output-path) pai= rs for =2D ;; all of MACHINE's services. =2D (mapm %store-monad =2D (lambda (service) =2D (mlet %store-monad ((file ((compose lower-object =2D shepherd-service-file) =2D service))) =2D (return (list (shepherd-service-canonical-name service) =2D (derivation->output-path file))))) =2D (service-value =2D (fold-services (operating-system-services (machine-system mac= hine)) =2D #:target-type shepherd-root-service-type)))) =2D =2D (define (remote-exp target-services) =2D (with-imported-modules '((gnu services herd)) =2D #~(begin =2D (use-modules (gnu services herd) =2D (srfi srfi-1)) =2D =2D (define running =2D (filter live-service-running (current-services))) =2D =2D (define (essential? service) =2D ;; Return #t if SERVICE is essential and should not be unloa= ded =2D ;; under any circumstance. =2D (memq (first (live-service-provision service)) =2D '(root shepherd))) =2D =2D (define (obsolete? service) =2D ;; Return #t if SERVICE can be safely unloaded. =2D (and (not (essential? service)) =2D (every (lambda (requirements) =2D (not (memq (first (live-service-provision serv= ice)) =2D requirements))) =2D (map live-service-requirement running)))) =2D =2D (define to-unload =2D (filter obsolete? =2D (remove (lambda (service) =2D (memq (first (live-service-provision servi= ce)) =2D (map first '#$target-services))) =2D running))) =2D =2D (define to-start =2D (remove (lambda (service-pair) =2D (memq (first service-pair) =2D (map (compose first live-service-provision) =2D running))) =2D '#$target-services)) =2D =2D ;; Unload obsolete services. =2D (for-each (lambda (service) =2D (false-if-exception =2D (unload-service service))) =2D to-unload) =2D =2D ;; Load the service files for any new services and start them. =2D (load-services/safe (map second to-start)) =2D (for-each start-service (map first to-start)) =2D =2D #t))) =2D =2D (mlet %store-monad ((target-services target-services)) =2D (machine-remote-eval machine (remote-exp target-services)))) =2D (define (machine-boot-parameters machine) "Monadic procedure returning a list of 'boot-parameters' for the generat= ions of MACHINE's system profile, ordered from most recent to oldest." @@ -275,71 +161,20 @@ of MACHINE's system profile, ordered from most recent= to oldest." (boot-parameters-kernel-arguments params)))))))) generations)))) =20 =2D(define (install-bootloader machine) =2D "Create a bootloader entry for the new system generation on MACHINE, a= nd =2Dconfigure the bootloader to boot that generation by default." =2D (define bootloader-installer-script =2D (@@ (guix scripts system) bootloader-installer-script)) =2D =2D (define (remote-exp installer bootcfg bootcfg-file) =2D (with-extensions (list guile-gcrypt) =2D (with-imported-modules (source-module-closure '((gnu build install) =2D (guix store) =2D (guix utils))) =2D #~(begin =2D (use-modules (gnu build install) =2D (guix store) =2D (guix utils)) =2D (let* ((gc-root (string-append "/" %gc-roots-directory "/boo= tcfg")) =2D (temp-gc-root (string-append gc-root ".new"))) =2D =2D (switch-symlinks temp-gc-root gc-root) =2D =2D (unless (false-if-exception =2D (begin =2D ;; The implementation of 'guix system reconfigu= re' =2D ;; saves the load path here. This is unnecessar= y here =2D ;; because each invocation of 'remote-eval' run= s in a =2D ;; distinct Guile REPL. =2D (install-boot-config #$bootcfg #$bootcfg-file "= /") =2D ;; The installation script may write to stdout,= which =2D ;; confuses 'remote-eval' when it attempts to r= ead a =2D ;; result from the remote REPL. We work around = this =2D ;; by forcing the output to a string. =2D (with-output-to-string =2D (lambda () =2D (primitive-load #$installer))))) =2D (delete-file temp-gc-root) =2D (error "failed to install bootloader")) =2D =2D (rename-file temp-gc-root gc-root) =2D #t))))) =2D =2D (mlet* %store-monad ((boot-parameters (machine-boot-parameters machine= ))) =2D (let* ((os (machine-system machine)) =2D (bootloader ((compose bootloader-configuration-bootloader =2D operating-system-bootloader) =2D os)) =2D (bootloader-target (bootloader-configuration-target =2D (operating-system-bootloader os))) =2D (installer (bootloader-installer-script =2D (bootloader-installer bootloader) =2D (bootloader-package bootloader) =2D bootloader-target =2D "/")) =2D (menu-entries (map boot-parameters->menu-entry boot-parameter= s)) =2D (bootcfg (operating-system-bootcfg os menu-entries)) =2D (bootcfg-file (bootloader-configuration-file bootloader))) =2D (machine-remote-eval machine (remote-exp installer bootcfg bootcfg= -file))))) =2D (define (deploy-managed-host machine) "Internal implementation of 'deploy-machine' for MACHINE instances with = an environment type of 'managed-host." (maybe-raise-unsupported-configuration-error machine) =2D (mbegin %store-monad =2D (switch-to-system machine) =2D (upgrade-shepherd-services machine) =2D (install-bootloader machine))) + (mlet %store-monad ((boot-parameters (machine-boot-parameters machine))) + (let* ((os (machine-system machine)) + (eval (cut machine-remote-eval machine <>)) + (menu-entries (map boot-parameters->menu-entry boot-parameters)) + (bootloader-configuration (operating-system-bootloader os)) + (bootcfg (operating-system-bootcfg os menu-entries))) + (mbegin %store-monad + (switch-to-system eval os) + (upgrade-shepherd-services eval os) + (install-bootloader eval bootloader-configuration bootcfg))))) =20 ;;; diff --git a/gnu/services/herd.scm b/gnu/services/herd.scm index 0008746fe..2207b2d34 100644 =2D-- a/gnu/services/herd.scm +++ b/gnu/services/herd.scm @@ -40,10 +40,12 @@ unknown-shepherd-error? unknown-shepherd-error-sexp =20 + live-service live-service? live-service-provision live-service-requirement live-service-running + live-service-canonical-name =20 with-shepherd-action current-services @@ -192,6 +194,10 @@ of pairs." (requirement live-service-requirement) ;list of symbols (running live-service-running)) ;#f | object =20 +(define (live-service-canonical-name service) + "Return the 'canonical name' of SERVICE." + (first (live-service-provision service))) + (define (current-services) "Return the list of currently defined Shepherd services, represented as objects. Return #f if the list of services could not be diff --git a/guix/scripts/system/reconfigure.scm b/guix/scripts/system/reco= nfigure.scm new file mode 100644 index 000000000..2c69ea727 =2D-- /dev/null +++ b/guix/scripts/system/reconfigure.scm @@ -0,0 +1,241 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright =C2=A9 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Court=C3= =A8s +;;; Copyright =C2=A9 2016 Alex Kost +;;; Copyright =C2=A9 2016, 2017, 2018 Chris Marusich +;;; Copyright =C2=A9 2017 Mathieu Othacehe +;;; Copyright =C2=A9 2018 Ricardo Wurmus +;;; Copyright =C2=A9 2019 Christopher Baines +;;; 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 (guix scripts system reconfigure) + #:autoload (gnu packages gnupg) (guile-gcrypt) + #:use-module (gnu bootloader) + #:use-module (gnu services) + #:use-module (gnu services herd) + #:use-module (gnu services shepherd) + #:use-module (gnu system) + #:use-module (guix gexp) + #:use-module (guix modules) + #:use-module (guix monads) + #:use-module (guix store) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:export (switch-system-program + switch-to-system + + upgrade-services-program + upgrade-shepherd-services + + install-bootloader-program + install-bootloader)) + +;;; Commentary: +;;; +;;; This module implements the "effectful" parts of system +;;; reconfiguration. Although building a system derivation is a pure +;;; operation, a number of impure operations must be carried out for the +;;; system configuration to be realized -- chiefly, creation of generation +;;; symlinks and invocation of activation scripts. +;;; +;;; Code: + + +;;; +;;; Profile creation. +;;; + +(define* (switch-system-program os #:optional profile) + "Return an executable store item that, upon being evaluated, will create= a +new generation of PROFILE pointing to the directory of OS, switch to it +atomically, and run OS's activation script." + (program-file + "switch-to-system.scm" + (with-extensions (list guile-gcrypt) + (with-imported-modules (source-module-closure '((guix config) + (guix profiles) + (guix utils))) + #~(begin + (use-modules (guix config) + (guix profiles) + (guix utils)) + + (define profile + (or #$profile (string-append %state-directory "/profiles/syst= em"))) + + (let* ((number (1+ (generation-number profile))) + (generation (generation-file-name profile number))) + (switch-symlinks generation #$os) + (switch-symlinks profile generation) + (setenv "GUIX_NEW_SYSTEM" #$os) + (primitive-load #$(operating-system-activation-script os)))))= ))) + +(define* (switch-to-system eval os #:optional profile) + "Using EVAL, a monadic procedure taking a single G-Expression as an argu= ment, +create a new generation of PROFILE pointing to the directory of OS, switch= to +it atomically, and run OS's activation script." + (eval #~(primitive-load #$(switch-system-program os profile)))) + + +;;; +;;; Services. +;;; + +(define (running-services eval) + "Using EVAL, a monadic procedure taking a single G-Expression as an argu= ment, +return the objects that are currently running on MACHINE." + (define remote-exp + (with-imported-modules '((gnu services herd)) + #~(begin + (use-modules (gnu services herd)) + (let ((services (current-services))) + (and services + ;; 'live-service-running' is ignored, as we can't necessa= rily + ;; serialize arbitrary objects. This should be fine for n= ow, + ;; since 'machine-current-services' is not exposed public= ly, + ;; and the resultant objects are only used= for + ;; resolving service dependencies. + (map (lambda (service) + (list (live-service-provision service) + (live-service-requirement service))) + services)))))) + (mlet %store-monad ((services (eval remote-exp))) + (return (map (match-lambda + ((provision requirement) + (live-service provision requirement #f))) + services)))) + +;; XXX: Currently, this does NOT attempt to restart running services. See +;; for details. +(define (upgrade-services-program service-files to-start to-unload to-rest= art) + "Return an executable store item that, upon being evaluated, will upgrade +the Shepherd (PID 1) by unloading obsolete services and loading new +services. SERVICE-FILES is a list of Shepherd service files to load, and +TO-START, TO-UNLOAD, and TO-RESTART are lists of the Shepherd services' +canonical names (symbols)." + (program-file + "upgrade-shepherd-services.scm" + (with-imported-modules '((gnu services herd)) + #~(begin + (use-modules (gnu services herd) + (srfi srfi-1)) + + ;; Load the service files for any new services. + (load-services/safe '#$service-files) + + ;; Unload obsolete services and start new services. + (for-each unload-service '#$to-unload) + (for-each start-service '#$to-start))))) + +(define* (upgrade-shepherd-services eval os) + "Using EVAL, a monadic procedure taking a single G-Expression as an argu= ment, +upgrade the Shepherd (PID 1) by unloading obsolete services and loading new +services as defined by OS." + (define target-services + (service-value + (fold-services (operating-system-services os) + #:target-type shepherd-root-service-type))) + + (mlet* %store-monad ((live-services (running-services eval))) + (let*-values (((to-unload to-restart) + (shepherd-service-upgrade live-services target-services= ))) + (let* ((to-unload (map live-service-canonical-name to-unload)) + (to-restart (map shepherd-service-canonical-name to-restart)) + (to-start (lset-difference eqv? + (map shepherd-service-canonical-na= me + target-services) + (map live-service-canonical-name + live-services))) + (service-files + (map shepherd-service-file + (filter (lambda (service) + (memq (shepherd-service-canonical-name servic= e) + to-start)) + target-services)))) + (eval #~(primitive-load #$(upgrade-services-program service-files + to-start + to-unload + to-restart))))= ))) + + +;;; +;;; Bootloader configuration. +;;; + +;; (format (current-error-port) "error: ~a~%" (condition-message c)) +;; (format #t "bootloader successfully installed on '~a'~%" +;; #$device) + +(define (install-bootloader-program installer bootloader-package bootcfg + bootcfg-file device target) + "Return an executable store item that, upon being evaluated, will install +BOOTCFG to BOOTCFG-FILE, a target file name, on DEVICE, a file system devi= ce, +at TARGET, a mount point, and subsequently run INSTALLER from +BOOTLOADER-PACKAGE." + (program-file + "install-bootloader.scm" + (with-extensions (list guile-gcrypt) + (with-imported-modules (source-module-closure '((gnu build bootloader) + (gnu build install) + (guix store) + (guix utils))) + #~(begin + (use-modules (gnu build bootloader) + (gnu build install) + (guix build utils) + (guix store) + (guix utils) + (ice-9 binary-ports) + (srfi srfi-34) + (srfi srfi-35)) + (let* ((gc-root (string-append #$target %gc-roots-directory "/b= ootcfg")) + (temp-gc-root (string-append gc-root ".new"))) + (switch-symlinks temp-gc-root gc-root) + (install-boot-config #$bootcfg #$bootcfg-file #$target) + ;; Preserve the previous activation's garbage collector root + ;; until the bootloader installer has run, so that a failure = in + ;; the bootloader's installer script doesn't leave the user w= ith + ;; a broken installation. + (when #$installer + (catch #t + (lambda () + (#$installer #$bootloader-package #$device #$target)) + (lambda args + (delete-file temp-gc-root) + (apply throw args)))) + (rename-file temp-gc-root gc-root))))))) + +(define* (install-bootloader eval configuration bootcfg + #:key + (run-installer? #t) + (target "/")) + "Using EVAL, a monadic procedure taking a single G-Expression as an argu= ment, +configure the bootloader on TARGET such that OS will be booted by default = and +additional configurations specified by MENU-ENTRIES can be selected." + (let* ((bootloader (bootloader-configuration-bootloader configuration)) + (installer (and run-installer? + (bootloader-installer bootloader))) + (package (bootloader-package bootloader)) + (device (bootloader-configuration-target configuration)) + (bootcfg-file (bootloader-configuration-file bootloader))) + (eval #~(primitive-load #$(install-bootloader-program installer + package + bootcfg + bootcfg-file + device + target))))) diff --git a/tests/services.scm b/tests/services.scm index 44ad0022c..572fe3816 100644 =2D-- a/tests/services.scm +++ b/tests/services.scm @@ -26,10 +26,6 @@ #:use-module (srfi srfi-64) #:use-module (ice-9 match)) =20 =2D(define live-service =2D (@@ (gnu services herd) live-service)) =2D =2D (test-begin "services") =20 (test-equal "services, default value" =2D-=20 2.22.0 --=-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQIzBAEBCAAdFiEEa1VJLOiXAjQ2BGSm9Qb9Fp2P2VoFAl0yBG0ACgkQ9Qb9Fp2P 2VowIRAAgrnk000QfHFUKWlSjEuUISR9nZC0h8GuiWaAxzCRnMuzZx4tSoqSPwo7 qPRcBC7NPB5cRXVcQR0Bdd7oMEB3YFIW0LBTfV6xAXx6CA7lAGUnKKezNrBToXpG iUoHRKkblidTqxBztTwioSIO0KGYRw57fR36YifiY62xCTLjjbQjlmWEfnTLyoI0 gr/TJPT96qo8PsB/q5tOuIKmLCrxL5R+D4Wga/ZQGhXiiQJQH4O/227vnzbUwx/A Krws6IzrNXM2NCWqED7IvNqOhn/HrkSTpdEix9d82EhAf/ATG7dpylyxVP31NABa mRsxjh97Ox9tos1Y2guH7AiwBZUWfvYlIkA2NbC99/Wx3AIWXDoCxHggB0N8hBsg HfcTG1dYjWd6MAeufHeDW3AuZ6YQVTpjBdDFZ/FjvTbuXpUsvj12MDLU3gUzxHEc XhlnaxPxfbsHdbgHF4dJbKahIrLJQYDJeiJl+g6fzBk9fdZ7eTpZTukaRJxONaxc zdmOPoebsTOVK2D92GI4FoDGN61kcCO8RnqGOZ7MS10+XqOm976rMo0u8EeViUAP 3Rbc5wGrCnb3vVm05YjB9TqqLNqw/PdG/gUNRt10g1sTHGNvZc9/aCwZh3/CAQj4 imuzQVntZOTk1Rpex9j4DKzIeQkg8d3HnxDzMsRB0ZQx51TGrHk= =lIG7 -----END PGP SIGNATURE----- --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Fri Jul 19 13:58:46 2019 Received: (at 36555) by debbugs.gnu.org; 19 Jul 2019 17:58:46 +0000 Received: from localhost ([127.0.0.1]:56535 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hoX9Y-0001Jq-PK for submit@debbugs.gnu.org; Fri, 19 Jul 2019 13:58:45 -0400 Received: from mx.sdf.org ([205.166.94.20]:51001) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hoX9W-0001Ji-LG for 36555@debbugs.gnu.org; Fri, 19 Jul 2019 13:58:43 -0400 Received: from Upsilon (mobile-107-107-62-64.mycingular.net [107.107.62.64]) (authenticated (0 bits)) by mx.sdf.org (8.15.2/8.14.5) with ESMTPSA id x6JHwThr009165 (using TLSv1.2 with cipher AES256-GCM-SHA384 (256 bits) verified NO); Fri, 19 Jul 2019 17:58:32 GMT From: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) To: Ludovic =?utf-8?Q?Court=C3=A8s?= Subject: Re: [bug#36555] [PATCH v4 2/3] guix system: Reimplement 'reconfigure'. 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> Date: Fri, 19 Jul 2019 13:58:26 -0400 In-Reply-To: <87wogdq575.fsf_-_@sdf.lonestar.org> (Jakob L. Kreuze's message of "Fri, 19 Jul 2019 13:55:58 -0400") Message-ID: <87r26lq531.fsf_-_@sdf.lonestar.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha256; protocol="application/pgp-signature" X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 36555 Cc: 36555@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= Content-Type: text/plain Content-Transfer-Encoding: quoted-printable * guix/scripts/system.scm (switch-to-system) (upgrade-shepherd-services, install-bootloader): Delete variable. * guix/scripts/system.scm (local-eval): New variable. =2D-- guix/scripts/system.scm | 182 +++++++++------------------------------- 1 file changed, 39 insertions(+), 143 deletions(-) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 60c1ca5c9..da515bb79 100644 =2D-- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -41,6 +41,7 @@ delete-matching-generations) #:use-module (guix graph) #:use-module (guix scripts graph) + #:use-module (guix scripts system reconfigure) #:use-module (guix build utils) #:use-module (guix progress) #:use-module ((guix build syscalls) #:select (terminal-columns)) @@ -178,43 +179,9 @@ TARGET, and register them." =20 (return *unspecified*))) =20 =2D(define* (install-bootloader installer =2D #:key =2D bootcfg bootcfg-file =2D target) =2D "Run INSTALLER, a bootloader installation script, with error handling,= in =2D%STORE-MONAD." =2D (mlet %store-monad ((installer-drv (if installer =2D (lower-object installer) =2D (return #f))) =2D (bootcfg (lower-object bootcfg))) =2D (let* ((gc-root (string-append target %gc-roots-directory =2D "/bootcfg")) =2D (temp-gc-root (string-append gc-root ".new")) =2D (install (and installer-drv =2D (derivation->output-path installer-drv))) =2D (bootcfg (derivation->output-path bootcfg))) =2D ;; Prepare the symlink to bootloader config file to make sure that= it's =2D ;; a GC root when 'installer-drv' completes (being a bit paranoid.) =2D (switch-symlinks temp-gc-root bootcfg) =2D =2D (unless (false-if-exception =2D (begin =2D (install-boot-config bootcfg bootcfg-file target) =2D (when install =2D (save-load-path-excursion (primitive-load install))))) =2D (delete-file temp-gc-root) =2D (leave (G_ "failed to install bootloader ~a~%") install)) =2D =2D ;; Register bootloader config file as a GC root so that its depend= encies =2D ;; (background image, font, etc.) are not reclaimed. =2D (rename-file temp-gc-root gc-root) =2D (return #t)))) =2D (define* (install os-drv target #:key (log-port (current-output-port)) =2D bootloader-installer install-bootloader? =2D bootcfg bootcfg-file) + install-bootloader? bootloader bootcfg) "Copy the closure of BOOTCFG, which includes the output of OS-DRV, to directory TARGET. TARGET must be an absolute directory name since that's = what 'register-path' expects. @@ -265,10 +232,11 @@ the ownership of '~a' may be incorrect!~%") (populate os-dir target) =20 (mwhen install-bootloader? =2D (install-bootloader bootloader-installer =2D #:bootcfg bootcfg =2D #:bootcfg-file bootcfg-file =2D #:target target)))))) + (install-bootloader local-eval bootloader bootcfg + #:target target) + (return + (format #t "bootloader successfully installed on '~a'~%" + (bootloader-configuration-target bootloader)))))))) =20 ;;; @@ -335,82 +303,6 @@ unload." (warning (G_ "failed to obtain list of shepherd services~%")) (return #f))))) =20 =2D(define (upgrade-shepherd-services os) =2D "Upgrade the Shepherd (PID 1) by unloading obsolete services and loadi= ng new =2Dservices specified in OS and not currently running. =2D =2DThis is currently very conservative in that it does not stop or unload a= ny =2Drunning service. Unloading or stopping the wrong service ('udev', say) = could =2Dbring the system down." =2D (define new-services =2D (service-value =2D (fold-services (operating-system-services os) =2D #:target-type shepherd-root-service-type))) =2D =2D ;; Arrange to simply emit a warning if the service upgrade fails. =2D (with-shepherd-error-handling =2D (call-with-service-upgrade-info new-services =2D (lambda (to-restart to-unload) =2D (for-each (lambda (unload) =2D (info (G_ "unloading service '~a'...~%") unload) =2D (unload-service unload)) =2D to-unload) =2D =2D (with-monad %store-monad =2D (munless (null? new-services) =2D (let ((new-service-names (map shepherd-service-canonical-na= me new-services)) =2D (to-restart-names (map shepherd-service-canonical-na= me to-restart)) =2D (to-start (filter shepherd-service-auto-star= t? new-services))) =2D (info (G_ "loading new services:~{ ~a~}...~%") new-service= -names) =2D (unless (null? to-restart-names) =2D ;; Listing TO-RESTART-NAMES in the message below wouldn'= t help =2D ;; because many essential services cannot be meaningfully =2D ;; restarted. See . =2D (format #t (G_ "To complete the upgrade, run 'herd resta= rt SERVICE' to stop, =2Dupgrade, and restart each service that was not automatically restarted.\= n"))) =2D (mlet %store-monad ((files (mapm %store-monad =2D (compose lower-object =2D shepherd-service= -file) =2D new-services))) =2D ;; Here we assume that FILES are exactly those that were= computed =2D ;; as part of the derivation that built OS, which is nor= mally the =2D ;; case. =2D (load-services/safe (map derivation->output-path files)) =2D =2D (for-each start-service =2D (map shepherd-service-canonical-name to-start)) =2D (return #t))))))))) =2D =2D(define* (switch-to-system os =2D #:optional (profile %system-profile)) =2D "Make a new generation of PROFILE pointing to the directory of OS, swi= tch to =2Dit atomically, and then run OS's activation script." =2D (mlet* %store-monad ((drv (operating-system-derivation os)) =2D (script (lower-object (operating-system-activatio= n-script os)))) =2D (let* ((system (derivation->output-path drv)) =2D (number (+ 1 (generation-number profile))) =2D (generation (generation-file-name profile number))) =2D (switch-symlinks generation system) =2D (switch-symlinks profile generation) =2D =2D (format #t (G_ "activating system...~%")) =2D =2D ;; The activation script may change $PATH, among others, so protect =2D ;; against that. =2D (save-environment-excursion =2D ;; Tell 'activate-current-system' what the new system is. =2D (setenv "GUIX_NEW_SYSTEM" system) =2D =2D ;; The activation script may modify '%load-path' & co., so protect =2D ;; against that. This is necessary to ensure that =2D ;; 'upgrade-shepherd-services' gets to see the right modules when= it =2D ;; computes derivations with 'gexp->derivation'. =2D (save-load-path-excursion =2D (primitive-load (derivation->output-path script)))) =2D =2D ;; Finally, try to update system services. =2D (upgrade-shepherd-services os)))) =2D (define-syntax-rule (unless-file-not-found exp) (catch 'system-error (lambda () @@ -505,18 +397,13 @@ STORE is an open connection to the store." ((bootloader-configuration-file-generator bootloader) bootloader-config entries #:old-entries old-entries))) =2D (bootcfg-file -> (bootloader-configuration-file bootloader)) =2D (target -> "/") (drvs -> (list bootcfg))) (mbegin %store-monad (show-what-to-build* drvs) (built-derivations drvs) =2D ;; Only install bootloader configuration file. Thus, no instal= ler is =2D ;; provided here. =2D (install-bootloader #f =2D #:bootcfg bootcfg =2D #:bootcfg-file bootcfg-file =2D #:target target)))))) + ;; Only install bootloader configuration file. + (install-bootloader local-eval bootloader-config bootcfg + #:run-installer? #f)))))) =20 ;;; @@ -825,6 +712,20 @@ and TARGET arguments." (format #t "bootloader successfully installed on '~= a'~%" #$device)))))) =20 +(define (local-eval exp) + "Evaluate EXP, a G-Expression, in-place." + (mlet* %store-monad ((lowered (lower-gexp exp)) + (_ (built-derivations (map gexp-input-thing + (lowered-gexp-inputs low= ered))))) + (save-load-path-excursion + (set! %load-path (lowered-gexp-load-path lowered)) + (set! %load-compiled-path (lowered-gexp-load-compiled-path lowered)) + (return + (guard (c ((message-condition? c) + (leave (G_ "failed to install bootloader:~%~a~%") + (condition-message c)))) + (primitive-eval (lowered-gexp-sexp lowered))))))) + (define* (perform-action action os #:key skip-safety-checks? install-bootloader? @@ -860,19 +761,12 @@ static checks." (map boot-parameters->menu-entry (profile-boot-parameters)))) =20 (define bootloader =2D (bootloader-configuration-bootloader (operating-system-bootloader os= ))) + (operating-system-bootloader os)) =20 (define bootcfg (and (memq action '(init reconfigure)) (operating-system-bootcfg os menu-entries))) =20 =2D (define bootloader-script =2D (let ((installer (bootloader-installer bootloader)) =2D (target (or target "/"))) =2D (bootloader-installer-script installer =2D (bootloader-package bootloader) =2D bootloader-target target))) =2D (when (eq? action 'reconfigure) (maybe-suggest-running-guix-pull)) =20 @@ -899,9 +793,7 @@ static checks." ;; See . (drvs (mapm %store-monad lower-object (if (memq action '(init reconfigure)) =2D (if install-bootloader? =2D (list sys bootcfg bootloader-script) =2D (list sys bootcfg)) + (list sys bootcfg) (list sys)))) (% (if derivations-only? (return (for-each (compose println derivation-file-n= ame) @@ -911,28 +803,32 @@ static checks." =20 (if (or dry-run? derivations-only?) (return #f) =2D (let ((bootcfg-file (bootloader-configuration-file bootloader))) + (begin (for-each (compose println derivation->output-path) drvs) =20 (case action ((reconfigure) + (newline) + (format #t (G_ "activating system...~%")) (mbegin %store-monad =2D (switch-to-system os) + (switch-to-system local-eval os) (mwhen install-bootloader? =2D (install-bootloader bootloader-script =2D #:bootcfg bootcfg =2D #:bootcfg-file bootcfg-file =2D #:target "/")))) + (install-bootloader local-eval bootloader bootcfg + #:target (or target "/")) + (return + (format #t "bootloader successfully installed on '~a'~%" + (bootloader-configuration-target bootloader)))) + (with-shepherd-error-handling + (upgrade-shepherd-services local-eval os)))) ((init) (newline) (format #t (G_ "initializing operating system under '~a'...~%= ") target) (install sys (canonicalize-path target) #:install-bootloader? install-bootloader? =2D #:bootcfg bootcfg =2D #:bootcfg-file bootcfg-file =2D #:bootloader-installer bootloader-script)) + #:bootloader bootloader + #:bootcfg bootcfg)) (else ;; All we had to do was to build SYS and maybe register an ;; indirect GC root. =2D-=20 2.22.0 --=-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQIzBAEBCAAdFiEEa1VJLOiXAjQ2BGSm9Qb9Fp2P2VoFAl0yBMIACgkQ9Qb9Fp2P 2Vq6fg//ZBEpZs6ZmzVEZo7MAzd1a5NKDC4PEWJVfrcsZe733oze9mx2Wrql5mGo s9nR90waciDJLiV7lTgE+G3bAnJ0G2mo/8TpSzg4QSafC6s2yCYW9O0EMqYro6vQ 7WD901PKwREmltNzVj3EyjUQHfStkVdEkJzn9GT4iun6GjzcA5Rnpj2fFxLeOamX oU9czqUMSZl7vfkAXqqFopkH3kH7l8ma3AYf1YzafvuBBPl2N42hG6kYxb6M4FPA nkeCRqYt/41FtRWbBSv5MYO2iRRYfMSfvzX/3v2JCX0NqX+y0yUy6b8dnjcmNgJz FzIYzAn9aE5HjZKJxSHHx3dDFTvUv4OlNShQSKtnRREkHcmZPa69VzeRa29s9gAE bDb57J+beVODhsAg0sp7TvbFxcVTokoRBB5aiNNp8VTj5Z2C5WMiZ4iTIMcYIIC2 uOaOdqgoLa7wZdpXSlzWH2nkXMlfAlaqc4tRHKipsc8DMlrimX69s7hFbRDoS6d0 00EmbSMzq1NSdky4Uu7E/yCayQzwi/4IGoLwj0XrPNXLgDcAitC9YWuGU23n6Hsn r2b1NhsdA1syC/D9luOjDp3ZaalLzi6L4otUoXu044ru5w6tDK0gHE4B/eDM1Ns4 bVqWF9LTM84NVmuehfYM49DlP0ZPBC7oW89AOuZVytNECieIQsg= =2Xr/ -----END PGP SIGNATURE----- --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Fri Jul 19 13:59:55 2019 Received: (at 36555) by debbugs.gnu.org; 19 Jul 2019 17:59:56 +0000 Received: from localhost ([127.0.0.1]:56539 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hoXAh-0001Ll-14 for submit@debbugs.gnu.org; Fri, 19 Jul 2019 13:59:55 -0400 Received: from mx.sdf.org ([205.166.94.20]:50831) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hoXAe-0001La-IF for 36555@debbugs.gnu.org; Fri, 19 Jul 2019 13:59:53 -0400 Received: from Upsilon (mobile-107-107-62-64.mycingular.net [107.107.62.64]) (authenticated (0 bits)) by mx.sdf.org (8.15.2/8.14.5) with ESMTPSA id x6JHxSV4018890 (using TLSv1.2 with cipher AES256-GCM-SHA384 (256 bits) verified NO); Fri, 19 Jul 2019 17:59:31 GMT From: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) To: Ludovic =?utf-8?Q?Court=C3=A8s?= Subject: Re: [bug#36555] [PATCH v4 3/3] tests: Add reconfigure system test. 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> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha256; protocol="application/pgp-signature" X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 36555 Cc: 36555@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= 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----- --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Fri Jul 19 15:36:33 2019 Received: (at 36555) by debbugs.gnu.org; 19 Jul 2019 19:36:33 +0000 Received: from localhost ([127.0.0.1]:56552 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hoYgC-0003io-OE for submit@debbugs.gnu.org; Fri, 19 Jul 2019 15:36:33 -0400 Received: from dustycloud.org ([50.116.34.160]:57654) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hoYg3-0003ho-Rw for 36555@debbugs.gnu.org; Fri, 19 Jul 2019 15:36:30 -0400 Received: from twig (localhost [127.0.0.1]) by dustycloud.org (Postfix) with ESMTPS id 099B826620; Fri, 19 Jul 2019 15:36:20 -0400 (EDT) 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> User-agent: mu4e 1.2.0; emacs 26.2 From: Christopher Lemmer Webber To: guix-patches@gnu.org Subject: Re: [bug#36555] [PATCH v3 0/3] Refactor out common behavior for system reconfiguration. In-reply-to: <87y30v3qke.fsf@sdf.lonestar.org> Date: Fri, 19 Jul 2019 15:36:20 -0400 Message-ID: <87a7d924wb.fsf@dustycloud.org> MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-Spam-Score: -0.0 (/) X-Debbugs-Envelope-To: 36555 Cc: Ludovic =?utf-8?Q?Court=C3=A8s?= , 36555@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) Jakob L. Kreuze writes: > Hello to anyone reviewing this patch, > > I probably should've held off on sending this reroll out. After taking > some more time to experiment with possible solutions, I was able to > figure most of this out. Comments would still be appreciated, but the > points I specifically asked for comments on no longer need special > treatment. Also, if you haven't already started reviewing this, v4 will > likely hit the mailing list tomorrow; everything's there, it just needs > to be cleaned up. > > zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) writes: > >> I still need to handle failed deployments in 'guix deploy'. I suspect >> that, for now, it would make sense to implement remote roll-backs and >> just roll-back the system on failure, at least until we've have some >> dialog about the proper way to do atomic deployments. > > Well, except for this. I'll submit a separate patch series addressing > this. I think that's fine to do in a separate series, and a good idea too. >> My biggest concern at the moment is error handling reporting in the >> new 'guix system reconfigure'. I'd like to emulate what was done with >> the previous version, but I'm at somewhat of a loss for how I'd go >> about that, since the error reporting was mixed with the >> reconfiguration code. So I'd like to ask for some suggestions: is the >> best way to catch errors in '%store-monad' to do what >> 'with-shepherd-error-handling' does, and then 'leave' on failure? >> >> Ludovic suggested guarding against 'message-condition' and having the >> expression I send to 'remote-eval' return either ('error message) or >> ('success). Would it make sense to just do this in all of the >> reconfiguration procedures? Or is raising exceptions in the >> reconfiguration procedures and catching them in the scripts' code the >> way to go? > > Comments, if anyone has them, would be appreciated, but I feel that I'm > in a good spot in terms of error handling now. Or even: ('error "error message here") (I suppose in case of success, a value would never be returned?) >> There's also a slight bug in the new 'guix system reconfigure' that >> I'll need to figure out. At the moment, it installs a bootloader entry >> for all but the newest generation. > > It wasn't actually a bug, I was misinterpreting the intended behavior of > 'guix system reconfigure'. :) Heh :) >> Oh, how na=C3=AFve I was four days ago. This reroll doesn't address this. >> Having the procedures "parameterized by an evaluation procedure" can >> be done in so many ways, and I think it would be best I put some >> serious thought into which of those ways would be the best. A >> 'local-eval' would clearly be much better than what I'm doing at the >> present in 'system.scm', but the solution I came up with today >> involved three layers of 'primitive-load', which I doubt is the way to >> go about it. I had the idea to parameterize on a procedure that takes >> a '' rather than a G-Expression as I was making dinner >> tonight, which seems to me like a sound idea, but we'll see if it >> works tomorrow when I try to implement it. > > Actually, a more generalized 'eval' (taking a G-Expression) was the > better way to go: it allowed me to simplify the interface to the > reconfiguration procedures even further. And, thanks to Ludovic's recent > patches with 'lower-gexp', I was able to collapse the Russian nesting > doll of 'primitive-load' calls. Yay! Generalization! >> Also, it hit me today that the safety checks done in 'guix system >> reconfigure' -- 'check-mapped-devices', >> 'check-file-system-availability', and 'check-initrd-modules' -- should >> also be done in 'guix deploy'. It might make sense for me to submit that >> change as a separate patch series so the code review for this doesn't >> get too complicated, but since we're on the topic of unifying the code >> between 'guix deploy' and 'guix system reconfigure', should I perhaps >> reimplement those procedures as '' objects like everything >> else in '(guix scripts system reconfigure)'? They aren't really >> effectful, but they concern system reconfiguration. > > Again, separate patch series. Yes, please do. My main worry is that such a patch series may be forgotten. Would it be inappropriate to make a "stub" patch issue for both of the followup patch series, since both seem important and we don't want to forget them? >> And, on the same note, should I go ahead and refactor the rest of the >> reconfiguration code in 'system.scm' out into '(guix scripts system >> reconfigure)'? I mean, this will probably be a separate patch series for >> the same reason that the safety checks would be a separate patch series, >> and I'll likely do this _after_ I come up with a decent way to >> parameterize on an evaluation procedure, but I'd like to know if it's a >> good idea or not before going ahead and ripping apart 'system.scm'. > > I'd still like comments on this, though. I guess see above. But I think we shouldn't wait, since I'd like to keep the energy up and get this merged in. - Chris From debbugs-submit-bounces@debbugs.gnu.org Sat Jul 20 10:29:59 2019 Received: (at 36555) by debbugs.gnu.org; 20 Jul 2019 14:29:59 +0000 Received: from localhost ([127.0.0.1]:57728 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hoqN4-0004vu-S3 for submit@debbugs.gnu.org; Sat, 20 Jul 2019 10:29:59 -0400 Received: from eggs.gnu.org ([209.51.188.92]:45791) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hoqN1-0004ve-9N for 36555@debbugs.gnu.org; Sat, 20 Jul 2019 10:29:58 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:51430) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1hoqMv-0000tP-OK; Sat, 20 Jul 2019 10:29:49 -0400 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=42226 helo=ribbon) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1hoqMu-0002k0-Ay; Sat, 20 Jul 2019 10:29:48 -0400 From: =?utf-8?Q?Ludovic_Court=C3=A8s?= To: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) Subject: Re: [bug#36555] [PATCH v4 1/3] guix system: Add 'reconfigure' module. 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> X-URL: http://www.fdn.fr/~lcourtes/ X-Revolutionary-Date: 2 Thermidor an 227 de la =?utf-8?Q?R=C3=A9volution?= X-PGP-Key-ID: 0x090B11993D9AEBB5 X-PGP-Key: http://www.fdn.fr/~lcourtes/ludovic.asc X-PGP-Fingerprint: 3CE4 6455 8A84 FDC6 9DB4 0CFB 090B 1199 3D9A EBB5 X-OS: x86_64-pc-linux-gnu Date: Sat, 20 Jul 2019 16:29:46 +0200 In-Reply-To: <87wogdq575.fsf_-_@sdf.lonestar.org> (Jakob L. Kreuze's message of "Fri, 19 Jul 2019 13:55:58 -0400") Message-ID: <874l3g7p9h.fsf@gnu.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2 (gnu/linux) MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 36555 Cc: 36555@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) Hello Jakob! zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) skribis: > * guix/scripts/system/reconfigure.scm: New file. > * Makefile.am (MODULES): Add it. > * guix/scripts/system.scm (bootloader-installer-script): Export variable. > * gnu/machine/ssh.scm (switch-to-system, upgrade-shepherd-services) > (install-bootloader): Delete variable. > * gnu/machine/ssh.scm (deploy-managed-host): Rewrite procedure. > * gnu/services/herd.scm (live-service): Export variable. > * gnu/services/herd.scm (live-service-canonical-name): New variable. > * tests/services.scm (live-service): Delete variable. It LGTM! I have some comments inline below, but nothing that should block this patch. > (define (deploy-managed-host machine) > "Internal implementation of 'deploy-machine' for MACHINE instances wit= h an > environment type of 'managed-host." > (maybe-raise-unsupported-configuration-error machine) > - (mbegin %store-monad > - (switch-to-system machine) > - (upgrade-shepherd-services machine) > - (install-bootloader machine))) > + (mlet %store-monad ((boot-parameters (machine-boot-parameters machine)= )) > + (let* ((os (machine-system machine)) > + (eval (cut machine-remote-eval machine <>)) > + (menu-entries (map boot-parameters->menu-entry boot-parameter= s)) > + (bootloader-configuration (operating-system-bootloader os)) > + (bootcfg (operating-system-bootcfg os menu-entries))) > + (mbegin %store-monad > + (switch-to-system eval os) > + (upgrade-shepherd-services eval os) > + (install-bootloader eval bootloader-configuration bootcfg))))) Really nice that it becomes this concise. > > ;;; > diff --git a/gnu/services/herd.scm b/gnu/services/herd.scm > index 0008746fe..2207b2d34 100644 > --- a/gnu/services/herd.scm > +++ b/gnu/services/herd.scm > @@ -40,10 +40,12 @@ > unknown-shepherd-error? > unknown-shepherd-error-sexp >=20=20 > + live-service I like to avoid exposing constructors so that one cannot =E2=80=9Cforge=E2= =80=9D invalid objects, but let=E2=80=99s see=E2=80=A6 > +(define* (switch-to-system eval os #:optional profile) > + "Using EVAL, a monadic procedure taking a single G-Expression as an ar= gument, > +create a new generation of PROFILE pointing to the directory of OS, swit= ch to > +it atomically, and run OS's activation script." > + (eval #~(primitive-load #$(switch-system-program os profile)))) I wonder it we should just use #~(begin (use-modules (guix build utils)) (invoke =E2=80=A6)) here and in other places. That=E2=80=99s probably better longer-term (for example when we switch to Guile=C2=A03, that could ease the transition since the right Guile would be used) but we can keep it this way and revisit it later. > +(define (running-services eval) > + "Using EVAL, a monadic procedure taking a single G-Expression as an ar= gument, > +return the objects that are currently running on MACHINE." > + (define remote-exp s/remote-exp/exp/ > + (with-imported-modules '((gnu services herd)) > + #~(begin > + (use-modules (gnu services herd)) > + (let ((services (current-services))) > + (and services > + ;; 'live-service-running' is ignored, as we can't neces= sarily > + ;; serialize arbitrary objects. This should be fine for= now, > + ;; since 'machine-current-services' is not exposed publ= icly, > + ;; and the resultant objects are only us= ed for > + ;; resolving service dependencies. > + (map (lambda (service) > + (list (live-service-provision service) > + (live-service-requirement service))) > + services)))))) > + (mlet %store-monad ((services (eval remote-exp))) > + (return (map (match-lambda > + ((provision requirement) > + (live-service provision requirement #f))) > + services)))) OK, that makes sense here. (Once we=E2=80=99ve done that (guix graph) demonadification we discussed be= fore, perhaps we can perform run =E2=80=98shepherd-service-upgrade=E2=80=99 entir= ely on the =E2=80=9Cother side=E2=80=9D, and at that point we won=E2=80=99t need to ex= pose the =E2=80=98live-service=E2=80=99 constructor.) > +;; (format (current-error-port) "error: ~a~%" (condition-message c)) > +;; (format #t "bootloader successfully installed on '~a'~%" > +;; #$device) A leftover? :-) These two statements disappeared in the process, but I think they=E2=80=99re added back by one of the subsequent patches, right? Thanks, Ludo=E2=80=99. From debbugs-submit-bounces@debbugs.gnu.org Sat Jul 20 10:41:03 2019 Received: (at 36555) by debbugs.gnu.org; 20 Jul 2019 14:41:03 +0000 Received: from localhost ([127.0.0.1]:57743 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hoqXn-0005Dw-6g for submit@debbugs.gnu.org; Sat, 20 Jul 2019 10:41:03 -0400 Received: from eggs.gnu.org ([209.51.188.92]:48160) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hoqXl-0005DK-DK for 36555@debbugs.gnu.org; Sat, 20 Jul 2019 10:41:01 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:51542) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1hoqXg-0002o8-8I; Sat, 20 Jul 2019 10:40:56 -0400 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=42246 helo=ribbon) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1hoqXf-00059d-IE; Sat, 20 Jul 2019 10:40:56 -0400 From: =?utf-8?Q?Ludovic_Court=C3=A8s?= To: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) Subject: Re: [bug#36555] [PATCH v4 2/3] guix system: Reimplement 'reconfigure'. 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> X-URL: http://www.fdn.fr/~lcourtes/ X-Revolutionary-Date: 2 Thermidor an 227 de la =?utf-8?Q?R=C3=A9volution?= X-PGP-Key-ID: 0x090B11993D9AEBB5 X-PGP-Key: http://www.fdn.fr/~lcourtes/ludovic.asc X-PGP-Fingerprint: 3CE4 6455 8A84 FDC6 9DB4 0CFB 090B 1199 3D9A EBB5 X-OS: x86_64-pc-linux-gnu Date: Sat, 20 Jul 2019 16:40:54 +0200 In-Reply-To: <87r26lq531.fsf_-_@sdf.lonestar.org> (Jakob L. Kreuze's message of "Fri, 19 Jul 2019 13:58:26 -0400") Message-ID: <87a7d86a6h.fsf@gnu.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2 (gnu/linux) MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 36555 Cc: 36555@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) Hello, zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) skribis: > * guix/scripts/system.scm (switch-to-system) > (upgrade-shepherd-services, install-bootloader): Delete variable. > * guix/scripts/system.scm (local-eval): New variable. ^ No need to repeat the file name here. However there are other changes no mentioned here, for example changes to the =E2=80=98install=E2=80=99 procedure. Could you add them to the log? > + (install-bootloader local-eval bootloader bootcfg > + #:target target) > + (return > + (format #t "bootloader successfully installed on '~a'~%" > + (bootloader-configuration-target bootloader)))))))) While you=E2=80=99re at it, could you change it to: (info (G_ "bootloader successfully installed on '~a'~%") =E2=80=A6) ? What happens when =E2=80=98install-bootloader=E2=80=99 fails though? We sh= ould make sure that the error is diagnosed, and that the output of =E2=80=98grub-inst= all=E2=80=99 or similar is shown when that happens. > +(define (local-eval exp) > + "Evaluate EXP, a G-Expression, in-place." Eventually we should add it to (guix gexp). > + (mlet* %store-monad ((lowered (lower-gexp exp)) > + (_ (built-derivations (map gexp-input-thing > + (lowered-gexp-inputs l= owered))))) Note that there are now a few places where we call =E2=80=98built-derivatio= ns=E2=80=99 without calling =E2=80=98show-what-to-build*=E2=80=99 first. That means th= e UX might be pretty bad since one has no idea what=E2=80=99s being built. Furthermore, that means substitutes may not be up-to-date, leading to many =E2=80=9Cupdating substitutes=E2=80=9D messages and HTTP round trips (= as happened with ). Last, doing several =E2=80=98build-derivations=E2=80=99 call with just a co= uple of derivations is less efficient than doing a single call with many derivations; that also has an impact on the UI, if we were to call =E2=80=98show-what-to-build*=E2=80=99 once for =E2=80=98build-derivations= =E2=80=99 call. What=E2=80=99s your experience with this in practice? There are several things we can do to improve on that. One is to have =E2=80=98built-derivations=E2=80=99 automatically call =E2=80=98show-what-t= o-build*=E2=80=99. However, (guix derivations) must not depend on (guix ui) so we could add a parameter to =E2=80=98run-with-store=E2=80=99 that would specify what to do= upon =E2=80=98build-derivations=E2=80=99. Last but not least, make sure to test this on your machine. :-) It=E2=80=99s sensitive code that we=E2=80=99d rather not break. Thanks! Ludo=E2=80=99. From debbugs-submit-bounces@debbugs.gnu.org Sat Jul 20 10:50:26 2019 Received: (at 36555) by debbugs.gnu.org; 20 Jul 2019 14:50:26 +0000 Received: from localhost ([127.0.0.1]:57751 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hoqgr-0005Ub-Re for submit@debbugs.gnu.org; Sat, 20 Jul 2019 10:50:26 -0400 Received: from eggs.gnu.org ([209.51.188.92]:49955) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hoqgq-0005UM-Nf for 36555@debbugs.gnu.org; Sat, 20 Jul 2019 10:50:24 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:51618) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1hoqgl-0000TQ-H6; Sat, 20 Jul 2019 10:50:19 -0400 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=42264 helo=ribbon) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1hoqgl-0005iy-4K; Sat, 20 Jul 2019 10:50:19 -0400 From: =?utf-8?Q?Ludovic_Court=C3=A8s?= To: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) Subject: Re: [bug#36555] [PATCH v4 3/3] tests: Add reconfigure system test. 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> <87muh9q51e.fsf_-_@sdf.lonestar.org> X-URL: http://www.fdn.fr/~lcourtes/ X-Revolutionary-Date: 2 Thermidor an 227 de la =?utf-8?Q?R=C3=A9volution?= X-PGP-Key-ID: 0x090B11993D9AEBB5 X-PGP-Key: http://www.fdn.fr/~lcourtes/ludovic.asc X-PGP-Fingerprint: 3CE4 6455 8A84 FDC6 9DB4 0CFB 090B 1199 3D9A EBB5 X-OS: x86_64-pc-linux-gnu Date: Sat, 20 Jul 2019 16:50:17 +0200 In-Reply-To: <87muh9q51e.fsf_-_@sdf.lonestar.org> (Jakob L. Kreuze's message of "Fri, 19 Jul 2019 13:59:25 -0400") Message-ID: <87wogc4v6e.fsf@gnu.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2 (gnu/linux) MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 36555 Cc: 36555@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) skribis: > * gnu/tests/reconfigure.scm: New file. > * gnu/local.mk (GNU_SYSTEM_MODULES): Add it. That=E2=80=99s really cool! > + (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)))) Perhaps you could also check the target of /run/current-system, and maybe check things like the set of user accounts (activation code)? > +(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 ensur= ing > + ;; 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" No need for docstrings for inner procedures; a comment is enough. > + (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" ^ s/new/obsolete/, no? Perhaps you could also check for the availability of a =E2=80=9Creplacement= =E2=80=9D slot (info "(shepherd) Slots of services") for services that exist both before and after the upgrade? This could be achieved by augmenting (gnu services herd) with a =E2=80=98live-service-replacement=E2=80=99 procedure,= I think. The rest LGTM! I think you=E2=80=99ve reached the most difficult part of this whole endeav= or. The good thing is that, once you=E2=80=99re past this, things will be much easier. Thank you! Ludo=E2=80=99. From debbugs-submit-bounces@debbugs.gnu.org Mon Jul 22 12:21:34 2019 Received: (at 36555) by debbugs.gnu.org; 22 Jul 2019 16:21:34 +0000 Received: from localhost ([127.0.0.1]:33518 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hpb4A-0002rK-1S for submit@debbugs.gnu.org; Mon, 22 Jul 2019 12:21:34 -0400 Received: from mx.sdf.org ([205.166.94.20]:53925) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hpb46-0002r9-4T for 36555@debbugs.gnu.org; Mon, 22 Jul 2019 12:21:33 -0400 Received: from Epsilon (pool-173-76-53-40.bstnma.fios.verizon.net [173.76.53.40]) (authenticated (0 bits)) by mx.sdf.org (8.15.2/8.14.5) with ESMTPSA id x6MGLNFU002174 (using TLSv1.2 with cipher AES256-GCM-SHA384 (256 bits) verified NO); Mon, 22 Jul 2019 16:21:28 GMT From: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) To: Christopher Lemmer Webber Subject: Re: [bug#36555] [PATCH v3 0/3] Refactor out common behavior for system reconfiguration. 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> <87a7d924wb.fsf@dustycloud.org> Date: Mon, 22 Jul 2019 12:18:53 -0400 In-Reply-To: <87a7d924wb.fsf@dustycloud.org> (Christopher Lemmer Webber's message of "Fri, 19 Jul 2019 15:36:20 -0400") Message-ID: <87k1caavpu.fsf@sdf.lonestar.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha256; protocol="application/pgp-signature" X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 36555 Cc: 36555@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= Content-Type: text/plain Hey, Chris! Christopher Lemmer Webber writes: > My main worry is that such a patch series may be forgotten. Would it > be inappropriate to make a "stub" patch issue for both of the followup > patch series, since both seem important and we don't want to forget > them? Alternatively, because these patches address existing issues with 'guix deploy', should we open tickets on the issue tracker? I don't have too much of a preference: either way should work fine for ensuring that we don't forget about them. Regards, Jakob --=-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQIzBAEBCAAdFiEEa1VJLOiXAjQ2BGSm9Qb9Fp2P2VoFAl014e0ACgkQ9Qb9Fp2P 2VoLLg/6AqwdBunkQB9rIxIHsTZG5gavGzUrs5qZJ0F8KHA+wV8hHY0zNzJJEBN7 9jhDTRzY/3fHQdDEk4Fd+URiZtFOvPhz6vTza+GhG4P3pTpJqLwdbMYivmS+RVcb j7141YP1LtyLIv02ZtOJGOO7KhRMm17voWg+/Wap2ttQA1vPYSVPDyMzNA6fKpnv LW5JXGqJijpnlYCqI6dKi0re7TTKqMNn5N63lISqdaeV9rN/WVw6fQCoR/+z6C+A AZ0foQf/Rk3I7V3R96n/N/fWtAa7Het8Y/E0CZMfmaF6+RtzDK4eEef1JvK00fQY 8nYvprPZWwH6xyGiFcbY0n84B/oydpvM0po3Mbxwft1G3XxtzqkotITvC6qAyEBc A9EhpefTCHxVbHzFuzI5VWHzic7mM/dtyLz4ug7bYkNNvmcEi8RRahSGIYr9J/Ko PG/XHnyWqxu8SapIiDF8AV3i4pkjslFn79RHnFAZmEWXfCEz9giRAx+3xcXgUMHg qq9VBY8ZAbCa9onP0qrs5i+GSe6+fMocrH9uwHnNvQw0GHPfr33x96fYp5Bo6wdM UaZwIrQI5497Ghj4BKTqm9Sz9GKlceySA7j5dzF7Sk8Qeq3WDXaXfes/f1gUUVio 9sU92PF5Y/a65u2+Uro0+r09nWy0Fjsqml+7xaQ4LVXDAUYLNFc= =HoKY -----END PGP SIGNATURE----- --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Mon Jul 22 12:39:05 2019 Received: (at 36555) by debbugs.gnu.org; 22 Jul 2019 16:39:05 +0000 Received: from localhost ([127.0.0.1]:33538 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hpbL7-0003Iw-10 for submit@debbugs.gnu.org; Mon, 22 Jul 2019 12:39:05 -0400 Received: from dustycloud.org ([50.116.34.160]:51108) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hpbL4-0003In-TE for 36555@debbugs.gnu.org; Mon, 22 Jul 2019 12:39:03 -0400 Received: from twig (localhost [127.0.0.1]) by dustycloud.org (Postfix) with ESMTPS id CACFB26618; Mon, 22 Jul 2019 12:39:01 -0400 (EDT) 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> <87a7d924wb.fsf@dustycloud.org> <87k1caavpu.fsf@sdf.lonestar.org> User-agent: mu4e 1.2.0; emacs 26.2 From: Christopher Lemmer Webber To: "Jakob L. Kreuze" Subject: Re: [bug#36555] [PATCH v3 0/3] Refactor out common behavior for system reconfiguration. In-reply-to: <87k1caavpu.fsf@sdf.lonestar.org> Date: Mon, 22 Jul 2019 12:39:01 -0400 Message-ID: <87muh6yqfu.fsf@dustycloud.org> MIME-Version: 1.0 Content-Type: text/plain X-Spam-Score: -0.0 (/) X-Debbugs-Envelope-To: 36555 Cc: 36555@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) Jakob L. Kreuze writes: > Hey, Chris! > > Christopher Lemmer Webber writes: > >> My main worry is that such a patch series may be forgotten. Would it >> be inappropriate to make a "stub" patch issue for both of the followup >> patch series, since both seem important and we don't want to forget >> them? > > Alternatively, because these patches address existing issues with 'guix > deploy', should we open tickets on the issue tracker? I don't have too > much of a preference: either way should work fine for ensuring that we > don't forget about them. > > Regards, > Jakob That's a good call. Yeah, I think put them there. From debbugs-submit-bounces@debbugs.gnu.org Mon Jul 22 14:19:28 2019 Received: (at 36555) by debbugs.gnu.org; 22 Jul 2019 18:19:28 +0000 Received: from localhost ([127.0.0.1]:33608 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hpcuG-0006Cy-1A for submit@debbugs.gnu.org; Mon, 22 Jul 2019 14:19:28 -0400 Received: from ol.sdf.org ([205.166.94.20]:65280 helo=mx.sdf.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hpcuA-0006Ce-WD for 36555@debbugs.gnu.org; Mon, 22 Jul 2019 14:19:27 -0400 Received: from Epsilon (pool-173-76-53-40.bstnma.fios.verizon.net [173.76.53.40]) (authenticated (0 bits)) by mx.sdf.org (8.15.2/8.14.5) with ESMTPSA id x6MIJIx1004028 (using TLSv1.2 with cipher AES256-GCM-SHA384 (256 bits) verified NO); Mon, 22 Jul 2019 18:19:20 GMT From: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) To: Ludovic =?utf-8?Q?Court=C3=A8s?= Subject: Re: [bug#36555] [PATCH v4 3/3] tests: Add reconfigure system test. 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> <87muh9q51e.fsf_-_@sdf.lonestar.org> <87wogc4v6e.fsf@gnu.org> Date: Mon, 22 Jul 2019 14:16:46 -0400 In-Reply-To: <87wogc4v6e.fsf@gnu.org> ("Ludovic \=\?utf-8\?Q\?Court\=C3\=A8s\=22'\?\= \=\?utf-8\?Q\?s\?\= message of "Sat, 20 Jul 2019 16:50:17 +0200") Message-ID: <87zhl69box.fsf@sdf.lonestar.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha256; protocol="application/pgp-signature" X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 36555 Cc: 36555@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Hi, Ludovic! Ludovic Court=C3=A8s writes: > Really nice that it becomes this concise. Yeah, I think (and hope) this is a good sign that we've picked the right abstraction for this :) > I like to avoid exposing constructors so that one cannot =E2=80=9Cforge= =E2=80=9D > invalid objects, but let=E2=80=99s see=E2=80=A6 Should I use @@ for this, perhaps? Aside from one other place in the test suite, it's a one-off use, and the objects are then only used internally. > I wonder it we should just use > > #~(begin (use-modules (guix build utils)) (invoke =E2=80=A6)) > > here and in other places. > > That=E2=80=99s probably better longer-term (for example when we switch to > Guile=C2=A03, that could ease the transition since the right Guile would = be > used) but we can keep it this way and revisit it later. Oh that's a good point, I agree that we should do that. I'll submit a separate patch once this gets merged. > s/remote-exp/exp/ > ... > A leftover? :-) > > These two statements disappeared in the process, but I think they=E2=80= =99re > added back by one of the subsequent patches, right? Good catches, thanks! Yes, the code is added back in the commits that follow. > OK, that makes sense here. > > (Once we=E2=80=99ve done that (guix graph) demonadification we discussed > before, perhaps we can perform run =E2=80=98shepherd-service-upgrade=E2= =80=99 entirely > on the =E2=80=9Cother side=E2=80=9D, and at that point we won=E2=80=99t n= eed to expose the > =E2=80=98live-service=E2=80=99 constructor.) The main issue with calling 'shepherd-service-upgrade' on the other side is that we'd need to send over the service objects (the current 'upgrade-services-program' deals with provision symbols rather than the service objects themselves). I'm certain it's possible, it's just easier said than done. I've got time to think it through, though :) > No need to repeat the file name here. > > However there are other changes no mentioned here, for example changes > to the =E2=80=98install=E2=80=99 procedure. Could you add them to the log? > > While you=E2=80=99re at it, could you change it to: > > (info (G_ "bootloader successfully installed on '~a'~%") =E2=80=A6) > > ? Yep, sure thing. > What happens when =E2=80=98install-bootloader=E2=80=99 fails though? We s= hould make > sure that the error is diagnosed, and that the output of > =E2=80=98grub-install=E2=80=99 or similar is shown when that happens. > Note that there are now a few places where we call =E2=80=98built-derivat= ions=E2=80=99 > without calling =E2=80=98show-what-to-build*=E2=80=99 first. That means t= he UX might > be pretty bad since one has no idea what=E2=80=99s being built. > > Furthermore, that means substitutes may not be up-to-date, leading to > many =E2=80=9Cupdating substitutes=E2=80=9D messages and HTTP round trips= (as happened > with ). > > Last, doing several =E2=80=98build-derivations=E2=80=99 call with just a = couple of > derivations is less efficient than doing a single call with many > derivations; that also has an impact on the UI, if we were to call > =E2=80=98show-what-to-build*=E2=80=99 once for =E2=80=98build-derivations= =E2=80=99 call. > > What=E2=80=99s your experience with this in practice? I haven't had too many issues with it since the G-Expressions tended to have few inputs, but those are some valid concerns. Would it be better to create derivations for locally-evaluated G-Expressions? For example, with 'program-file' or 'gexp->script'? I thought that evaluating them in-place might be better since that's one fewer store item that needs to be built, but if we were to turn the G-Expression into a derivation, we could add it to the call to 'show-what-to-build*' in 'guix system reconfigure'. > Eventually we should add it to (guix gexp). Yeah, that seems to make more sense. I can move it when I address the above. > Last but not least, make sure to test this on your machine. :-) > > It=E2=80=99s sensitive code that we=E2=80=99d rather not break. Heh, indeed! I've run it several times in a virtual machine, but running it on my desktop is the ultimate "I promise this works, and if it doesn't, I'll eat my hat." I'll do an update on this machine and report back. > Perhaps you could also check the target of /run/current-system, and > maybe check things like the set of user accounts (activation code)? > > Perhaps you could also check for the availability of a =E2=80=9Creplaceme= nt=E2=80=9D > slot (info "(shepherd) Slots of services") for services that exist > both before and after the upgrade? This could be achieved by > augmenting (gnu services herd) with a =E2=80=98live-service-replacement= =E2=80=99 > procedure, I think. Great ideas! In the interest of keeping this patch manageable, I'll submit these improvements separately. > No need for docstrings for inner procedures; a comment is enough. > ... > s/new/obsolete/, no? I can address these in my corrections, though. > I think you=E2=80=99ve reached the most difficult part of this whole ende= avor. > The good thing is that, once you=E2=80=99re past this, things will be much > easier. Agreed, I think this gives us a good framework for implementing provisioning etc. Regards, Jakob --=-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQIzBAEBCAAdFiEEa1VJLOiXAjQ2BGSm9Qb9Fp2P2VoFAl01/Y4ACgkQ9Qb9Fp2P 2VpF7A/9Glx0Vx7Hcb7SkbzSMeVN/MyUrFKJNkkn7GaVRRVxyZsyW1QvlR0PVTsT 6IyA803+54jdatfEuNM3sTXmU8foj+lOqnuFqDwoBS8az/Ih3mzcN3oUTViSJqLT fWARre1X9LwreTtxnnwWxQrRjEDuDZA4r4tvXxvnvVn8+Gq/TQkA5xLj8p7w2lVR StDMHgxtW16OSTrCAMguYB+93Ax53paxdMtvg2SXWOBVhTMw0g+J+pQXY38++TwM +jOg+X8SgPajGhbO2821YD/cN3FJSZ9Cvd/VKrX7HZ8KEufiRebi7o9Sb7AmXqXf bvFb57wMl0NGXuwCaIRCY/FohR0EMXeBKHHyiouqHPpfMJysud3PMKpcmafMgeR9 oobdM6xDoDoY81ztv0sT9s2rviHWsSU3+b2E2h7DyzulHrpZUv7mL+YvoBxNqJwi 7J/+Z3X4b/SzYpmRZ6rPLdLTsUjFXNI1ZhM351h477dC/c4p8zoaWczGZjY4qTf2 UIBXyhOc9y+mB8zUBHNaUN9dYKWsGPBnSPC4d0Jp798TbUfZIhbkE4VTHPg8tn0Y bJZGF27LmZ00a7JiTrq3S5leVdYOYD47avk5hhoZghjRsjfekaRMh+YHrc6aoOg8 gRLndoa1ppcdOu7LP3ZUDcsw/x5RFLk4LEeCssyh4f+KF3PcMcs= =eiWq -----END PGP SIGNATURE----- --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Mon Jul 22 14:26:05 2019 Received: (at 36555) by debbugs.gnu.org; 22 Jul 2019 18:26:05 +0000 Received: from localhost ([127.0.0.1]:33618 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hpd0f-0006QD-7q for submit@debbugs.gnu.org; Mon, 22 Jul 2019 14:26:05 -0400 Received: from mx.sdf.org ([205.166.94.20]:63351) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hpd0c-0006Pu-Rc for 36555@debbugs.gnu.org; Mon, 22 Jul 2019 14:26:03 -0400 Received: from Epsilon (pool-173-76-53-40.bstnma.fios.verizon.net [173.76.53.40]) (authenticated (0 bits)) by mx.sdf.org (8.15.2/8.14.5) with ESMTPSA id x6MIPvfm029310 (using TLSv1.2 with cipher AES256-GCM-SHA384 (256 bits) verified NO); Mon, 22 Jul 2019 18:26:01 GMT From: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) To: Ludovic =?utf-8?Q?Court=C3=A8s?= Subject: Re: [bug#36555] [PATCH v4 3/3] tests: Add reconfigure system test. 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> <87muh9q51e.fsf_-_@sdf.lonestar.org> <87wogc4v6e.fsf@gnu.org> <87zhl69box.fsf@sdf.lonestar.org> Date: Mon, 22 Jul 2019 14:23:30 -0400 In-Reply-To: <87zhl69box.fsf@sdf.lonestar.org> (Jakob L. Kreuze's message of "Mon, 22 Jul 2019 14:16:46 -0400") Message-ID: <87sgqy9bdp.fsf@sdf.lonestar.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha256; protocol="application/pgp-signature" X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 36555 Cc: 36555@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) writes: >> What happens when =E2=80=98install-bootloader=E2=80=99 fails though? We = should make >> sure that the error is diagnosed, and that the output of >> =E2=80=98grub-install=E2=80=99 or similar is shown when that happens. Apologies, forgot to respond to this point. This is handled in 'local-eval'. (guard (c ((message-condition? c) (leave (G_ "failed to install bootloader:~%~a~%") (condition-message c)))) ... --=-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQIzBAEBCAAdFiEEa1VJLOiXAjQ2BGSm9Qb9Fp2P2VoFAl01/yIACgkQ9Qb9Fp2P 2VoYvQ//W/AB6ttwtDwA7a0hFxC/sYrhOscty+v2SfXFSS/Az0OemauyEiIAxYaa OCwV51JGo6tH8mIWK+9RyDjTxJDQ8+dFOueZAaZffgzZkMBScpJLXchGt1+5nlQX 7uUkbfxIrWMeBUIchnM7M+/LuioWL/Di18t5sq4ac2Wfs1uSqA3P8Aw1RtZp6A8L Ky4t0pGBlC6dCIiDgglGoxRsfTBINTnP3kluRjiZIvKP0+jqFRqKe3u2gI7Ezcnr x0RH/sQdWaE0VaQLJUuq+Rw0AY1+nauBsXH6xGW6bxNqtfoOrM7qrK1Y3SaSs9La AQmB9DquIvnO/aEXi1pI7NL0xJsXE5HdqzWNV65MlC6DOmAn42cETQ6ksKt9LLyT rdMwEMwFIrcDh/tke/FDjCShVMmVDHUEP0Kjn6U9C4Q6DYmVgDA7RZelL27B5UDs eUxyjUKlZnegpYB0iSoI6I6uTPPQmrF4fgrAfoqtN66E5DQsLb9rSeVxwb7/Sp0q xKiumjVNX1hyYtYcOzONvcQDeUSNLmukeGNHL1oJvd7DplCM6YV1fgdc6ibhLY2j +nqyR6r85JY0XZIm0Ynhl/s6E7Exuf7ttJWTarrOOnbjIZGE+Rmc822EF0owobv5 xHM5ug3g0kKmHyecz6il/j4KPEKXZIjc6OFf6ocjRwRgjXr8koU= =CNso -----END PGP SIGNATURE----- --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Mon Jul 22 14:56:32 2019 Received: (at 36555) by debbugs.gnu.org; 22 Jul 2019 18:56:32 +0000 Received: from localhost ([127.0.0.1]:33634 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hpdU8-0007KZ-Bi for submit@debbugs.gnu.org; Mon, 22 Jul 2019 14:56:32 -0400 Received: from mx.sdf.org ([205.166.94.20]:57387) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hpdU5-0007KN-Ik for 36555@debbugs.gnu.org; Mon, 22 Jul 2019 14:56:30 -0400 Received: from Epsilon (pool-173-76-53-40.bstnma.fios.verizon.net [173.76.53.40]) (authenticated (0 bits)) by mx.sdf.org (8.15.2/8.14.5) with ESMTPSA id x6MIuRQ8015164 (using TLSv1.2 with cipher AES256-GCM-SHA384 (256 bits) verified NO); Mon, 22 Jul 2019 18:56:28 GMT From: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) To: Ludovic =?utf-8?Q?Court=C3=A8s?= Subject: Re: [bug#36555] [PATCH v5 0/3] Refactor out common behavior for system reconfiguration. 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> <87muh9q51e.fsf_-_@sdf.lonestar.org> <87wogc4v6e.fsf@gnu.org> <87zhl69box.fsf@sdf.lonestar.org> Date: Mon, 22 Jul 2019 14:54:00 -0400 In-Reply-To: <87zhl69box.fsf@sdf.lonestar.org> (Jakob L. Kreuze's message of "Mon, 22 Jul 2019 14:16:46 -0400") Message-ID: <87o91laojb.fsf_-_@sdf.lonestar.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha256; protocol="application/pgp-signature" X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 36555 Cc: 36555@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= Content-Type: text/plain Content-Transfer-Encoding: quoted-printable I'm feeling pretty good about this :) jakob@Epsilon ~/Code/guix [env] $ sudo -E ./pre-inst-env guix system reconf= igure ~/.config/guix/system/config.scm=20 substitute: updating substitutes from 'https://ci.guix.gnu.org'... 100.0% The following derivation will be built: /gnu/store/327py2dv6xjlm0xanqiqj1paxxx8g1rq-grub.cfg.drv building /gnu/store/327py2dv6xjlm0xanqiqj1paxxx8g1rq-grub.cfg.drv... /gnu/store/h45l455dg3wi6b24m0v8as5wdjskpfsm-system /gnu/store/razfpshw9n33dvm4bp0d2jwpdf4255hf-grub.cfg activating system... making '/gnu/store/h45l455dg3wi6b24m0v8as5wdjskpfsm-system' the current sys= tem... setting up setuid programs in '/run/setuid-programs'... populating /etc from /gnu/store/glzrd1cb6ngzwqvnph3q3pbxxjv8nprs-etc... substitute: updating substitutes from 'https://ci.guix.gnu.org'... 100.0% building /gnu/store/8vn3dlcmhri0f3ygfhqavlab2q35q2yn-install-bootloader.scm= .drv... guix system: bootloader successfully installed on '/dev/sda' substitute: updating substitutes from 'https://ci.guix.gnu.org'... 100.0% building /gnu/store/43cyy0nnrdr6wg9xzcph6shs4w7gfxi6-upgrade-shepherd-servi= ces.scm.drv... shepherd: Evaluating user expression (let* ((services (map primitive-load (= ?))) # ?) ?). Jakob L. Kreuze (3): guix system: Add 'reconfigure' module. guix system: Reimplement 'reconfigure'. tests: Add reconfigure system test. Makefile.am | 1 + gnu/local.mk | 1 + gnu/machine/ssh.scm | 189 ++------------------ gnu/services/herd.scm | 6 + gnu/tests/reconfigure.scm | 262 ++++++++++++++++++++++++++++ guix/scripts/system.scm | 186 +++++--------------- guix/scripts/system/reconfigure.scm | 237 +++++++++++++++++++++++++ tests/services.scm | 4 - 8 files changed, 560 insertions(+), 326 deletions(-) create mode 100644 gnu/tests/reconfigure.scm create mode 100644 guix/scripts/system/reconfigure.scm =2D-=20 2.22.0 --=-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQIzBAEBCAAdFiEEa1VJLOiXAjQ2BGSm9Qb9Fp2P2VoFAl02BkgACgkQ9Qb9Fp2P 2VocPA//Wv94YtOhQBskW4A1AS0R4/DetY7LRdtnHkhzjSzt69r7KrIMIaXeRR1j /yBHC3VFQ0L69vvD5qHb7XR842hGMyDyivdDCi5ZXIODMObkHiVYiKtfs3YgXRUz aWQvKBgfnUIRdpsuHYYLNdePg6FZpvygiWxRg5xnzn6lKiXkVx8ZfmgFQRE15fF7 O1sB4gNad2OIbndBWcAUBxF2Mb0lhva48rjMnfOmYv0OtiRoHRkFCbrxAkP/HprW 11A7acUdCRe7+3iMw6Ig6b+hnXGfavrSSgoK61Q1nUdkrMquJHcB71nLk8SoLseP g5jvrXUcitCe3OmGPJTvOEBHqGEZg8ERBCgPQHRNym5YyIFsrPDyZcCHwvdvo5M7 4wFzmOXLqTG+fAtacDS4T7M+LVu1HFIgPBdRF8LK+KLEBtxlKhLMgsKbMssmSvGh xrPmvGdTeDkn1iN8SAFWoD9No3Ne7oQ0d4/d7dqL5I2UGFnYrXXusC9gcwk6netw 9XhbWXgzUpBEedSrEZOJn+/blH8wD9pswOyZ0dyhymc6XTpCoNSqBzCSUP00vlbv PG7wuEd07dJouPKZSeYaJJMgaFVAQgn8NSrNmfkafBqYgSLjvMRe7mt01Haui+3j 3UmLruZ2se2i4Ww1+Z7jI6ALL6Q9nh5Y6tuRhCPrmWbZQ8Pfx1k= =x9G9 -----END PGP SIGNATURE----- --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Mon Jul 22 14:58:49 2019 Received: (at 36555) by debbugs.gnu.org; 22 Jul 2019 18:58:49 +0000 Received: from localhost ([127.0.0.1]:33638 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hpdWE-0007O5-UB for submit@debbugs.gnu.org; Mon, 22 Jul 2019 14:58:49 -0400 Received: from mx.sdf.org ([205.166.94.20]:56941) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hpdWA-0007Nv-G7 for 36555@debbugs.gnu.org; Mon, 22 Jul 2019 14:58:41 -0400 Received: from Epsilon (pool-173-76-53-40.bstnma.fios.verizon.net [173.76.53.40]) (authenticated (0 bits)) by mx.sdf.org (8.15.2/8.14.5) with ESMTPSA id x6MIwaka016159 (using TLSv1.2 with cipher AES256-GCM-SHA384 (256 bits) verified NO); Mon, 22 Jul 2019 18:58:37 GMT From: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) To: Ludovic =?utf-8?Q?Court=C3=A8s?= Subject: Re: [bug#36555] [PATCH v5 1/3] guix system: Add 'reconfigure' module. 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> <87muh9q51e.fsf_-_@sdf.lonestar.org> <87wogc4v6e.fsf@gnu.org> <87zhl69box.fsf@sdf.lonestar.org> <87o91laojb.fsf_-_@sdf.lonestar.org> Date: Mon, 22 Jul 2019 14:56:09 -0400 In-Reply-To: <87o91laojb.fsf_-_@sdf.lonestar.org> (Jakob L. Kreuze's message of "Mon, 22 Jul 2019 14:54:00 -0400") Message-ID: <87k1c9aofq.fsf_-_@sdf.lonestar.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha256; protocol="application/pgp-signature" X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 36555 Cc: 36555@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable * guix/scripts/system/reconfigure.scm: New file. * Makefile.am (MODULES): Add it. * guix/scripts/system.scm (bootloader-installer-script): Export variable. * gnu/machine/ssh.scm (switch-to-system, upgrade-shepherd-services) (install-bootloader): Delete variable. * gnu/machine/ssh.scm (deploy-managed-host): Rewrite procedure. * gnu/services/herd.scm (live-service): Export variable. * gnu/services/herd.scm (live-service-canonical-name): New variable. * tests/services.scm (live-service): Delete variable. =2D-- Makefile.am | 1 + gnu/machine/ssh.scm | 189 ++-------------------- gnu/services/herd.scm | 6 + guix/scripts/system/reconfigure.scm | 237 ++++++++++++++++++++++++++++ tests/services.scm | 4 - 5 files changed, 256 insertions(+), 181 deletions(-) create mode 100644 guix/scripts/system/reconfigure.scm diff --git a/Makefile.am b/Makefile.am index dd7720e87..58a96d348 100644 =2D-- a/Makefile.am +++ b/Makefile.am @@ -245,6 +245,7 @@ MODULES =3D \ guix/scripts/describe.scm \ guix/scripts/system.scm \ guix/scripts/system/search.scm \ + guix/scripts/system/reconfigure.scm \ guix/scripts/lint.scm \ guix/scripts/challenge.scm \ guix/scripts/import/crate.scm \ diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm index a7d1a967a..64d92acc9 100644 =2D-- a/gnu/machine/ssh.scm +++ b/gnu/machine/ssh.scm @@ -17,23 +17,21 @@ ;;; along with GNU Guix. If not, see . =20 (define-module (gnu machine ssh) =2D #:use-module (gnu bootloader) #:use-module (gnu machine) #:autoload (gnu packages gnupg) (guile-gcrypt) =2D #:use-module (gnu services) =2D #:use-module (gnu services shepherd) #:use-module (gnu system) =2D #:use-module (guix derivations) #:use-module (guix gexp) #:use-module (guix i18n) #:use-module (guix modules) #:use-module (guix monads) #:use-module (guix records) #:use-module (guix remote) + #:use-module (guix scripts system reconfigure) #:use-module (guix ssh) #:use-module (guix store) #:use-module (ice-9 match) #:use-module (srfi srfi-19) + #:use-module (srfi srfi-26) #:use-module (srfi srfi-35) #:export (managed-host-environment-type =20 @@ -105,118 +103,6 @@ an environment type of 'managed-host." ;;; System deployment. ;;; =20 =2D(define (switch-to-system machine) =2D "Monadic procedure creating a new generation on MACHINE and execute the =2Dactivation script for the new system configuration." =2D (define (remote-exp drv script) =2D (with-extensions (list guile-gcrypt) =2D (with-imported-modules (source-module-closure '((guix config) =2D (guix profiles) =2D (guix utils))) =2D #~(begin =2D (use-modules (guix config) =2D (guix profiles) =2D (guix utils)) =2D =2D (define %system-profile =2D (string-append %state-directory "/profiles/system")) =2D =2D (let* ((system #$drv) =2D (number (1+ (generation-number %system-profile))) =2D (generation (generation-file-name %system-profile num= ber))) =2D (switch-symlinks generation system) =2D (switch-symlinks %system-profile generation) =2D ;; The implementation of 'guix system reconfigure' saves t= he =2D ;; load path and environment here. This is unnecessary here =2D ;; because each invocation of 'remote-eval' runs in a dist= inct =2D ;; Guile REPL. =2D (setenv "GUIX_NEW_SYSTEM" system) =2D ;; The activation script may write to stdout, which confus= es =2D ;; 'remote-eval' when it attempts to read a result from the =2D ;; remote REPL. We work around this by forcing the output = to a =2D ;; string. =2D (with-output-to-string =2D (lambda () =2D (primitive-load #$script)))))))) =2D =2D (let* ((os (machine-system machine)) =2D (script (operating-system-activation-script os))) =2D (mlet* %store-monad ((drv (operating-system-derivation os))) =2D (machine-remote-eval machine (remote-exp drv script))))) =2D =2D;; XXX: Currently, this does NOT attempt to restart running services. Th= is is =2D;; also the case with 'guix system reconfigure'. =2D;; =2D;; See . =2D(define (upgrade-shepherd-services machine) =2D "Monadic procedure unloading and starting services on the remote as ne= eded =2Dto realize the MACHINE's system configuration." =2D (define target-services =2D ;; Monadic expression evaluating to a list of (name output-path) pai= rs for =2D ;; all of MACHINE's services. =2D (mapm %store-monad =2D (lambda (service) =2D (mlet %store-monad ((file ((compose lower-object =2D shepherd-service-file) =2D service))) =2D (return (list (shepherd-service-canonical-name service) =2D (derivation->output-path file))))) =2D (service-value =2D (fold-services (operating-system-services (machine-system mac= hine)) =2D #:target-type shepherd-root-service-type)))) =2D =2D (define (remote-exp target-services) =2D (with-imported-modules '((gnu services herd)) =2D #~(begin =2D (use-modules (gnu services herd) =2D (srfi srfi-1)) =2D =2D (define running =2D (filter live-service-running (current-services))) =2D =2D (define (essential? service) =2D ;; Return #t if SERVICE is essential and should not be unloa= ded =2D ;; under any circumstance. =2D (memq (first (live-service-provision service)) =2D '(root shepherd))) =2D =2D (define (obsolete? service) =2D ;; Return #t if SERVICE can be safely unloaded. =2D (and (not (essential? service)) =2D (every (lambda (requirements) =2D (not (memq (first (live-service-provision serv= ice)) =2D requirements))) =2D (map live-service-requirement running)))) =2D =2D (define to-unload =2D (filter obsolete? =2D (remove (lambda (service) =2D (memq (first (live-service-provision servi= ce)) =2D (map first '#$target-services))) =2D running))) =2D =2D (define to-start =2D (remove (lambda (service-pair) =2D (memq (first service-pair) =2D (map (compose first live-service-provision) =2D running))) =2D '#$target-services)) =2D =2D ;; Unload obsolete services. =2D (for-each (lambda (service) =2D (false-if-exception =2D (unload-service service))) =2D to-unload) =2D =2D ;; Load the service files for any new services and start them. =2D (load-services/safe (map second to-start)) =2D (for-each start-service (map first to-start)) =2D =2D #t))) =2D =2D (mlet %store-monad ((target-services target-services)) =2D (machine-remote-eval machine (remote-exp target-services)))) =2D (define (machine-boot-parameters machine) "Monadic procedure returning a list of 'boot-parameters' for the generat= ions of MACHINE's system profile, ordered from most recent to oldest." @@ -275,71 +161,20 @@ of MACHINE's system profile, ordered from most recent= to oldest." (boot-parameters-kernel-arguments params)))))))) generations)))) =20 =2D(define (install-bootloader machine) =2D "Create a bootloader entry for the new system generation on MACHINE, a= nd =2Dconfigure the bootloader to boot that generation by default." =2D (define bootloader-installer-script =2D (@@ (guix scripts system) bootloader-installer-script)) =2D =2D (define (remote-exp installer bootcfg bootcfg-file) =2D (with-extensions (list guile-gcrypt) =2D (with-imported-modules (source-module-closure '((gnu build install) =2D (guix store) =2D (guix utils))) =2D #~(begin =2D (use-modules (gnu build install) =2D (guix store) =2D (guix utils)) =2D (let* ((gc-root (string-append "/" %gc-roots-directory "/boo= tcfg")) =2D (temp-gc-root (string-append gc-root ".new"))) =2D =2D (switch-symlinks temp-gc-root gc-root) =2D =2D (unless (false-if-exception =2D (begin =2D ;; The implementation of 'guix system reconfigu= re' =2D ;; saves the load path here. This is unnecessar= y here =2D ;; because each invocation of 'remote-eval' run= s in a =2D ;; distinct Guile REPL. =2D (install-boot-config #$bootcfg #$bootcfg-file "= /") =2D ;; The installation script may write to stdout,= which =2D ;; confuses 'remote-eval' when it attempts to r= ead a =2D ;; result from the remote REPL. We work around = this =2D ;; by forcing the output to a string. =2D (with-output-to-string =2D (lambda () =2D (primitive-load #$installer))))) =2D (delete-file temp-gc-root) =2D (error "failed to install bootloader")) =2D =2D (rename-file temp-gc-root gc-root) =2D #t))))) =2D =2D (mlet* %store-monad ((boot-parameters (machine-boot-parameters machine= ))) =2D (let* ((os (machine-system machine)) =2D (bootloader ((compose bootloader-configuration-bootloader =2D operating-system-bootloader) =2D os)) =2D (bootloader-target (bootloader-configuration-target =2D (operating-system-bootloader os))) =2D (installer (bootloader-installer-script =2D (bootloader-installer bootloader) =2D (bootloader-package bootloader) =2D bootloader-target =2D "/")) =2D (menu-entries (map boot-parameters->menu-entry boot-parameter= s)) =2D (bootcfg (operating-system-bootcfg os menu-entries)) =2D (bootcfg-file (bootloader-configuration-file bootloader))) =2D (machine-remote-eval machine (remote-exp installer bootcfg bootcfg= -file))))) =2D (define (deploy-managed-host machine) "Internal implementation of 'deploy-machine' for MACHINE instances with = an environment type of 'managed-host." (maybe-raise-unsupported-configuration-error machine) =2D (mbegin %store-monad =2D (switch-to-system machine) =2D (upgrade-shepherd-services machine) =2D (install-bootloader machine))) + (mlet %store-monad ((boot-parameters (machine-boot-parameters machine))) + (let* ((os (machine-system machine)) + (eval (cut machine-remote-eval machine <>)) + (menu-entries (map boot-parameters->menu-entry boot-parameters)) + (bootloader-configuration (operating-system-bootloader os)) + (bootcfg (operating-system-bootcfg os menu-entries))) + (mbegin %store-monad + (switch-to-system eval os) + (upgrade-shepherd-services eval os) + (install-bootloader eval bootloader-configuration bootcfg))))) =20 ;;; diff --git a/gnu/services/herd.scm b/gnu/services/herd.scm index 0008746fe..2207b2d34 100644 =2D-- a/gnu/services/herd.scm +++ b/gnu/services/herd.scm @@ -40,10 +40,12 @@ unknown-shepherd-error? unknown-shepherd-error-sexp =20 + live-service live-service? live-service-provision live-service-requirement live-service-running + live-service-canonical-name =20 with-shepherd-action current-services @@ -192,6 +194,10 @@ of pairs." (requirement live-service-requirement) ;list of symbols (running live-service-running)) ;#f | object =20 +(define (live-service-canonical-name service) + "Return the 'canonical name' of SERVICE." + (first (live-service-provision service))) + (define (current-services) "Return the list of currently defined Shepherd services, represented as objects. Return #f if the list of services could not be diff --git a/guix/scripts/system/reconfigure.scm b/guix/scripts/system/reco= nfigure.scm new file mode 100644 index 000000000..8c7d46158 =2D-- /dev/null +++ b/guix/scripts/system/reconfigure.scm @@ -0,0 +1,237 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright =C2=A9 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Court=C3= =A8s +;;; Copyright =C2=A9 2016 Alex Kost +;;; Copyright =C2=A9 2016, 2017, 2018 Chris Marusich +;;; Copyright =C2=A9 2017 Mathieu Othacehe +;;; Copyright =C2=A9 2018 Ricardo Wurmus +;;; Copyright =C2=A9 2019 Christopher Baines +;;; 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 (guix scripts system reconfigure) + #:autoload (gnu packages gnupg) (guile-gcrypt) + #:use-module (gnu bootloader) + #:use-module (gnu services) + #:use-module (gnu services herd) + #:use-module (gnu services shepherd) + #:use-module (gnu system) + #:use-module (guix gexp) + #:use-module (guix modules) + #:use-module (guix monads) + #:use-module (guix store) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:export (switch-system-program + switch-to-system + + upgrade-services-program + upgrade-shepherd-services + + install-bootloader-program + install-bootloader)) + +;;; Commentary: +;;; +;;; This module implements the "effectful" parts of system +;;; reconfiguration. Although building a system derivation is a pure +;;; operation, a number of impure operations must be carried out for the +;;; system configuration to be realized -- chiefly, creation of generation +;;; symlinks and invocation of activation scripts. +;;; +;;; Code: + + +;;; +;;; Profile creation. +;;; + +(define* (switch-system-program os #:optional profile) + "Return an executable store item that, upon being evaluated, will create= a +new generation of PROFILE pointing to the directory of OS, switch to it +atomically, and run OS's activation script." + (program-file + "switch-to-system.scm" + (with-extensions (list guile-gcrypt) + (with-imported-modules (source-module-closure '((guix config) + (guix profiles) + (guix utils))) + #~(begin + (use-modules (guix config) + (guix profiles) + (guix utils)) + + (define profile + (or #$profile (string-append %state-directory "/profiles/syst= em"))) + + (let* ((number (1+ (generation-number profile))) + (generation (generation-file-name profile number))) + (switch-symlinks generation #$os) + (switch-symlinks profile generation) + (setenv "GUIX_NEW_SYSTEM" #$os) + (primitive-load #$(operating-system-activation-script os)))))= ))) + +(define* (switch-to-system eval os #:optional profile) + "Using EVAL, a monadic procedure taking a single G-Expression as an argu= ment, +create a new generation of PROFILE pointing to the directory of OS, switch= to +it atomically, and run OS's activation script." + (eval #~(primitive-load #$(switch-system-program os profile)))) + + +;;; +;;; Services. +;;; + +(define (running-services eval) + "Using EVAL, a monadic procedure taking a single G-Expression as an argu= ment, +return the objects that are currently running on MACHINE." + (define exp + (with-imported-modules '((gnu services herd)) + #~(begin + (use-modules (gnu services herd)) + (let ((services (current-services))) + (and services + ;; 'live-service-running' is ignored, as we can't necessa= rily + ;; serialize arbitrary objects. This should be fine for n= ow, + ;; since 'machine-current-services' is not exposed public= ly, + ;; and the resultant objects are only used= for + ;; resolving service dependencies. + (map (lambda (service) + (list (live-service-provision service) + (live-service-requirement service))) + services)))))) + (mlet %store-monad ((services (eval exp))) + (return (map (match-lambda + ((provision requirement) + (live-service provision requirement #f))) + services)))) + +;; XXX: Currently, this does NOT attempt to restart running services. See +;; for details. +(define (upgrade-services-program service-files to-start to-unload to-rest= art) + "Return an executable store item that, upon being evaluated, will upgrade +the Shepherd (PID 1) by unloading obsolete services and loading new +services. SERVICE-FILES is a list of Shepherd service files to load, and +TO-START, TO-UNLOAD, and TO-RESTART are lists of the Shepherd services' +canonical names (symbols)." + (program-file + "upgrade-shepherd-services.scm" + (with-imported-modules '((gnu services herd)) + #~(begin + (use-modules (gnu services herd) + (srfi srfi-1)) + + ;; Load the service files for any new services. + (load-services/safe '#$service-files) + + ;; Unload obsolete services and start new services. + (for-each unload-service '#$to-unload) + (for-each start-service '#$to-start))))) + +(define* (upgrade-shepherd-services eval os) + "Using EVAL, a monadic procedure taking a single G-Expression as an argu= ment, +upgrade the Shepherd (PID 1) by unloading obsolete services and loading new +services as defined by OS." + (define target-services + (service-value + (fold-services (operating-system-services os) + #:target-type shepherd-root-service-type))) + + (mlet* %store-monad ((live-services (running-services eval))) + (let*-values (((to-unload to-restart) + (shepherd-service-upgrade live-services target-services= ))) + (let* ((to-unload (map live-service-canonical-name to-unload)) + (to-restart (map shepherd-service-canonical-name to-restart)) + (to-start (lset-difference eqv? + (map shepherd-service-canonical-na= me + target-services) + (map live-service-canonical-name + live-services))) + (service-files + (map shepherd-service-file + (filter (lambda (service) + (memq (shepherd-service-canonical-name servic= e) + to-start)) + target-services)))) + (eval #~(primitive-load #$(upgrade-services-program service-files + to-start + to-unload + to-restart))))= ))) + + +;;; +;;; Bootloader configuration. +;;; + +(define (install-bootloader-program installer bootloader-package bootcfg + bootcfg-file device target) + "Return an executable store item that, upon being evaluated, will install +BOOTCFG to BOOTCFG-FILE, a target file name, on DEVICE, a file system devi= ce, +at TARGET, a mount point, and subsequently run INSTALLER from +BOOTLOADER-PACKAGE." + (program-file + "install-bootloader.scm" + (with-extensions (list guile-gcrypt) + (with-imported-modules (source-module-closure '((gnu build bootloader) + (gnu build install) + (guix store) + (guix utils))) + #~(begin + (use-modules (gnu build bootloader) + (gnu build install) + (guix build utils) + (guix store) + (guix utils) + (ice-9 binary-ports) + (srfi srfi-34) + (srfi srfi-35)) + (let* ((gc-root (string-append #$target %gc-roots-directory "/b= ootcfg")) + (temp-gc-root (string-append gc-root ".new"))) + (switch-symlinks temp-gc-root gc-root) + (install-boot-config #$bootcfg #$bootcfg-file #$target) + ;; Preserve the previous activation's garbage collector root + ;; until the bootloader installer has run, so that a failure = in + ;; the bootloader's installer script doesn't leave the user w= ith + ;; a broken installation. + (when #$installer + (catch #t + (lambda () + (#$installer #$bootloader-package #$device #$target)) + (lambda args + (delete-file temp-gc-root) + (apply throw args)))) + (rename-file temp-gc-root gc-root))))))) + +(define* (install-bootloader eval configuration bootcfg + #:key + (run-installer? #t) + (target "/")) + "Using EVAL, a monadic procedure taking a single G-Expression as an argu= ment, +configure the bootloader on TARGET such that OS will be booted by default = and +additional configurations specified by MENU-ENTRIES can be selected." + (let* ((bootloader (bootloader-configuration-bootloader configuration)) + (installer (and run-installer? + (bootloader-installer bootloader))) + (package (bootloader-package bootloader)) + (device (bootloader-configuration-target configuration)) + (bootcfg-file (bootloader-configuration-file bootloader))) + (eval #~(primitive-load #$(install-bootloader-program installer + package + bootcfg + bootcfg-file + device + target))))) diff --git a/tests/services.scm b/tests/services.scm index 44ad0022c..572fe3816 100644 =2D-- a/tests/services.scm +++ b/tests/services.scm @@ -26,10 +26,6 @@ #:use-module (srfi srfi-64) #:use-module (ice-9 match)) =20 =2D(define live-service =2D (@@ (gnu services herd) live-service)) =2D =2D (test-begin "services") =20 (test-equal "services, default value" =2D-=20 2.22.0 --=-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQIzBAEBCAAdFiEEa1VJLOiXAjQ2BGSm9Qb9Fp2P2VoFAl02BskACgkQ9Qb9Fp2P 2VrOFQ/+OxWRWF8/Q8v3fkBomA6kGrcQS121sML9w2YmpYgtKCR2TxWgaCsNy+nd CdZuqly9e+E9iGHQmeWbtE73Im75kVNyoB3kn97WOH9LFnIq1XLVO5fTW2kzK95z uw39jtsX1fXAUSkLXM2FzsfYGk+ezAXZ6sLZRa74YcD6t5zfO9S2Uf/rBPPisdTq nBZYGzBURGnwQMmP3yZgc+b8tq8J7FvyCdZ8OuFqchcBpMJTRwcIBt/cpSzt6+pN nwXQQ9oHBbW77mmHMHYXfzFkip21VTr36MnhanzIIz8tkiig/jZjR0rakRSMqjQW cVsHKHiYXdxx6eQPAuQkmW3M5gWzWHLVsfZkFC6Z0L+Da6D+tru9yMSVVg0oEJ2M jpV5n01UQxEYVmRQ4Vq6pymJxRMuxfkrAow4dtuKB8vVlW3d3CLkPpk5PmVqQCZS e/mCWBLFXqciSdwDCBOT5HCbUwI5BaeCsgAD2WSCAEAtBTmiSOQExwiapYLEqEe5 +uFtF32oPgH6lBLDkmA/Iiq2MRFXUzBUSNrUjTOXDK1C/WIwtzLiFjbICei4nB3/ nhx5bL9ndR3gpZH01WOaiLaCBI6pGdsZnIB0HfyFbZeO0UtsDeeaF9WPWSk/Wmpz LxkISuekgzqL/rga2wwOQOMbifdmj48Y6LeyxkrSzW7KSoMTwe0= =LJIz -----END PGP SIGNATURE----- --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Mon Jul 22 14:59:48 2019 Received: (at 36555) by debbugs.gnu.org; 22 Jul 2019 18:59:48 +0000 Received: from localhost ([127.0.0.1]:33642 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hpdXH-0007Pz-Qs for submit@debbugs.gnu.org; Mon, 22 Jul 2019 14:59:48 -0400 Received: from mx.sdf.org ([205.166.94.20]:56764) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hpdXF-0007Pp-30 for 36555@debbugs.gnu.org; Mon, 22 Jul 2019 14:59:45 -0400 Received: from Epsilon (pool-173-76-53-40.bstnma.fios.verizon.net [173.76.53.40]) (authenticated (0 bits)) by mx.sdf.org (8.15.2/8.14.5) with ESMTPSA id x6MIxhKi020065 (using TLSv1.2 with cipher AES256-GCM-SHA384 (256 bits) verified NO); Mon, 22 Jul 2019 18:59:44 GMT From: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) To: Ludovic =?utf-8?Q?Court=C3=A8s?= Subject: Re: [bug#36555] [PATCH v5 2/3] guix system: Reimplement 'reconfigure'. 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> <87muh9q51e.fsf_-_@sdf.lonestar.org> <87wogc4v6e.fsf@gnu.org> <87zhl69box.fsf@sdf.lonestar.org> <87o91laojb.fsf_-_@sdf.lonestar.org> <87k1c9aofq.fsf_-_@sdf.lonestar.org> Date: Mon, 22 Jul 2019 14:57:16 -0400 In-Reply-To: <87k1c9aofq.fsf_-_@sdf.lonestar.org> (Jakob L. Kreuze's message of "Mon, 22 Jul 2019 14:56:09 -0400") Message-ID: <87ftmxaodv.fsf_-_@sdf.lonestar.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha256; protocol="application/pgp-signature" X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 36555 Cc: 36555@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= Content-Type: text/plain Content-Transfer-Encoding: quoted-printable * guix/scripts/system.scm (switch-to-system) (upgrade-shepherd-services, install-bootloader): Delete variable. (local-eval): New variable. (install): Remove 'bootloader-installer' and 'bootcfg-file' parameters. (install): Add 'bootloader' parameter. =2D-- guix/scripts/system.scm | 186 +++++++++------------------------------- 1 file changed, 41 insertions(+), 145 deletions(-) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 60c1ca5c9..0a7a585af 100644 =2D-- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -41,6 +41,7 @@ delete-matching-generations) #:use-module (guix graph) #:use-module (guix scripts graph) + #:use-module (guix scripts system reconfigure) #:use-module (guix build utils) #:use-module (guix progress) #:use-module ((guix build syscalls) #:select (terminal-columns)) @@ -178,43 +179,9 @@ TARGET, and register them." =20 (return *unspecified*))) =20 =2D(define* (install-bootloader installer =2D #:key =2D bootcfg bootcfg-file =2D target) =2D "Run INSTALLER, a bootloader installation script, with error handling,= in =2D%STORE-MONAD." =2D (mlet %store-monad ((installer-drv (if installer =2D (lower-object installer) =2D (return #f))) =2D (bootcfg (lower-object bootcfg))) =2D (let* ((gc-root (string-append target %gc-roots-directory =2D "/bootcfg")) =2D (temp-gc-root (string-append gc-root ".new")) =2D (install (and installer-drv =2D (derivation->output-path installer-drv))) =2D (bootcfg (derivation->output-path bootcfg))) =2D ;; Prepare the symlink to bootloader config file to make sure that= it's =2D ;; a GC root when 'installer-drv' completes (being a bit paranoid.) =2D (switch-symlinks temp-gc-root bootcfg) =2D =2D (unless (false-if-exception =2D (begin =2D (install-boot-config bootcfg bootcfg-file target) =2D (when install =2D (save-load-path-excursion (primitive-load install))))) =2D (delete-file temp-gc-root) =2D (leave (G_ "failed to install bootloader ~a~%") install)) =2D =2D ;; Register bootloader config file as a GC root so that its depend= encies =2D ;; (background image, font, etc.) are not reclaimed. =2D (rename-file temp-gc-root gc-root) =2D (return #t)))) =2D (define* (install os-drv target #:key (log-port (current-output-port)) =2D bootloader-installer install-bootloader? =2D bootcfg bootcfg-file) + install-bootloader? bootloader bootcfg) "Copy the closure of BOOTCFG, which includes the output of OS-DRV, to directory TARGET. TARGET must be an absolute directory name since that's = what 'register-path' expects. @@ -265,10 +232,11 @@ the ownership of '~a' may be incorrect!~%") (populate os-dir target) =20 (mwhen install-bootloader? =2D (install-bootloader bootloader-installer =2D #:bootcfg bootcfg =2D #:bootcfg-file bootcfg-file =2D #:target target)))))) + (install-bootloader local-eval bootloader bootcfg + #:target target) + (return + (info (G_ "bootloader successfully installed on '~a'~%") + (bootloader-configuration-target bootloader)))))))) =20 ;;; @@ -335,82 +303,6 @@ unload." (warning (G_ "failed to obtain list of shepherd services~%")) (return #f))))) =20 =2D(define (upgrade-shepherd-services os) =2D "Upgrade the Shepherd (PID 1) by unloading obsolete services and loadi= ng new =2Dservices specified in OS and not currently running. =2D =2DThis is currently very conservative in that it does not stop or unload a= ny =2Drunning service. Unloading or stopping the wrong service ('udev', say) = could =2Dbring the system down." =2D (define new-services =2D (service-value =2D (fold-services (operating-system-services os) =2D #:target-type shepherd-root-service-type))) =2D =2D ;; Arrange to simply emit a warning if the service upgrade fails. =2D (with-shepherd-error-handling =2D (call-with-service-upgrade-info new-services =2D (lambda (to-restart to-unload) =2D (for-each (lambda (unload) =2D (info (G_ "unloading service '~a'...~%") unload) =2D (unload-service unload)) =2D to-unload) =2D =2D (with-monad %store-monad =2D (munless (null? new-services) =2D (let ((new-service-names (map shepherd-service-canonical-na= me new-services)) =2D (to-restart-names (map shepherd-service-canonical-na= me to-restart)) =2D (to-start (filter shepherd-service-auto-star= t? new-services))) =2D (info (G_ "loading new services:~{ ~a~}...~%") new-service= -names) =2D (unless (null? to-restart-names) =2D ;; Listing TO-RESTART-NAMES in the message below wouldn'= t help =2D ;; because many essential services cannot be meaningfully =2D ;; restarted. See . =2D (format #t (G_ "To complete the upgrade, run 'herd resta= rt SERVICE' to stop, =2Dupgrade, and restart each service that was not automatically restarted.\= n"))) =2D (mlet %store-monad ((files (mapm %store-monad =2D (compose lower-object =2D shepherd-service= -file) =2D new-services))) =2D ;; Here we assume that FILES are exactly those that were= computed =2D ;; as part of the derivation that built OS, which is nor= mally the =2D ;; case. =2D (load-services/safe (map derivation->output-path files)) =2D =2D (for-each start-service =2D (map shepherd-service-canonical-name to-start)) =2D (return #t))))))))) =2D =2D(define* (switch-to-system os =2D #:optional (profile %system-profile)) =2D "Make a new generation of PROFILE pointing to the directory of OS, swi= tch to =2Dit atomically, and then run OS's activation script." =2D (mlet* %store-monad ((drv (operating-system-derivation os)) =2D (script (lower-object (operating-system-activatio= n-script os)))) =2D (let* ((system (derivation->output-path drv)) =2D (number (+ 1 (generation-number profile))) =2D (generation (generation-file-name profile number))) =2D (switch-symlinks generation system) =2D (switch-symlinks profile generation) =2D =2D (format #t (G_ "activating system...~%")) =2D =2D ;; The activation script may change $PATH, among others, so protect =2D ;; against that. =2D (save-environment-excursion =2D ;; Tell 'activate-current-system' what the new system is. =2D (setenv "GUIX_NEW_SYSTEM" system) =2D =2D ;; The activation script may modify '%load-path' & co., so protect =2D ;; against that. This is necessary to ensure that =2D ;; 'upgrade-shepherd-services' gets to see the right modules when= it =2D ;; computes derivations with 'gexp->derivation'. =2D (save-load-path-excursion =2D (primitive-load (derivation->output-path script)))) =2D =2D ;; Finally, try to update system services. =2D (upgrade-shepherd-services os)))) =2D (define-syntax-rule (unless-file-not-found exp) (catch 'system-error (lambda () @@ -505,18 +397,13 @@ STORE is an open connection to the store." ((bootloader-configuration-file-generator bootloader) bootloader-config entries #:old-entries old-entries))) =2D (bootcfg-file -> (bootloader-configuration-file bootloader)) =2D (target -> "/") (drvs -> (list bootcfg))) (mbegin %store-monad (show-what-to-build* drvs) (built-derivations drvs) =2D ;; Only install bootloader configuration file. Thus, no instal= ler is =2D ;; provided here. =2D (install-bootloader #f =2D #:bootcfg bootcfg =2D #:bootcfg-file bootcfg-file =2D #:target target)))))) + ;; Only install bootloader configuration file. + (install-bootloader local-eval bootloader-config bootcfg + #:run-installer? #f)))))) =20 ;;; @@ -822,8 +709,22 @@ and TARGET arguments." (condition-message c)) (exit 1))) (#$installer #$bootloader #$device #$target) =2D (format #t "bootloader successfully installed on = '~a'~%" =2D #$device)))))) + (info (G_ "bootloader successfully installed on '~a= '~%") + #$device)))))) + +(define (local-eval exp) + "Evaluate EXP, a G-Expression, in-place." + (mlet* %store-monad ((lowered (lower-gexp exp)) + (_ (built-derivations (map gexp-input-thing + (lowered-gexp-inputs low= ered))))) + (save-load-path-excursion + (set! %load-path (lowered-gexp-load-path lowered)) + (set! %load-compiled-path (lowered-gexp-load-compiled-path lowered)) + (return + (guard (c ((message-condition? c) + (leave (G_ "failed to install bootloader:~%~a~%") + (condition-message c)))) + (primitive-eval (lowered-gexp-sexp lowered))))))) =20 (define* (perform-action action os #:key skip-safety-checks? @@ -860,19 +761,12 @@ static checks." (map boot-parameters->menu-entry (profile-boot-parameters)))) =20 (define bootloader =2D (bootloader-configuration-bootloader (operating-system-bootloader os= ))) + (operating-system-bootloader os)) =20 (define bootcfg (and (memq action '(init reconfigure)) (operating-system-bootcfg os menu-entries))) =20 =2D (define bootloader-script =2D (let ((installer (bootloader-installer bootloader)) =2D (target (or target "/"))) =2D (bootloader-installer-script installer =2D (bootloader-package bootloader) =2D bootloader-target target))) =2D (when (eq? action 'reconfigure) (maybe-suggest-running-guix-pull)) =20 @@ -899,9 +793,7 @@ static checks." ;; See . (drvs (mapm %store-monad lower-object (if (memq action '(init reconfigure)) =2D (if install-bootloader? =2D (list sys bootcfg bootloader-script) =2D (list sys bootcfg)) + (list sys bootcfg) (list sys)))) (% (if derivations-only? (return (for-each (compose println derivation-file-n= ame) @@ -911,28 +803,32 @@ static checks." =20 (if (or dry-run? derivations-only?) (return #f) =2D (let ((bootcfg-file (bootloader-configuration-file bootloader))) + (begin (for-each (compose println derivation->output-path) drvs) =20 (case action ((reconfigure) + (newline) + (format #t (G_ "activating system...~%")) (mbegin %store-monad =2D (switch-to-system os) + (switch-to-system local-eval os) (mwhen install-bootloader? =2D (install-bootloader bootloader-script =2D #:bootcfg bootcfg =2D #:bootcfg-file bootcfg-file =2D #:target "/")))) + (install-bootloader local-eval bootloader bootcfg + #:target (or target "/")) + (return + (info (G_ "bootloader successfully installed on '~a'~%") + (bootloader-configuration-target bootloader)))) + (with-shepherd-error-handling + (upgrade-shepherd-services local-eval os)))) ((init) (newline) (format #t (G_ "initializing operating system under '~a'...~%= ") target) (install sys (canonicalize-path target) #:install-bootloader? install-bootloader? =2D #:bootcfg bootcfg =2D #:bootcfg-file bootcfg-file =2D #:bootloader-installer bootloader-script)) + #:bootloader bootloader + #:bootcfg bootcfg)) (else ;; All we had to do was to build SYS and maybe register an ;; indirect GC root. =2D-=20 2.22.0 --=-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQIzBAEBCAAdFiEEa1VJLOiXAjQ2BGSm9Qb9Fp2P2VoFAl02BwwACgkQ9Qb9Fp2P 2Vpktw/9GiilStzlmlSIQEzSktc0nSs64Jb2vwUFFb7slsxMDG5Cni18o2EfVW2O hdBSGBCS8QTf98+n2cjqG4JjqBbZI/bfnNryXdRNJgHoD6SU/O8L6r2W1voIQupt nm/mQ0g/A2DCiD/jepsSOwA24PzveK08TSAOyMsi6BcXDXtvWVC/Mi9Vgwi9IFof ionyW5+d2IWW2OXj4hTbnAXZSexNkJ6+TFcJ86dCpFZe2qE/iFdXkzyA0LV9HgSj t3zI+0RiNRHvDU99rw3o6NJC2hBp0B7/DBgc+2S83oVU3uWV/fyP3eBNxRTjqFiC CZNC+yUtDZFEWtrrLtSJk+XHmnK6oiNlNSIXp65acHUp5ZgO8/XXY3uosnmW9b2x iv+sWGKJfDW648gBpCHBqpeix3JQZPULlsTOzsmk/M65oWjHVnBRSgdvYAyzy0bl 6zHiQNlvu9XC4R/d6hekF+RuZ/o5Unwt5cdyHenUWqtBpjQ5mvcNP76KuBWJvJ+3 WKwEmXPbcmohR/yNSwXy11PMRqhRQVsQpjwnEsgKHKTwkFqNSU1IZFOJz5E+v/oT AceLpf+gZn0l+Kp0j/Qz+LOaOA8CuL9n1g4rVYhkJfluNvnnxEsMsOOJD3Uw7UC0 Cc1yx8HZTFflqa8DXBrq1O5vp5+YRYpTLlsma5EAsC5To88pv6c= =7+GV -----END PGP SIGNATURE----- --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Mon Jul 22 15:00:26 2019 Received: (at 36555) by debbugs.gnu.org; 22 Jul 2019 19:00:26 +0000 Received: from localhost ([127.0.0.1]:33646 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hpdXt-0007T7-Sl for submit@debbugs.gnu.org; Mon, 22 Jul 2019 15:00:26 -0400 Received: from mx.sdf.org ([205.166.94.20]:56577) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hpdXp-0007Sv-Ut for 36555@debbugs.gnu.org; Mon, 22 Jul 2019 15:00:24 -0400 Received: from Epsilon (pool-173-76-53-40.bstnma.fios.verizon.net [173.76.53.40]) (authenticated (0 bits)) by mx.sdf.org (8.15.2/8.14.5) with ESMTPSA id x6MJ0Jbs017750 (using TLSv1.2 with cipher AES256-GCM-SHA384 (256 bits) verified NO); Mon, 22 Jul 2019 19:00:20 GMT From: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) To: Ludovic =?utf-8?Q?Court=C3=A8s?= Subject: Re: [bug#36555] [PATCH v5 3/3] tests: Add reconfigure system test. 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> <87muh9q51e.fsf_-_@sdf.lonestar.org> <87wogc4v6e.fsf@gnu.org> <87zhl69box.fsf@sdf.lonestar.org> <87o91laojb.fsf_-_@sdf.lonestar.org> <87k1c9aofq.fsf_-_@sdf.lonestar.org> <87ftmxaodv.fsf_-_@sdf.lonestar.org> Date: Mon, 22 Jul 2019 14:57:52 -0400 In-Reply-To: <87ftmxaodv.fsf_-_@sdf.lonestar.org> (Jakob L. Kreuze's message of "Mon, 22 Jul 2019 14:57:16 -0400") Message-ID: <87blxlaocv.fsf_-_@sdf.lonestar.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha256; protocol="application/pgp-signature" X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 36555 Cc: 36555@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= 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 | 262 ++++++++++++++++++++++++++++++++++++++ 2 files changed, 263 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..3a2f0a2e5 =2D-- /dev/null +++ b/gnu/tests/reconfigure.scm @@ -0,0 +1,262 @@ +;;; 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))) + + ;; Return the names of the generation symlinks on MARIONETTE. + (define (system-generations 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))) + + ;; Return the Shepherd service file for SERVICE, after ensuring that it + ;; exists in the store. + (define (ensure-service-file service) + (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))) + + ;; Return the names of the running services on MARIONETTE. + (define (running-services 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 obsolete 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))) + + ;; Return the system generation paths that have GRUB menu entrie= s. + (define (generations-in-grub-cfg marionette) + (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----- iQIzBAEBCAAdFiEEa1VJLOiXAjQ2BGSm9Qb9Fp2P2VoFAl02BzAACgkQ9Qb9Fp2P 2Voa2A//acEs+HMgIIRJnJ/0wXxqMfe16DR/olZwkk2OaqkuSPi/eBMJBiUOPgQH lbQIID5BtwxkDGDGqrf+iKYNUec4RdODw4FE/m1PVNvwYz1K2aIEaOtNPdvcHbMS QD58wxrcg8QVP3dzOwnt+aqXOwWWuUKKfS2Cr1fwGmnV8cTqOLqRgorDR+lgejmP Iye1fWnE72Cd8NWWc46pSKXROa3JIiKdPBY0yFLiqWnseLxPdEtGso+UB6FMG2I0 Ul4hiTP1d4rJQWwiPE3mUcgru59XyJNPJIel1LmcloKYSgG4qCB1a1OxiDJY0T9h 4o581rWHS/U6uaRfxYEJdjmvHuO5S6hHoDAJ1LyS+yrbpXobVU2bTs9/vjjqNff4 WYyQMFl9vN+4/YnpnNOVfk6L8Pqeu93K360nZYcFxNvCVZMomMwDoPXWjnOFHCxa orR+i0u92lzBiqmcN+qkAzrW7IZb39eaN6Vn+QeGvcgXIg/OCPFN14rUrrkoiH3e SJoAc68+ZLDRh2SN0K7dcqqPAJFVe7i3xVUTejwyEDeEnp3q3+ER2g4jlQXc5VXp V75ZLocrb074dXq36Q7jY/3havGqwnoCgcalW18YaXOnarpNmf8ihEcuqAKP+W1J etkhIx8s8ZFYhsMz1D1Bad4FGX3g2s/xN1r7aMHumcL59fKDXv4= =LyAF -----END PGP SIGNATURE----- --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Tue Jul 23 17:47:16 2019 Received: (at 36555) by debbugs.gnu.org; 23 Jul 2019 21:47:16 +0000 Received: from localhost ([127.0.0.1]:35729 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hq2cu-0000DZ-2r for submit@debbugs.gnu.org; Tue, 23 Jul 2019 17:47:16 -0400 Received: from eggs.gnu.org ([209.51.188.92]:51867) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hq2cs-0000DL-3j for 36555@debbugs.gnu.org; Tue, 23 Jul 2019 17:47:14 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:37057) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1hq2cl-0006V9-Sk; Tue, 23 Jul 2019 17:47:07 -0400 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=47932 helo=ribbon) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1hq2cl-00084b-Gg; Tue, 23 Jul 2019 17:47:07 -0400 From: =?utf-8?Q?Ludovic_Court=C3=A8s?= To: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) Subject: Re: [bug#36555] [PATCH v4 3/3] tests: Add reconfigure system test. 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> <87muh9q51e.fsf_-_@sdf.lonestar.org> <87wogc4v6e.fsf@gnu.org> <87zhl69box.fsf@sdf.lonestar.org> X-URL: http://www.fdn.fr/~lcourtes/ X-Revolutionary-Date: 5 Thermidor an 227 de la =?utf-8?Q?R=C3=A9volution?= X-PGP-Key-ID: 0x090B11993D9AEBB5 X-PGP-Key: http://www.fdn.fr/~lcourtes/ludovic.asc X-PGP-Fingerprint: 3CE4 6455 8A84 FDC6 9DB4 0CFB 090B 1199 3D9A EBB5 X-OS: x86_64-pc-linux-gnu Date: Tue, 23 Jul 2019 23:47:05 +0200 In-Reply-To: <87zhl69box.fsf@sdf.lonestar.org> (Jakob L. Kreuze's message of "Mon, 22 Jul 2019 14:16:46 -0400") Message-ID: <87o91kzana.fsf@gnu.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2 (gnu/linux) MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 36555 Cc: 36555@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) Hello, zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) skribis: > Ludovic Court=C3=A8s writes: [...] >> I like to avoid exposing constructors so that one cannot =E2=80=9Cforge= =E2=80=9D >> invalid objects, but let=E2=80=99s see=E2=80=A6 > > Should I use @@ for this, perhaps? No, it=E2=80=99s not any better ;-), but anyway, let=E2=80=99s address this= later. >> (Once we=E2=80=99ve done that (guix graph) demonadification we discussed >> before, perhaps we can perform run =E2=80=98shepherd-service-upgrade=E2= =80=99 entirely >> on the =E2=80=9Cother side=E2=80=9D, and at that point we won=E2=80=99t = need to expose the >> =E2=80=98live-service=E2=80=99 constructor.) > > The main issue with calling 'shepherd-service-upgrade' on the other side > is that we'd need to send over the service objects (the current > 'upgrade-services-program' deals with provision symbols rather than the > service objects themselves). > > I'm certain it's possible, it's just easier said than done. I've got > time to think it through, though :) Oh, you may be right. :-) >> What happens when =E2=80=98install-bootloader=E2=80=99 fails though? We = should make >> sure that the error is diagnosed, and that the output of >> =E2=80=98grub-install=E2=80=99 or similar is shown when that happens. I think you didn=E2=80=99t answer this specific question; thoughts? >> Note that there are now a few places where we call =E2=80=98built-deriva= tions=E2=80=99 >> without calling =E2=80=98show-what-to-build*=E2=80=99 first. That means = the UX might >> be pretty bad since one has no idea what=E2=80=99s being built. >> >> Furthermore, that means substitutes may not be up-to-date, leading to >> many =E2=80=9Cupdating substitutes=E2=80=9D messages and HTTP round trip= s (as happened >> with ). >> >> Last, doing several =E2=80=98build-derivations=E2=80=99 call with just a= couple of >> derivations is less efficient than doing a single call with many >> derivations; that also has an impact on the UI, if we were to call >> =E2=80=98show-what-to-build*=E2=80=99 once for =E2=80=98build-derivation= s=E2=80=99 call. >> >> What=E2=80=99s your experience with this in practice? > > I haven't had too many issues with it since the G-Expressions tended to > have few inputs, but those are some valid concerns. Would it be better > to create derivations for locally-evaluated G-Expressions? For example, > with 'program-file' or 'gexp->script'? I thought that evaluating them > in-place might be better since that's one fewer store item that needs to > be built, but if we were to turn the G-Expression into a derivation, we > could add it to the call to 'show-what-to-build*' in 'guix system > reconfigure'. The number of =E2=80=98build-derivations=E2=80=99 calls is the same whether= it=E2=80=99s local or distant. What would make a difference is having a single script instead of three=E2=80=94i.e., one program that does: #~(begin (activate-system =E2=80=A6) (upgrade-services =E2=80=A6) (switch-system =E2=80=A6)) I think this program could even be added to the =E2=80=98system=E2=80=99 derivation=E2=80=94i.e., as a file next to those in /run/current-system. That way, switching to a system generation would be a matter of running it=E2=80=99s =E2=80=98switch=E2=80=99 program. Perhaps this should be our horizon. WDYT? Thanks for your feedback! Ludo=E2=80=99. From debbugs-submit-bounces@debbugs.gnu.org Tue Jul 23 18:31:06 2019 Received: (at 36555) by debbugs.gnu.org; 23 Jul 2019 22:31:06 +0000 Received: from localhost ([127.0.0.1]:35783 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hq3JJ-0003C6-CV for submit@debbugs.gnu.org; Tue, 23 Jul 2019 18:31:06 -0400 Received: from eggs.gnu.org ([209.51.188.92]:37855) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hq3JF-00034E-EG for 36555@debbugs.gnu.org; Tue, 23 Jul 2019 18:31:04 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:37494) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1hq3J7-0008Qu-W1; Tue, 23 Jul 2019 18:30:54 -0400 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=48178 helo=ribbon) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1hq3J7-0002MK-Fi; Tue, 23 Jul 2019 18:30:53 -0400 From: =?utf-8?Q?Ludovic_Court=C3=A8s?= To: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) Subject: Re: [bug#36555] [PATCH v5 2/3] guix system: Reimplement 'reconfigure'. 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> <87muh9q51e.fsf_-_@sdf.lonestar.org> <87wogc4v6e.fsf@gnu.org> <87zhl69box.fsf@sdf.lonestar.org> <87o91laojb.fsf_-_@sdf.lonestar.org> <87k1c9aofq.fsf_-_@sdf.lonestar.org> <87ftmxaodv.fsf_-_@sdf.lonestar.org> X-URL: http://www.fdn.fr/~lcourtes/ X-Revolutionary-Date: 6 Thermidor an 227 de la =?utf-8?Q?R=C3=A9volution?= X-PGP-Key-ID: 0x090B11993D9AEBB5 X-PGP-Key: http://www.fdn.fr/~lcourtes/ludovic.asc X-PGP-Fingerprint: 3CE4 6455 8A84 FDC6 9DB4 0CFB 090B 1199 3D9A EBB5 X-OS: x86_64-pc-linux-gnu Date: Wed, 24 Jul 2019 00:30:51 +0200 In-Reply-To: <87ftmxaodv.fsf_-_@sdf.lonestar.org> (Jakob L. Kreuze's message of "Mon, 22 Jul 2019 14:57:16 -0400") Message-ID: <87ftmwz8mc.fsf@gnu.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2 (gnu/linux) MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 36555 Cc: 36555@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) Hello, zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) skribis: > +(define (local-eval exp) > + "Evaluate EXP, a G-Expression, in-place." > + (mlet* %store-monad ((lowered (lower-gexp exp)) > + (_ (built-derivations (map gexp-input-thing > + (lowered-gexp-inputs l= owered))))) Note that on current master this should be: (built-derivations (lowered-gexp-inputs lowered)) > + (save-load-path-excursion > + (set! %load-path (lowered-gexp-load-path lowered)) > + (set! %load-compiled-path (lowered-gexp-load-compiled-path lowered)) > + (return > + (guard (c ((message-condition? c) > + (leave (G_ "failed to install bootloader:~%~a~%") > + (condition-message c)))) > + (primitive-eval (lowered-gexp-sexp lowered))))))) My last grief for this patch series is exception handling above: it=E2=80= =99s not good to report =E2=80=9Cfailed to install bootloader=E2=80=9D whatever = the problem is. :-) Could we somehow move exception handling at the call sites? I know that monadic style makes it harder. The rest looks great, and congrats for being the first one to reconfigure with it! :-) Thanks, Ludo=E2=80=99. From debbugs-submit-bounces@debbugs.gnu.org Tue Jul 23 20:04:03 2019 Received: (at 36555) by debbugs.gnu.org; 24 Jul 2019 00:04:03 +0000 Received: from localhost ([127.0.0.1]:35821 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hq4lH-0000eM-5Q for submit@debbugs.gnu.org; Tue, 23 Jul 2019 20:04:03 -0400 Received: from mx.sdf.org ([205.166.94.20]:64686) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hq4lD-0000du-AT for 36555@debbugs.gnu.org; Tue, 23 Jul 2019 20:03:59 -0400 Received: from Epsilon (pool-173-76-53-40.bstnma.fios.verizon.net [173.76.53.40]) (authenticated (0 bits)) by mx.sdf.org (8.15.2/8.14.5) with ESMTPSA id x6O03trX000668 (using TLSv1.2 with cipher AES256-GCM-SHA384 (256 bits) verified NO); Wed, 24 Jul 2019 00:03:58 GMT From: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) To: Ludovic =?utf-8?Q?Court=C3=A8s?= Subject: Re: [bug#36555] [PATCH v4 3/3] tests: Add reconfigure system test. 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> <87muh9q51e.fsf_-_@sdf.lonestar.org> <87wogc4v6e.fsf@gnu.org> <87zhl69box.fsf@sdf.lonestar.org> <87o91kzana.fsf@gnu.org> Date: Tue, 23 Jul 2019 20:01:19 -0400 In-Reply-To: <87o91kzana.fsf@gnu.org> ("Ludovic \=\?utf-8\?Q\?Court\=C3\=A8s\=22'\?\= \=\?utf-8\?Q\?s\?\= message of "Tue, 23 Jul 2019 23:47:05 +0200") Message-ID: <87blxk9u7k.fsf@sdf.lonestar.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha256; protocol="application/pgp-signature" X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 36555 Cc: 36555@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Ludovic Court=C3=A8s writes: > I think you didn=E2=80=99t answer this specific question; thoughts? I had a peek at your more recent email, and think you dug up (and commented on) my handling of it, but I'll link [1] just in case. > The number of =E2=80=98build-derivations=E2=80=99 calls is the same wheth= er it=E2=80=99s local > or distant. > > What would make a difference is having a single script instead of > three=E2=80=94i.e., one program that does: > > #~(begin > (activate-system =E2=80=A6) > (upgrade-services =E2=80=A6) > (switch-system =E2=80=A6)) > > I think this program could even be added to the =E2=80=98system=E2=80=99 > derivation=E2=80=94i.e., as a file next to those in /run/current-system. > > That way, switching to a system generation would be a matter of running > it=E2=80=99s =E2=80=98switch=E2=80=99 program. > > Perhaps this should be our horizon. WDYT? I'm a fan of that idea. Having it as a file means we would be able to run activation services on a roll-back. I've added this to my to-do list of patches :) Regards, Jakob [1]: https://lists.gnu.org/archive/html/guix-patches/2019-07/msg00656.html --=-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQIzBAEBCAAdFiEEa1VJLOiXAjQ2BGSm9Qb9Fp2P2VoFAl03n88ACgkQ9Qb9Fp2P 2VpA6A//UyXv6XJ+BdjDa64Ooqy6BeHoACGqodxqpVCjnLd3GvXuCHP7bxeD+SOY XNd4JWwpeAIWOvnsDlW940nimAYkTDHdChJyfMDMwd2jSGZFY1u7rQ26YZ7n654T /O54cinT0KXnovpxbUz2HxgKloIuhDCQVapEU+6lEURNz42iGsIwf8DdFV1jAgAQ EVAOUifBNu1L+u6Ws62xLtwFhD6wfy6M6lSF4w1MA1SwguZGf83AuVJjrR8i+Bin LG+xEgLIKeI6vzbfvXmUEBB5AQ2336W1NQ2ADOmypd5mZDIqky2u8nahXSCCwgWy M5FvvxPUGcir6+gd9KT++Gx0Qz4q/9Ht0smnht1Sx1wu2HbFBLhIz5nMT7oT83X0 GQV6ZqXsfmMqVb2sOkArUiRMMTyV/punMgJkmExEdPSR/Y/4z3uANJMn8rqpwLS+ qY4XfM+sPnAEpNY6GHpm5uRJjqPXOqhr6YiSWn1c1OkbU8z7twFbNKz3wYGJGOSS 4U4PKRppcAGKGvl/xN3H5h6lVi3MMxG41XJxSoNn8xGZ3HMVDgwZyboF5i784IYj RBz47XKJj3CB3Di7VEzo/UGFS4kemK/F+f3EmrdrDFW4op/micAXoLM1OIXlRwQU XqD/Ua1y831X1DXZ51CMqPk29IKXOo0y2pztUkGg7JvWAnHr0tY= =cLl6 -----END PGP SIGNATURE----- --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Tue Jul 23 20:09:21 2019 Received: (at 36555) by debbugs.gnu.org; 24 Jul 2019 00:09:21 +0000 Received: from localhost ([127.0.0.1]:35825 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hq4qO-0000lT-Qu for submit@debbugs.gnu.org; Tue, 23 Jul 2019 20:09:21 -0400 Received: from mx.sdf.org ([205.166.94.20]:63441) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hq4qN-0000lM-EC for 36555@debbugs.gnu.org; Tue, 23 Jul 2019 20:09:19 -0400 Received: from Epsilon (pool-173-76-53-40.bstnma.fios.verizon.net [173.76.53.40]) (authenticated (0 bits)) by mx.sdf.org (8.15.2/8.14.5) with ESMTPSA id x6O09HgW004489 (using TLSv1.2 with cipher AES256-GCM-SHA384 (256 bits) verified NO); Wed, 24 Jul 2019 00:09:18 GMT From: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) To: Ludovic =?utf-8?Q?Court=C3=A8s?= Subject: Re: [bug#36555] [PATCH v5 2/3] guix system: Reimplement 'reconfigure'. 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> <87muh9q51e.fsf_-_@sdf.lonestar.org> <87wogc4v6e.fsf@gnu.org> <87zhl69box.fsf@sdf.lonestar.org> <87o91laojb.fsf_-_@sdf.lonestar.org> <87k1c9aofq.fsf_-_@sdf.lonestar.org> <87ftmxaodv.fsf_-_@sdf.lonestar.org> <87ftmwz8mc.fsf@gnu.org> Date: Tue, 23 Jul 2019 20:06:44 -0400 In-Reply-To: <87ftmwz8mc.fsf@gnu.org> ("Ludovic \=\?utf-8\?Q\?Court\=C3\=A8s\=22'\?\= \=\?utf-8\?Q\?s\?\= message of "Wed, 24 Jul 2019 00:30:51 +0200") Message-ID: <877e889tyj.fsf@sdf.lonestar.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha256; protocol="application/pgp-signature" X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 36555 Cc: 36555@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Ludovic Court=C3=A8s writes: > Note that on current master this should be: > > (built-derivations (lowered-gexp-inputs lowered)) > Ah, thank you. My feature branch is out of date again. > My last grief for this patch series is exception handling above: it=E2=80= =99s > not good to report =E2=80=9Cfailed to install bootloader=E2=80=9D whateve= r the problem > is. :-) > > Could we somehow move exception handling at the call sites? I know > that monadic style makes it harder. Whoops! It would definitely not be good to report "failed to install bootloader" for unrelated issues. I'll look into moving the handling into the call sites. Perhaps I can make a more general version of 'with-shepherd-error-handling'? > The rest looks great, and congrats for being the first one to > reconfigure with it! :-) Heh, thanks! It was pretty exhilarating watching the output go by. I didn't even do a system back-up beforehand because I was that confident in it. Regards, Jakob --=-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQIzBAEBCAAdFiEEa1VJLOiXAjQ2BGSm9Qb9Fp2P2VoFAl03oRQACgkQ9Qb9Fp2P 2VrFmg//TI9q2hNQEjFEBpk+X7TuMyBCdP0KZ4ngvmQQTlJg8TbLDdw0AHuxLQps EFP5JvTfA9kn6uiS4FkoZqUImm1qGjP7X7yLd6dL20gwT/xtr5aOrWrQGePFBejP j3g4VQcWrc+sMmnDahsM9dK5lKJ2Z+0Mdp3YPUesKNNWC9IcJdhxA2fKi7as6C2G YVjeA9a9K3DIll5LKhKlFORrT0UkLulThxj5e/3Mb/fK0Rlp2SVp1btYOzxmt+4s M/+HvYab3yeHwRpcKA0ZMly1Kp0eG+juJXHt5gcgnLwj+UOQ8+ArBz2dyEr20nfQ KJy758OQ0hBes4yGEjP5//coEzogjWeTF1H5yzCIPudjna3RY7BOzmsfWo+x3A2F pB9VdQvvEWM+fNah7wxeNqMzCat7wMk5UY6KVr7sz1I3NQhH4YP2EsaHIq6Fg0n+ cEaSv5+20Gk/+A9gHPUsN5MDQH5T9YkQswbWsy1wPxYlj2m21Ld03pxp8kHkYbfE q6PNxH00qHEkEAudJHxjbPknY0m0ClYAPsfFAYZjk8daRaUSeDSE4svLy4GQu32G y+A8jK46iJJyqvEFOqLoUqdvuE089O5Xp05sL7iqRt1KhN/jySBqPV6Lm1z1gC/4 GONDEDFmy/epIxprw6YZA6GKczi8I0Jci6MeKtSuVSGyk6Vgc/c= =PT/5 -----END PGP SIGNATURE----- --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Tue Jul 23 20:51:11 2019 Received: (at 36555) by debbugs.gnu.org; 24 Jul 2019 00:51:11 +0000 Received: from localhost ([127.0.0.1]:35837 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hq5Ut-0001jG-F1 for submit@debbugs.gnu.org; Tue, 23 Jul 2019 20:51:11 -0400 Received: from mx.sdf.org ([205.166.94.20]:61633) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hq5Up-0001j5-GK for 36555@debbugs.gnu.org; Tue, 23 Jul 2019 20:51:10 -0400 Received: from Epsilon (pool-173-76-53-40.bstnma.fios.verizon.net [173.76.53.40]) (authenticated (0 bits)) by mx.sdf.org (8.15.2/8.14.5) with ESMTPSA id x6O0p49V007425 (using TLSv1.2 with cipher AES256-GCM-SHA384 (256 bits) verified NO); Wed, 24 Jul 2019 00:51:05 GMT From: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) To: Ludovic =?utf-8?Q?Court=C3=A8s?= Subject: Re: [bug#36555] [PATCH v5 2/3] guix system: Reimplement 'reconfigure'. 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> <87muh9q51e.fsf_-_@sdf.lonestar.org> <87wogc4v6e.fsf@gnu.org> <87zhl69box.fsf@sdf.lonestar.org> <87o91laojb.fsf_-_@sdf.lonestar.org> <87k1c9aofq.fsf_-_@sdf.lonestar.org> <87ftmxaodv.fsf_-_@sdf.lonestar.org> <87ftmwz8mc.fsf@gnu.org> <877e889tyj.fsf@sdf.lonestar.org> Date: Tue, 23 Jul 2019 20:48:29 -0400 In-Reply-To: <877e889tyj.fsf@sdf.lonestar.org> (Jakob L. Kreuze's message of "Tue, 23 Jul 2019 20:06:44 -0400") Message-ID: <87tvbc8dgi.fsf@sdf.lonestar.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha256; protocol="application/pgp-signature" X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 36555 Cc: 36555@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= Content-Type: text/plain zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) writes: > Whoops! It would definitely not be good to report "failed to install > bootloader" for unrelated issues. I'll look into moving the handling > into the call sites. Perhaps I can make a more general version of > 'with-shepherd-error-handling'? I ran a few experiments with the Monad API and realized that this is going to be far easier than I had originally thought. In fact, I've already made what I believe to be the necessary changes to the code, I just need to test it out. Expect the update to this patch to be done by tomorrow morning -- I'm having trouble staying awake at my keyboard. Goodnight, friends! Jakob --=-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQIzBAEBCAAdFiEEa1VJLOiXAjQ2BGSm9Qb9Fp2P2VoFAl03qt0ACgkQ9Qb9Fp2P 2Vop6g/+NBiLM24ewoArG6ZaY2Iiyi1mz03c9YthdhNC9oU4eSYTELG2Er/YFmbK cQ4is4OaaP5vwGrnF6IPrBkpjWFrxeDlde7HGjF/72ENfS2kMHcKryqWbL2CYm5L tiRdmEkHzEA7nrdwGZr69o86OojERV10F1RgI5JeGdGj8PqWKs9jwXynzKffCurA tA5pU5EoGDgfhKONqJaKSD5dv8Zok9eMnJ48UTurYUhPYQtQNdTVvlmcMRCYGGcv A8qgb3kwVRCqpweLLXC6/fCz6IOZgWDSLlA7KRoE2jLs8dmPQxv3GwG6T3yaY8Ke eOw/DAM0ZQCZXNcdiUYmnco8Pjzbd1MI/9bXfTc7d9zgH8VJFwtTIyQZnrmtgRnO mMGVWT5Z5nui88dPMOt2sIW6z8QVfAOuif8xDypG/XWV0sIeMLSLPO5aJp3AXaEn dbpmdD1h4TYsw7ewfWyWeLVXs+kO/vNi7Y5eABKdueQewc1AoRbHuRZjRdl2Z1/I p0MXUw0inY3/wjm41mxbQJJYTvxVMXE21jzpSoHmXg4qrMMiogbO5GBQNHDNK10X tYxjH+/oeH2po30AnjiQT8ebNDCzFce1FudZODU6lkKrxnuhEMSKLWS5bCOI6lOe ymWk/6kKDsMwr6tJsc17vdarLfVmjrd/iJaqdg8vH0cIASs7QfA= =PWQa -----END PGP SIGNATURE----- --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Wed Jul 24 12:36:09 2019 Received: (at 36555) by debbugs.gnu.org; 24 Jul 2019 16:36:09 +0000 Received: from localhost ([127.0.0.1]:37927 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hqKFN-0002Iq-Cc for submit@debbugs.gnu.org; Wed, 24 Jul 2019 12:36:09 -0400 Received: from mx.sdf.org ([205.166.94.20]:53616) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hqKFJ-0002Ib-Ra for 36555@debbugs.gnu.org; Wed, 24 Jul 2019 12:36:07 -0400 Received: from Epsilon (pool-173-76-53-40.bstnma.fios.verizon.net [173.76.53.40]) (authenticated (0 bits)) by mx.sdf.org (8.15.2/8.14.5) with ESMTPSA id x6OGZsEh020476 (using TLSv1.2 with cipher AES256-GCM-SHA384 (256 bits) verified NO); Wed, 24 Jul 2019 16:36:04 GMT From: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) To: Ludovic =?utf-8?Q?Court=C3=A8s?= Subject: Re: [bug#36555] [PATCH v6 0/3] Refactor out common behavior for system reconfiguration. References: <87imsci9sj.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> <87muh9q51e.fsf_-_@sdf.lonestar.org> <87wogc4v6e.fsf@gnu.org> <87zhl69box.fsf@sdf.lonestar.org> <87o91laojb.fsf_-_@sdf.lonestar.org> <87k1c9aofq.fsf_-_@sdf.lonestar.org> <87ftmxaodv.fsf_-_@sdf.lonestar.org> <87ftmwz8mc.fsf@gnu.org> <877e889tyj.fsf@sdf.lonestar.org> <87tvbc8dgi.fsf@sdf.lonestar.org> Date: Wed, 24 Jul 2019 12:33:19 -0400 In-Reply-To: <87tvbc8dgi.fsf@sdf.lonestar.org> (Jakob L. Kreuze's message of "Tue, 23 Jul 2019 20:48:29 -0400") Message-ID: <87muh3bdf4.fsf_-_@sdf.lonestar.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha256; protocol="application/pgp-signature" X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 36555 Cc: 36555@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= Content-Type: text/plain Content-Transfer-Encoding: quoted-printable Updated to use the newer 'lowered-gexp' API, moved the 'guard' clause, and confirmed that everything still works. I think that's everything for this series. Jakob L. Kreuze (3): guix system: Add 'reconfigure' module. guix system: Reimplement 'reconfigure'. tests: Add reconfigure system test. Makefile.am | 1 + gnu/local.mk | 1 + gnu/machine/ssh.scm | 189 ++------------------ gnu/services/herd.scm | 6 + gnu/tests/reconfigure.scm | 262 ++++++++++++++++++++++++++++ guix/scripts/system.scm | 188 +++++--------------- guix/scripts/system/reconfigure.scm | 237 +++++++++++++++++++++++++ tests/services.scm | 4 - 8 files changed, 560 insertions(+), 328 deletions(-) create mode 100644 gnu/tests/reconfigure.scm create mode 100644 guix/scripts/system/reconfigure.scm =2D-=20 2.22.0 --=-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQIzBAEBCAAdFiEEa1VJLOiXAjQ2BGSm9Qb9Fp2P2VoFAl04iE8ACgkQ9Qb9Fp2P 2VqnnQ/6AonWoAwVj+XINZ5Y/QBjcC9JPey7SDJs6ceSdmSFANI0OwLf1JpQaexV 8UM56S8I+gtfbuZd2+ZTjT8IfEr7a5SM//eyE495sq7YkbF6sjhbso4kmTo+SxSJ TU4tnsnDTvK0cNlMnVnz3HBqipcrpBKmIUtbg/uV16aOv6GNxokU7+9dSPODE0SY tzSV4IKdfvPblgZA+Vka4J0aOa7bNqro9D0Ej420HN8yI+ocrpZbm1gbjc8cfkrS s1xRXSza+55qPgv+/RterW+1ZtKOJ2YetM0jTceJXqaqKyiUXjVu3jQHatJ2OST4 KwqYiy/1SPzUZPjgg6dOmymRh9GPMNWIBAnCLGeuYut8e3IFJNXV2V2G4h7KLrDf i6uCyzHJD2gqF1zBCVWaQYZbCMDEUVv9lDFQ5rTTcBs4UQYhkjPgtO2RooN8leaN KqFNuzDkkbtscspOGWRko7JzKXpouq/mPNUta4n9+hEKRinsHmJLT5JJHZbXR9Uj KCJaepiD2CTtjSoTQszbmEAyiYvRsSS965KtVoFsiSAqDowjlwc8DkSlXoefxLf3 hQxRLacCaGR694u0BRGt09vvoOZKVSW9IZkQFgkdQOhUfNlT6zx9JCPnRYmYmiqG q32QAYMIggTZLBb1rs+cbeeYrd6L5U0BQzflMCQ86H9NnSnNYVU= =+KIl -----END PGP SIGNATURE----- --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Wed Jul 24 12:36:47 2019 Received: (at 36555) by debbugs.gnu.org; 24 Jul 2019 16:36:47 +0000 Received: from localhost ([127.0.0.1]:37930 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hqKFt-0002Ja-R7 for submit@debbugs.gnu.org; Wed, 24 Jul 2019 12:36:46 -0400 Received: from mx.sdf.org ([205.166.94.20]:53527) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hqKFq-0002JS-U4 for 36555@debbugs.gnu.org; Wed, 24 Jul 2019 12:36:41 -0400 Received: from Epsilon (pool-173-76-53-40.bstnma.fios.verizon.net [173.76.53.40]) (authenticated (0 bits)) by mx.sdf.org (8.15.2/8.14.5) with ESMTPSA id x6OGabRC027296 (using TLSv1.2 with cipher AES256-GCM-SHA384 (256 bits) verified NO); Wed, 24 Jul 2019 16:36:38 GMT From: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) To: Ludovic =?utf-8?Q?Court=C3=A8s?= Subject: Re: [bug#36555] [PATCH v6 1/3] guix system: Add 'reconfigure' module. References: <87imsci9sj.fsf@sdf.lonestar.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> <87muh9q51e.fsf_-_@sdf.lonestar.org> <87wogc4v6e.fsf@gnu.org> <87zhl69box.fsf@sdf.lonestar.org> <87o91laojb.fsf_-_@sdf.lonestar.org> <87k1c9aofq.fsf_-_@sdf.lonestar.org> <87ftmxaodv.fsf_-_@sdf.lonestar.org> <87ftmwz8mc.fsf@gnu.org> <877e889tyj.fsf@sdf.lonestar.org> <87tvbc8dgi.fsf@sdf.lonestar.org> <87muh3bdf4.fsf_-_@sdf.lonestar.org> Date: Wed, 24 Jul 2019 12:34:02 -0400 In-Reply-To: <87muh3bdf4.fsf_-_@sdf.lonestar.org> (Jakob L. Kreuze's message of "Wed, 24 Jul 2019 12:33:19 -0400") Message-ID: <87imrrbddx.fsf_-_@sdf.lonestar.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha256; protocol="application/pgp-signature" X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 36555 Cc: 36555@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable * guix/scripts/system/reconfigure.scm: New file. * Makefile.am (MODULES): Add it. * guix/scripts/system.scm (bootloader-installer-script): Export variable. * gnu/machine/ssh.scm (switch-to-system, upgrade-shepherd-services) (install-bootloader): Delete variable. * gnu/machine/ssh.scm (deploy-managed-host): Rewrite procedure. * gnu/services/herd.scm (live-service): Export variable. * gnu/services/herd.scm (live-service-canonical-name): New variable. * tests/services.scm (live-service): Delete variable. =2D-- Makefile.am | 1 + gnu/machine/ssh.scm | 189 ++-------------------- gnu/services/herd.scm | 6 + guix/scripts/system/reconfigure.scm | 237 ++++++++++++++++++++++++++++ tests/services.scm | 4 - 5 files changed, 256 insertions(+), 181 deletions(-) create mode 100644 guix/scripts/system/reconfigure.scm diff --git a/Makefile.am b/Makefile.am index 7fa51d17ac..0bd85e8fcf 100644 =2D-- a/Makefile.am +++ b/Makefile.am @@ -249,6 +249,7 @@ MODULES =3D \ guix/scripts/describe.scm \ guix/scripts/system.scm \ guix/scripts/system/search.scm \ + guix/scripts/system/reconfigure.scm \ guix/scripts/lint.scm \ guix/scripts/challenge.scm \ guix/scripts/import/crate.scm \ diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm index 278d43c10f..552eafa9de 100644 =2D-- a/gnu/machine/ssh.scm +++ b/gnu/machine/ssh.scm @@ -17,23 +17,21 @@ ;;; along with GNU Guix. If not, see . =20 (define-module (gnu machine ssh) =2D #:use-module (gnu bootloader) #:use-module (gnu machine) #:autoload (gnu packages gnupg) (guile-gcrypt) =2D #:use-module (gnu services) =2D #:use-module (gnu services shepherd) #:use-module (gnu system) =2D #:use-module (guix derivations) #:use-module (guix gexp) #:use-module (guix i18n) #:use-module (guix modules) #:use-module (guix monads) #:use-module (guix records) #:use-module (guix remote) + #:use-module (guix scripts system reconfigure) #:use-module (guix ssh) #:use-module (guix store) #:use-module (ice-9 match) #:use-module (srfi srfi-19) + #:use-module (srfi srfi-26) #:use-module (srfi srfi-35) #:export (managed-host-environment-type =20 @@ -105,118 +103,6 @@ an environment type of 'managed-host." ;;; System deployment. ;;; =20 =2D(define (switch-to-system machine) =2D "Monadic procedure creating a new generation on MACHINE and execute the =2Dactivation script for the new system configuration." =2D (define (remote-exp drv script) =2D (with-extensions (list guile-gcrypt) =2D (with-imported-modules (source-module-closure '((guix config) =2D (guix profiles) =2D (guix utils))) =2D #~(begin =2D (use-modules (guix config) =2D (guix profiles) =2D (guix utils)) =2D =2D (define %system-profile =2D (string-append %state-directory "/profiles/system")) =2D =2D (let* ((system #$drv) =2D (number (1+ (generation-number %system-profile))) =2D (generation (generation-file-name %system-profile num= ber))) =2D (switch-symlinks generation system) =2D (switch-symlinks %system-profile generation) =2D ;; The implementation of 'guix system reconfigure' saves t= he =2D ;; load path and environment here. This is unnecessary here =2D ;; because each invocation of 'remote-eval' runs in a dist= inct =2D ;; Guile REPL. =2D (setenv "GUIX_NEW_SYSTEM" system) =2D ;; The activation script may write to stdout, which confus= es =2D ;; 'remote-eval' when it attempts to read a result from the =2D ;; remote REPL. We work around this by forcing the output = to a =2D ;; string. =2D (with-output-to-string =2D (lambda () =2D (primitive-load #$script)))))))) =2D =2D (let* ((os (machine-system machine)) =2D (script (operating-system-activation-script os))) =2D (mlet* %store-monad ((drv (operating-system-derivation os))) =2D (machine-remote-eval machine (remote-exp drv script))))) =2D =2D;; XXX: Currently, this does NOT attempt to restart running services. Th= is is =2D;; also the case with 'guix system reconfigure'. =2D;; =2D;; See . =2D(define (upgrade-shepherd-services machine) =2D "Monadic procedure unloading and starting services on the remote as ne= eded =2Dto realize the MACHINE's system configuration." =2D (define target-services =2D ;; Monadic expression evaluating to a list of (name output-path) pai= rs for =2D ;; all of MACHINE's services. =2D (mapm %store-monad =2D (lambda (service) =2D (mlet %store-monad ((file ((compose lower-object =2D shepherd-service-file) =2D service))) =2D (return (list (shepherd-service-canonical-name service) =2D (derivation->output-path file))))) =2D (service-value =2D (fold-services (operating-system-services (machine-system mac= hine)) =2D #:target-type shepherd-root-service-type)))) =2D =2D (define (remote-exp target-services) =2D (with-imported-modules '((gnu services herd)) =2D #~(begin =2D (use-modules (gnu services herd) =2D (srfi srfi-1)) =2D =2D (define running =2D (filter live-service-running (current-services))) =2D =2D (define (essential? service) =2D ;; Return #t if SERVICE is essential and should not be unloa= ded =2D ;; under any circumstance. =2D (memq (first (live-service-provision service)) =2D '(root shepherd))) =2D =2D (define (obsolete? service) =2D ;; Return #t if SERVICE can be safely unloaded. =2D (and (not (essential? service)) =2D (every (lambda (requirements) =2D (not (memq (first (live-service-provision serv= ice)) =2D requirements))) =2D (map live-service-requirement running)))) =2D =2D (define to-unload =2D (filter obsolete? =2D (remove (lambda (service) =2D (memq (first (live-service-provision servi= ce)) =2D (map first '#$target-services))) =2D running))) =2D =2D (define to-start =2D (remove (lambda (service-pair) =2D (memq (first service-pair) =2D (map (compose first live-service-provision) =2D running))) =2D '#$target-services)) =2D =2D ;; Unload obsolete services. =2D (for-each (lambda (service) =2D (false-if-exception =2D (unload-service service))) =2D to-unload) =2D =2D ;; Load the service files for any new services and start them. =2D (load-services/safe (map second to-start)) =2D (for-each start-service (map first to-start)) =2D =2D #t))) =2D =2D (mlet %store-monad ((target-services target-services)) =2D (machine-remote-eval machine (remote-exp target-services)))) =2D (define (machine-boot-parameters machine) "Monadic procedure returning a list of 'boot-parameters' for the generat= ions of MACHINE's system profile, ordered from most recent to oldest." @@ -275,71 +161,20 @@ of MACHINE's system profile, ordered from most recent= to oldest." (boot-parameters-kernel-arguments params)))))))) generations)))) =20 =2D(define (install-bootloader machine) =2D "Create a bootloader entry for the new system generation on MACHINE, a= nd =2Dconfigure the bootloader to boot that generation by default." =2D (define bootloader-installer-script =2D (@@ (guix scripts system) bootloader-installer-script)) =2D =2D (define (remote-exp installer bootcfg bootcfg-file) =2D (with-extensions (list guile-gcrypt) =2D (with-imported-modules (source-module-closure '((gnu build install) =2D (guix store) =2D (guix utils))) =2D #~(begin =2D (use-modules (gnu build install) =2D (guix store) =2D (guix utils)) =2D (let* ((gc-root (string-append "/" %gc-roots-directory "/boo= tcfg")) =2D (temp-gc-root (string-append gc-root ".new"))) =2D =2D (switch-symlinks temp-gc-root gc-root) =2D =2D (unless (false-if-exception =2D (begin =2D ;; The implementation of 'guix system reconfigu= re' =2D ;; saves the load path here. This is unnecessar= y here =2D ;; because each invocation of 'remote-eval' run= s in a =2D ;; distinct Guile REPL. =2D (install-boot-config #$bootcfg #$bootcfg-file "= /") =2D ;; The installation script may write to stdout,= which =2D ;; confuses 'remote-eval' when it attempts to r= ead a =2D ;; result from the remote REPL. We work around = this =2D ;; by forcing the output to a string. =2D (with-output-to-string =2D (lambda () =2D (primitive-load #$installer))))) =2D (delete-file temp-gc-root) =2D (error "failed to install bootloader")) =2D =2D (rename-file temp-gc-root gc-root) =2D #t))))) =2D =2D (mlet* %store-monad ((boot-parameters (machine-boot-parameters machine= ))) =2D (let* ((os (machine-system machine)) =2D (bootloader ((compose bootloader-configuration-bootloader =2D operating-system-bootloader) =2D os)) =2D (bootloader-target (bootloader-configuration-target =2D (operating-system-bootloader os))) =2D (installer (bootloader-installer-script =2D (bootloader-installer bootloader) =2D (bootloader-package bootloader) =2D bootloader-target =2D "/")) =2D (menu-entries (map boot-parameters->menu-entry boot-parameter= s)) =2D (bootcfg (operating-system-bootcfg os menu-entries)) =2D (bootcfg-file (bootloader-configuration-file bootloader))) =2D (machine-remote-eval machine (remote-exp installer bootcfg bootcfg= -file))))) =2D (define (deploy-managed-host machine) "Internal implementation of 'deploy-machine' for MACHINE instances with = an environment type of 'managed-host." (maybe-raise-unsupported-configuration-error machine) =2D (mbegin %store-monad =2D (switch-to-system machine) =2D (upgrade-shepherd-services machine) =2D (install-bootloader machine))) + (mlet %store-monad ((boot-parameters (machine-boot-parameters machine))) + (let* ((os (machine-system machine)) + (eval (cut machine-remote-eval machine <>)) + (menu-entries (map boot-parameters->menu-entry boot-parameters)) + (bootloader-configuration (operating-system-bootloader os)) + (bootcfg (operating-system-bootcfg os menu-entries))) + (mbegin %store-monad + (switch-to-system eval os) + (upgrade-shepherd-services eval os) + (install-bootloader eval bootloader-configuration bootcfg))))) =20 ;;; diff --git a/gnu/services/herd.scm b/gnu/services/herd.scm index 0008746fe9..2207b2d34b 100644 =2D-- a/gnu/services/herd.scm +++ b/gnu/services/herd.scm @@ -40,10 +40,12 @@ unknown-shepherd-error? unknown-shepherd-error-sexp =20 + live-service live-service? live-service-provision live-service-requirement live-service-running + live-service-canonical-name =20 with-shepherd-action current-services @@ -192,6 +194,10 @@ of pairs." (requirement live-service-requirement) ;list of symbols (running live-service-running)) ;#f | object =20 +(define (live-service-canonical-name service) + "Return the 'canonical name' of SERVICE." + (first (live-service-provision service))) + (define (current-services) "Return the list of currently defined Shepherd services, represented as objects. Return #f if the list of services could not be diff --git a/guix/scripts/system/reconfigure.scm b/guix/scripts/system/reco= nfigure.scm new file mode 100644 index 0000000000..8c7d461585 =2D-- /dev/null +++ b/guix/scripts/system/reconfigure.scm @@ -0,0 +1,237 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright =C2=A9 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Court=C3= =A8s +;;; Copyright =C2=A9 2016 Alex Kost +;;; Copyright =C2=A9 2016, 2017, 2018 Chris Marusich +;;; Copyright =C2=A9 2017 Mathieu Othacehe +;;; Copyright =C2=A9 2018 Ricardo Wurmus +;;; Copyright =C2=A9 2019 Christopher Baines +;;; 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 (guix scripts system reconfigure) + #:autoload (gnu packages gnupg) (guile-gcrypt) + #:use-module (gnu bootloader) + #:use-module (gnu services) + #:use-module (gnu services herd) + #:use-module (gnu services shepherd) + #:use-module (gnu system) + #:use-module (guix gexp) + #:use-module (guix modules) + #:use-module (guix monads) + #:use-module (guix store) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:export (switch-system-program + switch-to-system + + upgrade-services-program + upgrade-shepherd-services + + install-bootloader-program + install-bootloader)) + +;;; Commentary: +;;; +;;; This module implements the "effectful" parts of system +;;; reconfiguration. Although building a system derivation is a pure +;;; operation, a number of impure operations must be carried out for the +;;; system configuration to be realized -- chiefly, creation of generation +;;; symlinks and invocation of activation scripts. +;;; +;;; Code: + + +;;; +;;; Profile creation. +;;; + +(define* (switch-system-program os #:optional profile) + "Return an executable store item that, upon being evaluated, will create= a +new generation of PROFILE pointing to the directory of OS, switch to it +atomically, and run OS's activation script." + (program-file + "switch-to-system.scm" + (with-extensions (list guile-gcrypt) + (with-imported-modules (source-module-closure '((guix config) + (guix profiles) + (guix utils))) + #~(begin + (use-modules (guix config) + (guix profiles) + (guix utils)) + + (define profile + (or #$profile (string-append %state-directory "/profiles/syst= em"))) + + (let* ((number (1+ (generation-number profile))) + (generation (generation-file-name profile number))) + (switch-symlinks generation #$os) + (switch-symlinks profile generation) + (setenv "GUIX_NEW_SYSTEM" #$os) + (primitive-load #$(operating-system-activation-script os)))))= ))) + +(define* (switch-to-system eval os #:optional profile) + "Using EVAL, a monadic procedure taking a single G-Expression as an argu= ment, +create a new generation of PROFILE pointing to the directory of OS, switch= to +it atomically, and run OS's activation script." + (eval #~(primitive-load #$(switch-system-program os profile)))) + + +;;; +;;; Services. +;;; + +(define (running-services eval) + "Using EVAL, a monadic procedure taking a single G-Expression as an argu= ment, +return the objects that are currently running on MACHINE." + (define exp + (with-imported-modules '((gnu services herd)) + #~(begin + (use-modules (gnu services herd)) + (let ((services (current-services))) + (and services + ;; 'live-service-running' is ignored, as we can't necessa= rily + ;; serialize arbitrary objects. This should be fine for n= ow, + ;; since 'machine-current-services' is not exposed public= ly, + ;; and the resultant objects are only used= for + ;; resolving service dependencies. + (map (lambda (service) + (list (live-service-provision service) + (live-service-requirement service))) + services)))))) + (mlet %store-monad ((services (eval exp))) + (return (map (match-lambda + ((provision requirement) + (live-service provision requirement #f))) + services)))) + +;; XXX: Currently, this does NOT attempt to restart running services. See +;; for details. +(define (upgrade-services-program service-files to-start to-unload to-rest= art) + "Return an executable store item that, upon being evaluated, will upgrade +the Shepherd (PID 1) by unloading obsolete services and loading new +services. SERVICE-FILES is a list of Shepherd service files to load, and +TO-START, TO-UNLOAD, and TO-RESTART are lists of the Shepherd services' +canonical names (symbols)." + (program-file + "upgrade-shepherd-services.scm" + (with-imported-modules '((gnu services herd)) + #~(begin + (use-modules (gnu services herd) + (srfi srfi-1)) + + ;; Load the service files for any new services. + (load-services/safe '#$service-files) + + ;; Unload obsolete services and start new services. + (for-each unload-service '#$to-unload) + (for-each start-service '#$to-start))))) + +(define* (upgrade-shepherd-services eval os) + "Using EVAL, a monadic procedure taking a single G-Expression as an argu= ment, +upgrade the Shepherd (PID 1) by unloading obsolete services and loading new +services as defined by OS." + (define target-services + (service-value + (fold-services (operating-system-services os) + #:target-type shepherd-root-service-type))) + + (mlet* %store-monad ((live-services (running-services eval))) + (let*-values (((to-unload to-restart) + (shepherd-service-upgrade live-services target-services= ))) + (let* ((to-unload (map live-service-canonical-name to-unload)) + (to-restart (map shepherd-service-canonical-name to-restart)) + (to-start (lset-difference eqv? + (map shepherd-service-canonical-na= me + target-services) + (map live-service-canonical-name + live-services))) + (service-files + (map shepherd-service-file + (filter (lambda (service) + (memq (shepherd-service-canonical-name servic= e) + to-start)) + target-services)))) + (eval #~(primitive-load #$(upgrade-services-program service-files + to-start + to-unload + to-restart))))= ))) + + +;;; +;;; Bootloader configuration. +;;; + +(define (install-bootloader-program installer bootloader-package bootcfg + bootcfg-file device target) + "Return an executable store item that, upon being evaluated, will install +BOOTCFG to BOOTCFG-FILE, a target file name, on DEVICE, a file system devi= ce, +at TARGET, a mount point, and subsequently run INSTALLER from +BOOTLOADER-PACKAGE." + (program-file + "install-bootloader.scm" + (with-extensions (list guile-gcrypt) + (with-imported-modules (source-module-closure '((gnu build bootloader) + (gnu build install) + (guix store) + (guix utils))) + #~(begin + (use-modules (gnu build bootloader) + (gnu build install) + (guix build utils) + (guix store) + (guix utils) + (ice-9 binary-ports) + (srfi srfi-34) + (srfi srfi-35)) + (let* ((gc-root (string-append #$target %gc-roots-directory "/b= ootcfg")) + (temp-gc-root (string-append gc-root ".new"))) + (switch-symlinks temp-gc-root gc-root) + (install-boot-config #$bootcfg #$bootcfg-file #$target) + ;; Preserve the previous activation's garbage collector root + ;; until the bootloader installer has run, so that a failure = in + ;; the bootloader's installer script doesn't leave the user w= ith + ;; a broken installation. + (when #$installer + (catch #t + (lambda () + (#$installer #$bootloader-package #$device #$target)) + (lambda args + (delete-file temp-gc-root) + (apply throw args)))) + (rename-file temp-gc-root gc-root))))))) + +(define* (install-bootloader eval configuration bootcfg + #:key + (run-installer? #t) + (target "/")) + "Using EVAL, a monadic procedure taking a single G-Expression as an argu= ment, +configure the bootloader on TARGET such that OS will be booted by default = and +additional configurations specified by MENU-ENTRIES can be selected." + (let* ((bootloader (bootloader-configuration-bootloader configuration)) + (installer (and run-installer? + (bootloader-installer bootloader))) + (package (bootloader-package bootloader)) + (device (bootloader-configuration-target configuration)) + (bootcfg-file (bootloader-configuration-file bootloader))) + (eval #~(primitive-load #$(install-bootloader-program installer + package + bootcfg + bootcfg-file + device + target))))) diff --git a/tests/services.scm b/tests/services.scm index 44ad0022c6..572fe38164 100644 =2D-- a/tests/services.scm +++ b/tests/services.scm @@ -26,10 +26,6 @@ #:use-module (srfi srfi-64) #:use-module (ice-9 match)) =20 =2D(define live-service =2D (@@ (gnu services herd) live-service)) =2D =2D (test-begin "services") =20 (test-equal "services, default value" =2D-=20 2.22.0 --=-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQIzBAEBCAAdFiEEa1VJLOiXAjQ2BGSm9Qb9Fp2P2VoFAl04iHoACgkQ9Qb9Fp2P 2VoqEw//YZAWEbn8Ukw9P5y9bijf9jNQTp0hWft5RVNf8akBGZ7goSbVo7ZtD2Ly oc7Lo4gCKS21KFD7hvmdrTqEurLnD9t2ScoRbbTKK1ipbYaM0SJs9XaImr34epox RZQBWoN7cPJHRs2s8PFf/FPyg4UJETZsFM24vAiUtB1eKQTp6jX7KMPY4QUSh+tn DW58w2UuKbBbgnAlzW/nd9kNdDZPRR8fJ7NGTZEybEtTMgsLDmZS1VK5lf9P4WHi zy8/RHhuhr04ZeTKFy+EtJxPYTL9hS2K33qdf7CQgpXdnep0kw8ntKhYXIzQ4wMK Vyi0dH5mx6jfGjHf/fwe2UBbVJ2rp20PNnJmgOWpMahxqarSjrDGrLbKfhB/CJ2C IsrKk6ONeUVf3Oqarq7JTi3RBC72SvxrcU1BKknNC9IbLMPKfRH2iFwXAq3YikqK 3EdifItEoRm27pb2pkmN0ybgTN2RkyqZUxHBR3smf+dVYC9vj6uJFdeEiW2Qo2oS pBgxOGtJae+ZHWQdLyIKY7Wkgr0zBEsq0Fp09Bv4PcOcNUJEnY2sW/4nVzpsMSge wTG9XMGqb7/oQVlEUeGeDp+CrVsmgGBlRX8hsttqEeFoHCGtKgA/W59ztwnqn4Xl sPUo0lTlebXDeTTaxmRqJobF2plaPjg8ysbqyq1UwJzDv6V11Bo= =RQ7Q -----END PGP SIGNATURE----- --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Wed Jul 24 12:37:16 2019 Received: (at 36555) by debbugs.gnu.org; 24 Jul 2019 16:37:16 +0000 Received: from localhost ([127.0.0.1]:37935 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hqKGS-0002Kv-1k for submit@debbugs.gnu.org; Wed, 24 Jul 2019 12:37:16 -0400 Received: from mx.sdf.org ([205.166.94.20]:53435) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hqKGQ-0002Ko-Kv for 36555@debbugs.gnu.org; Wed, 24 Jul 2019 12:37:15 -0400 Received: from Epsilon (pool-173-76-53-40.bstnma.fios.verizon.net [173.76.53.40]) (authenticated (0 bits)) by mx.sdf.org (8.15.2/8.14.5) with ESMTPSA id x6OGbCVx010358 (using TLSv1.2 with cipher AES256-GCM-SHA384 (256 bits) verified NO); Wed, 24 Jul 2019 16:37:13 GMT From: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) To: Ludovic =?utf-8?Q?Court=C3=A8s?= Subject: Re: [bug#36555] [PATCH v6 2/3] guix system: Reimplement 'reconfigure'. References: <87imsci9sj.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> <87muh9q51e.fsf_-_@sdf.lonestar.org> <87wogc4v6e.fsf@gnu.org> <87zhl69box.fsf@sdf.lonestar.org> <87o91laojb.fsf_-_@sdf.lonestar.org> <87k1c9aofq.fsf_-_@sdf.lonestar.org> <87ftmxaodv.fsf_-_@sdf.lonestar.org> <87ftmwz8mc.fsf@gnu.org> <877e889tyj.fsf@sdf.lonestar.org> <87tvbc8dgi.fsf@sdf.lonestar.org> <87muh3bdf4.fsf_-_@sdf.lonestar.org> <87imrrbddx.fsf_-_@sdf.lonestar.org> Date: Wed, 24 Jul 2019 12:34:38 -0400 In-Reply-To: <87imrrbddx.fsf_-_@sdf.lonestar.org> (Jakob L. Kreuze's message of "Wed, 24 Jul 2019 12:34:02 -0400") Message-ID: <87ef2fbdcx.fsf_-_@sdf.lonestar.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha256; protocol="application/pgp-signature" X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 36555 Cc: 36555@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= Content-Type: text/plain Content-Transfer-Encoding: quoted-printable * guix/scripts/system.scm (switch-to-system) (upgrade-shepherd-services, install-bootloader): Delete variable. (local-eval): New variable. (install): Remove 'bootloader-installer' and 'bootcfg-file' parameters. (install): Add 'bootloader' parameter. =2D-- guix/scripts/system.scm | 188 +++++++++------------------------------- 1 file changed, 41 insertions(+), 147 deletions(-) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 67a4071684..115da665b4 100644 =2D-- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -41,6 +41,7 @@ delete-matching-generations) #:use-module (guix graph) #:use-module (guix scripts graph) + #:use-module (guix scripts system reconfigure) #:use-module (guix build utils) #:use-module (guix progress) #:use-module ((guix build syscalls) #:select (terminal-columns)) @@ -178,43 +179,9 @@ TARGET, and register them." =20 (return *unspecified*))) =20 =2D(define* (install-bootloader installer =2D #:key =2D bootcfg bootcfg-file =2D target) =2D "Run INSTALLER, a bootloader installation script, with error handling,= in =2D%STORE-MONAD." =2D (mlet %store-monad ((installer-drv (if installer =2D (lower-object installer) =2D (return #f))) =2D (bootcfg (lower-object bootcfg))) =2D (let* ((gc-root (string-append target %gc-roots-directory =2D "/bootcfg")) =2D (temp-gc-root (string-append gc-root ".new")) =2D (install (and installer-drv =2D (derivation->output-path installer-drv))) =2D (bootcfg (derivation->output-path bootcfg))) =2D ;; Prepare the symlink to bootloader config file to make sure that= it's =2D ;; a GC root when 'installer-drv' completes (being a bit paranoid.) =2D (switch-symlinks temp-gc-root bootcfg) =2D =2D (unless (false-if-exception =2D (begin =2D (install-boot-config bootcfg bootcfg-file target) =2D (when install =2D (save-load-path-excursion (primitive-load install))))) =2D (delete-file temp-gc-root) =2D (leave (G_ "failed to install bootloader ~a~%") install)) =2D =2D ;; Register bootloader config file as a GC root so that its depend= encies =2D ;; (background image, font, etc.) are not reclaimed. =2D (rename-file temp-gc-root gc-root) =2D (return #t)))) =2D (define* (install os-drv target #:key (log-port (current-output-port)) =2D bootloader-installer install-bootloader? =2D bootcfg bootcfg-file) + install-bootloader? bootloader bootcfg) "Copy the closure of BOOTCFG, which includes the output of OS-DRV, to directory TARGET. TARGET must be an absolute directory name since that's = what 'register-path' expects. @@ -265,10 +232,11 @@ the ownership of '~a' may be incorrect!~%") (populate os-dir target) =20 (mwhen install-bootloader? =2D (install-bootloader bootloader-installer =2D #:bootcfg bootcfg =2D #:bootcfg-file bootcfg-file =2D #:target target)))))) + (install-bootloader local-eval bootloader bootcfg + #:target target) + (return + (info (G_ "bootloader successfully installed on '~a'~%") + (bootloader-configuration-target bootloader)))))))) =20 ;;; @@ -335,82 +303,6 @@ unload." (warning (G_ "failed to obtain list of shepherd services~%")) (return #f))))) =20 =2D(define (upgrade-shepherd-services os) =2D "Upgrade the Shepherd (PID 1) by unloading obsolete services and loadi= ng new =2Dservices specified in OS and not currently running. =2D =2DThis is currently very conservative in that it does not stop or unload a= ny =2Drunning service. Unloading or stopping the wrong service ('udev', say) = could =2Dbring the system down." =2D (define new-services =2D (service-value =2D (fold-services (operating-system-services os) =2D #:target-type shepherd-root-service-type))) =2D =2D ;; Arrange to simply emit a warning if the service upgrade fails. =2D (with-shepherd-error-handling =2D (call-with-service-upgrade-info new-services =2D (lambda (to-restart to-unload) =2D (for-each (lambda (unload) =2D (info (G_ "unloading service '~a'...~%") unload) =2D (unload-service unload)) =2D to-unload) =2D =2D (with-monad %store-monad =2D (munless (null? new-services) =2D (let ((new-service-names (map shepherd-service-canonical-na= me new-services)) =2D (to-restart-names (map shepherd-service-canonical-na= me to-restart)) =2D (to-start (filter shepherd-service-auto-star= t? new-services))) =2D (info (G_ "loading new services:~{ ~a~}...~%") new-service= -names) =2D (unless (null? to-restart-names) =2D ;; Listing TO-RESTART-NAMES in the message below wouldn'= t help =2D ;; because many essential services cannot be meaningfully =2D ;; restarted. See . =2D (format #t (G_ "To complete the upgrade, run 'herd resta= rt SERVICE' to stop, =2Dupgrade, and restart each service that was not automatically restarted.\= n"))) =2D (mlet %store-monad ((files (mapm %store-monad =2D (compose lower-object =2D shepherd-service= -file) =2D new-services))) =2D ;; Here we assume that FILES are exactly those that were= computed =2D ;; as part of the derivation that built OS, which is nor= mally the =2D ;; case. =2D (load-services/safe (map derivation->output-path files)) =2D =2D (for-each start-service =2D (map shepherd-service-canonical-name to-start)) =2D (return #t))))))))) =2D =2D(define* (switch-to-system os =2D #:optional (profile %system-profile)) =2D "Make a new generation of PROFILE pointing to the directory of OS, swi= tch to =2Dit atomically, and then run OS's activation script." =2D (mlet* %store-monad ((drv (operating-system-derivation os)) =2D (script (lower-object (operating-system-activatio= n-script os)))) =2D (let* ((system (derivation->output-path drv)) =2D (number (+ 1 (generation-number profile))) =2D (generation (generation-file-name profile number))) =2D (switch-symlinks generation system) =2D (switch-symlinks profile generation) =2D =2D (format #t (G_ "activating system...~%")) =2D =2D ;; The activation script may change $PATH, among others, so protect =2D ;; against that. =2D (save-environment-excursion =2D ;; Tell 'activate-current-system' what the new system is. =2D (setenv "GUIX_NEW_SYSTEM" system) =2D =2D ;; The activation script may modify '%load-path' & co., so protect =2D ;; against that. This is necessary to ensure that =2D ;; 'upgrade-shepherd-services' gets to see the right modules when= it =2D ;; computes derivations with 'gexp->derivation'. =2D (save-load-path-excursion =2D (primitive-load (derivation->output-path script)))) =2D =2D ;; Finally, try to update system services. =2D (upgrade-shepherd-services os)))) =2D (define-syntax-rule (unless-file-not-found exp) (catch 'system-error (lambda () @@ -505,18 +397,13 @@ STORE is an open connection to the store." ((bootloader-configuration-file-generator bootloader) bootloader-config entries #:old-entries old-entries))) =2D (bootcfg-file -> (bootloader-configuration-file bootloader)) =2D (target -> "/") (drvs -> (list bootcfg))) (mbegin %store-monad (show-what-to-build* drvs) (built-derivations drvs) =2D ;; Only install bootloader configuration file. Thus, no instal= ler is =2D ;; provided here. =2D (install-bootloader #f =2D #:bootcfg bootcfg =2D #:bootcfg-file bootcfg-file =2D #:target target)))))) + ;; Only install bootloader configuration file. + (install-bootloader local-eval bootloader-config bootcfg + #:run-installer? #f)))))) =20 ;;; @@ -820,8 +707,17 @@ and TARGET arguments." (condition-message c)) (exit 1))) (#$installer #$bootloader #$device #$target) =2D (format #t "bootloader successfully installed on = '~a'~%" =2D #$device)))))) + (info (G_ "bootloader successfully installed on '~a= '~%") + #$device)))))) + +(define (local-eval exp) + "Evaluate EXP, a G-Expression, in-place." + (mlet* %store-monad ((lowered (lower-gexp exp)) + (_ (built-derivations (lowered-gexp-inputs lowered)= ))) + (save-load-path-excursion + (set! %load-path (lowered-gexp-load-path lowered)) + (set! %load-compiled-path (lowered-gexp-load-compiled-path lowered)) + (return (primitive-eval (lowered-gexp-sexp lowered)))))) =20 (define* (perform-action action os #:key skip-safety-checks? @@ -858,19 +754,12 @@ static checks." (map boot-parameters->menu-entry (profile-boot-parameters)))) =20 (define bootloader =2D (bootloader-configuration-bootloader (operating-system-bootloader os= ))) + (operating-system-bootloader os)) =20 (define bootcfg (and (memq action '(init reconfigure)) (operating-system-bootcfg os menu-entries))) =20 =2D (define bootloader-script =2D (let ((installer (bootloader-installer bootloader)) =2D (target (or target "/"))) =2D (bootloader-installer-script installer =2D (bootloader-package bootloader) =2D bootloader-target target))) =2D (when (eq? action 'reconfigure) (maybe-suggest-running-guix-pull)) =20 @@ -897,9 +786,7 @@ static checks." ;; See . (drvs (mapm %store-monad lower-object (if (memq action '(init reconfigure)) =2D (if install-bootloader? =2D (list sys bootcfg bootloader-script) =2D (list sys bootcfg)) + (list sys bootcfg) (list sys)))) (% (if derivations-only? (return (for-each (compose println derivation-file-n= ame) @@ -909,28 +796,35 @@ static checks." =20 (if (or dry-run? derivations-only?) (return #f) =2D (let ((bootcfg-file (bootloader-configuration-file bootloader))) + (begin (for-each (compose println derivation->output-path) drvs) =20 (case action ((reconfigure) =2D (mbegin %store-monad =2D (switch-to-system os) =2D (mwhen install-bootloader? =2D (install-bootloader bootloader-script =2D #:bootcfg bootcfg =2D #:bootcfg-file bootcfg-file =2D #:target "/")))) + (newline) + (format #t (G_ "activating system...~%")) + (guard (c ((message-condition? c) + (leave (G_ "failed to reconfigure system:~%~a~%") + (condition-message c)))) + (mbegin %store-monad + (switch-to-system local-eval os) + (mwhen install-bootloader? + (install-bootloader local-eval bootloader bootcfg + #:target (or target "/")) + (return + (info (G_ "bootloader successfully installed on '~a'~%= ") + (bootloader-configuration-target bootloader)))) + (with-shepherd-error-handling + (upgrade-shepherd-services local-eval os))))) ((init) (newline) (format #t (G_ "initializing operating system under '~a'...~%= ") target) (install sys (canonicalize-path target) #:install-bootloader? install-bootloader? =2D #:bootcfg bootcfg =2D #:bootcfg-file bootcfg-file =2D #:bootloader-installer bootloader-script)) + #:bootloader bootloader + #:bootcfg bootcfg)) (else ;; All we had to do was to build SYS and maybe register an ;; indirect GC root. =2D-=20 2.22.0 --=-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQIzBAEBCAAdFiEEa1VJLOiXAjQ2BGSm9Qb9Fp2P2VoFAl04iJ4ACgkQ9Qb9Fp2P 2VoYQA//WaGALKDzpemIlkyIErCTmDpSy2aiTEOgVDW+KinOhlTxXxKB5qs0sW0e APwLCAqx5B6dhFihMh+P9BJqmh+crH3Wzu/eLbo108pLk0Djc7T5Ke8T7k2q9wcz dLh0we8QeHLXaVUpzpCYQTMFJBDmR8mcUsX6nXUUiT+iEp9UQxggdtC7zvEenqvs IEQLXFAydJShzL27Om1vwAQS3fyp+HrVHVazLs9u7OvG7QhKGFGA3iMALxN+2igG 344aHOsbBXKakoiYo/2Zi4+Y1fFJD2GpJ6YJQbuNjh2iGl9NC1XBYspXu4C9uX3+ g5nnilM87kd4fVwdcylTC85cfgBntm4tNU3C3UcUalpV+xP+1ZrU40TYkziWxo7f fsvBK//WVOpPJdl8MHQ7x2q4Axcu0ZjHacCS+YggzBczv2z4VTmuqsrujaoV54OL 4Wz5/e/pp0sZsd20rd2rZECoSYQg+hPw1nj+nrpyvWoeQRZ7ZmY/DgwgCkvH9W4p /ntUZTgj0L5iXyBBGhDrgON3B1xM/NULVRXuWL+OTH/nRfFMnUoCwF7kfgBHmXE9 VffkG5j7dqiKikmam8LpW1AbhPIrzQK1VLVn/N2k/9twGHt/O8K92vpZJxbedxIA I6KmJs1SWkWfcyhIFpBKJoxHh/IgKBgm7fvL4Tb77E0nVCM2m84= =7C/H -----END PGP SIGNATURE----- --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Wed Jul 24 12:37:50 2019 Received: (at 36555) by debbugs.gnu.org; 24 Jul 2019 16:37:50 +0000 Received: from localhost ([127.0.0.1]:37938 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hqKGz-0002M5-LS for submit@debbugs.gnu.org; Wed, 24 Jul 2019 12:37:50 -0400 Received: from mx.sdf.org ([205.166.94.20]:53338) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hqKGw-0002Lw-UF for 36555@debbugs.gnu.org; Wed, 24 Jul 2019 12:37:47 -0400 Received: from Epsilon (pool-173-76-53-40.bstnma.fios.verizon.net [173.76.53.40]) (authenticated (0 bits)) by mx.sdf.org (8.15.2/8.14.5) with ESMTPSA id x6OGbjOJ011207 (using TLSv1.2 with cipher AES256-GCM-SHA384 (256 bits) verified NO); Wed, 24 Jul 2019 16:37:46 GMT From: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) To: Ludovic =?utf-8?Q?Court=C3=A8s?= Subject: Re: [bug#36555] [PATCH v6 3/3] tests: Add reconfigure system test. References: <87imsci9sj.fsf@sdf.lonestar.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> <87muh9q51e.fsf_-_@sdf.lonestar.org> <87wogc4v6e.fsf@gnu.org> <87zhl69box.fsf@sdf.lonestar.org> <87o91laojb.fsf_-_@sdf.lonestar.org> <87k1c9aofq.fsf_-_@sdf.lonestar.org> <87ftmxaodv.fsf_-_@sdf.lonestar.org> <87ftmwz8mc.fsf@gnu.org> <877e889tyj.fsf@sdf.lonestar.org> <87tvbc8dgi.fsf@sdf.lonestar.org> <87muh3bdf4.fsf_-_@sdf.lonestar.org> <87imrrbddx.fsf_-_@sdf.lonestar.org> <87ef2fbdcx.fsf_-_@sdf.lonestar.org> Date: Wed, 24 Jul 2019 12:35:10 -0400 In-Reply-To: <87ef2fbdcx.fsf_-_@sdf.lonestar.org> (Jakob L. Kreuze's message of "Wed, 24 Jul 2019 12:34:38 -0400") Message-ID: <87a7d3bdc1.fsf_-_@sdf.lonestar.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha256; protocol="application/pgp-signature" X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 36555 Cc: 36555@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= 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 | 262 ++++++++++++++++++++++++++++++++++++++ 2 files changed, 263 insertions(+) create mode 100644 gnu/tests/reconfigure.scm diff --git a/gnu/local.mk b/gnu/local.mk index eb3b0dcd3b..67faf72726 100644 =2D-- a/gnu/local.mk +++ b/gnu/local.mk @@ -597,6 +597,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 0000000000..3a2f0a2e53 =2D-- /dev/null +++ b/gnu/tests/reconfigure.scm @@ -0,0 +1,262 @@ +;;; 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))) + + ;; Return the names of the generation symlinks on MARIONETTE. + (define (system-generations 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))) + + ;; Return the Shepherd service file for SERVICE, after ensuring that it + ;; exists in the store. + (define (ensure-service-file service) + (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))) + + ;; Return the names of the running services on MARIONETTE. + (define (running-services 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 obsolete 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))) + + ;; Return the system generation paths that have GRUB menu entrie= s. + (define (generations-in-grub-cfg marionette) + (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----- iQIzBAEBCAAdFiEEa1VJLOiXAjQ2BGSm9Qb9Fp2P2VoFAl04iL4ACgkQ9Qb9Fp2P 2VomZA/9GytZWEx50J16q+uJfQhpk0Kl7oc0VJESNT4JaMvlMzVYqrVOkXbfvnZN 1vj+DktdtW0KSVd8laaKX4QEceyDQzmEeAeTp2VoAoJN4l8agJwe/o5sbH87B9Ws YaqyOTtCGz1Hkt+HpuYJFLWIZD+AiC63wEF4T6819dh9NTCInWcYb6+erS1U/zFd Dx96rFHJaYtKhb1E/lxmz1/5a/QgGz0S+eSQWXcqbQdUpVGxYgUJkUh1Lz5WrYTe SI9hEXEXeUjVbRQNxZTxk+oYHX4YPh/d/CYe8DRWudxpVUoWPBuE7uqhskJp1tFW oBWlSRAZJAcvUR1bz8dZkPB6ujNa+BsR4Q+LPgZMIdyl/25OouOiUeP0vU+T1dTr a4leTIzmdaTQwXLt8h1xImeo0wZdButPgrZFFfB3e+r+EZ1NYPE//UEn3HQzTT1T VgzGv49pGRTdoOaedzVl4zYhMdvnED1YwZWdP1Qjq9RejsEdHh4fNMAaFnw6y4Rp rGnZlSy/TErKXp9U49EN03M63+Tc/peHIkqor4Sm3M82TZ1/xC9HLdZzancl3aO5 j8lKE1DQrNckYeuHTGVC67uqRQRGffCASZbh1ehMFROrltbpjTOaF2zgaytVFdXi UWmyTRU/Giu4PA2oqwZ3huTHpRDQ0vgI9bMzqvrkBzBCNOyfwZQ= =dxqM -----END PGP SIGNATURE----- --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Wed Jul 24 18:44:21 2019 Received: (at 36555) by debbugs.gnu.org; 24 Jul 2019 22:44:21 +0000 Received: from localhost ([127.0.0.1]:38172 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hqPzh-0001qF-Iy for submit@debbugs.gnu.org; Wed, 24 Jul 2019 18:44:21 -0400 Received: from eggs.gnu.org ([209.51.188.92]:43406) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hqPza-0001px-B5 for 36555@debbugs.gnu.org; Wed, 24 Jul 2019 18:44:19 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:60487) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1hqPzV-0000I3-1L; Wed, 24 Jul 2019 18:44:09 -0400 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=48822 helo=ribbon) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1hqPzU-0006U3-Go; Wed, 24 Jul 2019 18:44:08 -0400 From: =?utf-8?Q?Ludovic_Court=C3=A8s?= To: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) Subject: Re: [bug#36555] [PATCH v4 3/3] tests: Add reconfigure system test. 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> <87muh9q51e.fsf_-_@sdf.lonestar.org> <87wogc4v6e.fsf@gnu.org> <87zhl69box.fsf@sdf.lonestar.org> <87o91kzana.fsf@gnu.org> <87blxk9u7k.fsf@sdf.lonestar.org> X-URL: http://www.fdn.fr/~lcourtes/ X-Revolutionary-Date: 7 Thermidor an 227 de la =?utf-8?Q?R=C3=A9volution?= X-PGP-Key-ID: 0x090B11993D9AEBB5 X-PGP-Key: http://www.fdn.fr/~lcourtes/ludovic.asc X-PGP-Fingerprint: 3CE4 6455 8A84 FDC6 9DB4 0CFB 090B 1199 3D9A EBB5 X-OS: x86_64-pc-linux-gnu Date: Thu, 25 Jul 2019 00:44:07 +0200 In-Reply-To: <87blxk9u7k.fsf@sdf.lonestar.org> (Jakob L. Kreuze's message of "Tue, 23 Jul 2019 20:01:19 -0400") Message-ID: <87wog7uk7c.fsf@gnu.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2 (gnu/linux) MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 36555 Cc: 36555@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) skribis: > Ludovic Court=C3=A8s writes: > >> I think you didn=E2=80=99t answer this specific question; thoughts? > > I had a peek at your more recent email, and think you dug up (and > commented on) my handling of it, but I'll link [1] just in case. Yup, sorry for the confusion! Ludo=E2=80=99. From debbugs-submit-bounces@debbugs.gnu.org Wed Jul 24 18:46:23 2019 Received: (at 36555) by debbugs.gnu.org; 24 Jul 2019 22:46:23 +0000 Received: from localhost ([127.0.0.1]:38176 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hqQ1f-0001th-2A for submit@debbugs.gnu.org; Wed, 24 Jul 2019 18:46:23 -0400 Received: from eggs.gnu.org ([209.51.188.92]:43687) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hqQ1e-0001tV-B0 for 36555@debbugs.gnu.org; Wed, 24 Jul 2019 18:46:22 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:60514) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1hqQ1Z-0001GC-51; Wed, 24 Jul 2019 18:46:17 -0400 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=48840 helo=ribbon) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1hqQ1Y-0006gG-OB; Wed, 24 Jul 2019 18:46:16 -0400 From: =?utf-8?Q?Ludovic_Court=C3=A8s?= To: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) Subject: Re: [bug#36555] [PATCH v5 2/3] guix system: Reimplement 'reconfigure'. References: <87imsci9sj.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> <87muh9q51e.fsf_-_@sdf.lonestar.org> <87wogc4v6e.fsf@gnu.org> <87zhl69box.fsf@sdf.lonestar.org> <87o91laojb.fsf_-_@sdf.lonestar.org> <87k1c9aofq.fsf_-_@sdf.lonestar.org> <87ftmxaodv.fsf_-_@sdf.lonestar.org> <87ftmwz8mc.fsf@gnu.org> <877e889tyj.fsf@sdf.lonestar.org> <87tvbc8dgi.fsf@sdf.lonestar.org> X-URL: http://www.fdn.fr/~lcourtes/ X-Revolutionary-Date: 7 Thermidor an 227 de la =?utf-8?Q?R=C3=A9volution?= X-PGP-Key-ID: 0x090B11993D9AEBB5 X-PGP-Key: http://www.fdn.fr/~lcourtes/ludovic.asc X-PGP-Fingerprint: 3CE4 6455 8A84 FDC6 9DB4 0CFB 090B 1199 3D9A EBB5 X-OS: x86_64-pc-linux-gnu Date: Thu, 25 Jul 2019 00:46:15 +0200 In-Reply-To: <87tvbc8dgi.fsf@sdf.lonestar.org> (Jakob L. Kreuze's message of "Tue, 23 Jul 2019 20:48:29 -0400") Message-ID: <87pnlzuk3s.fsf@gnu.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2 (gnu/linux) MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 36555 Cc: 36555@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) skribis: > zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) writes: > >> Whoops! It would definitely not be good to report "failed to install >> bootloader" for unrelated issues. I'll look into moving the handling >> into the call sites. Perhaps I can make a more general version of >> 'with-shepherd-error-handling'? > > I ran a few experiments with the Monad API and realized that this is > going to be far easier than I had originally thought. In fact, I've > already made what I believe to be the necessary changes to the code, I > just need to test it out. Expect the update to this patch to be done by > tomorrow morning -- I'm having trouble staying awake at my keyboard. Awesome. Something along the lines of =E2=80=98with-shepherd-error-handlin= g=E2=80=99 sounds great. Thanks! Ludo=E2=80=99. From debbugs-submit-bounces@debbugs.gnu.org Fri Jul 26 13:00:03 2019 Received: (at 36555-done) by debbugs.gnu.org; 26 Jul 2019 17:00:04 +0000 Received: from localhost ([127.0.0.1]:43298 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hr3Zb-0008Nj-EQ for submit@debbugs.gnu.org; Fri, 26 Jul 2019 13:00:03 -0400 Received: from eggs.gnu.org ([209.51.188.92]:59840) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hr3ZZ-0008Mj-Bi for 36555-done@debbugs.gnu.org; Fri, 26 Jul 2019 13:00:01 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:53011) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1hr3ZT-0005RS-MK; Fri, 26 Jul 2019 12:59:55 -0400 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=32810 helo=ribbon) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1hr3ZS-0000eT-3X; Fri, 26 Jul 2019 12:59:54 -0400 From: =?utf-8?Q?Ludovic_Court=C3=A8s?= To: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) Subject: Re: [bug#36555] [PATCH v6 3/3] tests: Add reconfigure system test. References: <87imsci9sj.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> <87muh9q51e.fsf_-_@sdf.lonestar.org> <87wogc4v6e.fsf@gnu.org> <87zhl69box.fsf@sdf.lonestar.org> <87o91laojb.fsf_-_@sdf.lonestar.org> <87k1c9aofq.fsf_-_@sdf.lonestar.org> <87ftmxaodv.fsf_-_@sdf.lonestar.org> <87ftmwz8mc.fsf@gnu.org> <877e889tyj.fsf@sdf.lonestar.org> <87tvbc8dgi.fsf@sdf.lonestar.org> <87muh3bdf4.fsf_-_@sdf.lonestar.org> <87imrrbddx.fsf_-_@sdf.lonestar.org> <87ef2fbdcx.fsf_-_@sdf.lonestar.org> <87a7d3bdc1.fsf_-_@sdf.lonestar.org> X-URL: http://www.fdn.fr/~lcourtes/ X-Revolutionary-Date: 8 Thermidor an 227 de la =?utf-8?Q?R=C3=A9volution?= X-PGP-Key-ID: 0x090B11993D9AEBB5 X-PGP-Key: http://www.fdn.fr/~lcourtes/ludovic.asc X-PGP-Fingerprint: 3CE4 6455 8A84 FDC6 9DB4 0CFB 090B 1199 3D9A EBB5 X-OS: x86_64-pc-linux-gnu Date: Fri, 26 Jul 2019 18:59:50 +0200 In-Reply-To: <87a7d3bdc1.fsf_-_@sdf.lonestar.org> (Jakob L. Kreuze's message of "Wed, 24 Jul 2019 12:35:10 -0400") Message-ID: <87wog4k9yx.fsf@gnu.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 36555-done Cc: 36555-done@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Hi there! I=E2=80=99ve applied the whole series with the change below. \o/ Because of the monadic style, the =E2=80=98guard=E2=80=99 clause had no eff= ect: --8<---------------cut here---------------start------------->8--- scheme@(guile-user)> ,run-in-store (guard (c (#t 'caught)) (mbegin %store-m= onad (return 1)(return (raise (condition (&message (message "oh!"))))))) While executing meta-command: Throw to key `srfi-34' with args `(#)'. --8<---------------cut here---------------end--------------->8--- I thought about adding it in some other way, but it turns out not to be needed at all because error conditions are guarded against in =E2=80=98guix-system=E2=80=99. Hence the patch. Thank you for the hard work on this series! I=E2=80=99ll be away from keyboard roughly until August 17th. Hopefully yo= u can get feedback from David or Chris, and maybe you can get others on board as well. :-) If my opinion on changes to the core is needed, you can always push to a separate branch in the meantime. Anyway, I=E2=80=99m conf= ident! Ludo=E2=80=99. --=-=-= Content-Type: text/x-patch Content-Disposition: inline diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 115da665b4..9fc3a10e98 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -804,19 +804,16 @@ static checks." ((reconfigure) (newline) (format #t (G_ "activating system...~%")) - (guard (c ((message-condition? c) - (leave (G_ "failed to reconfigure system:~%~a~%") - (condition-message c)))) - (mbegin %store-monad - (switch-to-system local-eval os) - (mwhen install-bootloader? - (install-bootloader local-eval bootloader bootcfg - #:target (or target "/")) - (return - (info (G_ "bootloader successfully installed on '~a'~%") - (bootloader-configuration-target bootloader)))) - (with-shepherd-error-handling - (upgrade-shepherd-services local-eval os))))) + (mbegin %store-monad + (switch-to-system local-eval os) + (mwhen install-bootloader? + (install-bootloader local-eval bootloader bootcfg + #:target (or target "/")) + (return + (info (G_ "bootloader successfully installed on '~a'~%") + (bootloader-configuration-target bootloader)))) + (with-shepherd-error-handling + (upgrade-shepherd-services local-eval os)))) ((init) (newline) (format #t (G_ "initializing operating system under '~a'...~%") --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Fri Jul 26 13:56:17 2019 Received: (at 36555-done) by debbugs.gnu.org; 26 Jul 2019 17:56:17 +0000 Received: from localhost ([127.0.0.1]:43326 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hr4Rl-0001Gv-Vq for submit@debbugs.gnu.org; Fri, 26 Jul 2019 13:56:17 -0400 Received: from ol.sdf.org ([205.166.94.20]:51379 helo=mx.sdf.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hr4Ri-0001GS-7j for 36555-done@debbugs.gnu.org; Fri, 26 Jul 2019 13:56:00 -0400 Received: from Epsilon (pool-173-76-53-40.bstnma.fios.verizon.net [173.76.53.40]) (authenticated (0 bits)) by mx.sdf.org (8.15.2/8.14.5) with ESMTPSA id x6QHtmJ8018934 (using TLSv1.2 with cipher AES256-GCM-SHA384 (256 bits) verified NO); Fri, 26 Jul 2019 17:55:54 GMT From: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) To: Ludovic =?utf-8?Q?Court=C3=A8s?= Subject: Re: [bug#36555] [PATCH v6 3/3] tests: Add reconfigure system test. References: <87imsci9sj.fsf@sdf.lonestar.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> <87muh9q51e.fsf_-_@sdf.lonestar.org> <87wogc4v6e.fsf@gnu.org> <87zhl69box.fsf@sdf.lonestar.org> <87o91laojb.fsf_-_@sdf.lonestar.org> <87k1c9aofq.fsf_-_@sdf.lonestar.org> <87ftmxaodv.fsf_-_@sdf.lonestar.org> <87ftmwz8mc.fsf@gnu.org> <877e889tyj.fsf@sdf.lonestar.org> <87tvbc8dgi.fsf@sdf.lonestar.org> <87muh3bdf4.fsf_-_@sdf.lonestar.org> <87imrrbddx.fsf_-_@sdf.lonestar.org> <87ef2fbdcx.fsf_-_@sdf.lonestar.org> <87a7d3bdc1.fsf_-_@sdf.lonestar.org> <87wog4k9yx.fsf@gnu.org> Date: Fri, 26 Jul 2019 13:53:03 -0400 In-Reply-To: <87wog4k9yx.fsf@gnu.org> ("Ludovic \=\?utf-8\?Q\?Court\=C3\=A8s\=22'\?\= \=\?utf-8\?Q\?s\?\= message of "Fri, 26 Jul 2019 18:59:50 +0200") Message-ID: <87imrolm2o.fsf@sdf.lonestar.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/signed; boundary="==-=-="; micalg=pgp-sha256; protocol="application/pgp-signature" X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 36555-done Cc: 36555-done@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --==-=-= Content-Type: multipart/mixed; boundary="=-=-=" --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Hi Ludo, Ludovic Court=C3=A8s writes: > Hi there! > > I=E2=80=99ve applied the whole series with the change below. \o/ Awesome, thank you! > Because of the monadic style, the =E2=80=98guard=E2=80=99 clause had no e= ffect: > > scheme@(guile-user)> ,run-in-store (guard (c (#t 'caught)) (mbegin %store= -monad (return 1)(return (raise (condition (&message (message "oh!"))))))) > While executing meta-command: > Throw to key `srfi-34' with args `(#)'. My thoughts were similar when I was working on earlier versions of this series, so I had devised the following snippet: --=-=-= Content-Type: text/plain Content-Disposition: inline; filename=example.scm (use-modules (guix monads) (guix store) (srfi srfi-34) (srfi srfi-35)) (define (monadic-procedure) (catch #t (lambda () (guard (c ((message-condition? c) (format (current-error-port) "error: ~a~%" (condition-message c)) (throw c))) (mbegin %store-monad (return (raise (condition (&message (message "Bogus error")))))))) (lambda _ (mbegin %store-monad (return (format #t "Error was caught~%")))))) (with-store store (run-with-store store (monadic-procedure))) --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Which, when run, outputs the following: jakob@Epsilon ~ $ guile example.scm error: Bogus error Error was caught I have a fairly weak understanding of monads, how they're implemented in Guix, and how exception handling works in Guile, so I'm not entirely sure why one example works and the other doesn't. Either way, > I thought about adding it in some other way, but it turns out not to > be needed at all because error conditions are guarded against in > =E2=80=98guix-system=E2=80=99. Hence the patch. I suppose that, in that case, we don't really need to worry about it. > Thank you for the hard work on this series! And thank you for all of the code review you've done :) > I=E2=80=99ll be away from keyboard roughly until August 17th. Hopefully y= ou > can get feedback from David or Chris, and maybe you can get others on > board as well. :-) If my opinion on changes to the core is needed, you > can always push to a separate branch in the meantime. Anyway, I=E2=80=99m > confident! Sounds good. Take care, Ludo! Regards, Jakob --=-=-=-- --==-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQIzBAEBCAAdFiEEa1VJLOiXAjQ2BGSm9Qb9Fp2P2VoFAl07Pf8ACgkQ9Qb9Fp2P 2VrIWg//V1avkkBnXtlTTiZyMaCWpU6wh/S+7lfXJROs9X783yvNoR0HIFxk7otQ gPApV8I6LMFqZ/slSntvgF5D6wvm/AlLf9fkSdW9RHU2uNZO2ttgVxNn9NHwGoDJ EQcawe/LSOhk/4BSJj9qaOnS05vicc2uZPd1rtwfnN8AIZB/x95czrynWRcdU/c3 xV2KliCp6K1iO5VoEqC48kAS48iwqmVsYuA/73INaKs69N9P3PkKycNz4lW5Zw/H 7/z6CoXm67JSQnz9w7eJ9guMU8SIki/TdMD8ewl2dZ6o54QTCUAF8z/xn3C8X1Mo ab0nrIdMUUNIpmuW6OofWCF8sR5Ni07UxyKmDTs2CiuJn554lRXNZM0s336wKh+G jTQYf3HD/zt2X9CQ8/1ARsB5scEeSwKvMV1HOFujaBX21+kq5UFgrRrs5JszoEz+ VfaCF4MUDKKkQDEIhVvrcI5TbrwEhzEyH7sprKCDw9Vblnr9fS9gyMZRiGnW5cuL BFDpDP0QD/X6KfWjyUYFYWalftmz9T1VzG6LG4ZNoG65Rznk5KPFl94t7vZGeiKF RIXgW3/dY/jNv7DYCfzcBoFYdYtDoFY50Z6rrlZ2cbdUzaUxDBXkAgGJU+o97ccg n38WnP+wTvHc0ZKO3dapaTv3JapbD7coWwMAezfiIRbRP/3W1qQ= =Fvuv -----END PGP SIGNATURE----- --==-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Tue Jul 30 12:58:16 2019 Received: (at 36555) by debbugs.gnu.org; 30 Jul 2019 16:58:16 +0000 Received: from localhost ([127.0.0.1]:51090 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hsVS3-0004tl-Tw for submit@debbugs.gnu.org; Tue, 30 Jul 2019 12:58:16 -0400 Received: from mx.sdf.org ([205.166.94.20]:50734) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hsVS2-0004tY-Ct for 36555@debbugs.gnu.org; Tue, 30 Jul 2019 12:58:14 -0400 Received: from Epsilon (pool-173-76-53-40.bstnma.fios.verizon.net [173.76.53.40]) (authenticated (0 bits)) by mx.sdf.org (8.15.2/8.14.5) with ESMTPSA id x6UGwC7q012757 (using TLSv1.2 with cipher AES256-GCM-SHA384 (256 bits) verified NO); Tue, 30 Jul 2019 16:58:13 GMT From: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) To: Ludovic =?utf-8?Q?Court=C3=A8s?= Subject: Re: [bug#36555] [PATCH v4 1/3] guix system: Add 'reconfigure' module. 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> <874l3g7p9h.fsf@gnu.org> Date: Tue, 30 Jul 2019 12:55:18 -0400 In-Reply-To: <874l3g7p9h.fsf@gnu.org> ("Ludovic \=\?utf-8\?Q\?Court\=C3\=A8s\=22'\?\= \=\?utf-8\?Q\?s\?\= message of "Sat, 20 Jul 2019 16:29:46 +0200") Message-ID: <87v9vjv4w9.fsf@sdf.lonestar.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha256; protocol="application/pgp-signature" X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 36555 Cc: 36555@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Hi Ludovic, Ludovic Court=C3=A8s writes: > I wonder it we should just use > > #~(begin (use-modules (guix build utils)) (invoke =E2=80=A6)) > > here and in other places. > > That=E2=80=99s probably better longer-term (for example when we switch to > Guile=C2=A03, that could ease the transition since the right Guile would = be > used) but we can keep it this way and revisit it later. I've been playing with this for a little while now, and I'm having second thoughts regarding the use of 'invoke'. Any exceptions thrown in the callee are swallowed into an '&invoke-error', so context for failure in i.e. the activation script is lost. Also, does it really matter that the "right" Guile is being used for the activation scripts if the daemon is still going to be running the old Guile? WDYT? Regards, Jakob --=-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQIzBAEBCAAdFiEEa1VJLOiXAjQ2BGSm9Qb9Fp2P2VoFAl1AdnYACgkQ9Qb9Fp2P 2VrKiA//WbZ7AUTHpEz7ov2kBJ2DfXMoTvqCCYrjLLS8+TpbqO6tyiG5bI1CmPe5 vpqhI++YP1WLQSunk7tmYhUoHNMWiHXPN5VTFEseS49lNp/riyq1yoiMhnDw6+LI xwJVBGCt52ri8HUc+GeQGUXsukIUHemBGIXmTvzDJdk8httzsyHnq/P+bPDHwIzU XVlEXqDXEiARvnSOetU5xAh8L8w5QsfL4BXvWlIS4mh1gK2li85w8ry7Ctx4UtVP fxECek7IeHtfLlYTWYE9qnjlD+ZYPLNJjcvL2JVx9n5Tte2eXb0dJmdCYPoHfrpf 05Q0sBu8q5YiyNg6Wm+gcF8v3QnUHwZfHqdIvEtDq+P68KxijbysyNR0ZOqUJur/ mSbV7Ko5Hc7WdngUDrLBi2umewEU2VyQr6ZXS/vJkY3g1pkxd3E23DTmv1psiVyp OzjSFAHPW+5+/KVB/dFIVhvQsiFIFNFYrrQdiEJDOoShqpM82F/DzeA/Zo3NjuQl kruMZLzsVC+W7ogCOkF/TNrT6vSTau1/ug8DozOGiGeWiUWUVBxaCcSiZDT2zBQm eKuKsL2dlqV6cXYetN4zfmAtHAZ94cQTK+Sl4Csw6pu8mWjybZAtPnPasY0XkAVe kejJ855CPrADeNJayafhmBHFJJtA81wHQZ5FDsyYlUF+VaPmjEo= =yDhe -----END PGP SIGNATURE----- --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Fri Aug 23 17:01:08 2019 Received: (at 36555) by debbugs.gnu.org; 23 Aug 2019 21:01:08 +0000 Received: from localhost ([127.0.0.1]:41305 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1i1GgF-00024y-DG for submit@debbugs.gnu.org; Fri, 23 Aug 2019 17:01:08 -0400 Received: from eggs.gnu.org ([209.51.188.92]:51901) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1i1GgC-0001xS-4p for 36555@debbugs.gnu.org; Fri, 23 Aug 2019 17:01:05 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:51099) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1i1Gg6-0001zN-Jz; Fri, 23 Aug 2019 17:00:58 -0400 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=52748 helo=ribbon) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1i1Gg6-0008EE-0g; Fri, 23 Aug 2019 17:00:58 -0400 From: =?utf-8?Q?Ludovic_Court=C3=A8s?= To: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) Subject: Re: [bug#36555] [PATCH v4 1/3] guix system: Add 'reconfigure' module. 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> <874l3g7p9h.fsf@gnu.org> <87v9vjv4w9.fsf@sdf.lonestar.org> X-URL: http://www.fdn.fr/~lcourtes/ X-Revolutionary-Date: 6 Fructidor an 227 de la =?utf-8?Q?R=C3=A9volution?= X-PGP-Key-ID: 0x090B11993D9AEBB5 X-PGP-Key: http://www.fdn.fr/~lcourtes/ludovic.asc X-PGP-Fingerprint: 3CE4 6455 8A84 FDC6 9DB4 0CFB 090B 1199 3D9A EBB5 X-OS: x86_64-pc-linux-gnu Date: Fri, 23 Aug 2019 23:00:56 +0200 In-Reply-To: <87v9vjv4w9.fsf@sdf.lonestar.org> (Jakob L. Kreuze's message of "Tue, 30 Jul 2019 12:55:18 -0400") Message-ID: <87ftlr1trr.fsf@gnu.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2 (gnu/linux) MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 36555 Cc: 36555@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) Hi, zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) skribis: > Ludovic Court=C3=A8s writes: > >> I wonder it we should just use >> >> #~(begin (use-modules (guix build utils)) (invoke =E2=80=A6)) >> >> here and in other places. >> >> That=E2=80=99s probably better longer-term (for example when we switch to >> Guile=C2=A03, that could ease the transition since the right Guile would= be >> used) but we can keep it this way and revisit it later. > > I've been playing with this for a little while now, and I'm having > second thoughts regarding the use of 'invoke'. Any exceptions thrown in > the callee are swallowed into an '&invoke-error', so context for failure > in i.e. the activation script is lost. Also, does it really matter that > the "right" Guile is being used for the activation scripts if the daemon > is still going to be running the old Guile? WDYT? I guess it only matters in corner cases=E2=80=94i.e., when switching Guiles. And even then, we=E2=80=99re probably still able to evaluate code, so you= =E2=80=99re right that it=E2=80=99s not that big a deal. And yeah, losing execution context isn=E2=80=99t great. So maybe the status quo is not so bad after all! Ludo=E2=80=99. From unknown Thu Jun 19 14:06:26 2025 Received: (at fakecontrol) by fakecontrolmessage; To: internal_control@debbugs.gnu.org From: Debbugs Internal Request Subject: Internal Control Message-Id: bug archived. Date: Sat, 21 Sep 2019 11:24:06 +0000 User-Agent: Fakemail v42.6.9 # This is a fake control message. # # The action: # bug archived. thanks # This fakemail brought to you by your local debbugs # administrator