Commit | Line | Data |
---|---|---|
fe1a39d3 | 1 | ;;; GNU Guix --- Functional package management for GNU |
94a88117 | 2 | ;;; Copyright © 2014, 2015, 2016, 2017 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> |
922e21f4 | 5 | ;;; Copyright © 2016 Sou Bunnbu <iyzsong@gmail.com> |
b9f67d6d | 6 | ;;; Copyright © 2017 Maxim Cournoyer <maxim.cournoyer@gmail.com> |
4a78fd46 | 7 | ;;; Copyright © 2017 Nils Gillmann <ng0@n0.is> |
fe1a39d3 LC |
8 | ;;; |
9 | ;;; This file is part of GNU Guix. | |
10 | ;;; | |
11 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | |
12 | ;;; under the terms of the GNU General Public License as published by | |
13 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
14 | ;;; your option) any later version. | |
15 | ;;; | |
16 | ;;; GNU Guix is distributed in the hope that it will be useful, but | |
17 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 | ;;; GNU General Public License for more details. | |
20 | ;;; | |
21 | ;;; You should have received a copy of the GNU General Public License | |
22 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |
23 | ||
24 | (define-module (gnu services desktop) | |
25 | #:use-module (gnu services) | |
0190c1c0 | 26 | #:use-module (gnu services shepherd) |
4467be21 | 27 | #:use-module (gnu services base) |
0adfe95a | 28 | #:use-module (gnu services dbus) |
4467be21 LC |
29 | #:use-module (gnu services avahi) |
30 | #:use-module (gnu services xorg) | |
31 | #:use-module (gnu services networking) | |
ef6a4844 | 32 | #:use-module (gnu services sound) |
38c2b503 LC |
33 | #:use-module ((gnu system file-systems) |
34 | #:select (%elogind-file-systems)) | |
fe1a39d3 | 35 | #:use-module (gnu system shadow) |
6e828634 | 36 | #:use-module (gnu system pam) |
fe1a39d3 LC |
37 | #:use-module (gnu packages glib) |
38 | #:use-module (gnu packages admin) | |
04463bb0 | 39 | #:use-module (gnu packages freedesktop) |
fe1a39d3 | 40 | #:use-module (gnu packages gnome) |
7a2413e4 | 41 | #:use-module (gnu packages xfce) |
4467be21 | 42 | #:use-module (gnu packages avahi) |
6726282b LC |
43 | #:use-module (gnu packages xdisorg) |
44 | #:use-module (gnu packages suckless) | |
922e21f4 | 45 | #:use-module (gnu packages linux) |
3547a5ef | 46 | #:use-module (gnu packages libusb) |
431703ff | 47 | #:use-module (gnu packages mate) |
04463bb0 | 48 | #:use-module (guix records) |
0adfe95a | 49 | #:use-module (guix packages) |
fe1a39d3 LC |
50 | #:use-module (guix store) |
51 | #:use-module (guix gexp) | |
0adfe95a | 52 | #:use-module (srfi srfi-1) |
fe1a39d3 | 53 | #:use-module (ice-9 match) |
24e96431 TČ |
54 | #:export (upower-configuration |
55 | upower-configuration? | |
56 | upower-service | |
57 | upower-service-type | |
58 | ||
59 | udisks-configuration | |
60 | udisks-configuration? | |
2b9e0a94 | 61 | udisks-service |
24e96431 TČ |
62 | udisks-service-type |
63 | ||
4467be21 | 64 | colord-service |
24e96431 | 65 | |
cee32ee4 | 66 | geoclue-application |
24e96431 TČ |
67 | geoclue-configuration |
68 | geoclue-configuration? | |
cee32ee4 AW |
69 | %standard-geoclue-applications |
70 | geoclue-service | |
24e96431 TČ |
71 | geoclue-service-type |
72 | ||
922e21f4 | 73 | bluetooth-service |
24e96431 | 74 | |
04463bb0 | 75 | elogind-configuration |
24e96431 | 76 | elogind-configuration? |
04463bb0 | 77 | elogind-service |
24e96431 TČ |
78 | elogind-service-type |
79 | ||
063c6082 AW |
80 | accountsservice-service-type |
81 | accountsservice-service | |
82 | ||
24e96431 TČ |
83 | gnome-desktop-configuration |
84 | gnome-desktop-configuration? | |
7a2413e4 | 85 | gnome-desktop-service |
24e96431 TČ |
86 | gnome-desktop-service-type |
87 | ||
431703ff | 88 | mate-desktop-configuration |
89 | mate-desktop-configuration? | |
90 | mate-desktop-service | |
91 | mate-desktop-service-type | |
92 | ||
24e96431 TČ |
93 | xfce-desktop-configuration |
94 | xfce-desktop-configuration? | |
7a2413e4 | 95 | xfce-desktop-service |
24e96431 TČ |
96 | xfce-desktop-service-type |
97 | ||
cd730719 TW |
98 | x11-socket-directory-service |
99 | ||
4467be21 | 100 | %desktop-services)) |
fe1a39d3 LC |
101 | |
102 | ;;; Commentary: | |
103 | ;;; | |
104 | ;;; This module contains service definitions for a "desktop" environment. | |
105 | ;;; | |
106 | ;;; Code: | |
107 | ||
108 | \f | |
cee32ee4 AW |
109 | ;;; |
110 | ;;; Helpers. | |
111 | ;;; | |
112 | ||
113 | (define (bool value) | |
114 | (if value "true\n" "false\n")) | |
115 | ||
7a2413e4 AW |
116 | (define (package-direct-input-selector input) |
117 | (lambda (package) | |
118 | (match (assoc-ref (package-direct-inputs package) input) | |
119 | ((package . _) package)))) | |
120 | ||
fe1a39d3 | 121 | |
0adfe95a LC |
122 | (define (wrapped-dbus-service service program variable value) |
123 | "Return a wrapper for @var{service}, a package containing a D-Bus service, | |
124 | where @var{program} is wrapped such that environment variable @var{variable} | |
125 | is set to @var{value} when the bus daemon launches it." | |
126 | (define wrapper | |
127 | (program-file (string-append (package-name service) "-program-wrapper") | |
128 | #~(begin | |
129 | (setenv #$variable #$value) | |
130 | (apply execl (string-append #$service "/" #$program) | |
131 | (string-append #$service "/" #$program) | |
132 | (cdr (command-line)))))) | |
133 | ||
4ee96a79 LC |
134 | (define build |
135 | (with-imported-modules '((guix build utils)) | |
136 | #~(begin | |
137 | (use-modules (guix build utils)) | |
138 | ||
139 | (define service-directory | |
140 | "/share/dbus-1/system-services") | |
141 | ||
142 | (mkdir-p (dirname (string-append #$output | |
143 | service-directory))) | |
144 | (copy-recursively (string-append #$service | |
145 | service-directory) | |
146 | (string-append #$output | |
147 | service-directory)) | |
148 | (symlink (string-append #$service "/etc") ;for etc/dbus-1 | |
149 | (string-append #$output "/etc")) | |
150 | ||
151 | (for-each (lambda (file) | |
152 | (substitute* file | |
153 | (("Exec[[:blank:]]*=[[:blank:]]*([[:graph:]]+)(.*)$" | |
154 | _ original-program arguments) | |
155 | (string-append "Exec=" #$wrapper arguments | |
156 | "\n")))) | |
157 | (find-files #$output "\\.service$"))))) | |
158 | ||
0adfe95a | 159 | (computed-file (string-append (package-name service) "-wrapper") |
4ee96a79 | 160 | build)) |
fe1a39d3 LC |
161 | |
162 | \f | |
163 | ;;; | |
164 | ;;; Upower D-Bus service. | |
165 | ;;; | |
166 | ||
0adfe95a LC |
167 | ;; TODO: Export. |
168 | (define-record-type* <upower-configuration> | |
169 | upower-configuration make-upower-configuration | |
170 | upower-configuration? | |
171 | (upower upower-configuration-upower | |
172 | (default upower)) | |
173 | (watts-up-pro? upower-configuration-watts-up-pro?) | |
174 | (poll-batteries? upower-configuration-poll-batteries?) | |
175 | (ignore-lid? upower-configuration-ignore-lid?) | |
176 | (use-percentage-for-policy? upower-configuration-use-percentage-for-policy?) | |
177 | (percentage-low upower-configuration-percentage-low) | |
178 | (percentage-critical upower-configuration-percentage-critical) | |
179 | (percentage-action upower-configuration-percentage-action) | |
180 | (time-low upower-configuration-time-low) | |
181 | (time-critical upower-configuration-time-critical) | |
182 | (time-action upower-configuration-time-action) | |
183 | (critical-power-action upower-configuration-critical-power-action)) | |
184 | ||
185 | (define* upower-configuration-file | |
186 | ;; Return an upower-daemon configuration file. | |
187 | (match-lambda | |
188 | (($ <upower-configuration> upower | |
189 | watts-up-pro? poll-batteries? ignore-lid? use-percentage-for-policy? | |
190 | percentage-low percentage-critical percentage-action time-low | |
191 | time-critical time-action critical-power-action) | |
192 | (plain-file "UPower.conf" | |
193 | (string-append | |
194 | "[UPower]\n" | |
195 | "EnableWattsUpPro=" (bool watts-up-pro?) | |
196 | "NoPollBatteries=" (bool (not poll-batteries?)) | |
197 | "IgnoreLid=" (bool ignore-lid?) | |
198 | "UsePercentageForPolicy=" (bool use-percentage-for-policy?) | |
199 | "PercentageLow=" (number->string percentage-low) "\n" | |
200 | "PercentageCritical=" (number->string percentage-critical) "\n" | |
201 | "PercentageAction=" (number->string percentage-action) "\n" | |
202 | "TimeLow=" (number->string time-low) "\n" | |
203 | "TimeCritical=" (number->string time-critical) "\n" | |
204 | "TimeAction=" (number->string time-action) "\n" | |
205 | "CriticalPowerAction=" (match critical-power-action | |
206 | ('hybrid-sleep "HybridSleep") | |
207 | ('hibernate "Hibernate") | |
208 | ('power-off "PowerOff")) | |
209 | "\n"))))) | |
210 | ||
0adfe95a LC |
211 | (define %upower-activation |
212 | #~(begin | |
213 | (use-modules (guix build utils)) | |
2da4f2dd | 214 | (mkdir-p "/var/lib/upower"))) |
0adfe95a LC |
215 | |
216 | (define (upower-dbus-service config) | |
217 | (list (wrapped-dbus-service (upower-configuration-upower config) | |
218 | "libexec/upowerd" | |
219 | "UPOWER_CONF_FILE_NAME" | |
220 | (upower-configuration-file config)))) | |
221 | ||
d4053c71 AK |
222 | (define (upower-shepherd-service config) |
223 | "Return a shepherd service for UPower with CONFIG." | |
0adfe95a LC |
224 | (let ((upower (upower-configuration-upower config)) |
225 | (config (upower-configuration-file config))) | |
d4053c71 | 226 | (list (shepherd-service |
0adfe95a LC |
227 | (documentation "Run the UPower power and battery monitor.") |
228 | (provision '(upower-daemon)) | |
229 | (requirement '(dbus-system udev)) | |
230 | ||
231 | (start #~(make-forkexec-constructor | |
232 | (list (string-append #$upower "/libexec/upowerd")) | |
233 | #:environment-variables | |
234 | (list (string-append "UPOWER_CONF_FILE_NAME=" | |
235 | #$config)))) | |
236 | (stop #~(make-kill-destructor)))))) | |
237 | ||
238 | (define upower-service-type | |
edc891fa LC |
239 | (let ((upower-package (compose list upower-configuration-upower))) |
240 | (service-type (name 'upower) | |
241 | (extensions | |
242 | (list (service-extension dbus-root-service-type | |
243 | upower-dbus-service) | |
244 | (service-extension shepherd-root-service-type | |
245 | upower-shepherd-service) | |
246 | (service-extension activation-service-type | |
247 | (const %upower-activation)) | |
248 | (service-extension udev-service-type | |
249 | upower-package) | |
250 | ||
251 | ;; Make the 'upower' command visible. | |
252 | (service-extension profile-service-type | |
253 | upower-package)))))) | |
fe1a39d3 LC |
254 | |
255 | (define* (upower-service #:key (upower upower) | |
256 | (watts-up-pro? #f) | |
257 | (poll-batteries? #t) | |
258 | (ignore-lid? #f) | |
259 | (use-percentage-for-policy? #f) | |
260 | (percentage-low 10) | |
261 | (percentage-critical 3) | |
262 | (percentage-action 2) | |
263 | (time-low 1200) | |
264 | (time-critical 300) | |
265 | (time-action 120) | |
266 | (critical-power-action 'hybrid-sleep)) | |
267 | "Return a service that runs @uref{http://upower.freedesktop.org/, | |
268 | @command{upowerd}}, a system-wide monitor for power consumption and battery | |
269 | levels, with the given configuration settings. It implements the | |
270 | @code{org.freedesktop.UPower} D-Bus interface, and is notably used by GNOME." | |
0adfe95a LC |
271 | (let ((config (upower-configuration |
272 | (watts-up-pro? watts-up-pro?) | |
273 | (poll-batteries? poll-batteries?) | |
274 | (ignore-lid? ignore-lid?) | |
275 | (use-percentage-for-policy? use-percentage-for-policy?) | |
276 | (percentage-low percentage-low) | |
277 | (percentage-critical percentage-critical) | |
278 | (percentage-action percentage-action) | |
279 | (time-low time-low) | |
280 | (time-critical time-critical) | |
281 | (time-action time-action) | |
282 | (critical-power-action critical-power-action)))) | |
283 | (service upower-service-type config))) | |
fe1a39d3 LC |
284 | |
285 | \f | |
cee32ee4 AW |
286 | ;;; |
287 | ;;; GeoClue D-Bus service. | |
288 | ;;; | |
289 | ||
0adfe95a LC |
290 | ;; TODO: Export. |
291 | (define-record-type* <geoclue-configuration> | |
292 | geoclue-configuration make-geoclue-configuration | |
293 | geoclue-configuration? | |
294 | (geoclue geoclue-configuration-geoclue | |
295 | (default geoclue)) | |
296 | (whitelist geoclue-configuration-whitelist) | |
297 | (wifi-geolocation-url geoclue-configuration-wifi-geolocation-url) | |
298 | (submit-data? geoclue-configuration-submit-data?) | |
299 | (wifi-submission-url geoclue-configuration-wifi-submission-url) | |
300 | (submission-nick geoclue-configuration-submission-nick) | |
301 | (applications geoclue-configuration-applications)) | |
302 | ||
cee32ee4 AW |
303 | (define* (geoclue-application name #:key (allowed? #t) system? (users '())) |
304 | "Configure default GeoClue access permissions for an application. NAME is | |
305 | the Desktop ID of the application, without the .desktop part. If ALLOWED? is | |
306 | true, the application will have access to location information by default. | |
307 | The boolean SYSTEM? value indicates that an application is a system component | |
308 | or not. Finally USERS is a list of UIDs of all users for which this | |
309 | application is allowed location info access. An empty users list means all | |
310 | users are allowed." | |
311 | (string-append | |
312 | "[" name "]\n" | |
313 | "allowed=" (bool allowed?) | |
314 | "system=" (bool system?) | |
315 | "users=" (string-join users ";") "\n")) | |
316 | ||
317 | (define %standard-geoclue-applications | |
318 | (list (geoclue-application "gnome-datetime-panel" #:system? #t) | |
319 | (geoclue-application "epiphany" #:system? #f) | |
320 | (geoclue-application "firefox" #:system? #f))) | |
321 | ||
0adfe95a | 322 | (define* (geoclue-configuration-file config) |
cee32ee4 | 323 | "Return a geoclue configuration file." |
be1c2c54 LC |
324 | (plain-file "geoclue.conf" |
325 | (string-append | |
326 | "[agent]\n" | |
0adfe95a LC |
327 | "whitelist=" |
328 | (string-join (geoclue-configuration-whitelist config) | |
329 | ";") "\n" | |
be1c2c54 | 330 | "[wifi]\n" |
0adfe95a LC |
331 | "url=" (geoclue-configuration-wifi-geolocation-url config) "\n" |
332 | "submit-data=" (bool (geoclue-configuration-submit-data? config)) | |
333 | "submission-url=" | |
334 | (geoclue-configuration-wifi-submission-url config) "\n" | |
335 | "submission-nick=" | |
336 | (geoclue-configuration-submission-nick config) | |
337 | "\n" | |
338 | (string-join (geoclue-configuration-applications config) | |
339 | "\n")))) | |
340 | ||
341 | (define (geoclue-dbus-service config) | |
342 | (list (wrapped-dbus-service (geoclue-configuration-geoclue config) | |
343 | "libexec/geoclue" | |
344 | "GEOCLUE_CONFIG_FILE" | |
345 | (geoclue-configuration-file config)))) | |
346 | ||
0adfe95a LC |
347 | (define %geoclue-accounts |
348 | (list (user-group (name "geoclue") (system? #t)) | |
349 | (user-account | |
350 | (name "geoclue") | |
351 | (group "geoclue") | |
352 | (system? #t) | |
353 | (comment "GeoClue daemon user") | |
354 | (home-directory "/var/empty") | |
355 | (shell "/run/current-system/profile/sbin/nologin")))) | |
356 | ||
357 | (define geoclue-service-type | |
358 | (service-type (name 'geoclue) | |
359 | (extensions | |
360 | (list (service-extension dbus-root-service-type | |
361 | geoclue-dbus-service) | |
0adfe95a LC |
362 | (service-extension account-service-type |
363 | (const %geoclue-accounts)))))) | |
cee32ee4 AW |
364 | |
365 | (define* (geoclue-service #:key (geoclue geoclue) | |
366 | (whitelist '()) | |
367 | (wifi-geolocation-url | |
368 | ;; Mozilla geolocation service: | |
369 | "https://location.services.mozilla.com/v1/geolocate?key=geoclue") | |
370 | (submit-data? #f) | |
371 | (wifi-submission-url | |
372 | "https://location.services.mozilla.com/v1/submit?key=geoclue") | |
373 | (submission-nick "geoclue") | |
374 | (applications %standard-geoclue-applications)) | |
375 | "Return a service that runs the @command{geoclue} location service. This | |
376 | service provides a D-Bus interface to allow applications to request access to | |
377 | a user's physical location, and optionally to add information to online | |
378 | location databases. By default, only the GNOME date-time panel and the Icecat | |
379 | and Epiphany web browsers are able to ask for the user's location, and in the | |
380 | case of Icecat and Epiphany, both will ask the user for permission first. See | |
381 | @uref{https://wiki.freedesktop.org/www/Software/GeoClue/, the geoclue web | |
382 | site} for more information." | |
0adfe95a LC |
383 | (service geoclue-service-type |
384 | (geoclue-configuration | |
385 | (geoclue geoclue) | |
386 | (whitelist whitelist) | |
387 | (wifi-geolocation-url wifi-geolocation-url) | |
388 | (submit-data? submit-data?) | |
389 | (wifi-submission-url wifi-submission-url) | |
390 | (submission-nick submission-nick) | |
391 | (applications applications)))) | |
cee32ee4 AW |
392 | |
393 | \f | |
922e21f4 SB |
394 | ;;; |
395 | ;;; Bluetooth. | |
396 | ;;; | |
397 | ||
b9f67d6d MC |
398 | (define-record-type* <bluetooth-configuration> |
399 | bluetooth-configuration make-bluetooth-configuration | |
400 | bluetooth-configuration? | |
401 | (bluez bluetooth-configuration-bluez (default bluez)) | |
402 | (auto-enable? bluetooth-configuration-auto-enable? (default #f))) | |
403 | ||
404 | (define (bluetooth-configuration-file config) | |
405 | "Return a configuration file for the systemd bluetooth service, as a string." | |
406 | (string-append | |
407 | "[Policy]\n" | |
408 | "AutoEnable=" (bool (bluetooth-configuration-auto-enable? | |
409 | config)))) | |
410 | ||
411 | (define (bluetooth-directory config) | |
412 | (computed-file "etc-bluetooth" | |
413 | #~(begin | |
414 | (mkdir #$output) | |
415 | (chdir #$output) | |
416 | (call-with-output-file "main.conf" | |
417 | (lambda (port) | |
418 | (display #$(bluetooth-configuration-file config) | |
419 | port)))))) | |
420 | ||
421 | (define (bluetooth-shepherd-service config) | |
922e21f4 SB |
422 | "Return a shepherd service for @command{bluetoothd}." |
423 | (shepherd-service | |
424 | (provision '(bluetooth)) | |
425 | (requirement '(dbus-system udev)) | |
426 | (documentation "Run the bluetoothd daemon.") | |
427 | (start #~(make-forkexec-constructor | |
b9f67d6d MC |
428 | (string-append #$(bluetooth-configuration-bluez config) |
429 | "/libexec/bluetooth/bluetoothd"))) | |
922e21f4 SB |
430 | (stop #~(make-kill-destructor)))) |
431 | ||
432 | (define bluetooth-service-type | |
433 | (service-type | |
434 | (name 'bluetooth) | |
435 | (extensions | |
b9f67d6d MC |
436 | (list (service-extension dbus-root-service-type |
437 | (compose list bluetooth-configuration-bluez)) | |
438 | (service-extension udev-service-type | |
439 | (compose list bluetooth-configuration-bluez)) | |
440 | (service-extension etc-service-type | |
441 | (lambda (config) | |
442 | `(("bluetooth" | |
443 | ,(bluetooth-directory config))))) | |
922e21f4 SB |
444 | (service-extension shepherd-root-service-type |
445 | (compose list bluetooth-shepherd-service)))))) | |
446 | ||
b9f67d6d | 447 | (define* (bluetooth-service #:key (bluez bluez) (auto-enable? #f)) |
922e21f4 | 448 | "Return a service that runs the @command{bluetoothd} daemon, which manages |
b9f67d6d MC |
449 | all the Bluetooth devices and provides a number of D-Bus interfaces. When |
450 | AUTO-ENABLE? is true, the bluetooth controller is powered automatically at | |
451 | boot. | |
922e21f4 SB |
452 | |
453 | Users need to be in the @code{lp} group to access the D-Bus service. | |
454 | " | |
b9f67d6d MC |
455 | (service bluetooth-service-type |
456 | (bluetooth-configuration | |
457 | (bluez bluez) | |
458 | (auto-enable? auto-enable?)))) | |
922e21f4 SB |
459 | |
460 | \f | |
222e3319 LC |
461 | ;;; |
462 | ;;; Colord D-Bus service. | |
463 | ;;; | |
464 | ||
465 | (define %colord-activation | |
466 | #~(begin | |
467 | (use-modules (guix build utils)) | |
468 | (mkdir-p "/var/lib/colord") | |
469 | (let ((user (getpwnam "colord"))) | |
470 | (chown "/var/lib/colord" | |
471 | (passwd:uid user) (passwd:gid user))))) | |
472 | ||
473 | (define %colord-accounts | |
474 | (list (user-group (name "colord") (system? #t)) | |
475 | (user-account | |
476 | (name "colord") | |
477 | (group "colord") | |
478 | (system? #t) | |
479 | (comment "colord daemon user") | |
480 | (home-directory "/var/empty") | |
9e41130b | 481 | (shell (file-append shadow "/sbin/nologin"))))) |
222e3319 LC |
482 | |
483 | (define colord-service-type | |
484 | (service-type (name 'colord) | |
485 | (extensions | |
486 | (list (service-extension account-service-type | |
487 | (const %colord-accounts)) | |
488 | (service-extension activation-service-type | |
489 | (const %colord-activation)) | |
490 | ||
491 | ;; Colord is a D-Bus service that dbus-daemon can | |
492 | ;; activate. | |
493 | (service-extension dbus-root-service-type list) | |
494 | ||
495 | ;; Colord provides "color device" rules for udev. | |
496 | (service-extension udev-service-type list) | |
497 | ||
498 | ;; It provides polkit "actions". | |
499 | (service-extension polkit-service-type list))))) | |
500 | ||
501 | (define* (colord-service #:key (colord colord)) | |
502 | "Return a service that runs @command{colord}, a system service with a D-Bus | |
503 | interface to manage the color profiles of input and output devices such as | |
504 | screens and scanners. It is notably used by the GNOME Color Manager graphical | |
505 | tool. See @uref{http://www.freedesktop.org/software/colord/, the colord web | |
506 | site} for more information." | |
507 | (service colord-service-type colord)) | |
0071c789 AW |
508 | |
509 | \f | |
2b9e0a94 LC |
510 | ;;; |
511 | ;;; UDisks. | |
512 | ;;; | |
513 | ||
514 | (define-record-type* <udisks-configuration> | |
515 | udisks-configuration make-udisks-configuration | |
516 | udisks-configuration? | |
517 | (udisks udisks-configuration-udisks | |
518 | (default udisks))) | |
519 | ||
58233964 CB |
520 | (define %udisks-activation |
521 | (with-imported-modules '((guix build utils)) | |
522 | #~(begin | |
523 | (use-modules (guix build utils)) | |
524 | ||
525 | (let ((run-dir "/var/run/udisks2")) | |
526 | (mkdir-p run-dir) | |
527 | (chmod run-dir #o700))))) | |
528 | ||
2b9e0a94 LC |
529 | (define udisks-service-type |
530 | (let ((udisks-package (lambda (config) | |
531 | (list (udisks-configuration-udisks config))))) | |
532 | (service-type (name 'udisks) | |
533 | (extensions | |
534 | (list (service-extension polkit-service-type | |
535 | udisks-package) | |
536 | (service-extension dbus-root-service-type | |
537 | udisks-package) | |
538 | (service-extension udev-service-type | |
beca0807 | 539 | udisks-package) |
58233964 CB |
540 | (service-extension activation-service-type |
541 | (const %udisks-activation)) | |
beca0807 LC |
542 | |
543 | ;; Profile 'udisksctl' & co. in the system profile. | |
544 | (service-extension profile-service-type | |
2b9e0a94 LC |
545 | udisks-package)))))) |
546 | ||
547 | (define* (udisks-service #:key (udisks udisks)) | |
548 | "Return a service for @uref{http://udisks.freedesktop.org/docs/latest/, | |
549 | UDisks}, a @dfn{disk management} daemon that provides user interfaces with | |
550 | notifications and ways to mount/unmount disks. Programs that talk to UDisks | |
551 | include the @command{udisksctl} command, part of UDisks, and GNOME Disks." | |
552 | (service udisks-service-type | |
553 | (udisks-configuration (udisks udisks)))) | |
554 | ||
555 | \f | |
04463bb0 AW |
556 | ;;; |
557 | ;;; Elogind login and seat management service. | |
558 | ;;; | |
559 | ||
560 | (define-record-type* <elogind-configuration> elogind-configuration | |
561 | make-elogind-configuration | |
562 | elogind-configuration | |
0adfe95a LC |
563 | (elogind elogind-package |
564 | (default elogind)) | |
04463bb0 AW |
565 | (kill-user-processes? elogind-kill-user-processes? |
566 | (default #f)) | |
567 | (kill-only-users elogind-kill-only-users | |
568 | (default '())) | |
569 | (kill-exclude-users elogind-kill-exclude-users | |
570 | (default '("root"))) | |
571 | (inhibit-delay-max-seconds elogind-inhibit-delay-max-seconds | |
572 | (default 5)) | |
573 | (handle-power-key elogind-handle-power-key | |
574 | (default 'poweroff)) | |
575 | (handle-suspend-key elogind-handle-suspend-key | |
576 | (default 'suspend)) | |
577 | (handle-hibernate-key elogind-handle-hibernate-key | |
574d9db2 MW |
578 | ;; (default 'hibernate) |
579 | ;; XXX Ignore it for now, since we don't | |
580 | ;; yet handle resume-from-hibernation in | |
581 | ;; our initrd. | |
582 | (default 'ignore)) | |
04463bb0 AW |
583 | (handle-lid-switch elogind-handle-lid-switch |
584 | (default 'suspend)) | |
585 | (handle-lid-switch-docked elogind-handle-lid-switch-docked | |
586 | (default 'ignore)) | |
587 | (power-key-ignore-inhibited? elogind-power-key-ignore-inhibited? | |
588 | (default #f)) | |
589 | (suspend-key-ignore-inhibited? elogind-suspend-key-ignore-inhibited? | |
590 | (default #f)) | |
591 | (hibernate-key-ignore-inhibited? elogind-hibernate-key-ignore-inhibited? | |
592 | (default #f)) | |
593 | (lid-switch-ignore-inhibited? elogind-lid-switch-ignore-inhibited? | |
594 | (default #t)) | |
595 | (holdoff-timeout-seconds elogind-holdoff-timeout-seconds | |
596 | (default 30)) | |
597 | (idle-action elogind-idle-action | |
598 | (default 'ignore)) | |
599 | (idle-action-seconds elogind-idle-action-seconds | |
600 | (default (* 30 60))) | |
601 | (runtime-directory-size-percent elogind-runtime-directory-size-percent | |
602 | (default 10)) | |
603 | (runtime-directory-size elogind-runtime-directory-size | |
604 | (default #f)) | |
605 | (remove-ipc? elogind-remove-ipc? | |
606 | (default #t)) | |
607 | ||
608 | (suspend-state elogind-suspend-state | |
609 | (default '("mem" "standby" "freeze"))) | |
610 | (suspend-mode elogind-suspend-mode | |
611 | (default '())) | |
612 | (hibernate-state elogind-hibernate-state | |
613 | (default '("disk"))) | |
614 | (hibernate-mode elogind-hibernate-mode | |
615 | (default '("platform" "shutdown"))) | |
616 | (hybrid-sleep-state elogind-hybrid-sleep-state | |
617 | (default '("disk"))) | |
618 | (hybrid-sleep-mode elogind-hybrid-sleep-mode | |
619 | (default | |
620 | '("suspend" "platform" "shutdown")))) | |
621 | ||
622 | (define (elogind-configuration-file config) | |
623 | (define (yesno x) | |
624 | (match x | |
625 | (#t "yes") | |
626 | (#f "no") | |
627 | (_ (error "expected #t or #f, instead got:" x)))) | |
628 | (define char-set:user-name | |
629 | (string->char-set "abcdefghijklmnopqrstuvwxyz0123456789_-")) | |
630 | (define (valid-list? l pred) | |
631 | (and-map (lambda (x) (string-every pred x)) l)) | |
632 | (define (user-name-list users) | |
633 | (unless (valid-list? users char-set:user-name) | |
634 | (error "invalid user list" users)) | |
635 | (string-join users " ")) | |
636 | (define (enum val allowed) | |
637 | (unless (memq val allowed) | |
638 | (error "invalid value" val allowed)) | |
639 | (symbol->string val)) | |
640 | (define (non-negative-integer x) | |
641 | (unless (exact-integer? x) (error "not an integer" x)) | |
642 | (when (negative? x) (error "negative number not allowed" x)) | |
643 | (number->string x)) | |
644 | (define handle-actions | |
645 | '(ignore poweroff reboot halt kexec suspend hibernate hybrid-sleep lock)) | |
646 | (define (handle-action x) | |
647 | (enum x handle-actions)) | |
648 | (define (sleep-list tokens) | |
649 | (unless (valid-list? tokens char-set:user-name) | |
650 | (error "invalid sleep list" tokens)) | |
651 | (string-join tokens " ")) | |
652 | (define-syntax ini-file-clause | |
653 | (syntax-rules () | |
654 | ((_ config (prop (parser getter))) | |
655 | (string-append prop "=" (parser (getter config)) "\n")) | |
656 | ((_ config str) | |
657 | (string-append str "\n")))) | |
658 | (define-syntax-rule (ini-file config file clause ...) | |
be1c2c54 | 659 | (plain-file file (string-append (ini-file-clause config clause) ...))) |
04463bb0 AW |
660 | (ini-file |
661 | config "logind.conf" | |
662 | "[Login]" | |
663 | ("KillUserProcesses" (yesno elogind-kill-user-processes?)) | |
664 | ("KillOnlyUsers" (user-name-list elogind-kill-only-users)) | |
665 | ("KillExcludeUsers" (user-name-list elogind-kill-exclude-users)) | |
666 | ("InhibitDelayMaxSecs" (non-negative-integer elogind-inhibit-delay-max-seconds)) | |
667 | ("HandlePowerKey" (handle-action elogind-handle-power-key)) | |
668 | ("HandleSuspendKey" (handle-action elogind-handle-suspend-key)) | |
669 | ("HandleHibernateKey" (handle-action elogind-handle-hibernate-key)) | |
670 | ("HandleLidSwitch" (handle-action elogind-handle-lid-switch)) | |
671 | ("HandleLidSwitchDocked" (handle-action elogind-handle-lid-switch-docked)) | |
672 | ("PowerKeyIgnoreInhibited" (yesno elogind-power-key-ignore-inhibited?)) | |
673 | ("SuspendKeyIgnoreInhibited" (yesno elogind-suspend-key-ignore-inhibited?)) | |
674 | ("HibernateKeyIgnoreInhibited" (yesno elogind-hibernate-key-ignore-inhibited?)) | |
675 | ("LidSwitchIgnoreInhibited" (yesno elogind-lid-switch-ignore-inhibited?)) | |
676 | ("HoldoffTimeoutSecs" (non-negative-integer elogind-holdoff-timeout-seconds)) | |
677 | ("IdleAction" (handle-action elogind-idle-action)) | |
678 | ("IdleActionSeconds" (non-negative-integer elogind-idle-action-seconds)) | |
679 | ("RuntimeDirectorySize" | |
680 | (identity | |
681 | (lambda (config) | |
682 | (match (elogind-runtime-directory-size-percent config) | |
683 | (#f (non-negative-integer (elogind-runtime-directory-size config))) | |
684 | (percent (string-append (non-negative-integer percent) "%")))))) | |
685 | ("RemoveIpc" (yesno elogind-remove-ipc?)) | |
686 | "[Sleep]" | |
687 | ("SuspendState" (sleep-list elogind-suspend-state)) | |
688 | ("SuspendMode" (sleep-list elogind-suspend-mode)) | |
689 | ("HibernateState" (sleep-list elogind-hibernate-state)) | |
690 | ("HibernateMode" (sleep-list elogind-hibernate-mode)) | |
691 | ("HybridSleepState" (sleep-list elogind-hybrid-sleep-state)) | |
692 | ("HybridSleepMode" (sleep-list elogind-hybrid-sleep-mode)))) | |
693 | ||
956ad60c LC |
694 | (define (elogind-dbus-service config) |
695 | (list (wrapped-dbus-service (elogind-package config) | |
696 | "libexec/elogind/elogind" | |
697 | "ELOGIND_CONF_FILE" | |
698 | (elogind-configuration-file config)))) | |
0adfe95a | 699 | |
e7ad0d58 LC |
700 | (define (pam-extension-procedure config) |
701 | "Return an extension for PAM-ROOT-SERVICE-TYPE that ensures that all the PAM | |
702 | services use 'pam_elogind.so', a module that allows elogind to keep track of | |
703 | logged-in users (run 'loginctl' to see elogind's world view of users and | |
704 | seats.)" | |
705 | (define pam-elogind | |
706 | (pam-entry | |
707 | (control "required") | |
9e41130b LC |
708 | (module (file-append (elogind-package config) |
709 | "/lib/security/pam_elogind.so")))) | |
e7ad0d58 LC |
710 | |
711 | (list (lambda (pam) | |
712 | (pam-service | |
713 | (inherit pam) | |
714 | (session (cons pam-elogind (pam-service-session pam))))))) | |
715 | ||
94a88117 LC |
716 | (define (elogind-shepherd-service config) |
717 | "Return a Shepherd service to start elogind according to @var{config}." | |
718 | (list (shepherd-service | |
719 | (requirement '(dbus-system)) | |
720 | (provision '(elogind)) | |
721 | (start #~(make-forkexec-constructor | |
722 | (list #$(file-append (elogind-package config) | |
723 | "/libexec/elogind/elogind")) | |
724 | #:environment-variables | |
725 | (list (string-append "ELOGIND_CONF_FILE=" | |
726 | #$(elogind-configuration-file | |
727 | config))))) | |
728 | (stop #~(make-kill-destructor))))) | |
729 | ||
0adfe95a LC |
730 | (define elogind-service-type |
731 | (service-type (name 'elogind) | |
732 | (extensions | |
956ad60c LC |
733 | (list (service-extension dbus-root-service-type |
734 | elogind-dbus-service) | |
0adfe95a LC |
735 | (service-extension udev-service-type |
736 | (compose list elogind-package)) | |
222e3319 LC |
737 | (service-extension polkit-service-type |
738 | (compose list elogind-package)) | |
05c5b165 | 739 | |
94a88117 LC |
740 | ;; Start elogind from the Shepherd rather than waiting |
741 | ;; for bus activation. This ensures that it can handle | |
742 | ;; events like lid close, etc. | |
743 | (service-extension shepherd-root-service-type | |
744 | elogind-shepherd-service) | |
745 | ||
05c5b165 LC |
746 | ;; Provide the 'loginctl' command. |
747 | (service-extension profile-service-type | |
748 | (compose list elogind-package)) | |
749 | ||
e7ad0d58 LC |
750 | ;; Extend PAM with pam_elogind.so. |
751 | (service-extension pam-root-service-type | |
38c2b503 LC |
752 | pam-extension-procedure) |
753 | ||
754 | ;; We need /run/user, /run/systemd, etc. | |
755 | (service-extension file-system-service-type | |
cf42428a LC |
756 | (const %elogind-file-systems)))) |
757 | (default-value (elogind-configuration)))) | |
0adfe95a LC |
758 | |
759 | (define* (elogind-service #:key (config (elogind-configuration))) | |
04463bb0 AW |
760 | "Return a service that runs the @command{elogind} login and seat management |
761 | service. The @command{elogind} service integrates with PAM to allow other | |
762 | system components to know the set of logged-in users as well as their session | |
763 | types (graphical, console, remote, etc.). It can also clean up after users | |
764 | when they log out." | |
0adfe95a | 765 | (service elogind-service-type config)) |
04463bb0 AW |
766 | |
767 | \f | |
063c6082 AW |
768 | ;;; |
769 | ;;; AccountsService service. | |
770 | ;;; | |
771 | ||
772 | (define %accountsservice-activation | |
773 | #~(begin | |
774 | (use-modules (guix build utils)) | |
775 | (mkdir-p "/var/lib/AccountsService"))) | |
776 | ||
777 | (define accountsservice-service-type | |
778 | (service-type (name 'accountsservice) | |
779 | (extensions | |
780 | (list (service-extension activation-service-type | |
781 | (const %accountsservice-activation)) | |
782 | (service-extension dbus-root-service-type list) | |
783 | (service-extension polkit-service-type list))))) | |
784 | ||
785 | (define* (accountsservice-service #:key (accountsservice accountsservice)) | |
786 | "Return a service that runs AccountsService, a system service that | |
787 | can list available accounts, change their passwords, and so on. | |
788 | AccountsService integrates with PolicyKit to enable unprivileged users to | |
789 | acquire the capability to modify their system configuration. | |
790 | @uref{https://www.freedesktop.org/wiki/Software/AccountsService/, the | |
791 | accountsservice web site} for more information." | |
792 | (service accountsservice-service-type accountsservice)) | |
793 | ||
794 | \f | |
7a2413e4 AW |
795 | ;;; |
796 | ;;; GNOME desktop service. | |
797 | ;;; | |
798 | ||
799 | (define-record-type* <gnome-desktop-configuration> gnome-desktop-configuration | |
800 | make-gnome-desktop-configuration | |
801 | gnome-desktop-configuration | |
802 | (gnome-package gnome-package (default gnome))) | |
803 | ||
b27ce416 LC |
804 | (define (gnome-polkit-settings config) |
805 | "Return the list of GNOME dependencies that provide polkit actions and | |
806 | rules." | |
807 | (let ((gnome (gnome-package config))) | |
808 | (map (lambda (name) | |
809 | ((package-direct-input-selector name) gnome)) | |
810 | '("gnome-settings-daemon" | |
811 | "gnome-control-center" | |
812 | "gnome-system-monitor" | |
813 | "gvfs")))) | |
814 | ||
7a2413e4 AW |
815 | (define gnome-desktop-service-type |
816 | (service-type | |
817 | (name 'gnome-desktop) | |
818 | (extensions | |
819 | (list (service-extension polkit-service-type | |
b27ce416 | 820 | gnome-polkit-settings) |
7a2413e4 AW |
821 | (service-extension profile-service-type |
822 | (compose list | |
823 | gnome-package)))))) | |
824 | ||
825 | (define* (gnome-desktop-service #:key (config (gnome-desktop-configuration))) | |
826 | "Return a service that adds the @code{gnome} package to the system profile, | |
827 | and extends polkit with the actions from @code{gnome-settings-daemon}." | |
828 | (service gnome-desktop-service-type config)) | |
829 | ||
431703ff | 830 | ;; MATE Desktop service. |
831 | ;; TODO: Add mate-screensaver. | |
832 | ||
833 | (define-record-type* <mate-desktop-configuration> mate-desktop-configuration | |
834 | make-mate-desktop-configuration | |
835 | mate-desktop-configuration | |
836 | (mate-package mate-package (default mate))) | |
837 | ||
838 | (define mate-desktop-service-type | |
839 | (service-type | |
840 | (name 'mate-desktop) | |
841 | (extensions | |
842 | (list (service-extension polkit-service-type | |
843 | (compose list | |
844 | (package-direct-input-selector | |
845 | "mate-settings-daemon") | |
846 | mate-package)) | |
847 | (service-extension profile-service-type | |
848 | (compose list | |
849 | mate-package)))))) | |
850 | ||
851 | (define* (mate-desktop-service #:key (config (mate-desktop-configuration))) | |
852 | "Return a service that adds the @code{mate} package to the system profile, | |
853 | and extends polkit with the actions from @code{mate-settings-daemon}." | |
854 | (service mate-desktop-service-type config)) | |
855 | ||
7a2413e4 AW |
856 | \f |
857 | ;;; | |
858 | ;;; XFCE desktop service. | |
859 | ;;; | |
860 | ||
861 | (define-record-type* <xfce-desktop-configuration> xfce-desktop-configuration | |
862 | make-xfce-desktop-configuration | |
863 | xfce-desktop-configuration | |
864 | (xfce xfce-package (default xfce))) | |
865 | ||
866 | (define xfce-desktop-service-type | |
867 | (service-type | |
868 | (name 'xfce-desktop) | |
869 | (extensions | |
870 | (list (service-extension polkit-service-type | |
871 | (compose list | |
872 | (package-direct-input-selector | |
873 | "thunar") | |
874 | xfce-package)) | |
875 | (service-extension profile-service-type | |
876 | (compose list | |
877 | xfce-package)))))) | |
878 | ||
879 | (define* (xfce-desktop-service #:key (config (xfce-desktop-configuration))) | |
880 | "Return a service that adds the @code{xfce} package to the system profile, | |
705b9714 | 881 | and extends polkit with the ability for @code{thunar} to manipulate the file |
7a2413e4 AW |
882 | system as root from within a user session, after the user has authenticated |
883 | with the administrator's password." | |
884 | (service xfce-desktop-service-type config)) | |
885 | ||
886 | \f | |
cd730719 TW |
887 | ;;; |
888 | ;;; X11 socket directory service | |
889 | ;;; | |
890 | ||
891 | (define x11-socket-directory-service | |
892 | ;; Return a service that creates /tmp/.X11-unix. When using X11, libxcb | |
893 | ;; takes care of creating that directory. However, when using XWayland, we | |
894 | ;; need to create beforehand. Thus, create it unconditionally here. | |
895 | (simple-service 'x11-socket-directory | |
896 | activation-service-type | |
897 | (with-imported-modules '((guix build utils)) | |
898 | #~(begin | |
899 | (use-modules (guix build utils)) | |
900 | (let ((directory "/tmp/.X11-unix")) | |
901 | (mkdir-p directory) | |
902 | (chmod directory #o777)))))) | |
903 | ||
904 | \f | |
cee32ee4 AW |
905 | ;;; |
906 | ;;; The default set of desktop services. | |
907 | ;;; | |
0adfe95a | 908 | |
4467be21 LC |
909 | (define %desktop-services |
910 | ;; List of services typically useful for a "desktop" use case. | |
b37f86d7 | 911 | (cons* (service slim-service-type) |
4467be21 | 912 | |
6726282b LC |
913 | ;; Screen lockers are a pretty useful thing and these are small. |
914 | (screen-locker-service slock) | |
915 | (screen-locker-service xlockmore "xlock") | |
916 | ||
3547a5ef LC |
917 | ;; Add udev rules for MTP devices so that non-root users can access |
918 | ;; them. | |
919 | (simple-service 'mtp udev-service-type (list libmtp)) | |
920 | ||
0adfe95a | 921 | ;; The D-Bus clique. |
4110fbc6 LC |
922 | (service network-manager-service-type) |
923 | (service wpa-supplicant-service-type) ;needed by NetworkManager | |
4467be21 | 924 | (avahi-service) |
2b9e0a94 | 925 | (udisks-service) |
4467be21 | 926 | (upower-service) |
063c6082 | 927 | (accountsservice-service) |
4467be21 | 928 | (colord-service) |
cee32ee4 | 929 | (geoclue-service) |
0071c789 | 930 | (polkit-service) |
04463bb0 | 931 | (elogind-service) |
0adfe95a | 932 | (dbus-service) |
4467be21 LC |
933 | |
934 | (ntp-service) | |
4467be21 | 935 | |
cd730719 TW |
936 | x11-socket-directory-service |
937 | ||
ef6a4844 OP |
938 | (service alsa-service-type) |
939 | ||
0adfe95a | 940 | %base-services)) |
4467be21 | 941 | |
fe1a39d3 | 942 | ;;; desktop.scm ends here |