summary refs log tree commit diff
path: root/gnu/services/herd.scm
diff options
context:
space:
mode:
authorMarius Bakke <mbakke@fastmail.com>2018-10-05 19:15:39 +0200
committerMarius Bakke <mbakke@fastmail.com>2018-10-05 19:15:39 +0200
commitcf6db76d2af2f287f12928df160447ab4165b3e5 (patch)
tree49a1309c0e04c00090ab106f7ae3495a6da328c1 /gnu/services/herd.scm
parente65b2181e8b436278e3dd0b405602a400fbd0a75 (diff)
parenta6798218bea0d6b2df598042d1ced29f74bb4250 (diff)
downloadguix-cf6db76d2af2f287f12928df160447ab4165b3e5.tar.gz
Merge branch 'master' into core-updates
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))