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 2018-08-26 21:54:14 +10:00 committed by Ludovic Courtès
parent 9bd85a785f
commit 4245ddcbc9
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
4 changed files with 48 additions and 28 deletions

View File

@ -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

View File

@ -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))

View File

@ -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

View File

@ -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))