diff mbox series

[bug#76502] services: ‘shepherd-service-upgrade’ handles canonical name changes.

Message ID 220207cd49aa16783ecb3c4293e1e75dedeae8fa.1740321954.git.ludo@gnu.org
State New
Headers
Series [bug#76502] services: ‘shepherd-service-upgrade’ handles canonical name changes. |

Commit Message

Ludovic Courtès Feb. 23, 2025, 2:47 p.m. UTC 
  Partly fixes <https://issues.guix.gnu.org/76315>.

Fixes a bug whereby a service whose canonical name has changed would not
be restarted—e.g., if '(syslogd) has a replacement providing
'(system-log syslogd).

* gnu/services/shepherd.scm (shepherd-service-upgrade)[running?]:
Remove.
[to-restart]: Change to a subset of LIVE.  Look up all the names of each
element of TARGET.
* guix/scripts/system/reconfigure.scm (upgrade-shepherd-services):
TO-RESTART is now a list of <live-service>; adjust accordingly.
* tests/services.scm ("shepherd-service-upgrade: one unchanged, one upgraded, one new"):
("shepherd-service-upgrade: service depended on is not unloaded"):
("shepherd-service-upgrade: obsolete services that depend on each other"):
("shepherd-service-upgrade: transient service"): Adjust accordingly.
("shepherd-service-upgrade: service has new canonical name"): New test.

Reported-by: Tomas Volf <~@wolfsden.cz>
Change-Id: I7cec495b4e824da5fad5518f039607cf92f935d9
---
 gnu/services/shepherd.scm           | 18 ++++++++++--------
 guix/scripts/system/reconfigure.scm |  2 +-
 tests/services.scm                  | 27 ++++++++++++++++++++++-----
 3 files changed, 33 insertions(+), 14 deletions(-)

Hello!

This should fix the ‘guix deploy’ warning Tomas reported
in <https://issues.guix.gnu.org/76315> when upgrading to the
Shepherd’s ‘system-log’.

In short, confusion was cause by the fact that '(syslogd) was
to be replaced by '(system-log syslogd), and the canonical name
of the latter is ‘system-log’, not ‘syslogd’.

Ludo’.


base-commit: 90aa90eb05429553402e0b5225d23f84742a9286

Comments

Tomas Volf March 2, 2025, 6:33 p.m. UTC | #1 
Reviewed-by: Tomas Volf <~@wolfsden.cz>
Ludovic Courtès March 4, 2025, 11:32 p.m. UTC | #2 
Pushed as 749eb1a2dd9fdf63a71f223b3f6756d9cb5940e6, thanks!
diff mbox series

Patch

diff --git a/gnu/services/shepherd.scm b/gnu/services/shepherd.scm
index cfbb3f1e30a..65c49b9c59a 100644
--- a/gnu/services/shepherd.scm
+++ b/gnu/services/shepherd.scm
@@ -517,8 +517,8 @@  (define* (shepherd-service-back-edges services
 
 (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 @@  (define (shepherd-service-upgrade live target)
     (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 @@  (define (shepherd-service-upgrade live target)
       (_  #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 d35980590d3..76855b43688 100644
--- a/guix/scripts/system/reconfigure.scm
+++ b/guix/scripts/system/reconfigure.scm
@@ -214,7 +214,7 @@  (define* (upgrade-shepherd-services eval 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 98b584f6c06..993283047f5 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 <ludo@gnu.org>
+;;; Copyright © 2015-2019, 2022-2023, 2025 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -225,7 +225,7 @@  (define-module (test-services)
                                  (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 @@  (define-module (test-services)
                                  (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 @@  (define-module (test-services)
                                  (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 @@  (define-module (test-services)
                                  (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