me
/
guix
Archived
1
0
Fork 0
Code

reconfigure: Start services not currently running. 

Fixes <https://bugs.gnu.org/43720>.
Reported by Andreas Enge <andreas@enge.fr>.

The bug was introduced in 5c793753b3,
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.
master
Ludovic Courtès 2020-10-11 16:30:38 +02:00
parent 14cbb4733c
commit cda046b3ea
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 19 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
guix/scripts/system/reconfigure.scm
View File

@ -126,22 +126,25 @@ return the <live-service> objects that are currently running on MACHINE."
(define exp (define exp
(with-imported-modules '((gnu services herd)) (with-imported-modules '((gnu services herd))
#~(begin #~(begin
(use-modules (gnu services herd)) (use-modules (gnu services herd)
(ice-9 match))
(let ((services (current-services))) (let ((services (current-services)))
(and 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) (map (lambda (service)
(list (live-service-provision 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)))))) services))))))
(mlet %store-monad ((services (eval exp))) (mlet %store-monad ((services (eval exp)))
(return (map (match-lambda (return (map (match-lambda
((provision requirement) ((provision requirement running)
(live-service provision requirement #f))) (live-service provision requirement running)))
services)))) services))))
;; XXX: Currently, this does NOT attempt to restart running services. See ;; 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))) (mlet* %store-monad ((live-services (running-services eval)))
(let*-values (((to-unload to-restart) (let*-values (((to-unload to-restart)
(shepherd-service-upgrade live-services target-services))) (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-restart (map shepherd-service-canonical-name to-restart))
(to-start (lset-difference eqv? (running (map live-service-canonical-name
(map shepherd-service-canonical-name (filter live-service-running live-services)))
target-services) (to-start (lset-difference eqv?
(map live-service-canonical-name (map shepherd-service-canonical-name
live-services))) target-services)
running))
(service-files (map shepherd-service-file target-services))) (service-files (map shepherd-service-file target-services)))
(eval #~(parameterize ((current-warning-port (%make-void-port "w"))) (eval #~(parameterize ((current-warning-port (%make-void-port "w")))
(primitive-load #$(upgrade-services-program service-files (primitive-load #$(upgrade-services-program service-files