summaryrefslogtreecommitdiff
path: root/guix/scripts/system
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2020-10-11 16:30:38 +0200
committerLudovic Courtès <ludo@gnu.org>2020-10-11 17:26:41 +0200
commitcda046b3eaeb60f756fa4964c4b2721a2d680192 (patch)
tree7261472a0c86142aa90707424143f6cad4250d72 /guix/scripts/system
parent14cbb4733c937d2befdff6def485264a6582fcdc (diff)
reconfigure: Start services not currently running.
Fixes <https://bugs.gnu.org/43720>. Reported by Andreas Enge <andreas@enge.fr>. The bug was introduced in 5c793753b31b1dcd9a554bce953124f7ae88ca9a, which changed the way TO-START is computed: as a function of the running services first, and then as a function of the live services (which includes services not currently running). * guix/scripts/system/reconfigure.scm (running-services): Serialize the 'running' field and return it. (upgrade-shepherd-services): Comput RUNNING. Compute TO-START as the difference between TARGET-SERVICES and RUNNING.
Diffstat (limited to 'guix/scripts/system')
-rw-r--r--guix/scripts/system/reconfigure.scm34
1 files changed, 19 insertions, 15 deletions
diff --git a/guix/scripts/system/reconfigure.scm b/guix/scripts/system/reconfigure.scm
index 45bb1d5d3b..d89caf80fc 100644
--- a/guix/scripts/system/reconfigure.scm
+++ b/guix/scripts/system/reconfigure.scm
@@ -126,22 +126,25 @@ return the <live-service> objects that are currently running on MACHINE."
(define exp
(with-imported-modules '((gnu services herd))
#~(begin
- (use-modules (gnu services herd))
+ (use-modules (gnu services herd)
+ (ice-9 match))
+
(let ((services (current-services)))
(and services
- ;; 'live-service-running' is ignored, as we can't necessarily
- ;; serialize arbitrary objects. This should be fine for now,
- ;; since 'machine-current-services' is not exposed publicly,
- ;; and the resultant <live-service> objects are only used for
- ;; resolving service dependencies.
(map (lambda (service)
(list (live-service-provision service)
- (live-service-requirement service)))
+ (live-service-requirement service)
+ (match (live-service-running service)
+ (#f #f)
+ (#t #t)
+ ((? number? pid) pid)
+ (_ #t)))) ;not serializable
services))))))
+
(mlet %store-monad ((services (eval exp)))
(return (map (match-lambda
- ((provision requirement)
- (live-service provision requirement #f)))
+ ((provision requirement running)
+ (live-service provision requirement running)))
services))))
;; XXX: Currently, this does NOT attempt to restart running services. See
@@ -181,13 +184,14 @@ services as defined by OS."
(mlet* %store-monad ((live-services (running-services eval)))
(let*-values (((to-unload to-restart)
(shepherd-service-upgrade live-services target-services)))
- (let* ((to-unload (map live-service-canonical-name to-unload))
+ (let* ((to-unload (map live-service-canonical-name to-unload))
(to-restart (map shepherd-service-canonical-name to-restart))
- (to-start (lset-difference eqv?
- (map shepherd-service-canonical-name
- target-services)
- (map live-service-canonical-name
- live-services)))
+ (running (map live-service-canonical-name
+ (filter live-service-running live-services)))
+ (to-start (lset-difference eqv?
+ (map shepherd-service-canonical-name
+ target-services)
+ running))
(service-files (map shepherd-service-file target-services)))
(eval #~(parameterize ((current-warning-port (%make-void-port "w")))
(primitive-load #$(upgrade-services-program service-files