@@ -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."
(return *unspecified*)))
-(define* (install-bootloader installer
- #:key
- bootcfg bootcfg-file
- target)
+(define (install-bootloader installer bootcfg bootcfg-file target)
"Run INSTALLER, a bootloader installation script, with error handling, in
%STORE-MONAD."
- (mlet %store-monad ((installer-drv (if installer
- (lower-object installer)
- (return #f)))
- (bootcfg (lower-object bootcfg)))
- (let* ((gc-root (string-append target %gc-roots-directory
- "/bootcfg"))
- (temp-gc-root (string-append gc-root ".new"))
- (install (and installer-drv
- (derivation->output-path installer-drv)))
- (bootcfg (derivation->output-path bootcfg)))
- ;; Prepare the symlink to bootloader config file to make sure that it's
- ;; a GC root when 'installer-drv' completes (being a bit paranoid.)
- (switch-symlinks temp-gc-root bootcfg)
-
- (unless (false-if-exception
- (begin
- (install-boot-config bootcfg bootcfg-file target)
- (when install
- (save-load-path-excursion (primitive-load install)))))
- (delete-file temp-gc-root)
- (leave (G_ "failed to install bootloader ~a~%") install))
-
- ;; Register bootloader config file as a GC root so that its dependencies
- ;; (background image, font, etc.) are not reclaimed.
- (rename-file temp-gc-root gc-root)
- (return #t))))
+ (mlet* %store-monad ((script (install-bootloader-program installer bootcfg
+ bootcfg-file target))
+ (file (lower-object script))
+ (_ (built-derivations (list file))))
+ (primitive-load (derivation->output-path file))))
(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)
(mwhen install-bootloader?
- (install-bootloader bootloader-installer
- #:bootcfg bootcfg
- #:bootcfg-file bootcfg-file
- #:target target))))))
+ (install-bootloader bootloader-installer bootcfg
+ bootcfg-file target))))))
;;;
@@ -348,69 +323,27 @@ bring the system down."
(fold-services (operating-system-services os)
#:target-type shepherd-root-service-type)))
- ;; Arrange to simply emit a warning if the service upgrade fails.
- (with-shepherd-error-handling
- (call-with-service-upgrade-info new-services
- (lambda (to-restart to-unload)
- (for-each (lambda (unload)
- (info (G_ "unloading service '~a'...~%") unload)
- (unload-service unload))
- to-unload)
-
- (with-monad %store-monad
- (munless (null? new-services)
- (let ((new-service-names (map shepherd-service-canonical-name new-services))
- (to-restart-names (map shepherd-service-canonical-name to-restart))
- (to-start (filter shepherd-service-auto-start? new-services)))
- (info (G_ "loading new services:~{ ~a~}...~%") new-service-names)
- (unless (null? to-restart-names)
- ;; Listing TO-RESTART-NAMES in the message below wouldn't help
- ;; because many essential services cannot be meaningfully
- ;; restarted. See <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=22039#30>.
- (format #t (G_ "To complete the upgrade, run 'herd restart SERVICE' to stop,
-upgrade, and restart each service that was not automatically restarted.\n")))
- (mlet %store-monad ((files (mapm %store-monad
- (compose lower-object
- shepherd-service-file)
- new-services)))
- ;; Here we assume that FILES are exactly those that were computed
- ;; as part of the derivation that built OS, which is normally the
- ;; case.
- (load-services/safe (map derivation->output-path files))
-
- (for-each start-service
- (map shepherd-service-canonical-name to-start))
- (return #t)))))))))
-
-(define* (switch-to-system os
- #:optional (profile %system-profile))
- "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 ((drv (operating-system-derivation os))
- (script (lower-object (operating-system-activation-script os))))
- (let* ((system (derivation->output-path drv))
- (number (+ 1 (generation-number profile)))
- (generation (generation-file-name profile number)))
- (switch-symlinks generation system)
- (switch-symlinks profile generation)
-
- (format #t (G_ "activating system...~%"))
-
- ;; The activation script may change $PATH, among others, so protect
- ;; against that.
- (save-environment-excursion
- ;; Tell 'activate-current-system' what the new system is.
- (setenv "GUIX_NEW_SYSTEM" system)
-
- ;; The activation script may modify '%load-path' & co., so protect
- ;; against that. This is necessary to ensure that
- ;; 'upgrade-shepherd-services' gets to see the right modules when it
- ;; computes derivations with 'gexp->derivation'.
- (save-load-path-excursion
- (primitive-load (derivation->output-path script))))
-
- ;; Finally, try to update system services.
- (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-service
+ new-services))
+ (script (upgrade-services-program target-services))
+ (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))))
(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 installer is
;; provided here.
- (install-bootloader #f
- #:bootcfg bootcfg
- #:bootcfg-file bootcfg-file
- #:target target))))))
+ (install-bootloader #f bootcfg bootcfg-file target))))))
;;;
@@ -920,11 +850,10 @@ static checks."
((reconfigure)
(mbegin %store-monad
(switch-to-system os)
+ (upgrade-shepherd-services os)
(mwhen install-bootloader?
- (install-bootloader bootloader-script
- #:bootcfg bootcfg
- #:bootcfg-file bootcfg-file
- #:target "/"))))
+ (install-bootloader bootloader-script bootcfg
+ bootcfg-file (or target "/")))))
((init)
(newline)
(format #t (G_ "initializing operating system under '~a'...~%")