Commit | Line | Data |
---|---|---|
fe1a39d3 LC |
1 | ;;; GNU Guix --- Functional package management for GNU |
2 | ;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org> | |
3 | ;;; Copyright © 2015 Andy Wingo <wingo@igalia.com> | |
4307c476 | 4 | ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> |
fe1a39d3 LC |
5 | ;;; |
6 | ;;; This file is part of GNU Guix. | |
7 | ;;; | |
8 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | |
9 | ;;; under the terms of the GNU General Public License as published by | |
10 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
11 | ;;; your option) any later version. | |
12 | ;;; | |
13 | ;;; GNU Guix is distributed in the hope that it will be useful, but | |
14 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
15 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
16 | ;;; GNU General Public License for more details. | |
17 | ;;; | |
18 | ;;; You should have received a copy of the GNU General Public License | |
19 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |
20 | ||
21 | (define-module (gnu services desktop) | |
22 | #:use-module (gnu services) | |
4467be21 LC |
23 | #:use-module (gnu services base) |
24 | #:use-module (gnu services avahi) | |
25 | #:use-module (gnu services xorg) | |
26 | #:use-module (gnu services networking) | |
fe1a39d3 | 27 | #:use-module (gnu system shadow) |
0071c789 | 28 | #:use-module (gnu system linux) ; unix-pam-service |
fe1a39d3 LC |
29 | #:use-module (gnu packages glib) |
30 | #:use-module (gnu packages admin) | |
04463bb0 | 31 | #:use-module (gnu packages freedesktop) |
fe1a39d3 | 32 | #:use-module (gnu packages gnome) |
4467be21 LC |
33 | #:use-module (gnu packages avahi) |
34 | #:use-module (gnu packages wicd) | |
0071c789 | 35 | #:use-module (gnu packages polkit) |
4307c476 MW |
36 | #:use-module ((gnu packages linux) |
37 | #:select (lvm2 fuse alsa-utils crda)) | |
04463bb0 | 38 | #:use-module (guix records) |
fe1a39d3 LC |
39 | #:use-module (guix store) |
40 | #:use-module (guix gexp) | |
41 | #:use-module (ice-9 match) | |
42 | #:export (dbus-service | |
43 | upower-service | |
4467be21 | 44 | colord-service |
cee32ee4 AW |
45 | geoclue-application |
46 | %standard-geoclue-applications | |
47 | geoclue-service | |
0071c789 | 48 | polkit-service |
04463bb0 AW |
49 | elogind-configuration |
50 | elogind-service | |
4467be21 | 51 | %desktop-services)) |
fe1a39d3 LC |
52 | |
53 | ;;; Commentary: | |
54 | ;;; | |
55 | ;;; This module contains service definitions for a "desktop" environment. | |
56 | ;;; | |
57 | ;;; Code: | |
58 | ||
59 | \f | |
cee32ee4 AW |
60 | ;;; |
61 | ;;; Helpers. | |
62 | ;;; | |
63 | ||
64 | (define (bool value) | |
65 | (if value "true\n" "false\n")) | |
66 | ||
67 | \f | |
fe1a39d3 LC |
68 | ;;; |
69 | ;;; D-Bus. | |
70 | ;;; | |
71 | ||
72 | (define (dbus-configuration-directory dbus services) | |
73 | "Return a configuration directory for @var{dbus} that includes the | |
74 | @code{etc/dbus-1/system.d} directories of each package listed in | |
75 | @var{services}." | |
76 | (define build | |
77 | #~(begin | |
78 | (use-modules (sxml simple) | |
79 | (srfi srfi-1)) | |
80 | ||
81 | (define (services->sxml services) | |
82 | ;; Return the SXML 'includedir' clauses for DIRS. | |
83 | `(busconfig | |
84 | ,@(append-map (lambda (dir) | |
85 | `((includedir | |
86 | ,(string-append dir "/etc/dbus-1/system.d")) | |
87 | (servicedir ;for '.service' files | |
e4fb9d2d | 88 | ,(string-append dir "/share/dbus-1/services")))) |
fe1a39d3 LC |
89 | services))) |
90 | ||
91 | (mkdir #$output) | |
92 | (copy-file (string-append #$dbus "/etc/dbus-1/system.conf") | |
93 | (string-append #$output "/system.conf")) | |
94 | ||
95 | ;; The default 'system.conf' has an <includedir> clause for | |
96 | ;; 'system.d', so create it. | |
97 | (mkdir (string-append #$output "/system.d")) | |
98 | ||
99 | ;; 'system-local.conf' is automatically included by the default | |
100 | ;; 'system.conf', so this is where we stuff our own things. | |
101 | (call-with-output-file (string-append #$output "/system-local.conf") | |
102 | (lambda (port) | |
103 | (sxml->xml (services->sxml (list #$@services)) | |
104 | port))))) | |
105 | ||
be1c2c54 | 106 | (computed-file "dbus-configuration" build)) |
fe1a39d3 LC |
107 | |
108 | (define* (dbus-service services #:key (dbus dbus)) | |
109 | "Return a service that runs the \"system bus\", using @var{dbus}, with | |
110 | support for @var{services}. | |
111 | ||
112 | @uref{http://dbus.freedesktop.org/, D-Bus} is an inter-process communication | |
113 | facility. Its system bus is used to allow system services to communicate and | |
114 | be notified of system-wide events. | |
115 | ||
116 | @var{services} must be a list of packages that provide an | |
117 | @file{etc/dbus-1/system.d} directory containing additional D-Bus configuration | |
118 | and policy files. For example, to allow avahi-daemon to use the system bus, | |
119 | @var{services} must be equal to @code{(list avahi)}." | |
be1c2c54 LC |
120 | (let ((conf (dbus-configuration-directory dbus services))) |
121 | (service | |
122 | (documentation "Run the D-Bus system daemon.") | |
123 | (provision '(dbus-system)) | |
124 | (requirement '(user-processes)) | |
125 | (start #~(make-forkexec-constructor | |
126 | (list (string-append #$dbus "/bin/dbus-daemon") | |
127 | "--nofork" | |
128 | (string-append "--config-file=" #$conf "/system.conf")))) | |
129 | (stop #~(make-kill-destructor)) | |
130 | (user-groups (list (user-group | |
131 | (name "messagebus") | |
132 | (system? #t)))) | |
133 | (user-accounts (list (user-account | |
134 | (name "messagebus") | |
135 | (group "messagebus") | |
136 | (system? #t) | |
137 | (comment "D-Bus system bus user") | |
138 | (home-directory "/var/run/dbus") | |
139 | (shell | |
140 | #~(string-append #$shadow "/sbin/nologin"))))) | |
141 | (activate #~(begin | |
142 | (use-modules (guix build utils)) | |
143 | ||
144 | (mkdir-p "/var/run/dbus") | |
145 | ||
146 | (let ((user (getpwnam "messagebus"))) | |
147 | (chown "/var/run/dbus" | |
148 | (passwd:uid user) (passwd:gid user))) | |
149 | ||
150 | (unless (file-exists? "/etc/machine-id") | |
151 | (format #t "creating /etc/machine-id...~%") | |
152 | (let ((prog (string-append #$dbus "/bin/dbus-uuidgen"))) | |
153 | ;; XXX: We can't use 'system' because the initrd's | |
154 | ;; guile system(3) only works when 'sh' is in $PATH. | |
155 | (let ((pid (primitive-fork))) | |
156 | (if (zero? pid) | |
157 | (call-with-output-file "/etc/machine-id" | |
158 | (lambda (port) | |
159 | (close-fdes 1) | |
160 | (dup2 (port->fdes port) 1) | |
161 | (execl prog))) | |
162 | (waitpid pid)))))))))) | |
fe1a39d3 LC |
163 | |
164 | \f | |
165 | ;;; | |
166 | ;;; Upower D-Bus service. | |
167 | ;;; | |
168 | ||
169 | (define* (upower-configuration-file #:key watts-up-pro? poll-batteries? | |
170 | ignore-lid? use-percentage-for-policy? | |
171 | percentage-low percentage-critical | |
172 | percentage-action time-low | |
173 | time-critical time-action | |
174 | critical-power-action) | |
175 | "Return an upower-daemon configuration file." | |
be1c2c54 LC |
176 | (plain-file "UPower.conf" |
177 | (string-append | |
178 | "[UPower]\n" | |
179 | "EnableWattsUpPro=" (bool watts-up-pro?) | |
180 | "NoPollBatteries=" (bool (not poll-batteries?)) | |
181 | "IgnoreLid=" (bool ignore-lid?) | |
182 | "UsePercentageForPolicy=" (bool use-percentage-for-policy?) | |
183 | "PercentageLow=" (number->string percentage-low) "\n" | |
184 | "PercentageCritical=" (number->string percentage-critical) "\n" | |
185 | "PercentageAction=" (number->string percentage-action) "\n" | |
186 | "TimeLow=" (number->string time-low) "\n" | |
187 | "TimeCritical=" (number->string time-critical) "\n" | |
188 | "TimeAction=" (number->string time-action) "\n" | |
189 | "CriticalPowerAction=" (match critical-power-action | |
190 | ('hybrid-sleep "HybridSleep") | |
191 | ('hibernate "Hibernate") | |
192 | ('power-off "PowerOff")) | |
193 | "\n"))) | |
fe1a39d3 LC |
194 | |
195 | (define* (upower-service #:key (upower upower) | |
196 | (watts-up-pro? #f) | |
197 | (poll-batteries? #t) | |
198 | (ignore-lid? #f) | |
199 | (use-percentage-for-policy? #f) | |
200 | (percentage-low 10) | |
201 | (percentage-critical 3) | |
202 | (percentage-action 2) | |
203 | (time-low 1200) | |
204 | (time-critical 300) | |
205 | (time-action 120) | |
206 | (critical-power-action 'hybrid-sleep)) | |
207 | "Return a service that runs @uref{http://upower.freedesktop.org/, | |
208 | @command{upowerd}}, a system-wide monitor for power consumption and battery | |
209 | levels, with the given configuration settings. It implements the | |
210 | @code{org.freedesktop.UPower} D-Bus interface, and is notably used by GNOME." | |
be1c2c54 LC |
211 | (let ((config (upower-configuration-file |
212 | #:watts-up-pro? watts-up-pro? | |
213 | #:poll-batteries? poll-batteries? | |
214 | #:ignore-lid? ignore-lid? | |
215 | #:use-percentage-for-policy? use-percentage-for-policy? | |
216 | #:percentage-low percentage-low | |
217 | #:percentage-critical percentage-critical | |
218 | #:percentage-action percentage-action | |
219 | #:time-low time-low | |
220 | #:time-critical time-critical | |
221 | #:time-action time-action | |
222 | #:critical-power-action critical-power-action))) | |
223 | (service | |
224 | (documentation "Run the UPower power and battery monitor.") | |
225 | (provision '(upower-daemon)) | |
226 | (requirement '(dbus-system udev)) | |
227 | ||
228 | (start #~(make-forkexec-constructor | |
229 | (list (string-append #$upower "/libexec/upowerd")) | |
230 | #:environment-variables | |
231 | (list (string-append "UPOWER_CONF_FILE_NAME=" #$config)))) | |
232 | (stop #~(make-kill-destructor)) | |
233 | (activate #~(begin | |
234 | (use-modules (guix build utils)) | |
235 | (mkdir-p "/var/lib/upower") | |
236 | (let ((user (getpwnam "upower"))) | |
237 | (chown "/var/lib/upower" | |
238 | (passwd:uid user) (passwd:gid user))))) | |
239 | ||
240 | (user-groups (list (user-group | |
241 | (name "upower") | |
242 | (system? #t)))) | |
243 | (user-accounts (list (user-account | |
244 | (name "upower") | |
245 | (group "upower") | |
246 | (system? #t) | |
247 | (comment "UPower daemon user") | |
248 | (home-directory "/var/empty") | |
249 | (shell | |
250 | #~(string-append #$shadow "/sbin/nologin")))))))) | |
fe1a39d3 LC |
251 | |
252 | \f | |
253 | ;;; | |
254 | ;;; Colord D-Bus service. | |
255 | ;;; | |
256 | ||
257 | (define* (colord-service #:key (colord colord)) | |
258 | "Return a service that runs @command{colord}, a system service with a D-Bus | |
259 | interface to manage the color profiles of input and output devices such as | |
260 | screens and scanners. It is notably used by the GNOME Color Manager graphical | |
261 | tool. See @uref{http://www.freedesktop.org/software/colord/, the colord web | |
262 | site} for more information." | |
be1c2c54 LC |
263 | (service |
264 | (documentation "Run the colord color management service.") | |
265 | (provision '(colord-daemon)) | |
266 | (requirement '(dbus-system udev)) | |
267 | ||
268 | (start #~(make-forkexec-constructor | |
269 | (list (string-append #$colord "/libexec/colord")))) | |
270 | (stop #~(make-kill-destructor)) | |
271 | (activate #~(begin | |
272 | (use-modules (guix build utils)) | |
273 | (mkdir-p "/var/lib/colord") | |
274 | (let ((user (getpwnam "colord"))) | |
275 | (chown "/var/lib/colord" | |
276 | (passwd:uid user) (passwd:gid user))))) | |
277 | ||
278 | (user-groups (list (user-group | |
279 | (name "colord") | |
280 | (system? #t)))) | |
281 | (user-accounts (list (user-account | |
282 | (name "colord") | |
283 | (group "colord") | |
284 | (system? #t) | |
285 | (comment "colord daemon user") | |
286 | (home-directory "/var/empty") | |
287 | (shell | |
288 | #~(string-append #$shadow "/sbin/nologin"))))))) | |
fe1a39d3 | 289 | |
cee32ee4 AW |
290 | \f |
291 | ;;; | |
292 | ;;; GeoClue D-Bus service. | |
293 | ;;; | |
294 | ||
295 | (define* (geoclue-application name #:key (allowed? #t) system? (users '())) | |
296 | "Configure default GeoClue access permissions for an application. NAME is | |
297 | the Desktop ID of the application, without the .desktop part. If ALLOWED? is | |
298 | true, the application will have access to location information by default. | |
299 | The boolean SYSTEM? value indicates that an application is a system component | |
300 | or not. Finally USERS is a list of UIDs of all users for which this | |
301 | application is allowed location info access. An empty users list means all | |
302 | users are allowed." | |
303 | (string-append | |
304 | "[" name "]\n" | |
305 | "allowed=" (bool allowed?) | |
306 | "system=" (bool system?) | |
307 | "users=" (string-join users ";") "\n")) | |
308 | ||
309 | (define %standard-geoclue-applications | |
310 | (list (geoclue-application "gnome-datetime-panel" #:system? #t) | |
311 | (geoclue-application "epiphany" #:system? #f) | |
312 | (geoclue-application "firefox" #:system? #f))) | |
313 | ||
314 | (define* (geoclue-configuration-file #:key whitelist wifi-geolocation-url | |
315 | submit-data? | |
316 | wifi-submission-url submission-nick | |
317 | applications) | |
318 | "Return a geoclue configuration file." | |
be1c2c54 LC |
319 | (plain-file "geoclue.conf" |
320 | (string-append | |
321 | "[agent]\n" | |
322 | "whitelist=" (string-join whitelist ";") "\n" | |
323 | "[wifi]\n" | |
324 | "url=" wifi-geolocation-url "\n" | |
325 | "submit-data=" (bool submit-data?) | |
326 | "submission-url=" wifi-submission-url "\n" | |
327 | "submission-nick=" submission-nick "\n" | |
328 | (string-join applications "\n")))) | |
cee32ee4 AW |
329 | |
330 | (define* (geoclue-service #:key (geoclue geoclue) | |
331 | (whitelist '()) | |
332 | (wifi-geolocation-url | |
333 | ;; Mozilla geolocation service: | |
334 | "https://location.services.mozilla.com/v1/geolocate?key=geoclue") | |
335 | (submit-data? #f) | |
336 | (wifi-submission-url | |
337 | "https://location.services.mozilla.com/v1/submit?key=geoclue") | |
338 | (submission-nick "geoclue") | |
339 | (applications %standard-geoclue-applications)) | |
340 | "Return a service that runs the @command{geoclue} location service. This | |
341 | service provides a D-Bus interface to allow applications to request access to | |
342 | a user's physical location, and optionally to add information to online | |
343 | location databases. By default, only the GNOME date-time panel and the Icecat | |
344 | and Epiphany web browsers are able to ask for the user's location, and in the | |
345 | case of Icecat and Epiphany, both will ask the user for permission first. See | |
346 | @uref{https://wiki.freedesktop.org/www/Software/GeoClue/, the geoclue web | |
347 | site} for more information." | |
be1c2c54 LC |
348 | (let ((config (geoclue-configuration-file |
349 | #:whitelist whitelist | |
350 | #:wifi-geolocation-url wifi-geolocation-url | |
351 | #:submit-data? submit-data? | |
352 | #:wifi-submission-url wifi-submission-url | |
353 | #:submission-nick submission-nick | |
354 | #:applications applications))) | |
355 | (service | |
356 | (documentation "Run the GeoClue location service.") | |
357 | (provision '(geoclue-daemon)) | |
358 | (requirement '(dbus-system)) | |
359 | ||
360 | (start #~(make-forkexec-constructor | |
361 | (list (string-append #$geoclue "/libexec/geoclue")) | |
362 | #:user "geoclue" | |
363 | #:environment-variables | |
364 | (list (string-append "GEOCLUE_CONFIG_FILE=" #$config)))) | |
365 | (stop #~(make-kill-destructor)) | |
366 | ||
367 | (user-groups (list (user-group | |
368 | (name "geoclue") | |
369 | (system? #t)))) | |
370 | (user-accounts (list (user-account | |
371 | (name "geoclue") | |
372 | (group "geoclue") | |
373 | (system? #t) | |
374 | (comment "GeoClue daemon user") | |
375 | (home-directory "/var/empty") | |
376 | (shell | |
377 | "/run/current-system/profile/sbin/nologin"))))))) | |
cee32ee4 AW |
378 | |
379 | \f | |
0071c789 AW |
380 | ;;; |
381 | ;;; Polkit privilege management service. | |
382 | ;;; | |
383 | ||
384 | (define* (polkit-service #:key (polkit polkit)) | |
385 | "Return a service that runs the @command{polkit} privilege management | |
386 | service. By querying the @command{polkit} service, a privileged system | |
387 | component can know when it should grant additional capabilities to ordinary | |
388 | users. For example, an ordinary user can be granted the capability to suspend | |
389 | the system if the user is logged in locally." | |
be1c2c54 LC |
390 | (service |
391 | (documentation "Run the polkit privilege management service.") | |
392 | (provision '(polkit-daemon)) | |
393 | (requirement '(dbus-system)) | |
394 | ||
395 | (start #~(make-forkexec-constructor | |
396 | (list (string-append #$polkit "/lib/polkit-1/polkitd")))) | |
397 | (stop #~(make-kill-destructor)) | |
398 | ||
399 | (user-groups (list (user-group | |
400 | (name "polkitd") | |
401 | (system? #t)))) | |
402 | (user-accounts (list (user-account | |
403 | (name "polkitd") | |
404 | (group "polkitd") | |
405 | (system? #t) | |
406 | (comment "Polkit daemon user") | |
407 | (home-directory "/var/empty") | |
408 | (shell | |
409 | "/run/current-system/profile/sbin/nologin")))) | |
410 | ||
411 | (pam-services (list (unix-pam-service "polkit-1"))))) | |
0071c789 AW |
412 | |
413 | \f | |
04463bb0 AW |
414 | ;;; |
415 | ;;; Elogind login and seat management service. | |
416 | ;;; | |
417 | ||
418 | (define-record-type* <elogind-configuration> elogind-configuration | |
419 | make-elogind-configuration | |
420 | elogind-configuration | |
421 | (kill-user-processes? elogind-kill-user-processes? | |
422 | (default #f)) | |
423 | (kill-only-users elogind-kill-only-users | |
424 | (default '())) | |
425 | (kill-exclude-users elogind-kill-exclude-users | |
426 | (default '("root"))) | |
427 | (inhibit-delay-max-seconds elogind-inhibit-delay-max-seconds | |
428 | (default 5)) | |
429 | (handle-power-key elogind-handle-power-key | |
430 | (default 'poweroff)) | |
431 | (handle-suspend-key elogind-handle-suspend-key | |
432 | (default 'suspend)) | |
433 | (handle-hibernate-key elogind-handle-hibernate-key | |
574d9db2 MW |
434 | ;; (default 'hibernate) |
435 | ;; XXX Ignore it for now, since we don't | |
436 | ;; yet handle resume-from-hibernation in | |
437 | ;; our initrd. | |
438 | (default 'ignore)) | |
04463bb0 AW |
439 | (handle-lid-switch elogind-handle-lid-switch |
440 | (default 'suspend)) | |
441 | (handle-lid-switch-docked elogind-handle-lid-switch-docked | |
442 | (default 'ignore)) | |
443 | (power-key-ignore-inhibited? elogind-power-key-ignore-inhibited? | |
444 | (default #f)) | |
445 | (suspend-key-ignore-inhibited? elogind-suspend-key-ignore-inhibited? | |
446 | (default #f)) | |
447 | (hibernate-key-ignore-inhibited? elogind-hibernate-key-ignore-inhibited? | |
448 | (default #f)) | |
449 | (lid-switch-ignore-inhibited? elogind-lid-switch-ignore-inhibited? | |
450 | (default #t)) | |
451 | (holdoff-timeout-seconds elogind-holdoff-timeout-seconds | |
452 | (default 30)) | |
453 | (idle-action elogind-idle-action | |
454 | (default 'ignore)) | |
455 | (idle-action-seconds elogind-idle-action-seconds | |
456 | (default (* 30 60))) | |
457 | (runtime-directory-size-percent elogind-runtime-directory-size-percent | |
458 | (default 10)) | |
459 | (runtime-directory-size elogind-runtime-directory-size | |
460 | (default #f)) | |
461 | (remove-ipc? elogind-remove-ipc? | |
462 | (default #t)) | |
463 | ||
464 | (suspend-state elogind-suspend-state | |
465 | (default '("mem" "standby" "freeze"))) | |
466 | (suspend-mode elogind-suspend-mode | |
467 | (default '())) | |
468 | (hibernate-state elogind-hibernate-state | |
469 | (default '("disk"))) | |
470 | (hibernate-mode elogind-hibernate-mode | |
471 | (default '("platform" "shutdown"))) | |
472 | (hybrid-sleep-state elogind-hybrid-sleep-state | |
473 | (default '("disk"))) | |
474 | (hybrid-sleep-mode elogind-hybrid-sleep-mode | |
475 | (default | |
476 | '("suspend" "platform" "shutdown")))) | |
477 | ||
478 | (define (elogind-configuration-file config) | |
479 | (define (yesno x) | |
480 | (match x | |
481 | (#t "yes") | |
482 | (#f "no") | |
483 | (_ (error "expected #t or #f, instead got:" x)))) | |
484 | (define char-set:user-name | |
485 | (string->char-set "abcdefghijklmnopqrstuvwxyz0123456789_-")) | |
486 | (define (valid-list? l pred) | |
487 | (and-map (lambda (x) (string-every pred x)) l)) | |
488 | (define (user-name-list users) | |
489 | (unless (valid-list? users char-set:user-name) | |
490 | (error "invalid user list" users)) | |
491 | (string-join users " ")) | |
492 | (define (enum val allowed) | |
493 | (unless (memq val allowed) | |
494 | (error "invalid value" val allowed)) | |
495 | (symbol->string val)) | |
496 | (define (non-negative-integer x) | |
497 | (unless (exact-integer? x) (error "not an integer" x)) | |
498 | (when (negative? x) (error "negative number not allowed" x)) | |
499 | (number->string x)) | |
500 | (define handle-actions | |
501 | '(ignore poweroff reboot halt kexec suspend hibernate hybrid-sleep lock)) | |
502 | (define (handle-action x) | |
503 | (enum x handle-actions)) | |
504 | (define (sleep-list tokens) | |
505 | (unless (valid-list? tokens char-set:user-name) | |
506 | (error "invalid sleep list" tokens)) | |
507 | (string-join tokens " ")) | |
508 | (define-syntax ini-file-clause | |
509 | (syntax-rules () | |
510 | ((_ config (prop (parser getter))) | |
511 | (string-append prop "=" (parser (getter config)) "\n")) | |
512 | ((_ config str) | |
513 | (string-append str "\n")))) | |
514 | (define-syntax-rule (ini-file config file clause ...) | |
be1c2c54 | 515 | (plain-file file (string-append (ini-file-clause config clause) ...))) |
04463bb0 AW |
516 | (ini-file |
517 | config "logind.conf" | |
518 | "[Login]" | |
519 | ("KillUserProcesses" (yesno elogind-kill-user-processes?)) | |
520 | ("KillOnlyUsers" (user-name-list elogind-kill-only-users)) | |
521 | ("KillExcludeUsers" (user-name-list elogind-kill-exclude-users)) | |
522 | ("InhibitDelayMaxSecs" (non-negative-integer elogind-inhibit-delay-max-seconds)) | |
523 | ("HandlePowerKey" (handle-action elogind-handle-power-key)) | |
524 | ("HandleSuspendKey" (handle-action elogind-handle-suspend-key)) | |
525 | ("HandleHibernateKey" (handle-action elogind-handle-hibernate-key)) | |
526 | ("HandleLidSwitch" (handle-action elogind-handle-lid-switch)) | |
527 | ("HandleLidSwitchDocked" (handle-action elogind-handle-lid-switch-docked)) | |
528 | ("PowerKeyIgnoreInhibited" (yesno elogind-power-key-ignore-inhibited?)) | |
529 | ("SuspendKeyIgnoreInhibited" (yesno elogind-suspend-key-ignore-inhibited?)) | |
530 | ("HibernateKeyIgnoreInhibited" (yesno elogind-hibernate-key-ignore-inhibited?)) | |
531 | ("LidSwitchIgnoreInhibited" (yesno elogind-lid-switch-ignore-inhibited?)) | |
532 | ("HoldoffTimeoutSecs" (non-negative-integer elogind-holdoff-timeout-seconds)) | |
533 | ("IdleAction" (handle-action elogind-idle-action)) | |
534 | ("IdleActionSeconds" (non-negative-integer elogind-idle-action-seconds)) | |
535 | ("RuntimeDirectorySize" | |
536 | (identity | |
537 | (lambda (config) | |
538 | (match (elogind-runtime-directory-size-percent config) | |
539 | (#f (non-negative-integer (elogind-runtime-directory-size config))) | |
540 | (percent (string-append (non-negative-integer percent) "%")))))) | |
541 | ("RemoveIpc" (yesno elogind-remove-ipc?)) | |
542 | "[Sleep]" | |
543 | ("SuspendState" (sleep-list elogind-suspend-state)) | |
544 | ("SuspendMode" (sleep-list elogind-suspend-mode)) | |
545 | ("HibernateState" (sleep-list elogind-hibernate-state)) | |
546 | ("HibernateMode" (sleep-list elogind-hibernate-mode)) | |
547 | ("HybridSleepState" (sleep-list elogind-hybrid-sleep-state)) | |
548 | ("HybridSleepMode" (sleep-list elogind-hybrid-sleep-mode)))) | |
549 | ||
550 | (define* (elogind-service #:key (elogind elogind) | |
551 | (config (elogind-configuration))) | |
552 | "Return a service that runs the @command{elogind} login and seat management | |
553 | service. The @command{elogind} service integrates with PAM to allow other | |
554 | system components to know the set of logged-in users as well as their session | |
555 | types (graphical, console, remote, etc.). It can also clean up after users | |
556 | when they log out." | |
be1c2c54 LC |
557 | (let ((config-file (elogind-configuration-file config))) |
558 | (service | |
559 | (documentation "Run the elogind login and seat management service.") | |
560 | (provision '(elogind)) | |
561 | (requirement '(dbus-system)) | |
562 | ||
563 | (start #~(make-forkexec-constructor | |
564 | (list (string-append #$elogind "/libexec/elogind/elogind")) | |
565 | #:environment-variables | |
566 | (list (string-append "ELOGIND_CONF_FILE=" #$config-file)))) | |
567 | (stop #~(make-kill-destructor))))) | |
04463bb0 AW |
568 | |
569 | \f | |
cee32ee4 AW |
570 | ;;; |
571 | ;;; The default set of desktop services. | |
572 | ;;; | |
4467be21 LC |
573 | (define %desktop-services |
574 | ;; List of services typically useful for a "desktop" use case. | |
575 | (cons* (slim-service) | |
576 | ||
577 | (avahi-service) | |
578 | (wicd-service) | |
579 | (upower-service) | |
0071c789 AW |
580 | ;; FIXME: The colord, geoclue, and polkit services could all be |
581 | ;; bus-activated by default, so they don't run at program startup. | |
582 | ;; However, user creation and /var/lib/colord creation happen at | |
583 | ;; service activation time, so we currently add them to the set of | |
584 | ;; default services. | |
4467be21 | 585 | (colord-service) |
cee32ee4 | 586 | (geoclue-service) |
0071c789 | 587 | (polkit-service) |
04463bb0 | 588 | (elogind-service) |
0071c789 | 589 | (dbus-service (list avahi wicd upower colord geoclue polkit elogind)) |
4467be21 LC |
590 | |
591 | (ntp-service) | |
4467be21 | 592 | |
be1c2c54 LC |
593 | (map (lambda (service) |
594 | (cond | |
595 | ;; Provide an nscd ready to use nss-mdns. | |
596 | ((memq 'nscd (service-provision service)) | |
b893f1ae LC |
597 | (nscd-service (nscd-configuration |
598 | (name-services (list nss-mdns))))) | |
be1c2c54 LC |
599 | |
600 | ;; Add more rules to udev-service. | |
601 | ;; | |
602 | ;; XXX Keep this in sync with the 'udev-service' call in | |
603 | ;; %base-services. Here we intend only to add 'upower', | |
604 | ;; 'colord', and 'elogind'. | |
605 | ((memq 'udev (service-provision service)) | |
606 | (udev-service #:rules | |
607 | (list lvm2 fuse alsa-utils crda | |
608 | upower colord elogind))) | |
609 | ||
610 | (else service))) | |
4467be21 LC |
611 | %base-services))) |
612 | ||
fe1a39d3 | 613 | ;;; desktop.scm ends here |