services: ‘shepherd-service-upgrade’ handles canonical name changes.

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
This commit is contained in:
Ludovic Courtès 2025-02-23 15:20:41 +01:00
parent c92fbc83d4
commit 749eb1a2dd
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
3 changed files with 33 additions and 14 deletions

View file

@ -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

View file

@ -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?

View file

@ -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 @@
(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