Commit | Line | Data |
---|---|---|
fe1a39d3 | 1 | ;;; GNU Guix --- Functional package management for GNU |
b2f948be | 2 | ;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020 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> |
d40c9f6c | 6 | ;;; Copyright © 2017, 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com> |
3c986a7d | 7 | ;;; Copyright © 2017 Nikita <nikita@n0.is> |
405c0c94 | 8 | ;;; Copyright © 2018, 2020 Efraim Flashner <efraim@flashner.co.il> |
d1ae6879 | 9 | ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net> |
6b692e96 | 10 | ;;; Copyright © 2017, 2019 Christopher Baines <mail@cbaines.net> |
97ab799a | 11 | ;;; Copyright © 2019 Tim Gesthuizen <tim.gesthuizen@yahoo.de> |
849af4ae | 12 | ;;; Copyright © 2019 David Wilson <david@daviwil.com> |
8764064c | 13 | ;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr> |
764d8966 | 14 | ;;; Copyright © 2020 Reza Alizadeh Majd <r.majd@pantherx.org> |
fe1a39d3 LC |
15 | ;;; |
16 | ;;; This file is part of GNU Guix. | |
17 | ;;; | |
18 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | |
19 | ;;; under the terms of the GNU General Public License as published by | |
20 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
21 | ;;; your option) any later version. | |
22 | ;;; | |
23 | ;;; GNU Guix is distributed in the hope that it will be useful, but | |
24 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
25 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
26 | ;;; GNU General Public License for more details. | |
27 | ;;; | |
28 | ;;; You should have received a copy of the GNU General Public License | |
29 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |
30 | ||
31 | (define-module (gnu services desktop) | |
32 | #:use-module (gnu services) | |
0190c1c0 | 33 | #:use-module (gnu services shepherd) |
4467be21 | 34 | #:use-module (gnu services base) |
0adfe95a | 35 | #:use-module (gnu services dbus) |
4467be21 LC |
36 | #:use-module (gnu services avahi) |
37 | #:use-module (gnu services xorg) | |
38 | #:use-module (gnu services networking) | |
ef6a4844 | 39 | #:use-module (gnu services sound) |
38c2b503 | 40 | #:use-module ((gnu system file-systems) |
405c0c94 | 41 | #:select (%elogind-file-systems file-system)) |
e9d271ed | 42 | #:use-module (gnu system) |
fe1a39d3 | 43 | #:use-module (gnu system shadow) |
6e828634 | 44 | #:use-module (gnu system pam) |
fe1a39d3 LC |
45 | #:use-module (gnu packages glib) |
46 | #:use-module (gnu packages admin) | |
96c7b4c8 | 47 | #:use-module (gnu packages cups) |
04463bb0 | 48 | #:use-module (gnu packages freedesktop) |
fe1a39d3 | 49 | #:use-module (gnu packages gnome) |
7a2413e4 | 50 | #:use-module (gnu packages xfce) |
4467be21 | 51 | #:use-module (gnu packages avahi) |
6726282b | 52 | #:use-module (gnu packages xdisorg) |
19b31090 | 53 | #:use-module (gnu packages scanner) |
6726282b | 54 | #:use-module (gnu packages suckless) |
922e21f4 | 55 | #:use-module (gnu packages linux) |
3547a5ef | 56 | #:use-module (gnu packages libusb) |
764d8966 | 57 | #:use-module (gnu packages lxqt) |
431703ff | 58 | #:use-module (gnu packages mate) |
d40c9f6c | 59 | #:use-module (gnu packages nfs) |
e9d271ed | 60 | #:use-module (gnu packages enlightenment) |
8d2c3c54 | 61 | #:use-module (guix deprecation) |
04463bb0 | 62 | #:use-module (guix records) |
0adfe95a | 63 | #:use-module (guix packages) |
fe1a39d3 | 64 | #:use-module (guix store) |
e9d271ed | 65 | #:use-module (guix utils) |
fe1a39d3 | 66 | #:use-module (guix gexp) |
0adfe95a | 67 | #:use-module (srfi srfi-1) |
fe1a39d3 | 68 | #:use-module (ice-9 match) |
6b692e96 CB |
69 | #:export (<upower-configuration> |
70 | upower-configuration | |
24e96431 | 71 | upower-configuration? |
6b692e96 CB |
72 | upower-configuration-upower |
73 | upower-configuration-watts-up-pro? | |
74 | upower-configuration-poll-batteries? | |
75 | upower-configuration-ignore-lid? | |
76 | upower-configuration-use-percentage-for-policy? | |
77 | upower-configuration-percentage-low | |
78 | upower-configuration-percentage-critical | |
79 | upower-configuration-percentage-action | |
80 | upower-configuration-time-low | |
81 | upower-configuration-time-critical | |
82 | upower-configuration-time-action | |
83 | upower-configuration-critical-power-action | |
84 | ||
24e96431 TČ |
85 | upower-service |
86 | upower-service-type | |
87 | ||
88 | udisks-configuration | |
89 | udisks-configuration? | |
2b9e0a94 | 90 | udisks-service |
24e96431 TČ |
91 | udisks-service-type |
92 | ||
92597c3c | 93 | colord-service-type |
4467be21 | 94 | colord-service |
24e96431 | 95 | |
cee32ee4 | 96 | geoclue-application |
24e96431 TČ |
97 | geoclue-configuration |
98 | geoclue-configuration? | |
cee32ee4 AW |
99 | %standard-geoclue-applications |
100 | geoclue-service | |
24e96431 TČ |
101 | geoclue-service-type |
102 | ||
76141930 LC |
103 | bluetooth-service-type |
104 | bluetooth-configuration | |
105 | bluetooth-configuration? | |
922e21f4 | 106 | bluetooth-service |
24e96431 | 107 | |
04463bb0 | 108 | elogind-configuration |
24e96431 | 109 | elogind-configuration? |
04463bb0 | 110 | elogind-service |
24e96431 TČ |
111 | elogind-service-type |
112 | ||
405c0c94 EF |
113 | %fontconfig-file-system |
114 | fontconfig-file-system-service | |
115 | ||
063c6082 AW |
116 | accountsservice-service-type |
117 | accountsservice-service | |
118 | ||
94e14398 | 119 | cups-pk-helper-service-type |
b2f948be | 120 | sane-service-type |
94e14398 | 121 | |
24e96431 TČ |
122 | gnome-desktop-configuration |
123 | gnome-desktop-configuration? | |
7a2413e4 | 124 | gnome-desktop-service |
24e96431 TČ |
125 | gnome-desktop-service-type |
126 | ||
431703ff | 127 | mate-desktop-configuration |
128 | mate-desktop-configuration? | |
129 | mate-desktop-service | |
130 | mate-desktop-service-type | |
131 | ||
764d8966 RAM |
132 | lxqt-desktop-configuration |
133 | lxqt-desktop-configuration? | |
764d8966 RAM |
134 | lxqt-desktop-service-type |
135 | ||
24e96431 TČ |
136 | xfce-desktop-configuration |
137 | xfce-desktop-configuration? | |
7a2413e4 | 138 | xfce-desktop-service |
24e96431 TČ |
139 | xfce-desktop-service-type |
140 | ||
cd730719 TW |
141 | x11-socket-directory-service |
142 | ||
e9d271ed EF |
143 | enlightenment-desktop-configuration |
144 | enlightenment-desktop-configuration? | |
145 | enlightenment-desktop-service-type | |
146 | ||
97ab799a TG |
147 | inputattach-configuration |
148 | inputattach-configuration? | |
149 | inputattach-service-type | |
150 | ||
7f25ff10 LP |
151 | polkit-wheel-service |
152 | ||
fe7b59c6 LP |
153 | gnome-keyring-configuration |
154 | gnome-keyring-configuration? | |
155 | gnome-keyring-service-type | |
156 | ||
4467be21 | 157 | %desktop-services)) |
fe1a39d3 LC |
158 | |
159 | ;;; Commentary: | |
160 | ;;; | |
161 | ;;; This module contains service definitions for a "desktop" environment. | |
162 | ;;; | |
163 | ;;; Code: | |
164 | ||
165 | \f | |
cee32ee4 AW |
166 | ;;; |
167 | ;;; Helpers. | |
168 | ;;; | |
169 | ||
170 | (define (bool value) | |
171 | (if value "true\n" "false\n")) | |
172 | ||
7a2413e4 AW |
173 | (define (package-direct-input-selector input) |
174 | (lambda (package) | |
175 | (match (assoc-ref (package-direct-inputs package) input) | |
176 | ((package . _) package)))) | |
177 | ||
fe1a39d3 | 178 | |
fe1a39d3 LC |
179 | \f |
180 | ;;; | |
181 | ;;; Upower D-Bus service. | |
182 | ;;; | |
183 | ||
0adfe95a LC |
184 | (define-record-type* <upower-configuration> |
185 | upower-configuration make-upower-configuration | |
186 | upower-configuration? | |
6b692e96 CB |
187 | (upower upower-configuration-upower |
188 | (default upower)) | |
189 | (watts-up-pro? upower-configuration-watts-up-pro? | |
190 | (default #f)) | |
191 | (poll-batteries? upower-configuration-poll-batteries? | |
192 | (default #t)) | |
193 | (ignore-lid? upower-configuration-ignore-lid? | |
194 | (default #f)) | |
195 | (use-percentage-for-policy? upower-configuration-use-percentage-for-policy? | |
196 | (default #f)) | |
197 | (percentage-low upower-configuration-percentage-low | |
198 | (default 10)) | |
199 | (percentage-critical upower-configuration-percentage-critical | |
200 | (default 3)) | |
201 | (percentage-action upower-configuration-percentage-action | |
202 | (default 2)) | |
203 | (time-low upower-configuration-time-low | |
204 | (default 1200)) | |
205 | (time-critical upower-configuration-time-critical | |
206 | (default 300)) | |
207 | (time-action upower-configuration-time-action | |
208 | (default 120)) | |
209 | (critical-power-action upower-configuration-critical-power-action | |
210 | (default 'hybrid-sleep))) | |
0adfe95a LC |
211 | |
212 | (define* upower-configuration-file | |
213 | ;; Return an upower-daemon configuration file. | |
214 | (match-lambda | |
215 | (($ <upower-configuration> upower | |
216 | watts-up-pro? poll-batteries? ignore-lid? use-percentage-for-policy? | |
217 | percentage-low percentage-critical percentage-action time-low | |
218 | time-critical time-action critical-power-action) | |
219 | (plain-file "UPower.conf" | |
220 | (string-append | |
221 | "[UPower]\n" | |
222 | "EnableWattsUpPro=" (bool watts-up-pro?) | |
223 | "NoPollBatteries=" (bool (not poll-batteries?)) | |
224 | "IgnoreLid=" (bool ignore-lid?) | |
225 | "UsePercentageForPolicy=" (bool use-percentage-for-policy?) | |
226 | "PercentageLow=" (number->string percentage-low) "\n" | |
227 | "PercentageCritical=" (number->string percentage-critical) "\n" | |
228 | "PercentageAction=" (number->string percentage-action) "\n" | |
229 | "TimeLow=" (number->string time-low) "\n" | |
230 | "TimeCritical=" (number->string time-critical) "\n" | |
231 | "TimeAction=" (number->string time-action) "\n" | |
232 | "CriticalPowerAction=" (match critical-power-action | |
233 | ('hybrid-sleep "HybridSleep") | |
234 | ('hibernate "Hibernate") | |
235 | ('power-off "PowerOff")) | |
236 | "\n"))))) | |
237 | ||
0adfe95a LC |
238 | (define %upower-activation |
239 | #~(begin | |
240 | (use-modules (guix build utils)) | |
2da4f2dd | 241 | (mkdir-p "/var/lib/upower"))) |
0adfe95a LC |
242 | |
243 | (define (upower-dbus-service config) | |
244 | (list (wrapped-dbus-service (upower-configuration-upower config) | |
245 | "libexec/upowerd" | |
aa071ca0 LC |
246 | `(("UPOWER_CONF_FILE_NAME" |
247 | ,(upower-configuration-file config)))))) | |
0adfe95a | 248 | |
d4053c71 AK |
249 | (define (upower-shepherd-service config) |
250 | "Return a shepherd service for UPower with CONFIG." | |
0adfe95a LC |
251 | (let ((upower (upower-configuration-upower config)) |
252 | (config (upower-configuration-file config))) | |
d4053c71 | 253 | (list (shepherd-service |
0adfe95a LC |
254 | (documentation "Run the UPower power and battery monitor.") |
255 | (provision '(upower-daemon)) | |
256 | (requirement '(dbus-system udev)) | |
257 | ||
258 | (start #~(make-forkexec-constructor | |
259 | (list (string-append #$upower "/libexec/upowerd")) | |
260 | #:environment-variables | |
261 | (list (string-append "UPOWER_CONF_FILE_NAME=" | |
262 | #$config)))) | |
263 | (stop #~(make-kill-destructor)))))) | |
264 | ||
265 | (define upower-service-type | |
edc891fa LC |
266 | (let ((upower-package (compose list upower-configuration-upower))) |
267 | (service-type (name 'upower) | |
8b9a7b26 CB |
268 | (description |
269 | "Run @command{upowerd}}, a system-wide monitor for power | |
270 | consumption and battery levels, with the given configuration settings. It | |
271 | implements the @code{org.freedesktop.UPower} D-Bus interface, and is notably | |
272 | used by GNOME.") | |
edc891fa LC |
273 | (extensions |
274 | (list (service-extension dbus-root-service-type | |
275 | upower-dbus-service) | |
276 | (service-extension shepherd-root-service-type | |
277 | upower-shepherd-service) | |
278 | (service-extension activation-service-type | |
279 | (const %upower-activation)) | |
280 | (service-extension udev-service-type | |
281 | upower-package) | |
282 | ||
283 | ;; Make the 'upower' command visible. | |
284 | (service-extension profile-service-type | |
8b9a7b26 CB |
285 | upower-package))) |
286 | (default-value (upower-configuration))))) | |
fe1a39d3 | 287 | |
8d2c3c54 CB |
288 | (define-deprecated (upower-service #:key (upower upower) |
289 | (watts-up-pro? #f) | |
290 | (poll-batteries? #t) | |
291 | (ignore-lid? #f) | |
292 | (use-percentage-for-policy? #f) | |
293 | (percentage-low 10) | |
294 | (percentage-critical 3) | |
295 | (percentage-action 2) | |
296 | (time-low 1200) | |
297 | (time-critical 300) | |
298 | (time-action 120) | |
299 | (critical-power-action 'hybrid-sleep)) | |
bb65f66c | 300 | upower-service-type |
fe1a39d3 LC |
301 | "Return a service that runs @uref{http://upower.freedesktop.org/, |
302 | @command{upowerd}}, a system-wide monitor for power consumption and battery | |
303 | levels, with the given configuration settings. It implements the | |
304 | @code{org.freedesktop.UPower} D-Bus interface, and is notably used by GNOME." | |
0adfe95a LC |
305 | (let ((config (upower-configuration |
306 | (watts-up-pro? watts-up-pro?) | |
307 | (poll-batteries? poll-batteries?) | |
308 | (ignore-lid? ignore-lid?) | |
309 | (use-percentage-for-policy? use-percentage-for-policy?) | |
310 | (percentage-low percentage-low) | |
311 | (percentage-critical percentage-critical) | |
312 | (percentage-action percentage-action) | |
313 | (time-low time-low) | |
314 | (time-critical time-critical) | |
315 | (time-action time-action) | |
316 | (critical-power-action critical-power-action)))) | |
317 | (service upower-service-type config))) | |
fe1a39d3 LC |
318 | |
319 | \f | |
cee32ee4 AW |
320 | ;;; |
321 | ;;; GeoClue D-Bus service. | |
322 | ;;; | |
323 | ||
0adfe95a LC |
324 | ;; TODO: Export. |
325 | (define-record-type* <geoclue-configuration> | |
326 | geoclue-configuration make-geoclue-configuration | |
327 | geoclue-configuration? | |
328 | (geoclue geoclue-configuration-geoclue | |
329 | (default geoclue)) | |
330 | (whitelist geoclue-configuration-whitelist) | |
331 | (wifi-geolocation-url geoclue-configuration-wifi-geolocation-url) | |
332 | (submit-data? geoclue-configuration-submit-data?) | |
333 | (wifi-submission-url geoclue-configuration-wifi-submission-url) | |
334 | (submission-nick geoclue-configuration-submission-nick) | |
335 | (applications geoclue-configuration-applications)) | |
336 | ||
cee32ee4 AW |
337 | (define* (geoclue-application name #:key (allowed? #t) system? (users '())) |
338 | "Configure default GeoClue access permissions for an application. NAME is | |
339 | the Desktop ID of the application, without the .desktop part. If ALLOWED? is | |
340 | true, the application will have access to location information by default. | |
341 | The boolean SYSTEM? value indicates that an application is a system component | |
342 | or not. Finally USERS is a list of UIDs of all users for which this | |
343 | application is allowed location info access. An empty users list means all | |
344 | users are allowed." | |
345 | (string-append | |
346 | "[" name "]\n" | |
347 | "allowed=" (bool allowed?) | |
348 | "system=" (bool system?) | |
349 | "users=" (string-join users ";") "\n")) | |
350 | ||
351 | (define %standard-geoclue-applications | |
352 | (list (geoclue-application "gnome-datetime-panel" #:system? #t) | |
353 | (geoclue-application "epiphany" #:system? #f) | |
354 | (geoclue-application "firefox" #:system? #f))) | |
355 | ||
0adfe95a | 356 | (define* (geoclue-configuration-file config) |
cee32ee4 | 357 | "Return a geoclue configuration file." |
be1c2c54 LC |
358 | (plain-file "geoclue.conf" |
359 | (string-append | |
360 | "[agent]\n" | |
0adfe95a LC |
361 | "whitelist=" |
362 | (string-join (geoclue-configuration-whitelist config) | |
363 | ";") "\n" | |
be1c2c54 | 364 | "[wifi]\n" |
0adfe95a LC |
365 | "url=" (geoclue-configuration-wifi-geolocation-url config) "\n" |
366 | "submit-data=" (bool (geoclue-configuration-submit-data? config)) | |
367 | "submission-url=" | |
368 | (geoclue-configuration-wifi-submission-url config) "\n" | |
369 | "submission-nick=" | |
370 | (geoclue-configuration-submission-nick config) | |
371 | "\n" | |
372 | (string-join (geoclue-configuration-applications config) | |
373 | "\n")))) | |
374 | ||
375 | (define (geoclue-dbus-service config) | |
376 | (list (wrapped-dbus-service (geoclue-configuration-geoclue config) | |
377 | "libexec/geoclue" | |
aa071ca0 LC |
378 | `(("GEOCLUE_CONFIG_FILE" |
379 | ,(geoclue-configuration-file config)))))) | |
0adfe95a | 380 | |
0adfe95a LC |
381 | (define %geoclue-accounts |
382 | (list (user-group (name "geoclue") (system? #t)) | |
383 | (user-account | |
384 | (name "geoclue") | |
385 | (group "geoclue") | |
386 | (system? #t) | |
387 | (comment "GeoClue daemon user") | |
388 | (home-directory "/var/empty") | |
389 | (shell "/run/current-system/profile/sbin/nologin")))) | |
390 | ||
391 | (define geoclue-service-type | |
392 | (service-type (name 'geoclue) | |
393 | (extensions | |
394 | (list (service-extension dbus-root-service-type | |
395 | geoclue-dbus-service) | |
0adfe95a LC |
396 | (service-extension account-service-type |
397 | (const %geoclue-accounts)))))) | |
cee32ee4 AW |
398 | |
399 | (define* (geoclue-service #:key (geoclue geoclue) | |
400 | (whitelist '()) | |
401 | (wifi-geolocation-url | |
402 | ;; Mozilla geolocation service: | |
403 | "https://location.services.mozilla.com/v1/geolocate?key=geoclue") | |
404 | (submit-data? #f) | |
405 | (wifi-submission-url | |
406 | "https://location.services.mozilla.com/v1/submit?key=geoclue") | |
407 | (submission-nick "geoclue") | |
408 | (applications %standard-geoclue-applications)) | |
409 | "Return a service that runs the @command{geoclue} location service. This | |
410 | service provides a D-Bus interface to allow applications to request access to | |
411 | a user's physical location, and optionally to add information to online | |
412 | location databases. By default, only the GNOME date-time panel and the Icecat | |
413 | and Epiphany web browsers are able to ask for the user's location, and in the | |
414 | case of Icecat and Epiphany, both will ask the user for permission first. See | |
415 | @uref{https://wiki.freedesktop.org/www/Software/GeoClue/, the geoclue web | |
416 | site} for more information." | |
0adfe95a LC |
417 | (service geoclue-service-type |
418 | (geoclue-configuration | |
419 | (geoclue geoclue) | |
420 | (whitelist whitelist) | |
421 | (wifi-geolocation-url wifi-geolocation-url) | |
422 | (submit-data? submit-data?) | |
423 | (wifi-submission-url wifi-submission-url) | |
424 | (submission-nick submission-nick) | |
425 | (applications applications)))) | |
cee32ee4 AW |
426 | |
427 | \f | |
922e21f4 SB |
428 | ;;; |
429 | ;;; Bluetooth. | |
430 | ;;; | |
431 | ||
b9f67d6d MC |
432 | (define-record-type* <bluetooth-configuration> |
433 | bluetooth-configuration make-bluetooth-configuration | |
434 | bluetooth-configuration? | |
435 | (bluez bluetooth-configuration-bluez (default bluez)) | |
436 | (auto-enable? bluetooth-configuration-auto-enable? (default #f))) | |
437 | ||
438 | (define (bluetooth-configuration-file config) | |
439 | "Return a configuration file for the systemd bluetooth service, as a string." | |
440 | (string-append | |
441 | "[Policy]\n" | |
442 | "AutoEnable=" (bool (bluetooth-configuration-auto-enable? | |
443 | config)))) | |
444 | ||
445 | (define (bluetooth-directory config) | |
446 | (computed-file "etc-bluetooth" | |
447 | #~(begin | |
448 | (mkdir #$output) | |
449 | (chdir #$output) | |
450 | (call-with-output-file "main.conf" | |
451 | (lambda (port) | |
452 | (display #$(bluetooth-configuration-file config) | |
453 | port)))))) | |
454 | ||
455 | (define (bluetooth-shepherd-service config) | |
922e21f4 SB |
456 | "Return a shepherd service for @command{bluetoothd}." |
457 | (shepherd-service | |
458 | (provision '(bluetooth)) | |
459 | (requirement '(dbus-system udev)) | |
460 | (documentation "Run the bluetoothd daemon.") | |
461 | (start #~(make-forkexec-constructor | |
7d903d2f LC |
462 | (list #$(file-append (bluetooth-configuration-bluez config) |
463 | "/libexec/bluetooth/bluetoothd")))) | |
922e21f4 SB |
464 | (stop #~(make-kill-destructor)))) |
465 | ||
466 | (define bluetooth-service-type | |
467 | (service-type | |
468 | (name 'bluetooth) | |
469 | (extensions | |
b9f67d6d MC |
470 | (list (service-extension dbus-root-service-type |
471 | (compose list bluetooth-configuration-bluez)) | |
472 | (service-extension udev-service-type | |
473 | (compose list bluetooth-configuration-bluez)) | |
474 | (service-extension etc-service-type | |
475 | (lambda (config) | |
476 | `(("bluetooth" | |
477 | ,(bluetooth-directory config))))) | |
922e21f4 | 478 | (service-extension shepherd-root-service-type |
76141930 | 479 | (compose list bluetooth-shepherd-service)))) |
97e98e22 | 480 | (default-value (bluetooth-configuration)) |
76141930 LC |
481 | (description "Run the @command{bluetoothd} daemon, which manages all the |
482 | Bluetooth devices and provides a number of D-Bus interfaces."))) | |
922e21f4 | 483 | |
b9f67d6d | 484 | (define* (bluetooth-service #:key (bluez bluez) (auto-enable? #f)) |
922e21f4 | 485 | "Return a service that runs the @command{bluetoothd} daemon, which manages |
b9f67d6d MC |
486 | all the Bluetooth devices and provides a number of D-Bus interfaces. When |
487 | AUTO-ENABLE? is true, the bluetooth controller is powered automatically at | |
488 | boot. | |
922e21f4 SB |
489 | |
490 | Users need to be in the @code{lp} group to access the D-Bus service. | |
491 | " | |
b9f67d6d MC |
492 | (service bluetooth-service-type |
493 | (bluetooth-configuration | |
494 | (bluez bluez) | |
495 | (auto-enable? auto-enable?)))) | |
922e21f4 SB |
496 | |
497 | \f | |
222e3319 LC |
498 | ;;; |
499 | ;;; Colord D-Bus service. | |
500 | ;;; | |
501 | ||
502 | (define %colord-activation | |
503 | #~(begin | |
504 | (use-modules (guix build utils)) | |
505 | (mkdir-p "/var/lib/colord") | |
506 | (let ((user (getpwnam "colord"))) | |
507 | (chown "/var/lib/colord" | |
508 | (passwd:uid user) (passwd:gid user))))) | |
509 | ||
510 | (define %colord-accounts | |
511 | (list (user-group (name "colord") (system? #t)) | |
512 | (user-account | |
513 | (name "colord") | |
514 | (group "colord") | |
515 | (system? #t) | |
516 | (comment "colord daemon user") | |
517 | (home-directory "/var/empty") | |
9e41130b | 518 | (shell (file-append shadow "/sbin/nologin"))))) |
222e3319 LC |
519 | |
520 | (define colord-service-type | |
521 | (service-type (name 'colord) | |
522 | (extensions | |
523 | (list (service-extension account-service-type | |
524 | (const %colord-accounts)) | |
525 | (service-extension activation-service-type | |
526 | (const %colord-activation)) | |
527 | ||
528 | ;; Colord is a D-Bus service that dbus-daemon can | |
529 | ;; activate. | |
530 | (service-extension dbus-root-service-type list) | |
531 | ||
532 | ;; Colord provides "color device" rules for udev. | |
533 | (service-extension udev-service-type list) | |
534 | ||
535 | ;; It provides polkit "actions". | |
92597c3c | 536 | (service-extension polkit-service-type list))) |
5afa23e1 | 537 | (default-value colord) |
92597c3c LC |
538 | (description |
539 | "Run @command{colord}, a system service with a D-Bus | |
540 | interface to manage the color profiles of input and output devices such as | |
541 | screens and scanners."))) | |
222e3319 | 542 | |
5afa23e1 LC |
543 | (define-deprecated (colord-service #:key (colord colord)) |
544 | colord-service-type | |
222e3319 LC |
545 | "Return a service that runs @command{colord}, a system service with a D-Bus |
546 | interface to manage the color profiles of input and output devices such as | |
547 | screens and scanners. It is notably used by the GNOME Color Manager graphical | |
548 | tool. See @uref{http://www.freedesktop.org/software/colord/, the colord web | |
549 | site} for more information." | |
550 | (service colord-service-type colord)) | |
0071c789 AW |
551 | |
552 | \f | |
2b9e0a94 LC |
553 | ;;; |
554 | ;;; UDisks. | |
555 | ;;; | |
556 | ||
557 | (define-record-type* <udisks-configuration> | |
558 | udisks-configuration make-udisks-configuration | |
559 | udisks-configuration? | |
560 | (udisks udisks-configuration-udisks | |
561 | (default udisks))) | |
562 | ||
58233964 CB |
563 | (define %udisks-activation |
564 | (with-imported-modules '((guix build utils)) | |
565 | #~(begin | |
566 | (use-modules (guix build utils)) | |
567 | ||
568 | (let ((run-dir "/var/run/udisks2")) | |
569 | (mkdir-p run-dir) | |
570 | (chmod run-dir #o700))))) | |
571 | ||
2b9e0a94 LC |
572 | (define udisks-service-type |
573 | (let ((udisks-package (lambda (config) | |
574 | (list (udisks-configuration-udisks config))))) | |
575 | (service-type (name 'udisks) | |
576 | (extensions | |
577 | (list (service-extension polkit-service-type | |
578 | udisks-package) | |
579 | (service-extension dbus-root-service-type | |
580 | udisks-package) | |
581 | (service-extension udev-service-type | |
beca0807 | 582 | udisks-package) |
58233964 CB |
583 | (service-extension activation-service-type |
584 | (const %udisks-activation)) | |
beca0807 LC |
585 | |
586 | ;; Profile 'udisksctl' & co. in the system profile. | |
587 | (service-extension profile-service-type | |
2b9e0a94 LC |
588 | udisks-package)))))) |
589 | ||
590 | (define* (udisks-service #:key (udisks udisks)) | |
591 | "Return a service for @uref{http://udisks.freedesktop.org/docs/latest/, | |
592 | UDisks}, a @dfn{disk management} daemon that provides user interfaces with | |
593 | notifications and ways to mount/unmount disks. Programs that talk to UDisks | |
594 | include the @command{udisksctl} command, part of UDisks, and GNOME Disks." | |
595 | (service udisks-service-type | |
596 | (udisks-configuration (udisks udisks)))) | |
597 | ||
598 | \f | |
04463bb0 AW |
599 | ;;; |
600 | ;;; Elogind login and seat management service. | |
601 | ;;; | |
602 | ||
603 | (define-record-type* <elogind-configuration> elogind-configuration | |
604 | make-elogind-configuration | |
00850bb8 | 605 | elogind-configuration? |
4c698cd5 TGR |
606 | (elogind elogind-package |
607 | (default elogind)) | |
608 | (kill-user-processes? elogind-kill-user-processes? | |
609 | (default #f)) | |
610 | (kill-only-users elogind-kill-only-users | |
611 | (default '())) | |
612 | (kill-exclude-users elogind-kill-exclude-users | |
613 | (default '("root"))) | |
614 | (inhibit-delay-max-seconds elogind-inhibit-delay-max-seconds | |
615 | (default 5)) | |
616 | (handle-power-key elogind-handle-power-key | |
617 | (default 'poweroff)) | |
618 | (handle-suspend-key elogind-handle-suspend-key | |
619 | (default 'suspend)) | |
620 | (handle-hibernate-key elogind-handle-hibernate-key | |
621 | ;; (default 'hibernate) | |
622 | ;; XXX Ignore it for now, since we don't | |
623 | ;; yet handle resume-from-hibernation in | |
624 | ;; our initrd. | |
625 | (default 'ignore)) | |
626 | (handle-lid-switch elogind-handle-lid-switch | |
627 | (default 'suspend)) | |
628 | (handle-lid-switch-docked elogind-handle-lid-switch-docked | |
629 | (default 'ignore)) | |
630 | (handle-lid-switch-external-power elogind-handle-lid-switch-external-power | |
631 | (default 'ignore)) | |
632 | (power-key-ignore-inhibited? elogind-power-key-ignore-inhibited? | |
633 | (default #f)) | |
634 | (suspend-key-ignore-inhibited? elogind-suspend-key-ignore-inhibited? | |
635 | (default #f)) | |
636 | (hibernate-key-ignore-inhibited? elogind-hibernate-key-ignore-inhibited? | |
637 | (default #f)) | |
638 | (lid-switch-ignore-inhibited? elogind-lid-switch-ignore-inhibited? | |
639 | (default #t)) | |
640 | (holdoff-timeout-seconds elogind-holdoff-timeout-seconds | |
641 | (default 30)) | |
642 | (idle-action elogind-idle-action | |
643 | (default 'ignore)) | |
644 | (idle-action-seconds elogind-idle-action-seconds | |
645 | (default (* 30 60))) | |
646 | (runtime-directory-size-percent elogind-runtime-directory-size-percent | |
647 | (default 10)) | |
648 | (runtime-directory-size elogind-runtime-directory-size | |
649 | (default #f)) | |
650 | (remove-ipc? elogind-remove-ipc? | |
651 | (default #t)) | |
652 | ||
653 | (suspend-state elogind-suspend-state | |
654 | (default '("mem" "standby" "freeze"))) | |
655 | (suspend-mode elogind-suspend-mode | |
656 | (default '())) | |
657 | (hibernate-state elogind-hibernate-state | |
658 | (default '("disk"))) | |
659 | (hibernate-mode elogind-hibernate-mode | |
660 | (default '("platform" "shutdown"))) | |
661 | (hybrid-sleep-state elogind-hybrid-sleep-state | |
662 | (default '("disk"))) | |
663 | (hybrid-sleep-mode elogind-hybrid-sleep-mode | |
664 | (default | |
665 | '("suspend" "platform" "shutdown")))) | |
04463bb0 AW |
666 | |
667 | (define (elogind-configuration-file config) | |
668 | (define (yesno x) | |
669 | (match x | |
670 | (#t "yes") | |
671 | (#f "no") | |
672 | (_ (error "expected #t or #f, instead got:" x)))) | |
673 | (define char-set:user-name | |
674 | (string->char-set "abcdefghijklmnopqrstuvwxyz0123456789_-")) | |
675 | (define (valid-list? l pred) | |
676 | (and-map (lambda (x) (string-every pred x)) l)) | |
677 | (define (user-name-list users) | |
678 | (unless (valid-list? users char-set:user-name) | |
679 | (error "invalid user list" users)) | |
680 | (string-join users " ")) | |
681 | (define (enum val allowed) | |
682 | (unless (memq val allowed) | |
683 | (error "invalid value" val allowed)) | |
684 | (symbol->string val)) | |
685 | (define (non-negative-integer x) | |
686 | (unless (exact-integer? x) (error "not an integer" x)) | |
687 | (when (negative? x) (error "negative number not allowed" x)) | |
688 | (number->string x)) | |
689 | (define handle-actions | |
690 | '(ignore poweroff reboot halt kexec suspend hibernate hybrid-sleep lock)) | |
691 | (define (handle-action x) | |
692 | (enum x handle-actions)) | |
693 | (define (sleep-list tokens) | |
694 | (unless (valid-list? tokens char-set:user-name) | |
695 | (error "invalid sleep list" tokens)) | |
696 | (string-join tokens " ")) | |
697 | (define-syntax ini-file-clause | |
698 | (syntax-rules () | |
699 | ((_ config (prop (parser getter))) | |
700 | (string-append prop "=" (parser (getter config)) "\n")) | |
701 | ((_ config str) | |
702 | (string-append str "\n")))) | |
703 | (define-syntax-rule (ini-file config file clause ...) | |
be1c2c54 | 704 | (plain-file file (string-append (ini-file-clause config clause) ...))) |
04463bb0 AW |
705 | (ini-file |
706 | config "logind.conf" | |
707 | "[Login]" | |
708 | ("KillUserProcesses" (yesno elogind-kill-user-processes?)) | |
709 | ("KillOnlyUsers" (user-name-list elogind-kill-only-users)) | |
710 | ("KillExcludeUsers" (user-name-list elogind-kill-exclude-users)) | |
ec868631 | 711 | ("InhibitDelayMaxSec" (non-negative-integer elogind-inhibit-delay-max-seconds)) |
04463bb0 AW |
712 | ("HandlePowerKey" (handle-action elogind-handle-power-key)) |
713 | ("HandleSuspendKey" (handle-action elogind-handle-suspend-key)) | |
714 | ("HandleHibernateKey" (handle-action elogind-handle-hibernate-key)) | |
715 | ("HandleLidSwitch" (handle-action elogind-handle-lid-switch)) | |
716 | ("HandleLidSwitchDocked" (handle-action elogind-handle-lid-switch-docked)) | |
4c698cd5 | 717 | ("HandleLidSwitchExternalPower" (handle-action elogind-handle-lid-switch-external-power)) |
04463bb0 AW |
718 | ("PowerKeyIgnoreInhibited" (yesno elogind-power-key-ignore-inhibited?)) |
719 | ("SuspendKeyIgnoreInhibited" (yesno elogind-suspend-key-ignore-inhibited?)) | |
720 | ("HibernateKeyIgnoreInhibited" (yesno elogind-hibernate-key-ignore-inhibited?)) | |
721 | ("LidSwitchIgnoreInhibited" (yesno elogind-lid-switch-ignore-inhibited?)) | |
ec868631 | 722 | ("HoldoffTimeoutSec" (non-negative-integer elogind-holdoff-timeout-seconds)) |
04463bb0 | 723 | ("IdleAction" (handle-action elogind-idle-action)) |
ec868631 | 724 | ("IdleActionSec" (non-negative-integer elogind-idle-action-seconds)) |
04463bb0 AW |
725 | ("RuntimeDirectorySize" |
726 | (identity | |
727 | (lambda (config) | |
728 | (match (elogind-runtime-directory-size-percent config) | |
729 | (#f (non-negative-integer (elogind-runtime-directory-size config))) | |
730 | (percent (string-append (non-negative-integer percent) "%")))))) | |
ec868631 | 731 | ("RemoveIPC" (yesno elogind-remove-ipc?)) |
04463bb0 AW |
732 | "[Sleep]" |
733 | ("SuspendState" (sleep-list elogind-suspend-state)) | |
734 | ("SuspendMode" (sleep-list elogind-suspend-mode)) | |
735 | ("HibernateState" (sleep-list elogind-hibernate-state)) | |
736 | ("HibernateMode" (sleep-list elogind-hibernate-mode)) | |
737 | ("HybridSleepState" (sleep-list elogind-hybrid-sleep-state)) | |
738 | ("HybridSleepMode" (sleep-list elogind-hybrid-sleep-mode)))) | |
739 | ||
956ad60c LC |
740 | (define (elogind-dbus-service config) |
741 | (list (wrapped-dbus-service (elogind-package config) | |
742 | "libexec/elogind/elogind" | |
aa071ca0 LC |
743 | `(("ELOGIND_CONF_FILE" |
744 | ,(elogind-configuration-file config)))))) | |
0adfe95a | 745 | |
e7ad0d58 LC |
746 | (define (pam-extension-procedure config) |
747 | "Return an extension for PAM-ROOT-SERVICE-TYPE that ensures that all the PAM | |
748 | services use 'pam_elogind.so', a module that allows elogind to keep track of | |
749 | logged-in users (run 'loginctl' to see elogind's world view of users and | |
750 | seats.)" | |
751 | (define pam-elogind | |
752 | (pam-entry | |
753 | (control "required") | |
9e41130b LC |
754 | (module (file-append (elogind-package config) |
755 | "/lib/security/pam_elogind.so")))) | |
e7ad0d58 LC |
756 | |
757 | (list (lambda (pam) | |
758 | (pam-service | |
759 | (inherit pam) | |
760 | (session (cons pam-elogind (pam-service-session pam))))))) | |
761 | ||
94a88117 LC |
762 | (define (elogind-shepherd-service config) |
763 | "Return a Shepherd service to start elogind according to @var{config}." | |
764 | (list (shepherd-service | |
765 | (requirement '(dbus-system)) | |
766 | (provision '(elogind)) | |
767 | (start #~(make-forkexec-constructor | |
768 | (list #$(file-append (elogind-package config) | |
769 | "/libexec/elogind/elogind")) | |
770 | #:environment-variables | |
771 | (list (string-append "ELOGIND_CONF_FILE=" | |
772 | #$(elogind-configuration-file | |
773 | config))))) | |
774 | (stop #~(make-kill-destructor))))) | |
775 | ||
0adfe95a LC |
776 | (define elogind-service-type |
777 | (service-type (name 'elogind) | |
778 | (extensions | |
956ad60c LC |
779 | (list (service-extension dbus-root-service-type |
780 | elogind-dbus-service) | |
0adfe95a LC |
781 | (service-extension udev-service-type |
782 | (compose list elogind-package)) | |
222e3319 LC |
783 | (service-extension polkit-service-type |
784 | (compose list elogind-package)) | |
05c5b165 | 785 | |
94a88117 LC |
786 | ;; Start elogind from the Shepherd rather than waiting |
787 | ;; for bus activation. This ensures that it can handle | |
788 | ;; events like lid close, etc. | |
789 | (service-extension shepherd-root-service-type | |
790 | elogind-shepherd-service) | |
791 | ||
05c5b165 LC |
792 | ;; Provide the 'loginctl' command. |
793 | (service-extension profile-service-type | |
794 | (compose list elogind-package)) | |
795 | ||
e7ad0d58 LC |
796 | ;; Extend PAM with pam_elogind.so. |
797 | (service-extension pam-root-service-type | |
38c2b503 LC |
798 | pam-extension-procedure) |
799 | ||
800 | ;; We need /run/user, /run/systemd, etc. | |
801 | (service-extension file-system-service-type | |
cf42428a LC |
802 | (const %elogind-file-systems)))) |
803 | (default-value (elogind-configuration)))) | |
0adfe95a LC |
804 | |
805 | (define* (elogind-service #:key (config (elogind-configuration))) | |
04463bb0 AW |
806 | "Return a service that runs the @command{elogind} login and seat management |
807 | service. The @command{elogind} service integrates with PAM to allow other | |
808 | system components to know the set of logged-in users as well as their session | |
809 | types (graphical, console, remote, etc.). It can also clean up after users | |
810 | when they log out." | |
0adfe95a | 811 | (service elogind-service-type config)) |
04463bb0 AW |
812 | |
813 | \f | |
405c0c94 EF |
814 | ;;; |
815 | ;;; Fontconfig and other desktop file-systems. | |
816 | ;;; | |
817 | ||
818 | (define %fontconfig-file-system | |
819 | (file-system | |
820 | (device "none") | |
821 | (mount-point "/var/cache/fontconfig") | |
822 | (type "tmpfs") | |
823 | (flags '(read-only)) | |
824 | (check? #f))) | |
825 | ||
826 | ;; The global fontconfig cache directory can sometimes contain stale entries, | |
827 | ;; possibly referencing fonts that have been GC'd, so mount it read-only. | |
828 | ;; As mentioned https://debbugs.gnu.org/cgi/bugreport.cgi?bug=36924#8 and | |
829 | ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=38046#10 and elsewhere. | |
830 | (define fontconfig-file-system-service | |
831 | (simple-service 'fontconfig-file-system | |
832 | file-system-service-type | |
833 | (list %fontconfig-file-system))) | |
834 | \f | |
063c6082 AW |
835 | ;;; |
836 | ;;; AccountsService service. | |
837 | ;;; | |
838 | ||
839 | (define %accountsservice-activation | |
840 | #~(begin | |
841 | (use-modules (guix build utils)) | |
842 | (mkdir-p "/var/lib/AccountsService"))) | |
843 | ||
844 | (define accountsservice-service-type | |
845 | (service-type (name 'accountsservice) | |
846 | (extensions | |
847 | (list (service-extension activation-service-type | |
848 | (const %accountsservice-activation)) | |
849 | (service-extension dbus-root-service-type list) | |
7f9018aa TGR |
850 | (service-extension polkit-service-type list))) |
851 | (default-value accountsservice))) | |
063c6082 AW |
852 | |
853 | (define* (accountsservice-service #:key (accountsservice accountsservice)) | |
854 | "Return a service that runs AccountsService, a system service that | |
855 | can list available accounts, change their passwords, and so on. | |
856 | AccountsService integrates with PolicyKit to enable unprivileged users to | |
857 | acquire the capability to modify their system configuration. | |
858 | @uref{https://www.freedesktop.org/wiki/Software/AccountsService/, the | |
859 | accountsservice web site} for more information." | |
860 | (service accountsservice-service-type accountsservice)) | |
861 | ||
862 | \f | |
96c7b4c8 CB |
863 | ;;; |
864 | ;;; cups-pk-helper service. | |
865 | ;;; | |
866 | ||
867 | (define cups-pk-helper-service-type | |
868 | (service-type | |
869 | (name 'cups-pk-helper) | |
870 | (description | |
871 | "PolicyKit helper to configure CUPS with fine-grained privileges.") | |
872 | (extensions | |
873 | (list (service-extension dbus-root-service-type list) | |
874 | (service-extension polkit-service-type list))) | |
875 | (default-value cups-pk-helper))) | |
876 | ||
877 | \f | |
b2f948be LC |
878 | ;;; |
879 | ;;; Scanner access via SANE. | |
880 | ;;; | |
881 | ||
882 | (define %sane-accounts | |
883 | ;; The '60-libsane.rules' udev rules refers to the "scanner" group. | |
884 | (list (user-group (name "scanner") (system? #t)))) | |
885 | ||
886 | (define sane-service-type | |
887 | (service-type | |
888 | (name 'sane) | |
889 | (description | |
890 | "This service provides access to scanners @i{via} | |
891 | @uref{http://www.sane-project.org, SANE} by installing the necessary udev | |
892 | rules.") | |
893 | (default-value sane-backends-minimal) | |
894 | (extensions | |
895 | (list (service-extension udev-service-type list) | |
896 | (service-extension account-service-type | |
897 | (const %sane-accounts)))))) | |
898 | ||
899 | ||
900 | \f | |
7a2413e4 AW |
901 | ;;; |
902 | ;;; GNOME desktop service. | |
903 | ;;; | |
904 | ||
905 | (define-record-type* <gnome-desktop-configuration> gnome-desktop-configuration | |
906 | make-gnome-desktop-configuration | |
00850bb8 | 907 | gnome-desktop-configuration? |
8764064c | 908 | (gnome gnome-package (default gnome))) |
7a2413e4 | 909 | |
b27ce416 LC |
910 | (define (gnome-polkit-settings config) |
911 | "Return the list of GNOME dependencies that provide polkit actions and | |
912 | rules." | |
913 | (let ((gnome (gnome-package config))) | |
914 | (map (lambda (name) | |
915 | ((package-direct-input-selector name) gnome)) | |
916 | '("gnome-settings-daemon" | |
917 | "gnome-control-center" | |
918 | "gnome-system-monitor" | |
919 | "gvfs")))) | |
920 | ||
7a2413e4 AW |
921 | (define gnome-desktop-service-type |
922 | (service-type | |
923 | (name 'gnome-desktop) | |
924 | (extensions | |
925 | (list (service-extension polkit-service-type | |
b27ce416 | 926 | gnome-polkit-settings) |
7a2413e4 AW |
927 | (service-extension profile-service-type |
928 | (compose list | |
d1ae6879 | 929 | gnome-package)))) |
ee05cc7f | 930 | (default-value (gnome-desktop-configuration)) |
d1ae6879 | 931 | (description "Run the GNOME desktop environment."))) |
7a2413e4 | 932 | |
ee05cc7f LC |
933 | (define-deprecated (gnome-desktop-service #:key (config |
934 | (gnome-desktop-configuration))) | |
935 | gnome-desktop-service-type | |
7a2413e4 AW |
936 | "Return a service that adds the @code{gnome} package to the system profile, |
937 | and extends polkit with the actions from @code{gnome-settings-daemon}." | |
938 | (service gnome-desktop-service-type config)) | |
939 | ||
431703ff | 940 | ;; MATE Desktop service. |
941 | ;; TODO: Add mate-screensaver. | |
942 | ||
943 | (define-record-type* <mate-desktop-configuration> mate-desktop-configuration | |
944 | make-mate-desktop-configuration | |
00850bb8 | 945 | mate-desktop-configuration? |
431703ff | 946 | (mate-package mate-package (default mate))) |
947 | ||
9bdb0fee LC |
948 | (define (mate-polkit-extension config) |
949 | "Return the list of packages for CONFIG's MATE package that extend polkit." | |
950 | (let ((mate (mate-package config))) | |
951 | (map (lambda (input) | |
952 | ((package-direct-input-selector input) mate)) | |
953 | '("mate-system-monitor" ;kill, renice processes | |
954 | "mate-settings-daemon" ;date/time settings | |
955 | "mate-power-manager" ;modify brightness | |
956 | "mate-control-center" ;RandR, display properties FIXME | |
957 | "mate-applets")))) ;CPU frequency scaling | |
958 | ||
431703ff | 959 | (define mate-desktop-service-type |
960 | (service-type | |
961 | (name 'mate-desktop) | |
962 | (extensions | |
963 | (list (service-extension polkit-service-type | |
9bdb0fee | 964 | mate-polkit-extension) |
431703ff | 965 | (service-extension profile-service-type |
966 | (compose list | |
a31d7334 | 967 | mate-package)))) |
984a6162 | 968 | (default-value (mate-desktop-configuration)) |
a31d7334 | 969 | (description "Run the MATE desktop environment."))) |
431703ff | 970 | |
082c648d LC |
971 | (define-deprecated (mate-desktop-service #:key |
972 | (config | |
973 | (mate-desktop-configuration))) | |
974 | mate-desktop-service-type | |
431703ff | 975 | "Return a service that adds the @code{mate} package to the system profile, |
976 | and extends polkit with the actions from @code{mate-settings-daemon}." | |
977 | (service mate-desktop-service-type config)) | |
978 | ||
7a2413e4 AW |
979 | \f |
980 | ;;; | |
981 | ;;; XFCE desktop service. | |
982 | ;;; | |
983 | ||
984 | (define-record-type* <xfce-desktop-configuration> xfce-desktop-configuration | |
985 | make-xfce-desktop-configuration | |
00850bb8 | 986 | xfce-desktop-configuration? |
7a2413e4 AW |
987 | (xfce xfce-package (default xfce))) |
988 | ||
849af4ae DW |
989 | (define (xfce-polkit-settings config) |
990 | "Return the list of XFCE dependencies that provide polkit actions and | |
991 | rules." | |
992 | (let ((xfce (xfce-package config))) | |
993 | (map (lambda (name) | |
994 | ((package-direct-input-selector name) xfce)) | |
995 | '("thunar" | |
996 | "xfce4-power-manager")))) | |
997 | ||
7a2413e4 AW |
998 | (define xfce-desktop-service-type |
999 | (service-type | |
1000 | (name 'xfce-desktop) | |
1001 | (extensions | |
1002 | (list (service-extension polkit-service-type | |
849af4ae | 1003 | xfce-polkit-settings) |
7a2413e4 | 1004 | (service-extension profile-service-type |
391e0d65 LC |
1005 | (compose list xfce-package)))) |
1006 | (default-value (xfce-desktop-configuration)) | |
1007 | (description "Run the Xfce desktop environment."))) | |
7a2413e4 | 1008 | |
391e0d65 LC |
1009 | (define-deprecated (xfce-desktop-service #:key (config |
1010 | (xfce-desktop-configuration))) | |
1011 | xfce-desktop-service-type | |
7a2413e4 | 1012 | "Return a service that adds the @code{xfce} package to the system profile, |
705b9714 | 1013 | and extends polkit with the ability for @code{thunar} to manipulate the file |
7a2413e4 AW |
1014 | system as root from within a user session, after the user has authenticated |
1015 | with the administrator's password." | |
1016 | (service xfce-desktop-service-type config)) | |
1017 | ||
764d8966 RAM |
1018 | +\f |
1019 | ;;; | |
1020 | ;;; Lxqt desktop service. | |
1021 | ;;; | |
1022 | ||
1023 | (define-record-type* <lxqt-desktop-configuration> lxqt-desktop-configuration | |
1024 | make-lxqt-desktop-configuration | |
1025 | lxqt-desktop-configuration? | |
1026 | (lxqt lxqt-package | |
1027 | (default lxqt))) | |
1028 | ||
1029 | (define (lxqt-polkit-settings config) | |
1030 | "Return the list of LXQt dependencies that provide polkit actions and | |
1031 | rules." | |
1032 | (let ((lxqt (lxqt-package config))) | |
1033 | (map (lambda (name) | |
1034 | ((package-direct-input-selector name) lxqt)) | |
1035 | '("lxqt-admin")))) | |
1036 | ||
1037 | (define lxqt-desktop-service-type | |
1038 | (service-type | |
1039 | (name 'lxqt-desktop) | |
1040 | (extensions | |
1041 | (list (service-extension polkit-service-type | |
1042 | lxqt-polkit-settings) | |
1043 | (service-extension profile-service-type | |
1044 | (compose list lxqt-package)))) | |
1045 | (default-value (lxqt-desktop-configuration)) | |
1046 | (description "Run LXQt desktop environment."))) | |
1047 | ||
7a2413e4 | 1048 | \f |
cd730719 TW |
1049 | ;;; |
1050 | ;;; X11 socket directory service | |
1051 | ;;; | |
1052 | ||
1053 | (define x11-socket-directory-service | |
1054 | ;; Return a service that creates /tmp/.X11-unix. When using X11, libxcb | |
1055 | ;; takes care of creating that directory. However, when using XWayland, we | |
1056 | ;; need to create beforehand. Thus, create it unconditionally here. | |
1057 | (simple-service 'x11-socket-directory | |
1058 | activation-service-type | |
1059 | (with-imported-modules '((guix build utils)) | |
1060 | #~(begin | |
1061 | (use-modules (guix build utils)) | |
1062 | (let ((directory "/tmp/.X11-unix")) | |
1063 | (mkdir-p directory) | |
1064 | (chmod directory #o777)))))) | |
e9d271ed EF |
1065 | \f |
1066 | ;;; | |
1067 | ;;; Enlightenment desktop service. | |
1068 | ;;; | |
1069 | ||
1070 | (define-record-type* <enlightenment-desktop-configuration> | |
1071 | enlightenment-desktop-configuration make-enlightenment-desktop-configuration | |
1072 | enlightenment-desktop-configuration? | |
1073 | ;; <package> | |
1074 | (enlightenment enlightenment-package | |
1075 | (default enlightenment))) | |
1076 | ||
1077 | (define (enlightenment-setuid-programs enlightenment-desktop-configuration) | |
1078 | (match-record enlightenment-desktop-configuration | |
1079 | <enlightenment-desktop-configuration> | |
1080 | (enlightenment) | |
2ae11cd0 EF |
1081 | (list (file-append enlightenment |
1082 | "/lib/enlightenment/utils/enlightenment_sys") | |
1083 | (file-append enlightenment | |
1084 | "/lib/enlightenment/utils/enlightenment_system") | |
1085 | (file-append enlightenment | |
1086 | "/lib/enlightenment/utils/enlightenment_ckpasswd")))) | |
e9d271ed EF |
1087 | |
1088 | (define enlightenment-desktop-service-type | |
1089 | (service-type | |
1090 | (name 'enlightenment-desktop) | |
1091 | (extensions | |
1092 | (list (service-extension dbus-root-service-type | |
1093 | (compose list | |
1094 | (package-direct-input-selector | |
1095 | "efl") | |
1096 | enlightenment-package)) | |
1097 | (service-extension setuid-program-service-type | |
1098 | enlightenment-setuid-programs) | |
1099 | (service-extension profile-service-type | |
1100 | (compose list | |
1101 | enlightenment-package)))) | |
1102 | (default-value (enlightenment-desktop-configuration)) | |
1103 | (description | |
1104 | "Return a service that adds the @code{enlightenment} package to the system | |
1105 | profile, and extends dbus with the ability for @code{efl} to generate | |
1106 | thumbnails and makes setuid the programs which enlightenment needs to function | |
1107 | as expected."))) | |
cd730719 TW |
1108 | |
1109 | \f | |
97ab799a TG |
1110 | ;;; |
1111 | ;;; inputattach-service-type | |
1112 | ;;; | |
1113 | ||
1114 | (define-record-type* <inputattach-configuration> | |
1115 | inputattach-configuration | |
1116 | make-inputattach-configuration | |
1117 | inputattach-configuration? | |
1118 | (device-type inputattach-configuration-device-type | |
1119 | (default "wacom")) | |
1120 | (device inputattach-configuration-device | |
1121 | (default "/dev/ttyS0")) | |
84261a23 TG |
1122 | (baud-rate inputattach-configuration-baud-rate |
1123 | (default #f)) | |
97ab799a TG |
1124 | (log-file inputattach-configuration-log-file |
1125 | (default #f))) | |
1126 | ||
1127 | (define inputattach-shepherd-service | |
1128 | (match-lambda | |
84261a23 TG |
1129 | (($ <inputattach-configuration> type device baud-rate log-file) |
1130 | (let ((args (append (if baud-rate | |
daec54f0 | 1131 | (list "--baud" (number->string baud-rate)) |
84261a23 TG |
1132 | '()) |
1133 | (list (string-append "--" type) | |
1134 | device)))) | |
1135 | (list (shepherd-service | |
1136 | (provision '(inputattach)) | |
1137 | (requirement '(udev)) | |
1138 | (documentation "inputattach daemon") | |
1139 | (start #~(make-forkexec-constructor | |
1140 | (cons (string-append #$inputattach | |
1141 | "/bin/inputattach") | |
1142 | (quote #$args)) | |
1143 | #:log-file #$log-file)) | |
1144 | (stop #~(make-kill-destructor)))))))) | |
97ab799a TG |
1145 | |
1146 | (define inputattach-service-type | |
1147 | (service-type | |
1148 | (name 'inputattach) | |
1149 | (extensions | |
1150 | (list (service-extension shepherd-root-service-type | |
1151 | inputattach-shepherd-service))) | |
1152 | (default-value (inputattach-configuration)) | |
1153 | (description "Return a service that runs inputattach on a device and | |
1154 | dispatches events from it."))) | |
1155 | ||
1156 | \f | |
fe7b59c6 LP |
1157 | ;;; |
1158 | ;;; gnome-keyring-service-type | |
1159 | ;;; | |
1160 | ||
1161 | (define-record-type* <gnome-keyring-configuration> gnome-keyring-configuration | |
1162 | make-gnome-keyring-configuration | |
1163 | gnome-keyring-configuration? | |
1164 | (keyring gnome-keyring-package (default gnome-keyring)) | |
1165 | (pam-services gnome-keyring-pam-services (default '(("gdm-password" . login) | |
1166 | ("passwd" . passwd))))) | |
1167 | ||
1168 | (define (pam-gnome-keyring config) | |
1169 | (define (%pam-keyring-entry . arguments) | |
1170 | (pam-entry | |
1171 | (control "optional") | |
1172 | (module (file-append (gnome-keyring-package config) | |
1173 | "/lib/security/pam_gnome_keyring.so")) | |
1174 | (arguments arguments))) | |
1175 | ||
1176 | (list | |
1177 | (lambda (service) | |
1178 | (case (assoc-ref (gnome-keyring-pam-services config) | |
1179 | (pam-service-name service)) | |
1180 | ((login) | |
1181 | (pam-service | |
1182 | (inherit service) | |
1183 | (auth (append (pam-service-auth service) | |
1184 | (list (%pam-keyring-entry)))) | |
1185 | (session (append (pam-service-session service) | |
1186 | (list (%pam-keyring-entry "auto_start")))))) | |
1187 | ((passwd) | |
1188 | (pam-service | |
1189 | (inherit service) | |
1190 | (password (append (pam-service-password service) | |
1191 | (list (%pam-keyring-entry)))))) | |
1192 | (else service))))) | |
1193 | ||
1194 | (define gnome-keyring-service-type | |
1195 | (service-type | |
1196 | (name 'gnome-keyring) | |
1197 | (extensions (list | |
1198 | (service-extension pam-root-service-type pam-gnome-keyring))) | |
1199 | (default-value (gnome-keyring-configuration)) | |
1200 | (description "Return a service, that adds the @code{gnome-keyring} package | |
1201 | to the system profile and extends PAM with entries using | |
1202 | @code{pam_gnome_keyring.so}, unlocking a user's login keyring when they log in | |
1203 | or setting its password with passwd."))) | |
1204 | ||
1205 | \f | |
7f25ff10 LP |
1206 | ;;; |
1207 | ;;; polkit-wheel-service -- Allow wheel group to perform admin actions | |
1208 | ;;; | |
1209 | ||
1210 | (define polkit-wheel | |
1211 | (file-union | |
1212 | "polkit-wheel" | |
1213 | `(("share/polkit-1/rules.d/wheel.rules" | |
1214 | ,(plain-file | |
1215 | "wheel.rules" | |
1216 | "polkit.addAdminRule(function(action, subject) { | |
1217 | return [\"unix-group:wheel\"]; | |
1218 | }); | |
1219 | "))))) | |
1220 | ||
1221 | (define polkit-wheel-service | |
1222 | (simple-service 'polkit-wheel polkit-service-type (list polkit-wheel))) | |
1223 | ||
1224 | \f | |
cee32ee4 AW |
1225 | ;;; |
1226 | ;;; The default set of desktop services. | |
1227 | ;;; | |
0adfe95a | 1228 | |
4467be21 LC |
1229 | (define %desktop-services |
1230 | ;; List of services typically useful for a "desktop" use case. | |
357b287b | 1231 | (cons* (service gdm-service-type) |
4467be21 | 1232 | |
6726282b LC |
1233 | ;; Screen lockers are a pretty useful thing and these are small. |
1234 | (screen-locker-service slock) | |
1235 | (screen-locker-service xlockmore "xlock") | |
1236 | ||
3547a5ef LC |
1237 | ;; Add udev rules for MTP devices so that non-root users can access |
1238 | ;; them. | |
1239 | (simple-service 'mtp udev-service-type (list libmtp)) | |
19b31090 | 1240 | ;; Add udev rules for scanners. |
b2f948be | 1241 | (service sane-service-type) |
27b77228 LP |
1242 | ;; Add polkit rules, so that non-root users in the wheel group can |
1243 | ;; perform administrative tasks (similar to "sudo"). | |
1244 | polkit-wheel-service | |
3547a5ef | 1245 | |
d40c9f6c MC |
1246 | ;; Allow desktop users to also mount NTFS and NFS file systems |
1247 | ;; without root. | |
1248 | (simple-service 'mount-setuid-helpers setuid-program-service-type | |
1249 | (list (file-append nfs-utils "/sbin/mount.nfs") | |
1250 | (file-append ntfs-3g "/sbin/mount.ntfs-3g"))) | |
1251 | ||
405c0c94 EF |
1252 | ;; The global fontconfig cache directory can sometimes contain |
1253 | ;; stale entries, possibly referencing fonts that have been GC'd, | |
1254 | ;; so mount it read-only. | |
1255 | fontconfig-file-system-service | |
1256 | ||
05d907ac | 1257 | ;; NetworkManager and its applet. |
4110fbc6 LC |
1258 | (service network-manager-service-type) |
1259 | (service wpa-supplicant-service-type) ;needed by NetworkManager | |
05d907ac LC |
1260 | (simple-service 'network-manager-applet |
1261 | profile-service-type | |
1262 | (list network-manager-applet)) | |
36f5d78d | 1263 | (service modem-manager-service-type) |
7dbeb5a7 | 1264 | (service usb-modeswitch-service-type) |
05d907ac LC |
1265 | |
1266 | ;; The D-Bus clique. | |
2e04ab71 | 1267 | (service avahi-service-type) |
2b9e0a94 | 1268 | (udisks-service) |
8b9a7b26 | 1269 | (service upower-service-type) |
063c6082 | 1270 | (accountsservice-service) |
96c7b4c8 | 1271 | (service cups-pk-helper-service-type) |
5afa23e1 | 1272 | (service colord-service-type) |
cee32ee4 | 1273 | (geoclue-service) |
cc178ac7 | 1274 | (service polkit-service-type) |
04463bb0 | 1275 | (elogind-service) |
0adfe95a | 1276 | (dbus-service) |
4467be21 | 1277 | |
64791eb7 | 1278 | (service ntp-service-type) |
4467be21 | 1279 | |
cd730719 TW |
1280 | x11-socket-directory-service |
1281 | ||
71e33e32 | 1282 | (service pulseaudio-service-type) |
ef6a4844 OP |
1283 | (service alsa-service-type) |
1284 | ||
0adfe95a | 1285 | %base-services)) |
4467be21 | 1286 | |
fe1a39d3 | 1287 | ;;; desktop.scm ends here |