From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([2001:470:142:3::10]:51290) by lists.gnu.org with esmtp (Exim 4.86_2) (envelope-from ) id 1hpdXc-0006cN-SI for guix-patches@gnu.org; Mon, 22 Jul 2019 15:00:10 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1hpdXa-0001Dh-Sg for guix-patches@gnu.org; Mon, 22 Jul 2019 15:00:08 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:53054) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1hpdXX-0001BW-90 for guix-patches@gnu.org; Mon, 22 Jul 2019 15:00:04 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1hpdXX-0007Qt-2b for guix-patches@gnu.org; Mon, 22 Jul 2019 15:00:03 -0400 Subject: [bug#36555] [PATCH v5 2/3] 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> <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> MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha256; protocol="application/pgp-signature" List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+kyle=kyleam.com@gnu.org Sender: "Guix-patches" To: Ludovic =?UTF-8?Q?Court=C3=A8s?= Cc: 36555@debbugs.gnu.org --=-=-= Content-Type: text/plain 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----- --=-=-=--