aboutsummaryrefslogtreecommitdiff
path: root/gnu/services/herd.scm
diff options
context:
space:
mode:
authorCarlo Zancanaro <carlo@zancanaro.id.au>2018-08-26 21:54:14 +1000
committerLudovic Courtès <ludo@gnu.org>2018-09-26 23:40:36 +0200
commit4245ddcbc9f935804c17c97872b90ec1050c2d75 (patch)
treea6b02dd3bb8065fdd64fa26126d2949da20b912f /gnu/services/herd.scm
parent9bd85a785f47d039b027de854b78b9ded0892e02 (diff)
downloadguix-4245ddcbc9f935804c17c97872b90ec1050c2d75.tar
guix-4245ddcbc9f935804c17c97872b90ec1050c2d75.tar.gz
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>
Diffstat (limited to 'gnu/services/herd.scm')
-rw-r--r--gnu/services/herd.scm20
1 files changed, 20 insertions, 0 deletions
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))