1
0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2026-04-06 21:20:33 +02:00

services: 'modify-services' preserves service ordering.

Fixes <https://issues.guix.gnu.org/63921>.

The regression was introduced in
dbbc7e9461, which changed the order of
services.  As a result, someone using 'modify-services' could find
themselves with incorrect ordering of expressions in the "boot" script,
whereby the cleanup expressions would come after (execl ".../shepherd").
This, in turn, would lead shepherd to error out at boot with EADDRINUSE
on /var/run/shepherd/socket.

* gnu/services.scm (%delete-service, %apply-clauses): Remove.
(clause-alist): New macro.
(apply-clauses): New procedure.
(modify-services): Use it.  Adjust docstring.
* tests/services.scm ("modify-services: do nothing"): Remove 'sort' call.
("modify-services: delete service"): Likewise, and add 't4' service.
("modify-services: change value"): Remove 'sort' call and fix expected value.
This commit is contained in:
Ludovic Courtès
2023-06-06 11:41:39 +02:00
parent dc0c5d56ee
commit 1819512073
2 changed files with 81 additions and 51 deletions

View File

@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015-2019, 2022 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015-2019, 2022, 2023 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -287,7 +287,7 @@
(x x))))
(test-equal "modify-services: do nothing"
'(1 2 3)
'(1 2 3) ;note: service order must be preserved
(let* ((t1 (service-type (name 't1)
(extensions '())
(description "")))
@@ -298,12 +298,11 @@
(extensions '())
(description "")))
(services (list (service t1 1) (service t2 2) (service t3 3))))
(sort (map service-value
(modify-services services))
<)))
(map service-value
(modify-services services))))
(test-equal "modify-services: delete service"
'(1)
'(1 4) ;note: service order must be preserved
(let* ((t1 (service-type (name 't1)
(extensions '())
(description "")))
@@ -313,12 +312,15 @@
(t3 (service-type (name 't3)
(extensions '())
(description "")))
(services (list (service t1 1) (service t2 2) (service t3 3))))
(sort (map service-value
(modify-services services
(delete t3)
(delete t2)))
<)))
(t4 (service-type (name 't4)
(extensions '())
(description "")))
(services (list (service t1 1) (service t2 2)
(service t3 3) (service t4 4))))
(map service-value
(modify-services services
(delete t3)
(delete t2)))))
(test-error "modify-services: delete non-existing service"
#t
@@ -336,7 +338,7 @@
(delete t3))))
(test-equal "modify-services: change value"
'(2 11 33)
'(11 2 33) ;note: service order must be preserved
(let* ((t1 (service-type (name 't1)
(extensions '())
(description "")))
@@ -347,11 +349,10 @@
(extensions '())
(description "")))
(services (list (service t1 1) (service t2 2) (service t3 3))))
(sort (map service-value
(modify-services services
(t1 value => 11)
(t3 value => 33)))
<)))
(map service-value
(modify-services services
(t1 value => 11)
(t3 value => 33)))))
(test-error "modify-services: change value for non-existing service"
#t