branch master updated: reconfigure: Start services not currently running.

[guix-commits]

This is an automated email from the git hooks/post-receive script.

civodul pushed a commit to branch master
in repository guix.

The following commit(s) were added to refs/heads/master by this push:
     new cda046b  reconfigure: Start services not currently running.
cda046b is described below

commit cda046b3eaeb60f756fa4964c4b2721a2d680192
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Sun Oct 11 16:30:38 2020 +0200

    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.
---
 guix/scripts/system/reconfigure.scm | 34 +++++++++++++++++++---------------
 1 file changed, 19 insertions(+), 15 deletions(-)

diff --git a/guix/scripts/system/reconfigure.scm 
b/guix/scripts/system/reconfigure.scm
index 45bb1d5..d89caf8 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