Package: guix-patches;
Reported by: Ludovic Courtès <ludo <at> gnu.org>
Date: Sun, 23 Feb 2025 14:49:03 UTC
Severity: normal
Tags: patch
Done: Ludovic Courtès <ludo <at> gnu.org>
Bug is archived. No further changes may be made.
View this message in rfc822 format
From: Ludovic Courtès <ludo <at> gnu.org> To: 76502 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org>, Tomas Volf <~@wolfsden.cz>, Christopher Baines <guix <at> cbaines.net>, Josselin Poiret <dev <at> jpoiret.xyz>, Ludovic Courtès <ludo <at> gnu.org>, Mathieu Othacehe <othacehe <at> gnu.org>, Simon Tournier <zimon.toutoune <at> gmail.com>, Tobias Geerinckx-Rice <me <at> tobias.gr> Subject: [bug#76502] [PATCH] services: ‘shepherd-service-upgrade’ handles canonical name changes. Date: Sun, 23 Feb 2025 15:47:41 +0100
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’.
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 <at> gnu.org>
+;;; Copyright © 2015-2019, 2022-2023, 2025 Ludovic Courtès <ludo <at> 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
base-commit: 90aa90eb05429553402e0b5225d23f84742a9286
--
2.48.1
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.