From cda046b3eaeb60f756fa4964c4b2721a2d680192 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 11 Oct 2020 16:30:38 +0200 Subject: reconfigure: Start services not currently running. Fixes . Reported by Andreas Enge . 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. --- guix/scripts/system/reconfigure.scm | 34 +++++++++++++++++++--------------- 1 file changed, 19 insertions(+), 15 deletions(-) (limited to 'guix/scripts/system') 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 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 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 -- cgit v1.2.3