From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([2001:470:142:3::10]:59561) by lists.gnu.org with esmtp (Exim 4.86_2) (envelope-from ) id 1hkvV8-0003sD-FP for guix-patches@gnu.org; Tue, 09 Jul 2019 15:10:08 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1hkvV6-0004R5-2o for guix-patches@gnu.org; Tue, 09 Jul 2019 15:10:06 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:53694) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1hkvV4-0004Pe-78 for guix-patches@gnu.org; Tue, 09 Jul 2019 15:10:03 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1hkvV4-00049D-1J for guix-patches@gnu.org; Tue, 09 Jul 2019 15:10:02 -0400 Subject: [bug#36555] [PATCH v2 2/3] guix system: Reimplement 'reconfigure'. Resent-Message-ID: From: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) 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> 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: Christopher Lemmer Webber Cc: 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 | 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----- --=-=-=--