diff options
| -rw-r--r-- | gnu/services/shepherd.scm | 18 | ||||
| -rw-r--r-- | guix/scripts/system/reconfigure.scm | 2 | ||||
| -rw-r--r-- | tests/services.scm | 27 |
3 files changed, 33 insertions, 14 deletions
diff --git a/gnu/services/shepherd.scm b/gnu/services/shepherd.scm index cfbb3f1e30..65c49b9c59 100644 --- a/gnu/services/shepherd.scm +++ b/gnu/services/shepherd.scm @@ -517,8 +517,8 @@ 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 -need to be restarted to complete their upgrade." +to be unloaded, and the subset of LIVE that needs to be restarted to complete +their upgrade." (define (essential? service) (memq (first (live-service-provision service)) '(root shepherd))) @@ -531,10 +531,6 @@ need to be restarted to complete their upgrade." (shepherd-service-lookup-procedure live live-service-provision)) - (define (running? service) - (and=> (lookup-live (shepherd-service-canonical-name service)) - live-service-running)) - (define live-service-dependents (shepherd-service-back-edges live #:provision live-service-provision @@ -546,8 +542,14 @@ need to be restarted to complete their upgrade." (_ #f))) (define to-restart - ;; Restart services that are currently running. - (filter running? target)) + ;; Restart services that appear in TARGET and are currently running. + (filter-map (lambda (service) + (and=> (any lookup-live + (shepherd-service-provision service)) + (lambda (live) + (and (live-service-running live) + live)))) + target)) (define to-unload ;; Unload services that are no longer required. Essential services must diff --git a/guix/scripts/system/reconfigure.scm b/guix/scripts/system/reconfigure.scm index d35980590d..76855b4368 100644 --- a/guix/scripts/system/reconfigure.scm +++ b/guix/scripts/system/reconfigure.scm @@ -214,7 +214,7 @@ services as defined by OS." (let* ((to-unload to-restart (shepherd-service-upgrade live-services target-services)) (to-unload (map live-service-canonical-name to-unload)) - (to-restart (map shepherd-service-canonical-name to-restart)) + (to-restart (map live-service-canonical-name to-restart)) (running (map live-service-canonical-name (filter live-service-running live-services))) (to-start (lset-difference eqv? diff --git a/tests/services.scm b/tests/services.scm index 98b584f6c0..993283047f 100644 --- a/tests/services.scm +++ b/tests/services.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2015-2019, 2022, 2023 Ludovic Courtès <[email protected]> +;;; Copyright © 2015-2019, 2022-2023, 2025 Ludovic Courtès <[email protected]> ;;; ;;; This file is part of GNU Guix. ;;; @@ -225,7 +225,7 @@ (start #t))))) (lambda (unload restart) (list (map live-service-provision unload) - (map shepherd-service-provision restart))))) + (map live-service-provision restart))))) (test-equal "shepherd-service-upgrade: service depended on is not unloaded" '(((baz)) ;unload @@ -243,7 +243,7 @@ (start #t))))) (lambda (unload restart) (list (map live-service-provision unload) - (map shepherd-service-provision restart))))) + (map live-service-provision restart))))) (test-equal "shepherd-service-upgrade: obsolete services that depend on each other" '(((foo) (bar) (baz)) ;unload @@ -260,7 +260,7 @@ (start #t))))) (lambda (unload restart) (list (map live-service-provision unload) - (map shepherd-service-provision restart))))) + (map live-service-provision restart))))) (test-equal "shepherd-service-upgrade: transient service" ;; Transient service must not be unloaded: @@ -277,7 +277,24 @@ (start #t))))) (lambda (unload restart) (list (map live-service-provision unload) - (map shepherd-service-provision restart))))) + (map live-service-provision restart))))) + +(test-equal "shepherd-service-upgrade: service has new canonical name" + '(((qux)) ;unload + ((ssh) (foo))) ;restart + (call-with-values + (lambda () + (shepherd-service-upgrade + (list (live-service '(ssh) '() #f 42) ;running + (live-service '(foo) '() #f #t) ;changed canonical name + (live-service '(qux) '() #f #t)) ;obsolete + (list (shepherd-service (provision '(ssh)) + (start #t)) + (shepherd-service (provision '(bar foo)) + (start #t))))) + (lambda (unload restart) + (list (map live-service-provision unload) + (map live-service-provision restart))))) (test-eq "lookup-service-types" system-service-type |