aboutsummaryrefslogtreecommitdiff
path: root/gnu/services/desktop.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-09-09 09:17:31 +0200
committerLudovic Courtès <ludo@gnu.org>2015-10-10 22:46:14 +0200
commitbe1c2c54d9f918f50f71c6d32a72d4498c07504c (patch)
tree642d087516b3ae7c2ffad6444e25b410712c92be /gnu/services/desktop.scm
parentce8a6dfc43265787c23fb93d3877fbcacb0451e4 (diff)
downloadguix-be1c2c54d9f918f50f71c6d32a72d4498c07504c.tar
guix-be1c2c54d9f918f50f71c6d32a72d4498c07504c.tar.gz
system: Make service procedures non-monadic.
* gnu/services/avahi.scm (configuration-file): Use 'plain-file' instead of 'text-file'. (avahi-service): Turn into a regular procedure that returns a <service>. * gnu/services/base.scm (root-file-system-service, file-system-service, user-unmount-service, user-processes-service, host-name-service, console-keymap-service, console-font-service, mingetty-service, nscd.conf-file, nscd-service): Likewise. (%default-syslog.conf): New variable. (syslog-service): Use it. Turn into a regular procedure. (guix-service, udev-rules-union, kvm-udev-rule, udev-service, device-mapping-service, swap-service): Likewise. * gnu/services/databases.scm (%default-postgres-hba, %default-postgres-ident): Use 'plain-file' instead of 'text-file'. (%default-postgres-config): Use 'mixed-text-file' instead of 'text-file*'. (postgresql-service): Use 'program-file' instead of 'gexp->script'. Turn into a regular procedure. * gnu/services/desktop.scm (dbus-configuration-directory): Use 'computed-file' instead of 'gexp->derivation'. (upower-configuration-file, geoclue-configuration-file, elogind-configuration-file): Use 'plain-file' instead of 'text-file'. (dbus-service, upower-service, colord-service, geoclue-service, polkit-service, elogind-service): Turn into regular procedures. (%desktop-services): Remove use of 'mlet' when iterating on %BASE-SERVICES. * gnu/services/lirc.scm (lirc-service): Turn into a regular procedure. * gnu/services/networking.scm (static-networking-service, dhcp-client-service, ntp-service, tor-service, bitlbee-service, wicd-service): Likewise. * gnu/services/ssh.scm (lsh-service): Likewise. * gnu/services/web.scm (nginx-service): Likewise. * gnu/services/xorg.scm (xorg-configuration-file): Use 'mixed-text-file' instead of 'text-file*'. (xorg-start-command, slim-service): Turn into regular procedures. (xinitrc): Use 'program-file' instead of 'gexp->script'. * gnu/system/install.scm (cow-store-service, configuration-template-service): Turn into regular procedures. * gnu/system.scm (other-file-system-services, device-mapping-services, swap-services, essential-services, operating-system-services, user-shells, operating-system-accounts): Remove now unnecessary 'mlet' and turn into regular procedures. (operating-system-etc-directory, operating-system-activation-script, operating-system-boot-script): Adjust accordingly. * doc/guix.texi (Base Services, Networking Services, X Window, Desktop Services, Database Services, Web Services, Various Services, Name Service Switch): Adjust accordingly.
Diffstat (limited to 'gnu/services/desktop.scm')
-rw-r--r--gnu/services/desktop.scm450
1 files changed, 220 insertions, 230 deletions
diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index b91bdd8ad3..35b19146dd 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -35,7 +35,6 @@
#:use-module (gnu packages polkit)
#:use-module ((gnu packages linux)
#:select (lvm2 fuse alsa-utils crda))
- #:use-module (guix monads)
#:use-module (guix records)
#:use-module (guix store)
#:use-module (guix gexp)
@@ -104,7 +103,7 @@
(sxml->xml (services->sxml (list #$@services))
port)))))
- (gexp->derivation "dbus-configuration" build))
+ (computed-file "dbus-configuration" build))
(define* (dbus-service services #:key (dbus dbus))
"Return a service that runs the \"system bus\", using @var{dbus}, with
@@ -118,50 +117,49 @@ be notified of system-wide events.
@file{etc/dbus-1/system.d} directory containing additional D-Bus configuration
and policy files. For example, to allow avahi-daemon to use the system bus,
@var{services} must be equal to @code{(list avahi)}."
- (mlet %store-monad ((conf (dbus-configuration-directory dbus services)))
- (return
- (service
- (documentation "Run the D-Bus system daemon.")
- (provision '(dbus-system))
- (requirement '(user-processes))
- (start #~(make-forkexec-constructor
- (list (string-append #$dbus "/bin/dbus-daemon")
- "--nofork"
- (string-append "--config-file=" #$conf "/system.conf"))))
- (stop #~(make-kill-destructor))
- (user-groups (list (user-group
- (name "messagebus")
- (system? #t))))
- (user-accounts (list (user-account
- (name "messagebus")
- (group "messagebus")
- (system? #t)
- (comment "D-Bus system bus user")
- (home-directory "/var/run/dbus")
- (shell
- #~(string-append #$shadow "/sbin/nologin")))))
- (activate #~(begin
- (use-modules (guix build utils))
-
- (mkdir-p "/var/run/dbus")
-
- (let ((user (getpwnam "messagebus")))
- (chown "/var/run/dbus"
- (passwd:uid user) (passwd:gid user)))
-
- (unless (file-exists? "/etc/machine-id")
- (format #t "creating /etc/machine-id...~%")
- (let ((prog (string-append #$dbus "/bin/dbus-uuidgen")))
- ;; XXX: We can't use 'system' because the initrd's
- ;; guile system(3) only works when 'sh' is in $PATH.
- (let ((pid (primitive-fork)))
- (if (zero? pid)
- (call-with-output-file "/etc/machine-id"
- (lambda (port)
- (close-fdes 1)
- (dup2 (port->fdes port) 1)
- (execl prog)))
- (waitpid pid)))))))))))
+ (let ((conf (dbus-configuration-directory dbus services)))
+ (service
+ (documentation "Run the D-Bus system daemon.")
+ (provision '(dbus-system))
+ (requirement '(user-processes))
+ (start #~(make-forkexec-constructor
+ (list (string-append #$dbus "/bin/dbus-daemon")
+ "--nofork"
+ (string-append "--config-file=" #$conf "/system.conf"))))
+ (stop #~(make-kill-destructor))
+ (user-groups (list (user-group
+ (name "messagebus")
+ (system? #t))))
+ (user-accounts (list (user-account
+ (name "messagebus")
+ (group "messagebus")
+ (system? #t)
+ (comment "D-Bus system bus user")
+ (home-directory "/var/run/dbus")
+ (shell
+ #~(string-append #$shadow "/sbin/nologin")))))
+ (activate #~(begin
+ (use-modules (guix build utils))
+
+ (mkdir-p "/var/run/dbus")
+
+ (let ((user (getpwnam "messagebus")))
+ (chown "/var/run/dbus"
+ (passwd:uid user) (passwd:gid user)))
+
+ (unless (file-exists? "/etc/machine-id")
+ (format #t "creating /etc/machine-id...~%")
+ (let ((prog (string-append #$dbus "/bin/dbus-uuidgen")))
+ ;; XXX: We can't use 'system' because the initrd's
+ ;; guile system(3) only works when 'sh' is in $PATH.
+ (let ((pid (primitive-fork)))
+ (if (zero? pid)
+ (call-with-output-file "/etc/machine-id"
+ (lambda (port)
+ (close-fdes 1)
+ (dup2 (port->fdes port) 1)
+ (execl prog)))
+ (waitpid pid))))))))))
;;;
@@ -175,24 +173,24 @@ and policy files. For example, to allow avahi-daemon to use the system bus,
time-critical time-action
critical-power-action)
"Return an upower-daemon configuration file."
- (text-file "UPower.conf"
- (string-append
- "[UPower]\n"
- "EnableWattsUpPro=" (bool watts-up-pro?)
- "NoPollBatteries=" (bool (not poll-batteries?))
- "IgnoreLid=" (bool ignore-lid?)
- "UsePercentageForPolicy=" (bool use-percentage-for-policy?)
- "PercentageLow=" (number->string percentage-low) "\n"
- "PercentageCritical=" (number->string percentage-critical) "\n"
- "PercentageAction=" (number->string percentage-action) "\n"
- "TimeLow=" (number->string time-low) "\n"
- "TimeCritical=" (number->string time-critical) "\n"
- "TimeAction=" (number->string time-action) "\n"
- "CriticalPowerAction=" (match critical-power-action
- ('hybrid-sleep "HybridSleep")
- ('hibernate "Hibernate")
- ('power-off "PowerOff"))
- "\n")))
+ (plain-file "UPower.conf"
+ (string-append
+ "[UPower]\n"
+ "EnableWattsUpPro=" (bool watts-up-pro?)
+ "NoPollBatteries=" (bool (not poll-batteries?))
+ "IgnoreLid=" (bool ignore-lid?)
+ "UsePercentageForPolicy=" (bool use-percentage-for-policy?)
+ "PercentageLow=" (number->string percentage-low) "\n"
+ "PercentageCritical=" (number->string percentage-critical) "\n"
+ "PercentageAction=" (number->string percentage-action) "\n"
+ "TimeLow=" (number->string time-low) "\n"
+ "TimeCritical=" (number->string time-critical) "\n"
+ "TimeAction=" (number->string time-action) "\n"
+ "CriticalPowerAction=" (match critical-power-action
+ ('hybrid-sleep "HybridSleep")
+ ('hibernate "Hibernate")
+ ('power-off "PowerOff"))
+ "\n")))
(define* (upower-service #:key (upower upower)
(watts-up-pro? #f)
@@ -210,47 +208,46 @@ and policy files. For example, to allow avahi-daemon to use the system bus,
@command{upowerd}}, a system-wide monitor for power consumption and battery
levels, with the given configuration settings. It implements the
@code{org.freedesktop.UPower} D-Bus interface, and is notably used by GNOME."
- (mlet %store-monad ((config (upower-configuration-file
- #:watts-up-pro? watts-up-pro?
- #:poll-batteries? poll-batteries?
- #:ignore-lid? ignore-lid?
- #:use-percentage-for-policy? use-percentage-for-policy?
- #:percentage-low percentage-low
- #:percentage-critical percentage-critical
- #:percentage-action percentage-action
- #:time-low time-low
- #:time-critical time-critical
- #:time-action time-action
- #:critical-power-action critical-power-action)))
- (return
- (service
- (documentation "Run the UPower power and battery monitor.")
- (provision '(upower-daemon))
- (requirement '(dbus-system udev))
-
- (start #~(make-forkexec-constructor
- (list (string-append #$upower "/libexec/upowerd"))
- #:environment-variables
- (list (string-append "UPOWER_CONF_FILE_NAME=" #$config))))
- (stop #~(make-kill-destructor))
- (activate #~(begin
- (use-modules (guix build utils))
- (mkdir-p "/var/lib/upower")
- (let ((user (getpwnam "upower")))
- (chown "/var/lib/upower"
- (passwd:uid user) (passwd:gid user)))))
-
- (user-groups (list (user-group
- (name "upower")
- (system? #t))))
- (user-accounts (list (user-account
- (name "upower")
- (group "upower")
- (system? #t)
- (comment "UPower daemon user")
- (home-directory "/var/empty")
- (shell
- #~(string-append #$shadow "/sbin/nologin")))))))))
+ (let ((config (upower-configuration-file
+ #:watts-up-pro? watts-up-pro?
+ #:poll-batteries? poll-batteries?
+ #:ignore-lid? ignore-lid?
+ #:use-percentage-for-policy? use-percentage-for-policy?
+ #:percentage-low percentage-low
+ #:percentage-critical percentage-critical
+ #:percentage-action percentage-action
+ #:time-low time-low
+ #:time-critical time-critical
+ #:time-action time-action
+ #:critical-power-action critical-power-action)))
+ (service
+ (documentation "Run the UPower power and battery monitor.")
+ (provision '(upower-daemon))
+ (requirement '(dbus-system udev))
+
+ (start #~(make-forkexec-constructor
+ (list (string-append #$upower "/libexec/upowerd"))
+ #:environment-variables
+ (list (string-append "UPOWER_CONF_FILE_NAME=" #$config))))
+ (stop #~(make-kill-destructor))
+ (activate #~(begin
+ (use-modules (guix build utils))
+ (mkdir-p "/var/lib/upower")
+ (let ((user (getpwnam "upower")))
+ (chown "/var/lib/upower"
+ (passwd:uid user) (passwd:gid user)))))
+
+ (user-groups (list (user-group
+ (name "upower")
+ (system? #t))))
+ (user-accounts (list (user-account
+ (name "upower")
+ (group "upower")
+ (system? #t)
+ (comment "UPower daemon user")
+ (home-directory "/var/empty")
+ (shell
+ #~(string-append #$shadow "/sbin/nologin"))))))))
;;;
@@ -263,34 +260,32 @@ interface to manage the color profiles of input and output devices such as
screens and scanners. It is notably used by the GNOME Color Manager graphical
tool. See @uref{http://www.freedesktop.org/software/colord/, the colord web
site} for more information."
- (with-monad %store-monad
- (return
- (service
- (documentation "Run the colord color management service.")
- (provision '(colord-daemon))
- (requirement '(dbus-system udev))
-
- (start #~(make-forkexec-constructor
- (list (string-append #$colord "/libexec/colord"))))
- (stop #~(make-kill-destructor))
- (activate #~(begin
- (use-modules (guix build utils))
- (mkdir-p "/var/lib/colord")
- (let ((user (getpwnam "colord")))
- (chown "/var/lib/colord"
- (passwd:uid user) (passwd:gid user)))))
-
- (user-groups (list (user-group
- (name "colord")
- (system? #t))))
- (user-accounts (list (user-account
- (name "colord")
- (group "colord")
- (system? #t)
- (comment "colord daemon user")
- (home-directory "/var/empty")
- (shell
- #~(string-append #$shadow "/sbin/nologin")))))))))
+ (service
+ (documentation "Run the colord color management service.")
+ (provision '(colord-daemon))
+ (requirement '(dbus-system udev))
+
+ (start #~(make-forkexec-constructor
+ (list (string-append #$colord "/libexec/colord"))))
+ (stop #~(make-kill-destructor))
+ (activate #~(begin
+ (use-modules (guix build utils))
+ (mkdir-p "/var/lib/colord")
+ (let ((user (getpwnam "colord")))
+ (chown "/var/lib/colord"
+ (passwd:uid user) (passwd:gid user)))))
+
+ (user-groups (list (user-group
+ (name "colord")
+ (system? #t))))
+ (user-accounts (list (user-account
+ (name "colord")
+ (group "colord")
+ (system? #t)
+ (comment "colord daemon user")
+ (home-directory "/var/empty")
+ (shell
+ #~(string-append #$shadow "/sbin/nologin")))))))
;;;
@@ -321,16 +316,16 @@ users are allowed."
wifi-submission-url submission-nick
applications)
"Return a geoclue configuration file."
- (text-file "geoclue.conf"
- (string-append
- "[agent]\n"
- "whitelist=" (string-join whitelist ";") "\n"
- "[wifi]\n"
- "url=" wifi-geolocation-url "\n"
- "submit-data=" (bool submit-data?)
- "submission-url=" wifi-submission-url "\n"
- "submission-nick=" submission-nick "\n"
- (string-join applications "\n"))))
+ (plain-file "geoclue.conf"
+ (string-append
+ "[agent]\n"
+ "whitelist=" (string-join whitelist ";") "\n"
+ "[wifi]\n"
+ "url=" wifi-geolocation-url "\n"
+ "submit-data=" (bool submit-data?)
+ "submission-url=" wifi-submission-url "\n"
+ "submission-nick=" submission-nick "\n"
+ (string-join applications "\n"))))
(define* (geoclue-service #:key (geoclue geoclue)
(whitelist '())
@@ -350,37 +345,36 @@ and Epiphany web browsers are able to ask for the user's location, and in the
case of Icecat and Epiphany, both will ask the user for permission first. See
@uref{https://wiki.freedesktop.org/www/Software/GeoClue/, the geoclue web
site} for more information."
- (mlet %store-monad ((config (geoclue-configuration-file
- #:whitelist whitelist
- #:wifi-geolocation-url wifi-geolocation-url
- #:submit-data? submit-data?
- #:wifi-submission-url wifi-submission-url
- #:submission-nick submission-nick
- #:applications applications)))
- (return
- (service
- (documentation "Run the GeoClue location service.")
- (provision '(geoclue-daemon))
- (requirement '(dbus-system))
-
- (start #~(make-forkexec-constructor
- (list (string-append #$geoclue "/libexec/geoclue"))
- #:user "geoclue"
- #:environment-variables
- (list (string-append "GEOCLUE_CONFIG_FILE=" #$config))))
- (stop #~(make-kill-destructor))
-
- (user-groups (list (user-group
- (name "geoclue")
- (system? #t))))
- (user-accounts (list (user-account
- (name "geoclue")
- (group "geoclue")
- (system? #t)
- (comment "GeoClue daemon user")
- (home-directory "/var/empty")
- (shell
- "/run/current-system/profile/sbin/nologin"))))))))
+ (let ((config (geoclue-configuration-file
+ #:whitelist whitelist
+ #:wifi-geolocation-url wifi-geolocation-url
+ #:submit-data? submit-data?
+ #:wifi-submission-url wifi-submission-url
+ #:submission-nick submission-nick
+ #:applications applications)))
+ (service
+ (documentation "Run the GeoClue location service.")
+ (provision '(geoclue-daemon))
+ (requirement '(dbus-system))
+
+ (start #~(make-forkexec-constructor
+ (list (string-append #$geoclue "/libexec/geoclue"))
+ #:user "geoclue"
+ #:environment-variables
+ (list (string-append "GEOCLUE_CONFIG_FILE=" #$config))))
+ (stop #~(make-kill-destructor))
+
+ (user-groups (list (user-group
+ (name "geoclue")
+ (system? #t))))
+ (user-accounts (list (user-account
+ (name "geoclue")
+ (group "geoclue")
+ (system? #t)
+ (comment "GeoClue daemon user")
+ (home-directory "/var/empty")
+ (shell
+ "/run/current-system/profile/sbin/nologin")))))))
;;;
@@ -393,30 +387,28 @@ service. By querying the @command{polkit} service, a privileged system
component can know when it should grant additional capabilities to ordinary
users. For example, an ordinary user can be granted the capability to suspend
the system if the user is logged in locally."
- (with-monad %store-monad
- (return
- (service
- (documentation "Run the polkit privilege management service.")
- (provision '(polkit-daemon))
- (requirement '(dbus-system))
-
- (start #~(make-forkexec-constructor
- (list (string-append #$polkit "/lib/polkit-1/polkitd"))))
- (stop #~(make-kill-destructor))
-
- (user-groups (list (user-group
- (name "polkitd")
- (system? #t))))
- (user-accounts (list (user-account
- (name "polkitd")
- (group "polkitd")
- (system? #t)
- (comment "Polkit daemon user")
- (home-directory "/var/empty")
- (shell
- "/run/current-system/profile/sbin/nologin"))))
-
- (pam-services (list (unix-pam-service "polkit-1")))))))
+ (service
+ (documentation "Run the polkit privilege management service.")
+ (provision '(polkit-daemon))
+ (requirement '(dbus-system))
+
+ (start #~(make-forkexec-constructor
+ (list (string-append #$polkit "/lib/polkit-1/polkitd"))))
+ (stop #~(make-kill-destructor))
+
+ (user-groups (list (user-group
+ (name "polkitd")
+ (system? #t))))
+ (user-accounts (list (user-account
+ (name "polkitd")
+ (group "polkitd")
+ (system? #t)
+ (comment "Polkit daemon user")
+ (home-directory "/var/empty")
+ (shell
+ "/run/current-system/profile/sbin/nologin"))))
+
+ (pam-services (list (unix-pam-service "polkit-1")))))
;;;
@@ -520,7 +512,7 @@ the system if the user is logged in locally."
((_ config str)
(string-append str "\n"))))
(define-syntax-rule (ini-file config file clause ...)
- (text-file file (string-append (ini-file-clause config clause) ...)))
+ (plain-file file (string-append (ini-file-clause config clause) ...)))
(ini-file
config "logind.conf"
"[Login]"
@@ -562,18 +554,17 @@ service. The @command{elogind} service integrates with PAM to allow other
system components to know the set of logged-in users as well as their session
types (graphical, console, remote, etc.). It can also clean up after users
when they log out."
- (mlet %store-monad ((config-file (elogind-configuration-file config)))
- (return
- (service
- (documentation "Run the elogind login and seat management service.")
- (provision '(elogind))
- (requirement '(dbus-system))
-
- (start #~(make-forkexec-constructor
- (list (string-append #$elogind "/libexec/elogind/elogind"))
- #:environment-variables
- (list (string-append "ELOGIND_CONF_FILE=" #$config-file))))
- (stop #~(make-kill-destructor))))))
+ (let ((config-file (elogind-configuration-file config)))
+ (service
+ (documentation "Run the elogind login and seat management service.")
+ (provision '(elogind))
+ (requirement '(dbus-system))
+
+ (start #~(make-forkexec-constructor
+ (list (string-append #$elogind "/libexec/elogind/elogind"))
+ #:environment-variables
+ (list (string-append "ELOGIND_CONF_FILE=" #$config-file))))
+ (stop #~(make-kill-destructor)))))
;;;
@@ -599,25 +590,24 @@ when they log out."
(ntp-service)
- (map (lambda (mservice)
- (mlet %store-monad ((service mservice))
- (cond
- ;; Provide an nscd ready to use nss-mdns.
- ((memq 'nscd (service-provision service))
- (nscd-service (nscd-configuration)
- #:name-services (list nss-mdns)))
-
- ;; Add more rules to udev-service.
- ;;
- ;; XXX Keep this in sync with the 'udev-service' call in
- ;; %base-services. Here we intend only to add 'upower',
- ;; 'colord', and 'elogind'.
- ((memq 'udev (service-provision service))
- (udev-service #:rules
- (list lvm2 fuse alsa-utils crda
- upower colord elogind)))
-
- (else mservice))))
+ (map (lambda (service)
+ (cond
+ ;; Provide an nscd ready to use nss-mdns.
+ ((memq 'nscd (service-provision service))
+ (nscd-service (nscd-configuration)
+ #:name-services (list nss-mdns)))
+
+ ;; Add more rules to udev-service.
+ ;;
+ ;; XXX Keep this in sync with the 'udev-service' call in
+ ;; %base-services. Here we intend only to add 'upower',
+ ;; 'colord', and 'elogind'.
+ ((memq 'udev (service-provision service))
+ (udev-service #:rules
+ (list lvm2 fuse alsa-utils crda
+ upower colord elogind)))
+
+ (else service)))
%base-services)))
;;; desktop.scm ends here