diff options
author | Ludovic Courtès <ludo@gnu.org> | 2020-10-11 16:30:38 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2020-10-11 17:26:41 +0200 |
commit | cda046b3eaeb60f756fa4964c4b2721a2d680192 (patch) | |
tree | 7261472a0c86142aa90707424143f6cad4250d72 /guix/scripts/system | |
parent | 14cbb4733c937d2befdff6def485264a6582fcdc (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.scm | 34 |
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 |