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:
Carlo Zancanaro
Ludovic Courtès
parent
9bd85a785f
commit
4245ddcbc9
|
|
@ -33,7 +33,7 @@ Copyright @copyright{} 2016 Alex ter Weele@*
|
|||
Copyright @copyright{} 2017, 2018 Clément Lassieur@*
|
||||
Copyright @copyright{} 2017 Mathieu Othacehe@*
|
||||
Copyright @copyright{} 2017 Federico Beffa@*
|
||||
Copyright @copyright{} 2017 Carlo Zancanaro@*
|
||||
Copyright @copyright{} 2017, 2018 Carlo Zancanaro@*
|
||||
Copyright @copyright{} 2017 Thomas Danckaert@*
|
||||
Copyright @copyright{} 2017 humanitiesNerd@*
|
||||
Copyright @copyright{} 2017 Christopher Allan Webber@*
|
||||
|
|
@ -21920,9 +21920,9 @@ systems already running GuixSD.}.
|
|||
This effects all the configuration specified in @var{file}: user
|
||||
accounts, system services, global package list, setuid programs, etc.
|
||||
The command starts system services specified in @var{file} that are not
|
||||
currently running; if a service is currently running, it does not
|
||||
attempt to upgrade it since this would not be possible without stopping it
|
||||
first.
|
||||
currently running; if a service is currently running this command will
|
||||
arrange for it to be upgraded the next time it is stopped (eg. by
|
||||
@code{herd stop X} or @code{herd restart X}).
|
||||
|
||||
This command creates a new generation whose number is one greater than
|
||||
the current generation (as reported by @command{guix system
|
||||
|
|
|
|||
|
|
@ -50,6 +50,7 @@
|
|||
unload-services
|
||||
unload-service
|
||||
load-services
|
||||
load-services/safe
|
||||
start-service
|
||||
stop-service))
|
||||
|
||||
|
|
@ -232,6 +233,25 @@ returns a shepherd <service> object."
|
|||
`(primitive-load ,file))
|
||||
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)
|
||||
(with-shepherd-action name ('start) result
|
||||
result))
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2013, 2014, 2015, 2016, 2018 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
|
||||
;;; Copyright © 2018 Carlo Zancanaro <carlo@zancanaro.id.au>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
|
|
@ -329,7 +330,7 @@ symbols provided/required by a service."
|
|||
(define (shepherd-service-upgrade live target)
|
||||
"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
|
||||
needs to be loaded."
|
||||
need to be restarted to complete their upgrade."
|
||||
(define (essential? service)
|
||||
(memq (first (live-service-provision service))
|
||||
'(root shepherd)))
|
||||
|
|
@ -346,12 +347,6 @@ needs to be loaded."
|
|||
(and=> (lookup-live (shepherd-service-canonical-name service))
|
||||
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
|
||||
(shepherd-service-back-edges live
|
||||
#:provision live-service-provision
|
||||
|
|
@ -362,16 +357,14 @@ needs to be loaded."
|
|||
(#f (every obsolete? (live-service-dependents service)))
|
||||
(_ #f)))
|
||||
|
||||
(define to-load
|
||||
;; Only load services that are either new or currently stopped.
|
||||
(remove running? target))
|
||||
(define to-restart
|
||||
;; Restart services that are currently running.
|
||||
(filter running? target))
|
||||
|
||||
(define to-unload
|
||||
;; Unload services that are (1) no longer required, or (2) are in TO-LOAD.
|
||||
(remove essential?
|
||||
(append (filter obsolete? live)
|
||||
(filter-map stopped to-load))))
|
||||
;; Unload services that are no longer required.
|
||||
(remove essential? (filter obsolete? live)))
|
||||
|
||||
(values to-unload to-load))
|
||||
(values to-unload to-restart))
|
||||
|
||||
;;; shepherd.scm ends here
|
||||
|
|
|
|||
|
|
@ -310,9 +310,9 @@ names of services to load (upgrade), and the list of names of services to
|
|||
unload."
|
||||
(match (current-services)
|
||||
((services ...)
|
||||
(let-values (((to-unload to-load)
|
||||
(let-values (((to-unload to-restart)
|
||||
(shepherd-service-upgrade services new-services)))
|
||||
(mproc to-load
|
||||
(mproc to-restart
|
||||
(map (compose first live-service-provision)
|
||||
to-unload))))
|
||||
(#f
|
||||
|
|
@ -335,25 +335,32 @@ bring the system down."
|
|||
;; Arrange to simply emit a warning if the service upgrade fails.
|
||||
(with-shepherd-error-handling
|
||||
(call-with-service-upgrade-info new-services
|
||||
(lambda (to-load to-unload)
|
||||
(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? to-load)
|
||||
(let ((to-load-names (map shepherd-service-canonical-name to-load))
|
||||
(to-start (filter shepherd-service-auto-start? to-load)))
|
||||
(info (G_ "loading new services:~{ ~a~}...~%") to-load-names)
|
||||
(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)
|
||||
to-load)))
|
||||
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 (map derivation->output-path files))
|
||||
(load-services/safe (map derivation->output-path files))
|
||||
|
||||
(for-each start-service
|
||||
(map shepherd-service-canonical-name to-start))
|
||||
|
|
|
|||
Loading…
Reference in New Issue