guix system: Load all services on reconfigure, not just stopped ones.
This uses the 'replacement' service slot introduced in the Shepherd version 0.5.0. * gnu/services/shepherd.scm (shepherd-service-upgrade): Return a list of services that need to be restarted to complete their upgrade. * guix/scripts/system.scm (call-with-service-upgrade-info): Rename an internal variable to reflect the change to shepherd-service-upgrade. (upgrade-shepherd-services): Call 'load-services/safe' instead of 'load-services'. Print a message about services that need to be manually restarted. * gnu/services/herd.scm (load-services/safe): New procedure. * doc/guix.texi (Invoking guix system): Document the new behaviour. Co-authored-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
parent
9bd85a785f
commit
4245ddcbc9
|
@ -33,7 +33,7 @@ Copyright @copyright{} 2016 Alex ter Weele@*
|
||||||
Copyright @copyright{} 2017, 2018 Clément Lassieur@*
|
Copyright @copyright{} 2017, 2018 Clément Lassieur@*
|
||||||
Copyright @copyright{} 2017 Mathieu Othacehe@*
|
Copyright @copyright{} 2017 Mathieu Othacehe@*
|
||||||
Copyright @copyright{} 2017 Federico Beffa@*
|
Copyright @copyright{} 2017 Federico Beffa@*
|
||||||
Copyright @copyright{} 2017 Carlo Zancanaro@*
|
Copyright @copyright{} 2017, 2018 Carlo Zancanaro@*
|
||||||
Copyright @copyright{} 2017 Thomas Danckaert@*
|
Copyright @copyright{} 2017 Thomas Danckaert@*
|
||||||
Copyright @copyright{} 2017 humanitiesNerd@*
|
Copyright @copyright{} 2017 humanitiesNerd@*
|
||||||
Copyright @copyright{} 2017 Christopher Allan Webber@*
|
Copyright @copyright{} 2017 Christopher Allan Webber@*
|
||||||
|
@ -21920,9 +21920,9 @@ systems already running GuixSD.}.
|
||||||
This effects all the configuration specified in @var{file}: user
|
This effects all the configuration specified in @var{file}: user
|
||||||
accounts, system services, global package list, setuid programs, etc.
|
accounts, system services, global package list, setuid programs, etc.
|
||||||
The command starts system services specified in @var{file} that are not
|
The command starts system services specified in @var{file} that are not
|
||||||
currently running; if a service is currently running, it does not
|
currently running; if a service is currently running this command will
|
||||||
attempt to upgrade it since this would not be possible without stopping it
|
arrange for it to be upgraded the next time it is stopped (eg. by
|
||||||
first.
|
@code{herd stop X} or @code{herd restart X}).
|
||||||
|
|
||||||
This command creates a new generation whose number is one greater than
|
This command creates a new generation whose number is one greater than
|
||||||
the current generation (as reported by @command{guix system
|
the current generation (as reported by @command{guix system
|
||||||
|
|
|
@ -50,6 +50,7 @@
|
||||||
unload-services
|
unload-services
|
||||||
unload-service
|
unload-service
|
||||||
load-services
|
load-services
|
||||||
|
load-services/safe
|
||||||
start-service
|
start-service
|
||||||
stop-service))
|
stop-service))
|
||||||
|
|
||||||
|
@ -232,6 +233,25 @@ returns a shepherd <service> object."
|
||||||
`(primitive-load ,file))
|
`(primitive-load ,file))
|
||||||
files))))
|
files))))
|
||||||
|
|
||||||
|
(define (load-services/safe files)
|
||||||
|
"This is like 'load-services', but make sure only the subset of FILES that
|
||||||
|
can be safely reloaded is actually reloaded.
|
||||||
|
|
||||||
|
This is done to accommodate the Shepherd < 0.15.0 where services lacked the
|
||||||
|
'replacement' slot, and where 'register-services' would throw an exception
|
||||||
|
when passed a service with an already-registered name."
|
||||||
|
(eval-there `(let* ((services (map primitive-load ',files))
|
||||||
|
(slots (map slot-definition-name
|
||||||
|
(class-slots <service>)))
|
||||||
|
(can-replace? (memq 'replacement slots)))
|
||||||
|
(define (registered? service)
|
||||||
|
(not (null? (lookup-services (canonical-name service)))))
|
||||||
|
|
||||||
|
(apply register-services
|
||||||
|
(if can-replace?
|
||||||
|
services
|
||||||
|
(remove registered? services))))))
|
||||||
|
|
||||||
(define (start-service name)
|
(define (start-service name)
|
||||||
(with-shepherd-action name ('start) result
|
(with-shepherd-action name ('start) result
|
||||||
result))
|
result))
|
||||||
|
|
|
@ -1,6 +1,7 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2013, 2014, 2015, 2016, 2018 Ludovic Courtès <ludo@gnu.org>
|
;;; Copyright © 2013, 2014, 2015, 2016, 2018 Ludovic Courtès <ludo@gnu.org>
|
||||||
;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
|
;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
|
||||||
|
;;; Copyright © 2018 Carlo Zancanaro <carlo@zancanaro.id.au>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
|
@ -329,7 +330,7 @@ symbols provided/required by a service."
|
||||||
(define (shepherd-service-upgrade live target)
|
(define (shepherd-service-upgrade live target)
|
||||||
"Return two values: the subset of LIVE (a list of <live-service>) that needs
|
"Return two values: the subset of LIVE (a list of <live-service>) that needs
|
||||||
to be unloaded, and the subset of TARGET (a list of <shepherd-service>) that
|
to be unloaded, and the subset of TARGET (a list of <shepherd-service>) that
|
||||||
needs to be loaded."
|
need to be restarted to complete their upgrade."
|
||||||
(define (essential? service)
|
(define (essential? service)
|
||||||
(memq (first (live-service-provision service))
|
(memq (first (live-service-provision service))
|
||||||
'(root shepherd)))
|
'(root shepherd)))
|
||||||
|
@ -346,12 +347,6 @@ needs to be loaded."
|
||||||
(and=> (lookup-live (shepherd-service-canonical-name service))
|
(and=> (lookup-live (shepherd-service-canonical-name service))
|
||||||
live-service-running))
|
live-service-running))
|
||||||
|
|
||||||
(define (stopped service)
|
|
||||||
(match (lookup-live (shepherd-service-canonical-name service))
|
|
||||||
(#f #f)
|
|
||||||
(service (and (not (live-service-running service))
|
|
||||||
service))))
|
|
||||||
|
|
||||||
(define live-service-dependents
|
(define live-service-dependents
|
||||||
(shepherd-service-back-edges live
|
(shepherd-service-back-edges live
|
||||||
#:provision live-service-provision
|
#:provision live-service-provision
|
||||||
|
@ -362,16 +357,14 @@ needs to be loaded."
|
||||||
(#f (every obsolete? (live-service-dependents service)))
|
(#f (every obsolete? (live-service-dependents service)))
|
||||||
(_ #f)))
|
(_ #f)))
|
||||||
|
|
||||||
(define to-load
|
(define to-restart
|
||||||
;; Only load services that are either new or currently stopped.
|
;; Restart services that are currently running.
|
||||||
(remove running? target))
|
(filter running? target))
|
||||||
|
|
||||||
(define to-unload
|
(define to-unload
|
||||||
;; Unload services that are (1) no longer required, or (2) are in TO-LOAD.
|
;; Unload services that are no longer required.
|
||||||
(remove essential?
|
(remove essential? (filter obsolete? live)))
|
||||||
(append (filter obsolete? live)
|
|
||||||
(filter-map stopped to-load))))
|
|
||||||
|
|
||||||
(values to-unload to-load))
|
(values to-unload to-restart))
|
||||||
|
|
||||||
;;; shepherd.scm ends here
|
;;; shepherd.scm ends here
|
||||||
|
|
|
@ -310,9 +310,9 @@ names of services to load (upgrade), and the list of names of services to
|
||||||
unload."
|
unload."
|
||||||
(match (current-services)
|
(match (current-services)
|
||||||
((services ...)
|
((services ...)
|
||||||
(let-values (((to-unload to-load)
|
(let-values (((to-unload to-restart)
|
||||||
(shepherd-service-upgrade services new-services)))
|
(shepherd-service-upgrade services new-services)))
|
||||||
(mproc to-load
|
(mproc to-restart
|
||||||
(map (compose first live-service-provision)
|
(map (compose first live-service-provision)
|
||||||
to-unload))))
|
to-unload))))
|
||||||
(#f
|
(#f
|
||||||
|
@ -335,25 +335,32 @@ bring the system down."
|
||||||
;; Arrange to simply emit a warning if the service upgrade fails.
|
;; Arrange to simply emit a warning if the service upgrade fails.
|
||||||
(with-shepherd-error-handling
|
(with-shepherd-error-handling
|
||||||
(call-with-service-upgrade-info new-services
|
(call-with-service-upgrade-info new-services
|
||||||
(lambda (to-load to-unload)
|
(lambda (to-restart to-unload)
|
||||||
(for-each (lambda (unload)
|
(for-each (lambda (unload)
|
||||||
(info (G_ "unloading service '~a'...~%") unload)
|
(info (G_ "unloading service '~a'...~%") unload)
|
||||||
(unload-service unload))
|
(unload-service unload))
|
||||||
to-unload)
|
to-unload)
|
||||||
|
|
||||||
(with-monad %store-monad
|
(with-monad %store-monad
|
||||||
(munless (null? to-load)
|
(munless (null? new-services)
|
||||||
(let ((to-load-names (map shepherd-service-canonical-name to-load))
|
(let ((new-service-names (map shepherd-service-canonical-name new-services))
|
||||||
(to-start (filter shepherd-service-auto-start? to-load)))
|
(to-restart-names (map shepherd-service-canonical-name to-restart))
|
||||||
(info (G_ "loading new services:~{ ~a~}...~%") to-load-names)
|
(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
|
(mlet %store-monad ((files (mapm %store-monad
|
||||||
(compose lower-object
|
(compose lower-object
|
||||||
shepherd-service-file)
|
shepherd-service-file)
|
||||||
to-load)))
|
new-services)))
|
||||||
;; Here we assume that FILES are exactly those that were computed
|
;; Here we assume that FILES are exactly those that were computed
|
||||||
;; as part of the derivation that built OS, which is normally the
|
;; as part of the derivation that built OS, which is normally the
|
||||||
;; case.
|
;; case.
|
||||||
(load-services (map derivation->output-path files))
|
(load-services/safe (map derivation->output-path files))
|
||||||
|
|
||||||
(for-each start-service
|
(for-each start-service
|
||||||
(map shepherd-service-canonical-name to-start))
|
(map shepherd-service-canonical-name to-start))
|
||||||
|
|
Loading…
Reference in New Issue