From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([2001:470:142:3::10]:42333) by lists.gnu.org with esmtp (Exim 4.86_2) (envelope-from ) id 1hjXvw-0007Oo-Py for guix-patches@gnu.org; Fri, 05 Jul 2019 19:48:06 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1hjXvu-0005Md-J8 for guix-patches@gnu.org; Fri, 05 Jul 2019 19:48:04 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:45166) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1hjXvu-0005MX-FY for guix-patches@gnu.org; Fri, 05 Jul 2019 19:48:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1hjXvu-0007do-AP for guix-patches@gnu.org; Fri, 05 Jul 2019 19:48:02 -0400 Subject: [bug#36404] [PATCH 1/3] guix system: Add 'reconfigure' module. Resent-Message-ID: From: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) References: <87o92ianbj.fsf@sdf.lonestar.org> <87o92glap5.fsf@dustycloud.org> <878sthoqzi.fsf@gnu.org> <87r2799tzd.fsf@sdf.lonestar.org> <87d0isrsmk.fsf@sdf.lonestar.org> <878std3fw0.fsf@sdf.lonestar.org> <87wogwoqrg.fsf@gnu.org> <87bly8f3kq.fsf_-_@sdf.lonestar.org> Date: Fri, 05 Jul 2019 19:46:44 -0400 In-Reply-To: <87bly8f3kq.fsf_-_@sdf.lonestar.org> (Jakob L. Kreuze's message of "Fri, 05 Jul 2019 19:45:41 -0400") Message-ID: <877e8wf3iz.fsf_-_@sdf.lonestar.org> MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha256; protocol="application/pgp-signature" List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+kyle=kyleam.com@gnu.org Sender: "Guix-patches" To: Ludovic =?UTF-8?Q?Court=C3=A8s?= Cc: 36404@debbugs.gnu.org --=-=-= 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. =2D-- Makefile.am | 1 + guix/scripts/system.scm | 1 + guix/scripts/system/reconfigure.scm | 157 ++++++++++++++++++++++++++++ 3 files changed, 159 insertions(+) create mode 100644 guix/scripts/system/reconfigure.scm diff --git a/Makefile.am b/Makefile.am index 4d3024e58..1934a21b1 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/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..f4ca6b4b1 =2D-- /dev/null +++ b/guix/scripts/system/reconfigure.scm @@ -0,0 +1,157 @@ +;;; 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 (guix scripts system reconfigure) + #:autoload (gnu packages gnupg) (guile-gcrypt) + #:use-module (guix gexp) + #:use-module (guix modules) + #:export (switch-to-system + upgrade-shepherd-services + 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: + +(define (switch-to-system system-derivation activation-script) + "Return a G-Expression that, upon being evaluated, will create a new +generation for SYSTEM-DERIVATION and execute ACTIVATION-SCRIPT." + (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* ((system #$system-derivation) + (number (1+ (generation-number %system-profile))) + (generation (generation-file-name %system-profile number)= )) + (switch-symlinks generation system) + (switch-symlinks %system-profile generation) + ;; The implementation of 'guix system reconfigure' saves the + ;; load path and environment here. This is unnecessary here + ;; because each invocation of 'remote-eval' runs in a distinct + ;; Guile REPL. + (setenv "GUIX_NEW_SYSTEM" system) + ;; The activation script may write to stdout, which confuses + ;; 'remote-eval' when it attempts to read a result from the + ;; remote REPL. We work around this by forcing the output to a + ;; string. + (with-output-to-string + (lambda () + (primitive-load #$activation-script)))))))) + +;; XXX: Currently, this does NOT attempt to restart running services. See +;; for details. +(define (upgrade-shepherd-services target-services) + "Return a G-Expression that, upon being evaluated, will use TARGET-SERVI= CES, +a list of (shepherd-service-canonical-name, shepherd-service-file) pairs to +determine which services are obsolete and need to be unloaded, as well as +which services are new and need to be started." + (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 installer-script bootcfg bootcfg-file target) + "Return a G-Expression that, upon being evaluated, will install BOOTCFG = to +BOOTCFG-FILE, a target path, on TARGET, a mount point, and subsequently run +INSTALLER-SCRIPT." + (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 "/bootcfg= ")) + (temp-gc-root (string-append gc-root ".new"))) + + (switch-symlinks temp-gc-root gc-root) + + (unless (false-if-exception + (begin + ;; The implementation of 'guix system reconfigure' + ;; saves the load path here. This is unnecessary he= re + ;; because each invocation of 'remote-eval' runs in= a + ;; distinct Guile REPL. + (install-boot-config #$bootcfg #$bootcfg-file #$tar= get) + ;; The installation script may write to stdout, whi= ch + ;; confuses 'remote-eval' when it attempts to read a + ;; result from the remote REPL. We work around this + ;; by forcing the output to a string. + (with-output-to-string + (lambda () + (primitive-load #$installer-script))))) + (delete-file temp-gc-root) + (error "failed to install bootloader")) + + (rename-file temp-gc-root gc-root)))))) =2D-=20 2.22.0 --=-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQIzBAEBCAAdFiEEa1VJLOiXAjQ2BGSm9Qb9Fp2P2VoFAl0f4WQACgkQ9Qb9Fp2P 2Vo9Hw/+KM7O6w9UYcD/ts2eVeOj2PiJtd3GMRWHP+k+AUUk4dqGV2IujmTx0eWK ZlWMahR19Xvf+HXSUF3RuJU2d2zhgb2Rtk8QjTFXYUPouSVn2nPekFySK57JkG4V MIN0ijzqGoudzx5letv0wJoPqb/fpfaDdZF1CzAwDLY91l7sCz/V04LN67N0LPLU /XXaL5vgAzNdFV5oC3Dg0Mt7tNFho6O0pwtRaJ5jbUwpPUo0fV3WX9BEU8idNXRX v1uh8Lz1v8CLNxneunOSAcQkcY8NGzuawLWM7r0vDqBScz/bb68yRBpDzdTpR/8Y +kTcV8eM2kwchiP2LPpq9b4YNji7/rUxbdAnpshWn9IamZoOY+hLtdo7W+mvmOKz lEFcIs7h43pWrQQ3re/1AhTc+O+vOGC5qJ+nvduoAGXVKFy/TvaiX9irt6SUqBrZ yozjeOjpqfoon5KmsAF0cxkbFZLQoDZMve8xW7aQoKPClxHem6Ny0rPISm8DCV8A mYtHVbHoxlNPL8wd8/DT4T5c4EqOEEzuxStpSJTu2+4LmJ7df+GLdbmKjP/1Qusg vTKGjjRI7ZemccTMJSOcygUbwrvye0uVIa10Jv2OGq4sioE7kJBFw/856r13/vhq urFO2yxsgTZijI0sdvgeTcaQtDyHLQH2U1Qn47SsSuajVzELR9M= =0KCQ -----END PGP SIGNATURE----- --=-=-=--