diff options
Diffstat (limited to 'gnu')
| -rw-r--r-- | gnu/services/herd.scm | 20 | ||||
| -rw-r--r-- | gnu/services/shepherd.scm | 23 |
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 |