Merge branch 'master' into core-updates

4 files changed, 111 insertions, 32 deletions

diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index bf21707bfe..8dacf54668 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -27,6 +27,8 @@
   #:use-module (gnu services avahi)
   #:use-module (gnu services xorg)
   #:use-module (gnu services networking)
+  #:use-module ((gnu system file-systems)
+                #:select (%elogind-file-systems))
   #:use-module (gnu system shadow)
   #:use-module (gnu system pam)
   #:use-module (gnu packages glib)
@@ -760,7 +762,11 @@ seats.)"
 
                        ;; Extend PAM with pam_elogind.so.
                        (service-extension pam-root-service-type
-                                          pam-extension-procedure)))))
+                                          pam-extension-procedure)
+
+                       ;; We need /run/user, /run/systemd, etc.
+                       (service-extension file-system-service-type
+                                          (const %elogind-file-systems))))))
 
 (define* (elogind-service #:key (config (elogind-configuration)))
   "Return a service that runs the @command{elogind} login and seat management
@@ -823,7 +829,7 @@ and extends polkit with the actions from @code{gnome-settings-daemon}."
 
 (define* (xfce-desktop-service #:key (config (xfce-desktop-configuration)))
   "Return a service that adds the @code{xfce} package to the system profile,
-and extends polkit with the abilit for @code{thunar} to manipulate the file
+and extends polkit with the ability for @code{thunar} to manipulate the file
 system as root from within a user session, after the user has authenticated
 with the administrator's password."
   (service xfce-desktop-service-type config))
diff --git a/gnu/services/herd.scm b/gnu/services/herd.scm
index 7a9db90012..03bfbf1d78 100644
--- a/gnu/services/herd.scm
+++ b/gnu/services/herd.scm
@@ -17,8 +17,8 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu services herd)
-  #:use-module (guix combinators)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
@@ -37,6 +37,11 @@
             unknown-shepherd-error?
             unknown-shepherd-error-sexp
 
+            live-service?
+            live-service-provision
+            live-service-requirement
+            live-service-running
+
             current-services
             unload-services
             unload-service
@@ -165,25 +170,27 @@ of pairs."
      (let ((key (and=> (assoc-ref alist 'key) car)) ...)
        exp ...))))
 
+;; Information about live Shepherd services.
+(define-record-type <live-service>
+  (live-service provision requirement running)
+  live-service?
+  (provision    live-service-provision)           ;list of symbols
+  (requirement  live-service-requirement)         ;list of symbols
+  (running      live-service-running))            ;#f | object
+
 (define (current-services)
-  "Return two lists: the list of currently running services, and the list of
-currently stopped services.  Return #f and #f if the list of services could
-not be obtained."
+  "Return the list of currently defined Shepherd services, represented as
+<live-service> objects.  Return #f if the list of services could not be
+obtained."
   (with-shepherd-action 'root ('status) services
     (match services
       ((('service ('version 0 _ ...) _ ...) ...)
-       (fold2 (lambda (service running-services stopped-services)
-                (alist-let* service (provides running)
-                  (if running
-                      (values (cons (first provides) running-services)
-                              stopped-services)
-                      (values running-services
-                              (cons (first provides) stopped-services)))))
-              '()
-              '()
-              services))
+       (map (lambda (service)
+              (alist-let* service (provides requires running)
+                (live-service provides requires running)))
+            services))
       (x
-       (values #f #f)))))
+       #f))))
 
 (define (unload-service service)
   "Unload SERVICE, a symbol name; return #t on success."
diff --git a/gnu/services/shepherd.scm b/gnu/services/shepherd.scm
index a14f51592a..3273184b9a 100644
--- a/gnu/services/shepherd.scm
+++ b/gnu/services/shepherd.scm
@@ -25,6 +25,7 @@
   #:use-module (guix records)
   #:use-module (guix derivations)                 ;imported-modules, etc.
   #:use-module (gnu services)
+  #:use-module (gnu services herd)
   #:use-module (gnu packages admin)
   #:use-module (ice-9 match)
   #:use-module (ice-9 vlist)
@@ -52,7 +53,9 @@
 
             shepherd-service-file
 
-            shepherd-service-back-edges))
+            shepherd-service-lookup-procedure
+            shepherd-service-back-edges
+            shepherd-service-upgrade))
 
 ;;; Commentary:
 ;;;
@@ -249,20 +252,35 @@ stored."
 
     (gexp->file "shepherd.conf" config)))
 
-(define (shepherd-service-back-edges services)
+(define* (shepherd-service-lookup-procedure services
+                                            #:optional
+                                            (provision
+                                             shepherd-service-provision))
+  "Return a procedure that, when passed a symbol, return the item among
+SERVICES that provides this symbol.  PROVISION must be a one-argument
+procedure that takes a service and returns the list of symbols it provides."
+  (let ((services (fold (lambda (service result)
+                          (fold (cut vhash-consq <> service <>)
+                                result
+                                (provision service)))
+                        vlist-null
+                        services)))
+    (lambda (name)
+      (match (vhash-assq name services)
+        ((_ . service) service)
+        (#f            #f)))))
+
+(define* (shepherd-service-back-edges services
+                                      #:key
+                                      (provision shepherd-service-provision)
+                                      (requirement shepherd-service-requirement))
   "Return a procedure that, when given a <shepherd-service> from SERVICES,
-returns the list of <shepherd-service> that depend on it."
+returns the list of <shepherd-service> that depend on it.
+
+Use PROVISION and REQUIREMENT as one-argument procedures that return the
+symbols provided/required by a service."
   (define provision->service
-    (let ((services (fold (lambda (service result)
-                            (fold (cut vhash-consq <> service <>)
-                                  result
-                                  (shepherd-service-provision service)))
-                          vlist-null
-                          services)))
-      (lambda (name)
-        (match (vhash-assq name services)
-          ((_ . service) service)
-          (#f            #f)))))
+    (shepherd-service-lookup-procedure services provision))
 
   (define edges
     (fold (lambda (service edges)
@@ -270,11 +288,59 @@ returns the list of <shepherd-service> that depend on it."
                     (vhash-consq (provision->service requirement) service
                                  edges))
                   edges
-                  (shepherd-service-requirement service)))
+                  (requirement service)))
           vlist-null
           services))
 
   (lambda (service)
     (vhash-foldq* cons '() service edges)))
 
+(define (shepherd-service-upgrade live target)
+  "Return two values: the subset of LIVE (a list of <live-service>) that needs
+to be unloaded, and the subset of TARGET (a list of <shepherd-service>) that
+needs to be loaded."
+  (define (essential? service)
+    (memq (first (live-service-provision service))
+          '(root shepherd)))
+
+  (define lookup-target
+    (shepherd-service-lookup-procedure target
+                                       shepherd-service-provision))
+
+  (define lookup-live
+    (shepherd-service-lookup-procedure live
+                                       live-service-provision))
+
+  (define (running? service)
+    (and=> (lookup-live (shepherd-service-canonical-name service))
+           live-service-running))
+
+  (define (stopped service)
+    (match (lookup-live (shepherd-service-canonical-name service))
+      (#f #f)
+      (service (and (not (live-service-running service))
+                    service))))
+
+  (define live-service-dependents
+    (shepherd-service-back-edges live
+                                 #:provision live-service-provision
+                                 #:requirement live-service-requirement))
+
+  (define (obsolete? service)
+    (match (lookup-target (first (live-service-provision service)))
+      (#f (every obsolete? (live-service-dependents service)))
+      (_  #f)))
+
+  (define to-load
+    ;; Only load services that are either new or currently stopped.
+    (remove running? target))
+
+  (define to-unload
+    ;; Unload services that are (1) no longer required, or (2) are in TO-LOAD.
+    (remove essential?
+            (append (filter obsolete? live)
+                    (filter-map stopped to-load))))
+
+  (values to-unload to-load))
+
 ;;; shepherd.scm ends here
diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm
index 905c88ff66..4e311deb84 100644
--- a/gnu/services/xorg.scm
+++ b/gnu/services/xorg.scm
@@ -26,7 +26,7 @@
   #:use-module (gnu packages guile)
   #:use-module (gnu packages xorg)
   #:use-module (gnu packages gl)
-  #:use-module (gnu packages slim)
+  #:use-module (gnu packages display-managers)
   #:use-module (gnu packages gnustep)
   #:use-module (gnu packages admin)
   #:use-module (gnu packages bash)