diff options
Diffstat (limited to 'gnu/services')
| -rw-r--r-- | gnu/services/desktop.scm | 10 | ||||
| -rw-r--r-- | gnu/services/herd.scm | 37 | ||||
| -rw-r--r-- | gnu/services/shepherd.scm | 94 | ||||
| -rw-r--r-- | gnu/services/xorg.scm | 2 |
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) |