aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--doc/guix.texi8
-rw-r--r--gnu/services/herd.scm20
-rw-r--r--gnu/services/shepherd.scm23
-rw-r--r--guix/scripts/system.scm25
4 files changed, 48 insertions, 28 deletions
diff --git a/doc/guix.texi b/doc/guix.texi
index 6b4b06f46d..e1046eb512 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -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
diff --git a/gnu/services/herd.scm b/gnu/services/herd.scm
index 8c96b70731..8ff817759d 100644
--- a/gnu/services/herd.scm
+++ b/gnu/services/herd.scm
@@ -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))
diff --git a/gnu/services/shepherd.scm b/gnu/services/shepherd.scm
index 4cd2249841..4c7e72049f 100644
--- a/gnu/services/shepherd.scm
+++ b/gnu/services/shepherd.scm
@@ -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
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 69bd05b516..1e7620f147 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -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))