Commit | Line | Data |
---|---|---|
fe1a39d3 | 1 | ;;; GNU Guix --- Functional package management for GNU |
edc891fa | 2 | ;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> |
fe1a39d3 | 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) | |
0190c1c0 | 23 | #:use-module (gnu services shepherd) |
4467be21 | 24 | #:use-module (gnu services base) |
0adfe95a | 25 | #:use-module (gnu services dbus) |
4467be21 LC |
26 | #:use-module (gnu services avahi) |
27 | #:use-module (gnu services xorg) | |
28 | #:use-module (gnu services networking) | |
fe1a39d3 | 29 | #:use-module (gnu system shadow) |
6e828634 | 30 | #:use-module (gnu system pam) |
fe1a39d3 LC |
31 | #:use-module (gnu packages glib) |
32 | #:use-module (gnu packages admin) | |
04463bb0 | 33 | #:use-module (gnu packages freedesktop) |
fe1a39d3 | 34 | #:use-module (gnu packages gnome) |
4467be21 | 35 | #:use-module (gnu packages avahi) |
0071c789 | 36 | #:use-module (gnu packages polkit) |
6726282b LC |
37 | #:use-module (gnu packages xdisorg) |
38 | #:use-module (gnu packages suckless) | |
04463bb0 | 39 | #:use-module (guix records) |
0adfe95a | 40 | #:use-module (guix packages) |
fe1a39d3 LC |
41 | #:use-module (guix store) |
42 | #:use-module (guix gexp) | |
0adfe95a | 43 | #:use-module (srfi srfi-1) |
fe1a39d3 | 44 | #:use-module (ice-9 match) |
0adfe95a | 45 | #:export (upower-service |
2b9e0a94 | 46 | udisks-service |
4467be21 | 47 | colord-service |
cee32ee4 AW |
48 | geoclue-application |
49 | %standard-geoclue-applications | |
50 | geoclue-service | |
0071c789 | 51 | polkit-service |
04463bb0 AW |
52 | elogind-configuration |
53 | elogind-service | |
4467be21 | 54 | %desktop-services)) |
fe1a39d3 LC |
55 | |
56 | ;;; Commentary: | |
57 | ;;; | |
58 | ;;; This module contains service definitions for a "desktop" environment. | |
59 | ;;; | |
60 | ;;; Code: | |
61 | ||
62 | \f | |
cee32ee4 AW |
63 | ;;; |
64 | ;;; Helpers. | |
65 | ;;; | |
66 | ||
67 | (define (bool value) | |
68 | (if value "true\n" "false\n")) | |
69 | ||
fe1a39d3 | 70 | |
0adfe95a LC |
71 | (define (wrapped-dbus-service service program variable value) |
72 | "Return a wrapper for @var{service}, a package containing a D-Bus service, | |
73 | where @var{program} is wrapped such that environment variable @var{variable} | |
74 | is set to @var{value} when the bus daemon launches it." | |
75 | (define wrapper | |
76 | (program-file (string-append (package-name service) "-program-wrapper") | |
77 | #~(begin | |
78 | (setenv #$variable #$value) | |
79 | (apply execl (string-append #$service "/" #$program) | |
80 | (string-append #$service "/" #$program) | |
81 | (cdr (command-line)))))) | |
82 | ||
83 | (computed-file (string-append (package-name service) "-wrapper") | |
84 | #~(begin | |
85 | (use-modules (guix build utils)) | |
86 | ||
87 | (define service-directory | |
88 | "/share/dbus-1/system-services") | |
89 | ||
90 | (mkdir-p (dirname (string-append #$output | |
91 | service-directory))) | |
92 | (copy-recursively (string-append #$service | |
93 | service-directory) | |
94 | (string-append #$output | |
95 | service-directory)) | |
96 | (symlink (string-append #$service "/etc") ;for etc/dbus-1 | |
97 | (string-append #$output "/etc")) | |
98 | ||
99 | (for-each (lambda (file) | |
100 | (substitute* file | |
101 | (("Exec[[:blank:]]*=[[:blank:]]*([[:graph:]]+)(.*)$" | |
102 | _ original-program arguments) | |
103 | (string-append "Exec=" #$wrapper arguments | |
104 | "\n")))) | |
105 | (find-files #$output "\\.service$"))) | |
106 | #:modules '((guix build utils)))) | |
fe1a39d3 LC |
107 | |
108 | \f | |
109 | ;;; | |
110 | ;;; Upower D-Bus service. | |
111 | ;;; | |
112 | ||
0adfe95a LC |
113 | ;; TODO: Export. |
114 | (define-record-type* <upower-configuration> | |
115 | upower-configuration make-upower-configuration | |
116 | upower-configuration? | |
117 | (upower upower-configuration-upower | |
118 | (default upower)) | |
119 | (watts-up-pro? upower-configuration-watts-up-pro?) | |
120 | (poll-batteries? upower-configuration-poll-batteries?) | |
121 | (ignore-lid? upower-configuration-ignore-lid?) | |
122 | (use-percentage-for-policy? upower-configuration-use-percentage-for-policy?) | |
123 | (percentage-low upower-configuration-percentage-low) | |
124 | (percentage-critical upower-configuration-percentage-critical) | |
125 | (percentage-action upower-configuration-percentage-action) | |
126 | (time-low upower-configuration-time-low) | |
127 | (time-critical upower-configuration-time-critical) | |
128 | (time-action upower-configuration-time-action) | |
129 | (critical-power-action upower-configuration-critical-power-action)) | |
130 | ||
131 | (define* upower-configuration-file | |
132 | ;; Return an upower-daemon configuration file. | |
133 | (match-lambda | |
134 | (($ <upower-configuration> upower | |
135 | watts-up-pro? poll-batteries? ignore-lid? use-percentage-for-policy? | |
136 | percentage-low percentage-critical percentage-action time-low | |
137 | time-critical time-action critical-power-action) | |
138 | (plain-file "UPower.conf" | |
139 | (string-append | |
140 | "[UPower]\n" | |
141 | "EnableWattsUpPro=" (bool watts-up-pro?) | |
142 | "NoPollBatteries=" (bool (not poll-batteries?)) | |
143 | "IgnoreLid=" (bool ignore-lid?) | |
144 | "UsePercentageForPolicy=" (bool use-percentage-for-policy?) | |
145 | "PercentageLow=" (number->string percentage-low) "\n" | |
146 | "PercentageCritical=" (number->string percentage-critical) "\n" | |
147 | "PercentageAction=" (number->string percentage-action) "\n" | |
148 | "TimeLow=" (number->string time-low) "\n" | |
149 | "TimeCritical=" (number->string time-critical) "\n" | |
150 | "TimeAction=" (number->string time-action) "\n" | |
151 | "CriticalPowerAction=" (match critical-power-action | |
152 | ('hybrid-sleep "HybridSleep") | |
153 | ('hibernate "Hibernate") | |
154 | ('power-off "PowerOff")) | |
155 | "\n"))))) | |
156 | ||
0adfe95a LC |
157 | (define %upower-activation |
158 | #~(begin | |
159 | (use-modules (guix build utils)) | |
2da4f2dd | 160 | (mkdir-p "/var/lib/upower"))) |
0adfe95a LC |
161 | |
162 | (define (upower-dbus-service config) | |
163 | (list (wrapped-dbus-service (upower-configuration-upower config) | |
164 | "libexec/upowerd" | |
165 | "UPOWER_CONF_FILE_NAME" | |
166 | (upower-configuration-file config)))) | |
167 | ||
d4053c71 AK |
168 | (define (upower-shepherd-service config) |
169 | "Return a shepherd service for UPower with CONFIG." | |
0adfe95a LC |
170 | (let ((upower (upower-configuration-upower config)) |
171 | (config (upower-configuration-file config))) | |
d4053c71 | 172 | (list (shepherd-service |
0adfe95a LC |
173 | (documentation "Run the UPower power and battery monitor.") |
174 | (provision '(upower-daemon)) | |
175 | (requirement '(dbus-system udev)) | |
176 | ||
177 | (start #~(make-forkexec-constructor | |
178 | (list (string-append #$upower "/libexec/upowerd")) | |
179 | #:environment-variables | |
180 | (list (string-append "UPOWER_CONF_FILE_NAME=" | |
181 | #$config)))) | |
182 | (stop #~(make-kill-destructor)))))) | |
183 | ||
184 | (define upower-service-type | |
edc891fa LC |
185 | (let ((upower-package (compose list upower-configuration-upower))) |
186 | (service-type (name 'upower) | |
187 | (extensions | |
188 | (list (service-extension dbus-root-service-type | |
189 | upower-dbus-service) | |
190 | (service-extension shepherd-root-service-type | |
191 | upower-shepherd-service) | |
192 | (service-extension activation-service-type | |
193 | (const %upower-activation)) | |
194 | (service-extension udev-service-type | |
195 | upower-package) | |
196 | ||
197 | ;; Make the 'upower' command visible. | |
198 | (service-extension profile-service-type | |
199 | upower-package)))))) | |
fe1a39d3 LC |
200 | |
201 | (define* (upower-service #:key (upower upower) | |
202 | (watts-up-pro? #f) | |
203 | (poll-batteries? #t) | |
204 | (ignore-lid? #f) | |
205 | (use-percentage-for-policy? #f) | |
206 | (percentage-low 10) | |
207 | (percentage-critical 3) | |
208 | (percentage-action 2) | |
209 | (time-low 1200) | |
210 | (time-critical 300) | |
211 | (time-action 120) | |
212 | (critical-power-action 'hybrid-sleep)) | |
213 | "Return a service that runs @uref{http://upower.freedesktop.org/, | |
214 | @command{upowerd}}, a system-wide monitor for power consumption and battery | |
215 | levels, with the given configuration settings. It implements the | |
216 | @code{org.freedesktop.UPower} D-Bus interface, and is notably used by GNOME." | |
0adfe95a LC |
217 | (let ((config (upower-configuration |
218 | (watts-up-pro? watts-up-pro?) | |
219 | (poll-batteries? poll-batteries?) | |
220 | (ignore-lid? ignore-lid?) | |
221 | (use-percentage-for-policy? use-percentage-for-policy?) | |
222 | (percentage-low percentage-low) | |
223 | (percentage-critical percentage-critical) | |
224 | (percentage-action percentage-action) | |
225 | (time-low time-low) | |
226 | (time-critical time-critical) | |
227 | (time-action time-action) | |
228 | (critical-power-action critical-power-action)))) | |
229 | (service upower-service-type config))) | |
fe1a39d3 LC |
230 | |
231 | \f | |
cee32ee4 AW |
232 | ;;; |
233 | ;;; GeoClue D-Bus service. | |
234 | ;;; | |
235 | ||
0adfe95a LC |
236 | ;; TODO: Export. |
237 | (define-record-type* <geoclue-configuration> | |
238 | geoclue-configuration make-geoclue-configuration | |
239 | geoclue-configuration? | |
240 | (geoclue geoclue-configuration-geoclue | |
241 | (default geoclue)) | |
242 | (whitelist geoclue-configuration-whitelist) | |
243 | (wifi-geolocation-url geoclue-configuration-wifi-geolocation-url) | |
244 | (submit-data? geoclue-configuration-submit-data?) | |
245 | (wifi-submission-url geoclue-configuration-wifi-submission-url) | |
246 | (submission-nick geoclue-configuration-submission-nick) | |
247 | (applications geoclue-configuration-applications)) | |
248 | ||
cee32ee4 AW |
249 | (define* (geoclue-application name #:key (allowed? #t) system? (users '())) |
250 | "Configure default GeoClue access permissions for an application. NAME is | |
251 | the Desktop ID of the application, without the .desktop part. If ALLOWED? is | |
252 | true, the application will have access to location information by default. | |
253 | The boolean SYSTEM? value indicates that an application is a system component | |
254 | or not. Finally USERS is a list of UIDs of all users for which this | |
255 | application is allowed location info access. An empty users list means all | |
256 | users are allowed." | |
257 | (string-append | |
258 | "[" name "]\n" | |
259 | "allowed=" (bool allowed?) | |
260 | "system=" (bool system?) | |
261 | "users=" (string-join users ";") "\n")) | |
262 | ||
263 | (define %standard-geoclue-applications | |
264 | (list (geoclue-application "gnome-datetime-panel" #:system? #t) | |
265 | (geoclue-application "epiphany" #:system? #f) | |
266 | (geoclue-application "firefox" #:system? #f))) | |
267 | ||
0adfe95a | 268 | (define* (geoclue-configuration-file config) |
cee32ee4 | 269 | "Return a geoclue configuration file." |
be1c2c54 LC |
270 | (plain-file "geoclue.conf" |
271 | (string-append | |
272 | "[agent]\n" | |
0adfe95a LC |
273 | "whitelist=" |
274 | (string-join (geoclue-configuration-whitelist config) | |
275 | ";") "\n" | |
be1c2c54 | 276 | "[wifi]\n" |
0adfe95a LC |
277 | "url=" (geoclue-configuration-wifi-geolocation-url config) "\n" |
278 | "submit-data=" (bool (geoclue-configuration-submit-data? config)) | |
279 | "submission-url=" | |
280 | (geoclue-configuration-wifi-submission-url config) "\n" | |
281 | "submission-nick=" | |
282 | (geoclue-configuration-submission-nick config) | |
283 | "\n" | |
284 | (string-join (geoclue-configuration-applications config) | |
285 | "\n")))) | |
286 | ||
287 | (define (geoclue-dbus-service config) | |
288 | (list (wrapped-dbus-service (geoclue-configuration-geoclue config) | |
289 | "libexec/geoclue" | |
290 | "GEOCLUE_CONFIG_FILE" | |
291 | (geoclue-configuration-file config)))) | |
292 | ||
0adfe95a LC |
293 | (define %geoclue-accounts |
294 | (list (user-group (name "geoclue") (system? #t)) | |
295 | (user-account | |
296 | (name "geoclue") | |
297 | (group "geoclue") | |
298 | (system? #t) | |
299 | (comment "GeoClue daemon user") | |
300 | (home-directory "/var/empty") | |
301 | (shell "/run/current-system/profile/sbin/nologin")))) | |
302 | ||
303 | (define geoclue-service-type | |
304 | (service-type (name 'geoclue) | |
305 | (extensions | |
306 | (list (service-extension dbus-root-service-type | |
307 | geoclue-dbus-service) | |
0adfe95a LC |
308 | (service-extension account-service-type |
309 | (const %geoclue-accounts)))))) | |
cee32ee4 AW |
310 | |
311 | (define* (geoclue-service #:key (geoclue geoclue) | |
312 | (whitelist '()) | |
313 | (wifi-geolocation-url | |
314 | ;; Mozilla geolocation service: | |
315 | "https://location.services.mozilla.com/v1/geolocate?key=geoclue") | |
316 | (submit-data? #f) | |
317 | (wifi-submission-url | |
318 | "https://location.services.mozilla.com/v1/submit?key=geoclue") | |
319 | (submission-nick "geoclue") | |
320 | (applications %standard-geoclue-applications)) | |
321 | "Return a service that runs the @command{geoclue} location service. This | |
322 | service provides a D-Bus interface to allow applications to request access to | |
323 | a user's physical location, and optionally to add information to online | |
324 | location databases. By default, only the GNOME date-time panel and the Icecat | |
325 | and Epiphany web browsers are able to ask for the user's location, and in the | |
326 | case of Icecat and Epiphany, both will ask the user for permission first. See | |
327 | @uref{https://wiki.freedesktop.org/www/Software/GeoClue/, the geoclue web | |
328 | site} for more information." | |
0adfe95a LC |
329 | (service geoclue-service-type |
330 | (geoclue-configuration | |
331 | (geoclue geoclue) | |
332 | (whitelist whitelist) | |
333 | (wifi-geolocation-url wifi-geolocation-url) | |
334 | (submit-data? submit-data?) | |
335 | (wifi-submission-url wifi-submission-url) | |
336 | (submission-nick submission-nick) | |
337 | (applications applications)))) | |
cee32ee4 AW |
338 | |
339 | \f | |
0071c789 AW |
340 | ;;; |
341 | ;;; Polkit privilege management service. | |
342 | ;;; | |
343 | ||
222e3319 LC |
344 | (define-record-type* <polkit-configuration> |
345 | polkit-configuration make-polkit-configuration | |
346 | polkit-configuration? | |
347 | (polkit polkit-configuration-polkit ;<package> | |
348 | (default polkit)) | |
349 | (actions polkit-configuration-actions ;list of <package> | |
350 | (default '()))) | |
351 | ||
0adfe95a LC |
352 | (define %polkit-accounts |
353 | (list (user-group (name "polkitd") (system? #t)) | |
354 | (user-account | |
355 | (name "polkitd") | |
356 | (group "polkitd") | |
357 | (system? #t) | |
358 | (comment "Polkit daemon user") | |
359 | (home-directory "/var/empty") | |
360 | (shell "/run/current-system/profile/sbin/nologin")))) | |
361 | ||
362 | (define %polkit-pam-services | |
7824d445 | 363 | (list (unix-pam-service "polkit-1"))) |
0adfe95a | 364 | |
222e3319 LC |
365 | (define (polkit-directory packages) |
366 | "Return a directory containing an @file{actions} and possibly a | |
367 | @file{rules.d} sub-directory, for use as @file{/etc/polkit-1}." | |
368 | (computed-file "etc-polkit-1" | |
369 | #~(begin | |
370 | (use-modules (guix build union) (srfi srfi-26)) | |
371 | ||
372 | (union-build #$output | |
373 | (map (cut string-append <> | |
374 | "/share/polkit-1") | |
375 | (list #$@packages)))) | |
376 | #:modules '((guix build union)))) | |
377 | ||
378 | (define polkit-etc-files | |
379 | (match-lambda | |
380 | (($ <polkit-configuration> polkit packages) | |
381 | `(("polkit-1" ,(polkit-directory packages)))))) | |
382 | ||
383 | (define polkit-setuid-programs | |
384 | (match-lambda | |
385 | (($ <polkit-configuration> polkit) | |
386 | (list #~(string-append #$polkit | |
eac26c3b RW |
387 | "/lib/polkit-1/polkit-agent-helper-1") |
388 | #~(string-append #$polkit "/bin/pkexec"))))) | |
222e3319 | 389 | |
0adfe95a | 390 | (define polkit-service-type |
0adfe95a LC |
391 | (service-type (name 'polkit) |
392 | (extensions | |
393 | (list (service-extension account-service-type | |
394 | (const %polkit-accounts)) | |
395 | (service-extension pam-root-service-type | |
396 | (const %polkit-pam-services)) | |
397 | (service-extension dbus-root-service-type | |
222e3319 LC |
398 | (compose |
399 | list | |
400 | polkit-configuration-polkit)) | |
401 | (service-extension etc-service-type | |
402 | polkit-etc-files) | |
403 | (service-extension setuid-program-service-type | |
404 | polkit-setuid-programs))) | |
405 | ||
406 | ;; Extensions are lists of packages that provide polkit rules | |
407 | ;; or actions under share/polkit-1/{actions,rules.d}. | |
408 | (compose concatenate) | |
409 | (extend (lambda (config actions) | |
410 | (polkit-configuration | |
411 | (inherit config) | |
412 | (actions | |
413 | (append (polkit-configuration-actions config) | |
414 | actions))))))) | |
0adfe95a | 415 | |
0071c789 | 416 | (define* (polkit-service #:key (polkit polkit)) |
222e3319 LC |
417 | "Return a service that runs the |
418 | @uref{http://www.freedesktop.org/wiki/Software/polkit/, Polkit privilege | |
419 | management service}, which allows system administrators to grant access to | |
420 | privileged operations in a structured way. By querying the Polkit service, a | |
421 | privileged system component can know when it should grant additional | |
422 | capabilities to ordinary users. For example, an ordinary user can be granted | |
423 | the capability to suspend the system if the user is logged in locally." | |
424 | (service polkit-service-type | |
425 | (polkit-configuration (polkit polkit)))) | |
426 | ||
427 | \f | |
428 | ;;; | |
429 | ;;; Colord D-Bus service. | |
430 | ;;; | |
431 | ||
432 | (define %colord-activation | |
433 | #~(begin | |
434 | (use-modules (guix build utils)) | |
435 | (mkdir-p "/var/lib/colord") | |
436 | (let ((user (getpwnam "colord"))) | |
437 | (chown "/var/lib/colord" | |
438 | (passwd:uid user) (passwd:gid user))))) | |
439 | ||
440 | (define %colord-accounts | |
441 | (list (user-group (name "colord") (system? #t)) | |
442 | (user-account | |
443 | (name "colord") | |
444 | (group "colord") | |
445 | (system? #t) | |
446 | (comment "colord daemon user") | |
447 | (home-directory "/var/empty") | |
448 | (shell #~(string-append #$shadow "/sbin/nologin"))))) | |
449 | ||
450 | (define colord-service-type | |
451 | (service-type (name 'colord) | |
452 | (extensions | |
453 | (list (service-extension account-service-type | |
454 | (const %colord-accounts)) | |
455 | (service-extension activation-service-type | |
456 | (const %colord-activation)) | |
457 | ||
458 | ;; Colord is a D-Bus service that dbus-daemon can | |
459 | ;; activate. | |
460 | (service-extension dbus-root-service-type list) | |
461 | ||
462 | ;; Colord provides "color device" rules for udev. | |
463 | (service-extension udev-service-type list) | |
464 | ||
465 | ;; It provides polkit "actions". | |
466 | (service-extension polkit-service-type list))))) | |
467 | ||
468 | (define* (colord-service #:key (colord colord)) | |
469 | "Return a service that runs @command{colord}, a system service with a D-Bus | |
470 | interface to manage the color profiles of input and output devices such as | |
471 | screens and scanners. It is notably used by the GNOME Color Manager graphical | |
472 | tool. See @uref{http://www.freedesktop.org/software/colord/, the colord web | |
473 | site} for more information." | |
474 | (service colord-service-type colord)) | |
0071c789 AW |
475 | |
476 | \f | |
2b9e0a94 LC |
477 | ;;; |
478 | ;;; UDisks. | |
479 | ;;; | |
480 | ||
481 | (define-record-type* <udisks-configuration> | |
482 | udisks-configuration make-udisks-configuration | |
483 | udisks-configuration? | |
484 | (udisks udisks-configuration-udisks | |
485 | (default udisks))) | |
486 | ||
487 | (define udisks-service-type | |
488 | (let ((udisks-package (lambda (config) | |
489 | (list (udisks-configuration-udisks config))))) | |
490 | (service-type (name 'udisks) | |
491 | (extensions | |
492 | (list (service-extension polkit-service-type | |
493 | udisks-package) | |
494 | (service-extension dbus-root-service-type | |
495 | udisks-package) | |
496 | (service-extension udev-service-type | |
beca0807 LC |
497 | udisks-package) |
498 | ||
499 | ;; Profile 'udisksctl' & co. in the system profile. | |
500 | (service-extension profile-service-type | |
2b9e0a94 LC |
501 | udisks-package)))))) |
502 | ||
503 | (define* (udisks-service #:key (udisks udisks)) | |
504 | "Return a service for @uref{http://udisks.freedesktop.org/docs/latest/, | |
505 | UDisks}, a @dfn{disk management} daemon that provides user interfaces with | |
506 | notifications and ways to mount/unmount disks. Programs that talk to UDisks | |
507 | include the @command{udisksctl} command, part of UDisks, and GNOME Disks." | |
508 | (service udisks-service-type | |
509 | (udisks-configuration (udisks udisks)))) | |
510 | ||
511 | \f | |
04463bb0 AW |
512 | ;;; |
513 | ;;; Elogind login and seat management service. | |
514 | ;;; | |
515 | ||
516 | (define-record-type* <elogind-configuration> elogind-configuration | |
517 | make-elogind-configuration | |
518 | elogind-configuration | |
0adfe95a LC |
519 | (elogind elogind-package |
520 | (default elogind)) | |
04463bb0 AW |
521 | (kill-user-processes? elogind-kill-user-processes? |
522 | (default #f)) | |
523 | (kill-only-users elogind-kill-only-users | |
524 | (default '())) | |
525 | (kill-exclude-users elogind-kill-exclude-users | |
526 | (default '("root"))) | |
527 | (inhibit-delay-max-seconds elogind-inhibit-delay-max-seconds | |
528 | (default 5)) | |
529 | (handle-power-key elogind-handle-power-key | |
530 | (default 'poweroff)) | |
531 | (handle-suspend-key elogind-handle-suspend-key | |
532 | (default 'suspend)) | |
533 | (handle-hibernate-key elogind-handle-hibernate-key | |
574d9db2 MW |
534 | ;; (default 'hibernate) |
535 | ;; XXX Ignore it for now, since we don't | |
536 | ;; yet handle resume-from-hibernation in | |
537 | ;; our initrd. | |
538 | (default 'ignore)) | |
04463bb0 AW |
539 | (handle-lid-switch elogind-handle-lid-switch |
540 | (default 'suspend)) | |
541 | (handle-lid-switch-docked elogind-handle-lid-switch-docked | |
542 | (default 'ignore)) | |
543 | (power-key-ignore-inhibited? elogind-power-key-ignore-inhibited? | |
544 | (default #f)) | |
545 | (suspend-key-ignore-inhibited? elogind-suspend-key-ignore-inhibited? | |
546 | (default #f)) | |
547 | (hibernate-key-ignore-inhibited? elogind-hibernate-key-ignore-inhibited? | |
548 | (default #f)) | |
549 | (lid-switch-ignore-inhibited? elogind-lid-switch-ignore-inhibited? | |
550 | (default #t)) | |
551 | (holdoff-timeout-seconds elogind-holdoff-timeout-seconds | |
552 | (default 30)) | |
553 | (idle-action elogind-idle-action | |
554 | (default 'ignore)) | |
555 | (idle-action-seconds elogind-idle-action-seconds | |
556 | (default (* 30 60))) | |
557 | (runtime-directory-size-percent elogind-runtime-directory-size-percent | |
558 | (default 10)) | |
559 | (runtime-directory-size elogind-runtime-directory-size | |
560 | (default #f)) | |
561 | (remove-ipc? elogind-remove-ipc? | |
562 | (default #t)) | |
563 | ||
564 | (suspend-state elogind-suspend-state | |
565 | (default '("mem" "standby" "freeze"))) | |
566 | (suspend-mode elogind-suspend-mode | |
567 | (default '())) | |
568 | (hibernate-state elogind-hibernate-state | |
569 | (default '("disk"))) | |
570 | (hibernate-mode elogind-hibernate-mode | |
571 | (default '("platform" "shutdown"))) | |
572 | (hybrid-sleep-state elogind-hybrid-sleep-state | |
573 | (default '("disk"))) | |
574 | (hybrid-sleep-mode elogind-hybrid-sleep-mode | |
575 | (default | |
576 | '("suspend" "platform" "shutdown")))) | |
577 | ||
578 | (define (elogind-configuration-file config) | |
579 | (define (yesno x) | |
580 | (match x | |
581 | (#t "yes") | |
582 | (#f "no") | |
583 | (_ (error "expected #t or #f, instead got:" x)))) | |
584 | (define char-set:user-name | |
585 | (string->char-set "abcdefghijklmnopqrstuvwxyz0123456789_-")) | |
586 | (define (valid-list? l pred) | |
587 | (and-map (lambda (x) (string-every pred x)) l)) | |
588 | (define (user-name-list users) | |
589 | (unless (valid-list? users char-set:user-name) | |
590 | (error "invalid user list" users)) | |
591 | (string-join users " ")) | |
592 | (define (enum val allowed) | |
593 | (unless (memq val allowed) | |
594 | (error "invalid value" val allowed)) | |
595 | (symbol->string val)) | |
596 | (define (non-negative-integer x) | |
597 | (unless (exact-integer? x) (error "not an integer" x)) | |
598 | (when (negative? x) (error "negative number not allowed" x)) | |
599 | (number->string x)) | |
600 | (define handle-actions | |
601 | '(ignore poweroff reboot halt kexec suspend hibernate hybrid-sleep lock)) | |
602 | (define (handle-action x) | |
603 | (enum x handle-actions)) | |
604 | (define (sleep-list tokens) | |
605 | (unless (valid-list? tokens char-set:user-name) | |
606 | (error "invalid sleep list" tokens)) | |
607 | (string-join tokens " ")) | |
608 | (define-syntax ini-file-clause | |
609 | (syntax-rules () | |
610 | ((_ config (prop (parser getter))) | |
611 | (string-append prop "=" (parser (getter config)) "\n")) | |
612 | ((_ config str) | |
613 | (string-append str "\n")))) | |
614 | (define-syntax-rule (ini-file config file clause ...) | |
be1c2c54 | 615 | (plain-file file (string-append (ini-file-clause config clause) ...))) |
04463bb0 AW |
616 | (ini-file |
617 | config "logind.conf" | |
618 | "[Login]" | |
619 | ("KillUserProcesses" (yesno elogind-kill-user-processes?)) | |
620 | ("KillOnlyUsers" (user-name-list elogind-kill-only-users)) | |
621 | ("KillExcludeUsers" (user-name-list elogind-kill-exclude-users)) | |
622 | ("InhibitDelayMaxSecs" (non-negative-integer elogind-inhibit-delay-max-seconds)) | |
623 | ("HandlePowerKey" (handle-action elogind-handle-power-key)) | |
624 | ("HandleSuspendKey" (handle-action elogind-handle-suspend-key)) | |
625 | ("HandleHibernateKey" (handle-action elogind-handle-hibernate-key)) | |
626 | ("HandleLidSwitch" (handle-action elogind-handle-lid-switch)) | |
627 | ("HandleLidSwitchDocked" (handle-action elogind-handle-lid-switch-docked)) | |
628 | ("PowerKeyIgnoreInhibited" (yesno elogind-power-key-ignore-inhibited?)) | |
629 | ("SuspendKeyIgnoreInhibited" (yesno elogind-suspend-key-ignore-inhibited?)) | |
630 | ("HibernateKeyIgnoreInhibited" (yesno elogind-hibernate-key-ignore-inhibited?)) | |
631 | ("LidSwitchIgnoreInhibited" (yesno elogind-lid-switch-ignore-inhibited?)) | |
632 | ("HoldoffTimeoutSecs" (non-negative-integer elogind-holdoff-timeout-seconds)) | |
633 | ("IdleAction" (handle-action elogind-idle-action)) | |
634 | ("IdleActionSeconds" (non-negative-integer elogind-idle-action-seconds)) | |
635 | ("RuntimeDirectorySize" | |
636 | (identity | |
637 | (lambda (config) | |
638 | (match (elogind-runtime-directory-size-percent config) | |
639 | (#f (non-negative-integer (elogind-runtime-directory-size config))) | |
640 | (percent (string-append (non-negative-integer percent) "%")))))) | |
641 | ("RemoveIpc" (yesno elogind-remove-ipc?)) | |
642 | "[Sleep]" | |
643 | ("SuspendState" (sleep-list elogind-suspend-state)) | |
644 | ("SuspendMode" (sleep-list elogind-suspend-mode)) | |
645 | ("HibernateState" (sleep-list elogind-hibernate-state)) | |
646 | ("HibernateMode" (sleep-list elogind-hibernate-mode)) | |
647 | ("HybridSleepState" (sleep-list elogind-hybrid-sleep-state)) | |
648 | ("HybridSleepMode" (sleep-list elogind-hybrid-sleep-mode)))) | |
649 | ||
d4053c71 AK |
650 | (define (elogind-shepherd-service config) |
651 | "Return a shepherd service for elogind, using @var{config}." | |
26909789 LC |
652 | ;; TODO: We could probably rely on service activation but the '.service' |
653 | ;; file currently contains an erroneous 'Exec' line. | |
0adfe95a LC |
654 | (let ((config-file (elogind-configuration-file config)) |
655 | (elogind (elogind-package config))) | |
d4053c71 | 656 | (list (shepherd-service |
0adfe95a LC |
657 | (documentation "Run the elogind login and seat management service.") |
658 | (provision '(elogind)) | |
659 | (requirement '(dbus-system)) | |
660 | ||
661 | (start #~(make-forkexec-constructor | |
662 | (list (string-append #$elogind "/libexec/elogind/elogind")) | |
663 | #:environment-variables | |
664 | (list (string-append "ELOGIND_CONF_FILE=" #$config-file)))) | |
665 | (stop #~(make-kill-destructor)))))) | |
666 | ||
667 | (define elogind-service-type | |
668 | (service-type (name 'elogind) | |
669 | (extensions | |
d4053c71 AK |
670 | (list (service-extension shepherd-root-service-type |
671 | elogind-shepherd-service) | |
0adfe95a LC |
672 | (service-extension dbus-root-service-type |
673 | (compose list elogind-package)) | |
674 | (service-extension udev-service-type | |
675 | (compose list elogind-package)) | |
222e3319 LC |
676 | (service-extension polkit-service-type |
677 | (compose list elogind-package)) | |
05c5b165 LC |
678 | |
679 | ;; Provide the 'loginctl' command. | |
680 | (service-extension profile-service-type | |
681 | (compose list elogind-package)) | |
682 | ||
222e3319 | 683 | ;; TODO: Extend PAM with pam_elogind.so. |
0adfe95a LC |
684 | )))) |
685 | ||
686 | (define* (elogind-service #:key (config (elogind-configuration))) | |
04463bb0 AW |
687 | "Return a service that runs the @command{elogind} login and seat management |
688 | service. The @command{elogind} service integrates with PAM to allow other | |
689 | system components to know the set of logged-in users as well as their session | |
690 | types (graphical, console, remote, etc.). It can also clean up after users | |
691 | when they log out." | |
0adfe95a | 692 | (service elogind-service-type config)) |
04463bb0 AW |
693 | |
694 | \f | |
cee32ee4 AW |
695 | ;;; |
696 | ;;; The default set of desktop services. | |
697 | ;;; | |
0adfe95a | 698 | |
4467be21 LC |
699 | (define %desktop-services |
700 | ;; List of services typically useful for a "desktop" use case. | |
701 | (cons* (slim-service) | |
702 | ||
6726282b LC |
703 | ;; Screen lockers are a pretty useful thing and these are small. |
704 | (screen-locker-service slock) | |
705 | (screen-locker-service xlockmore "xlock") | |
706 | ||
0adfe95a | 707 | ;; The D-Bus clique. |
4467be21 LC |
708 | (avahi-service) |
709 | (wicd-service) | |
2b9e0a94 | 710 | (udisks-service) |
4467be21 LC |
711 | (upower-service) |
712 | (colord-service) | |
cee32ee4 | 713 | (geoclue-service) |
0071c789 | 714 | (polkit-service) |
04463bb0 | 715 | (elogind-service) |
0adfe95a | 716 | (dbus-service) |
4467be21 LC |
717 | |
718 | (ntp-service) | |
4467be21 | 719 | |
0adfe95a | 720 | %base-services)) |
4467be21 | 721 | |
fe1a39d3 | 722 | ;;; desktop.scm ends here |