ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

guix system: Load all services on reconfigure, not just stopped ones.

Browse source 
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
Show stats Download patch file Download diff file Expand all files Collapse all files

8
doc/guix.texi
View file

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

20
gnu/services/herd.scm
View file

@ -50,6 +50,7 @@ (define-module (gnu services herd)
unload-services
unload-service
load-services
load-services/safe
start-service
stop-service))
@ -232,6 +233,25 @@ (define (load-services files)
`(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))

23
gnu/services/shepherd.scm
View file

@ -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 @@ (define edges
(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 @@ (define (running? service)
(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 @@ (define (obsolete? service)
(#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

25
guix/scripts/system.scm
View file

@ -310,9 +310,9 @@ (define (call-with-service-upgrade-info new-services mproc)
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 @@ (define new-services
;; 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))