From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([2001:470:142:3::10]:44489) by lists.gnu.org with esmtp (Exim 4.86_2) (envelope-from ) id 1hkZpt-0006Qx-0Q for guix-patches@gnu.org; Mon, 08 Jul 2019 16:02:07 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1hkZpr-0006c9-6i for guix-patches@gnu.org; Mon, 08 Jul 2019 16:02:04 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:50803) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1hkZpq-0006bx-Na for guix-patches@gnu.org; Mon, 08 Jul 2019 16:02:03 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1hkZpq-0004OD-Jm for guix-patches@gnu.org; Mon, 08 Jul 2019 16:02:02 -0400 Subject: [bug#36555] [PATCH 2/2] guix system: Reimplement 'reconfigure'. Resent-Message-ID: From: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) 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> 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: 36555@debbugs.gnu.org --=-=-= 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----- --=-=-=--