summary refs log tree commit diff
path: root/gnu/services
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/services')
-rw-r--r--gnu/services/herd.scm20
-rw-r--r--gnu/services/shepherd.scm23
2 files changed, 28 insertions, 15 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))
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