projects/guix·blob ruby-team · refs

2793 lines · 107.0 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2014-2022 Ludovic Courtès <[email protected]>
3;;; Copyright © 2015 Andy Wingo <[email protected]>
4;;; Copyright © 2015 Mark H Weaver <[email protected]>
5;;; Copyright © 2016 Sou Bunnbu <[email protected]>
6;;; Copyright © 2017, 2020, 2022, 2023, 2025 Maxim Cournoyer <[email protected]>
7;;; Copyright © 2017 Nikita <[email protected]>
8;;; Copyright © 2017, 2019 Hartmut Goebel <[email protected]>
9;;; Copyright © 2018, 2020, 2022, 2025 Efraim Flashner <[email protected]>
10;;; Copyright © 2018, 2023 Ricardo Wurmus <[email protected]>
11;;; Copyright © 2017, 2019 Christopher Baines <[email protected]>
12;;; Copyright © 2019 Tim Gesthuizen <[email protected]>
13;;; Copyright © 2019 David Wilson <[email protected]>
14;;; Copyright © 2020, 2024 Tobias Geerinckx-Rice <[email protected]>
15;;; Copyright © 2020 Reza Alizadeh Majd <[email protected]>
16;;; Copyright © 2021 Brice Waegeneire <[email protected]>
17;;; Copyright © 2021, 2022 muradm <[email protected]>
18;;; Copyright © 2023 Bruno Victal <[email protected]>
19;;; Copyright © 2023 Zheng Junjie <[email protected]>
20;;; Copyright © 2024 45mg <[email protected]>
21;;; Copyright © 2024 Raven Hallsby <[email protected]>
22;;; Copyright © 2025 Jonathan Brielmaier <[email protected]>
23;;; Copyright © 2025 Sergio Pastor Pérez <[email protected]>
24;;; Copyright © 2025 dan <[email protected]>
25;;; Copyright © 2026 Noé Lopez <[email protected]>
26;;; Copyright © 2026 Herman Rimm <[email protected]>
27;;;
28;;; This file is part of GNU Guix.
29;;;
30;;; GNU Guix is free software; you can redistribute it and/or modify it
31;;; under the terms of the GNU General Public License as published by
32;;; the Free Software Foundation; either version 3 of the License, or (at
33;;; your option) any later version.
34;;;
35;;; GNU Guix is distributed in the hope that it will be useful, but
36;;; WITHOUT ANY WARRANTY; without even the implied warranty of
37;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
38;;; GNU General Public License for more details.
39;;;
40;;; You should have received a copy of the GNU General Public License
41;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
42
43(define-module (gnu services desktop)
44 #:use-module ((gnu home services utils) #:select (object->camel-case-string))
45 #:use-module (gnu services)
46 #:use-module (gnu services shepherd)
47 #:use-module (gnu services base)
48 #:use-module (gnu services configuration)
49 #:use-module (gnu services dbus)
50 #:use-module (gnu services avahi)
51 #:use-module (gnu services xorg)
52 #:use-module (gnu services networking)
53 #:use-module (gnu services sound)
54 #:use-module ((gnu system file-systems)
55 #:select (%control-groups
56 %elogind-file-systems
57 file-system))
58 #:autoload (gnu services sddm) (sddm-service-type)
59 #:use-module (gnu system)
60 #:use-module (gnu system privilege)
61 #:use-module (gnu system shadow)
62 #:use-module (gnu system uuid)
63 #:use-module (gnu system pam)
64 #:use-module (gnu packages glib)
65 #:use-module (gnu packages admin)
66 #:use-module (gnu packages bash)
67 #:use-module (gnu packages cups)
68 #:use-module (gnu packages dns)
69 #:use-module (gnu packages freedesktop)
70 #:use-module (gnu packages gnome)
71 #:use-module (gnu packages kde-plasma)
72 #:use-module (gnu packages pulseaudio)
73 #:use-module (gnu packages xfce)
74 #:use-module (gnu packages xdisorg)
75 #:use-module (gnu packages scanner)
76 #:use-module (gnu packages suckless)
77 #:use-module (gnu packages sugar)
78 #:use-module (gnu packages linux)
79 #:use-module (gnu packages libusb)
80 #:use-module (gnu packages lxqt)
81 #:use-module (gnu packages mate)
82 #:use-module (gnu packages nfs)
83 #:use-module (gnu packages enlightenment)
84 #:use-module (gnu packages haskell-apps)
85 #:use-module (gnu packages rust-apps)
86 #:use-module (gnu packages video)
87 #:use-module (guix deprecation)
88 #:use-module (guix i18n)
89 #:use-module (guix records)
90 #:use-module (guix packages)
91 #:use-module (guix search-paths)
92 #:use-module (guix store)
93 #:use-module (guix ui)
94 #:use-module (guix utils)
95 #:use-module (guix gexp)
96 #:use-module (guix modules)
97 #:use-module (srfi srfi-1)
98 #:use-module (srfi srfi-26)
99 #:use-module (ice-9 format)
100 #:use-module (ice-9 match)
101 #:export (<upower-configuration>
102 upower-configuration
103 upower-configuration?
104 upower-configuration-upower
105 upower-configuration-watts-up-pro?
106 upower-configuration-poll-batteries?
107 upower-configuration-ignore-lid?
108 upower-configuration-use-percentage-for-policy?
109 upower-configuration-percentage-low
110 upower-configuration-percentage-critical
111 upower-configuration-percentage-action
112 upower-configuration-time-low
113 upower-configuration-time-critical
114 upower-configuration-time-action
115 upower-configuration-critical-power-action
116
117 upower-service-type
118
119 udisks-configuration
120 udisks-configuration?
121 udisks-service ; deprecated
122 udisks-service-type
123
124 gvfs-configuration
125 gvfs-configuration?
126 gvfs-service-type
127
128 colord-service-type
129
130 kmonad-configuration
131 kmonad-configuration-keymaps
132 kmonad-configuration-kmonad
133 kmonad-configuration?
134 kmonad-service-type
135
136 kanata-service-type
137 kanata-configuration
138 kanata-configuration?
139 kanata-configuration-kanata
140 kanata-configuration-keymaps
141
142 gpu-screen-recorder-configuration
143 gpu-screen-recorder-configuration?
144 gpu-screen-recorder-service-type
145
146 geoclue-application
147 geoclue-configuration
148 geoclue-configuration?
149 %standard-geoclue-applications
150 geoclue-service ; deprecated
151 geoclue-service-type
152
153 iio-sensor-proxy-configuration
154 iio-sensor-proxy-configuration?
155 iio-sensor-proxy-configuration-io-sensor-proxy
156 iio-sensor-proxy-service-type
157
158 bluetooth-service-type
159 bluetooth-configuration
160 bluetooth-configuration?
161 bluetooth-service ; deprecated
162
163 elogind-configuration
164 elogind-configuration?
165 elogind-service ; deprecated
166 elogind-service-type
167
168 gardenhostd-configuration
169 gardenhostd-service-type
170
171 %gdm-file-system
172 gdm-file-system-service
173
174 %fontconfig-file-system
175 fontconfig-file-system-service
176
177 accountsservice-service-type
178 accountsservice-service ; deprecated
179
180 cups-pk-helper-service-type
181
182 sane-configuration
183 sane-configuration?
184 sane-configuration-backends
185 sane-configuration-sane
186 sane-service-type
187
188 gnome-desktop-configuration
189 gnome-desktop-configuration?
190 gnome-desktop-configuration-core-services
191 gnome-desktop-configuration-shell
192 gnome-desktop-configuration-utilities
193 gnome-desktop-configuration-extra-packages
194 gnome-desktop-configuration-polkit-ignorelist
195 gnome-desktop-configuration-udev-ignorelist
196 gnome-desktop-configuration-keyring
197 gnome-desktop-service
198 gnome-desktop-service-type
199
200 mate-desktop-configuration
201 mate-desktop-configuration?
202 mate-desktop-service-type
203
204 lxqt-desktop-configuration
205 lxqt-desktop-configuration?
206 lxqt-desktop-service-type
207
208 sugar-desktop-configuration
209 sugar-desktop-configuration?
210 sugar-desktop-service-type
211
212 plasma-desktop-configuration
213 plasma-desktop-configuration?
214 plasma-desktop-service-type
215
216 xfce-desktop-configuration
217 xfce-desktop-configuration?
218 xfce-desktop-service-type
219
220 x11-socket-directory-service ;deprecated
221 x11-socket-directory-service-type
222
223 enlightenment-desktop-configuration
224 enlightenment-desktop-configuration?
225 enlightenment-desktop-service-type
226
227 inputattach-configuration
228 inputattach-configuration?
229 inputattach-service-type
230
231 polkit-wheel-service
232
233 gnome-keyring-configuration
234 gnome-keyring-configuration?
235 gnome-keyring-service-type
236
237 kwallet-configuration
238 kwallet-configuration?
239 kwallet-service-type
240
241 seatd-configuration
242 seatd-service-type
243
244 %desktop-services))
245
246;;; Commentary:
247;;;
248;;; This module contains service definitions for a "desktop" environment.
249;;;
250;;; Code:
251
252
253;;;
254;;; Helpers.
255;;;
256
257(define (bool value)
258 (if value "true\n" "false\n"))
259
260(define list-of-file-likes?
261 (list-of file-like?))
262
263(define (package-direct-input-selector tree)
264 "Return a procedure that selects TREE from the inputs of PACKAGE. If TREE
265is a list, it recursively searches it until it locates the last item of TREE."
266 (lambda (package)
267 (let loop ((tree (if (pair? tree)
268 tree
269 (list tree)))
270 (package package))
271 (if (null? tree)
272 package
273 (loop (cdr tree)
274 (car (assoc-ref (package-direct-inputs package)
275 (car tree))))))))
276(define (pascal-case text)
277 (object->camel-case-string text 'upper))
278
279
280;;;
281;;; Upower D-Bus service.
282;;;
283
284(define-record-type* <upower-configuration>
285 upower-configuration make-upower-configuration
286 upower-configuration?
287 (upower upower-configuration-upower
288 (default upower))
289 (watts-up-pro? upower-configuration-watts-up-pro?
290 (default #f))
291 (poll-batteries? upower-configuration-poll-batteries?
292 (default #t))
293 (ignore-lid? upower-configuration-ignore-lid?
294 (default #f))
295 (use-percentage-for-policy? upower-configuration-use-percentage-for-policy?
296 (default #t))
297 (percentage-low upower-configuration-percentage-low
298 (default 20))
299 (percentage-critical upower-configuration-percentage-critical
300 (default 5))
301 (percentage-action upower-configuration-percentage-action
302 (default 2))
303 (time-low upower-configuration-time-low
304 (default 1200))
305 (time-critical upower-configuration-time-critical
306 (default 300))
307 (time-action upower-configuration-time-action
308 (default 120))
309 (critical-power-action upower-configuration-critical-power-action
310 (default 'hybrid-sleep)))
311
312(define* upower-configuration-file
313 ;; Return an upower-daemon configuration file.
314 (match-lambda
315 (($ <upower-configuration> upower
316 watts-up-pro? poll-batteries? ignore-lid? use-percentage-for-policy?
317 percentage-low percentage-critical percentage-action time-low
318 time-critical time-action critical-power-action)
319 (plain-file "UPower.conf"
320 (string-append
321 "[UPower]\n"
322 "EnableWattsUpPro=" (bool watts-up-pro?)
323 "NoPollBatteries=" (bool (not poll-batteries?))
324 "IgnoreLid=" (bool ignore-lid?)
325 "UsePercentageForPolicy=" (bool use-percentage-for-policy?)
326 "PercentageLow=" (number->string percentage-low) "\n"
327 "PercentageCritical=" (number->string percentage-critical) "\n"
328 "PercentageAction=" (number->string percentage-action) "\n"
329 "TimeLow=" (number->string time-low) "\n"
330 "TimeCritical=" (number->string time-critical) "\n"
331 "TimeAction=" (number->string time-action) "\n"
332 "CriticalPowerAction=" (match critical-power-action
333 ('hybrid-sleep "HybridSleep")
334 ('hibernate "Hibernate")
335 ('power-off "PowerOff"))
336 "\n")))))
337
338(define %upower-activation
339 #~(begin
340 (use-modules (guix build utils))
341 (mkdir-p "/var/lib/upower")))
342
343(define (upower-dbus-service config)
344 (list (wrapped-dbus-service (upower-configuration-upower config)
345 "libexec/upowerd"
346 `(("UPOWER_CONF_FILE_NAME"
347 ,(upower-configuration-file config))))))
348
349(define (upower-shepherd-service config)
350 "Return a shepherd service for UPower with CONFIG."
351 (let ((upower (upower-configuration-upower config))
352 (config (upower-configuration-file config)))
353 (list (shepherd-service
354 (documentation "Run the UPower power and battery monitor.")
355 (provision '(upower-daemon))
356 (requirement '(user-processes dbus-system udev))
357
358 (start #~(make-forkexec-constructor
359 (list (string-append #$upower "/libexec/upowerd"))
360 #:environment-variables
361 (list (string-append "UPOWER_CONF_FILE_NAME="
362 #$config))))
363 (stop #~(make-kill-destructor))
364 (actions (list (shepherd-configuration-action config)))))))
365
366(define upower-service-type
367 (let ((upower-package (compose list upower-configuration-upower)))
368 (service-type (name 'upower)
369 (description
370 "Run @command{upowerd}, a system-wide monitor for power
371consumption and battery levels, with the given configuration settings. It
372implements the @code{org.freedesktop.UPower} D-Bus interface, and is notably
373used by GNOME.")
374 (extensions
375 (list (service-extension dbus-root-service-type
376 upower-dbus-service)
377 (service-extension shepherd-root-service-type
378 upower-shepherd-service)
379 (service-extension activation-service-type
380 (const %upower-activation))
381 (service-extension udev-service-type
382 upower-package)
383
384 ;; Make the 'upower' command visible.
385 (service-extension profile-service-type
386 upower-package)))
387 (default-value (upower-configuration)))))
388
389
390;;;
391;;; GeoClue D-Bus service.
392;;;
393
394(define* (geoclue-application name #:key (allowed? #t) system? (users '()))
395 "Configure default GeoClue access permissions for an application. NAME is
396the Desktop ID of the application, without the .desktop part. If ALLOWED? is
397true, the application will have access to location information by default.
398The boolean SYSTEM? value indicates that an application is a system component
399or not. Finally USERS is a list of UIDs of all users for which this
400application is allowed location info access. An empty users list means all
401users are allowed."
402 (string-append
403 "[" name "]\n"
404 "allowed=" (bool allowed?)
405 "system=" (bool system?)
406 "users=" (string-join users ";") "\n"))
407
408(define %standard-geoclue-applications
409 (list (geoclue-application "gnome-datetime-panel" #:system? #t)
410 (geoclue-application "epiphany" #:system? #f)
411 (geoclue-application "firefox" #:system? #f)
412 (geoclue-application "librewolf" #:system? #f)
413 (geoclue-application "icecat" #:system? #f)
414 (geoclue-application "redshift" #:system? #f)))
415
416;; TODO: Use define-configuration and export accessors.
417(define-record-type* <geoclue-configuration>
418 geoclue-configuration make-geoclue-configuration
419 geoclue-configuration?
420 (geoclue geoclue-configuration-geoclue
421 (default geoclue))
422 (whitelist geoclue-configuration-whitelist
423 (default '()))
424 (wifi-geolocation-url
425 geoclue-configuration-wifi-geolocation-url
426 ;; BeaconDB geolocation service:
427 (default "https://api.beacondb.net/v1/geolocate?key=geoclue_guix.gnu.org"))
428 (submit-data? geoclue-configuration-submit-data?
429 (default #f))
430 (wifi-submission-url
431 geoclue-configuration-wifi-submission-url
432 (default "https://api.beacondb.net/v2/geosubmit"))
433 (submission-nick geoclue-configuration-submission-nick
434 (default "geoclue"))
435 (applications geoclue-configuration-applications
436 (default %standard-geoclue-applications)))
437
438(define* (geoclue-configuration-file config)
439 "Return a geoclue configuration file."
440 (plain-file "geoclue.conf"
441 (string-append
442 "[agent]\n"
443 "whitelist="
444 (string-join (geoclue-configuration-whitelist config)
445 ";") "\n"
446 "[wifi]\n"
447 "url=" (geoclue-configuration-wifi-geolocation-url config) "\n"
448 "submit-data=" (bool (geoclue-configuration-submit-data? config))
449 "submission-url="
450 (geoclue-configuration-wifi-submission-url config) "\n"
451 "submission-nick="
452 (geoclue-configuration-submission-nick config)
453 "\n"
454 (string-join (geoclue-configuration-applications config)
455 "\n"))))
456
457(define (geoclue-dbus-service config)
458 (list (wrapped-dbus-service (geoclue-configuration-geoclue config)
459 "libexec/geoclue"
460 `(("GEOCLUE_CONFIG_FILE"
461 ,(geoclue-configuration-file config))))))
462
463(define %geoclue-accounts
464 (list (user-group (name "geoclue") (system? #t))
465 (user-account
466 (name "geoclue")
467 (group "geoclue")
468 (system? #t)
469 (comment "GeoClue daemon user")
470 (home-directory "/var/empty")
471 (shell "/run/current-system/profile/sbin/nologin"))))
472
473(define geoclue-service-type
474 (service-type (name 'geoclue)
475 (extensions
476 (list (service-extension dbus-root-service-type
477 geoclue-dbus-service)
478 (service-extension account-service-type
479 (const %geoclue-accounts))))
480 (description "Run the @command{geoclue} location service.
481This service provides a D-Bus interface to allow applications to request
482access to a user's physical location, and optionally to add information to
483online location databases.")
484 (default-value (geoclue-configuration))))
485
486(define-deprecated
487 (geoclue-service #:key (geoclue geoclue)
488 (whitelist '())
489 (wifi-geolocation-url
490 ;; Mozilla geolocation service:
491 "https://location.services.mozilla.com/v1/geolocate?key=geoclue")
492 (submit-data? #f)
493 (wifi-submission-url
494 "https://location.services.mozilla.com/v1/submit?key=geoclue")
495 (submission-nick "geoclue")
496 (applications %standard-geoclue-applications))
497 geoclue-service-type
498 "Return a service that runs the @command{geoclue} location service. This
499service provides a D-Bus interface to allow applications to request access to
500a user's physical location, and optionally to add information to online
501location databases. By default, only the GNOME date-time panel and the Icecat
502and Epiphany web browsers are able to ask for the user's location, and in the
503case of Icecat and Epiphany, both will ask the user for permission first. See
504@uref{https://wiki.freedesktop.org/www/Software/GeoClue/, the geoclue web
505site} for more information."
506 (service geoclue-service-type
507 (geoclue-configuration
508 (geoclue geoclue)
509 (whitelist whitelist)
510 (wifi-geolocation-url wifi-geolocation-url)
511 (submit-data? submit-data?)
512 (wifi-submission-url wifi-submission-url)
513 (submission-nick submission-nick)
514 (applications applications))))
515
516
517;;;
518;;; IIO Sensor proxy.
519;;;
520
521(define-record-type* <iio-sensor-proxy-configuration>
522 iio-sensor-proxy-configuration make-iio-sensor-proxy-configuration
523 iio-sensor-proxy-configuration?
524 (iio-sensor-proxy iio-sensor-proxy-configuration-iio-sensor-proxy
525 (default iio-sensor-proxy)))
526
527(define iio-sensor-proxy-shepherd-service
528 (match-record-lambda <iio-sensor-proxy-configuration>
529 (iio-sensor-proxy)
530 (list (shepherd-service
531 (documentation "IIO sensors to D-Bus proxy")
532 (requirement '(user-processes dbus-system udev))
533 (provision '(iio-sensor-proxy))
534 (start #~(make-forkexec-constructor
535 (list #$(file-append iio-sensor-proxy
536 "/libexec/iio-sensor-proxy"))))
537 (stop #~(make-kill-destructor))))))
538
539(define iio-sensor-proxy-service-type
540 (let ((iio-sensor-proxy-package
541 (match-record-lambda <iio-sensor-proxy-configuration>
542 (iio-sensor-proxy)
543 (list iio-sensor-proxy))))
544 (service-type
545 (name 'iio-sensor-proxy)
546 (extensions
547 (list (service-extension polkit-service-type
548 iio-sensor-proxy-package)
549 (service-extension dbus-root-service-type
550 iio-sensor-proxy-package)
551 (service-extension udev-service-type
552 iio-sensor-proxy-package)
553 (service-extension shepherd-root-service-type
554 iio-sensor-proxy-shepherd-service)))
555 (default-value (iio-sensor-proxy-configuration))
556 (description
557 "Run the @command{iio-sensor-proxy} daemon, which provides IIO sensors data
558through a D-Bus interface."))))
559
560
561;;;
562;;; Bluetooth.
563;;;
564
565(define-record-type* <bluetooth-configuration>
566 bluetooth-configuration make-bluetooth-configuration
567 bluetooth-configuration?
568 (bluez bluetooth-configuration-bluez (default bluez))
569
570 ;;; [General]
571 (name bluetooth-configuration-name (default "BlueZ"))
572 (class bluetooth-configuration-class (default #x000000))
573 (discoverable-timeout
574 bluetooth-configuration-discoverable-timeout (default 180))
575 (always-pairable? bluetooth-configuration-always-pairable? (default #f))
576 (pairable-timeout bluetooth-configuration-pairable-timeout (default 0))
577
578 ;;; MAYBE: Exclude into separate <device-id> record-type?
579 (device-id bluetooth-configuration-device-id (default #f))
580 (reverse-service-discovery?
581 bluetooth-configuration-reverse-service-discovery (default #t))
582 (name-resolving? bluetooth-configuration-name-resolving? (default #t))
583 (debug-keys? bluetooth-configuration-debug-keys? (default #f))
584
585 ;;; Possible values:
586 ;;; 'dual, 'bredr, 'le
587 (controller-mode bluetooth-configuration-controller-mode (default 'dual))
588
589 ;;; Possible values:
590 ;;; 'off, 'single, 'multiple
591 (multi-profile bluetooth-configuration-multi-profile (default 'off))
592 (fast-connectable? bluetooth-configuration-fast-connectable? (default #f))
593
594 ;;; Possible values:
595 ;;; for LE mode: 'off, 'network/on, 'device
596 ;;; for Dual mode: 'off, 'network/on', 'device, 'limited-network, 'limited-device
597 ;;; Source: https://git.kernel.org/pub/scm/bluetooth/bluez.git/tree/src/main.conf#n68
598 (privacy bluetooth-configuration-privacy (default 'off))
599
600 ;;; Possible values:
601 ;;; 'never, 'confirm, 'always
602 (just-works-repairing
603 bluetooth-configuration-just-works-repairing (default 'never))
604 (temporary-timeout bluetooth-configuration-temporary-timeout (default 30))
605 (refresh-discovery? bluetooth-configuration-refresh-discovery (default #t))
606
607 ;;; Possible values: #t, #f, (uuid <uuid>)
608 ;;; Possible UUIDs:
609 ;;; d4992530-b9ec-469f-ab01-6c481c47da1c (BlueZ Experimental Debug)
610 ;;; 671b10b5-42c0-4696-9227-eb28d1b049d6 (BlueZ Experimental Simultaneous Central and Peripheral)
611 ;;; 15c0a148-c273-11ea-b3de-0242ac130004 (BlueZ Experimental LL privacy)
612 ;;; 330859bc-7506-492d-9370-9a6f0614037f (BlueZ Experimental Bluetooth Quality Report)
613 ;;; a6695ace-ee7f-4fb9-881a-5fac66c629af (BlueZ Experimental Offload Codecs)
614 ;;; Source: https://git.kernel.org/pub/scm/bluetooth/bluez.git/tree/src/main.conf#n110
615 (experimental bluetooth-configuration-experimental (default #f))
616 (remote-name-request-retry-delay
617 bluetooth-configuration-remote-name-request-retry-delay (default 300))
618
619 ;;; [BR]
620 (page-scan-type bluetooth-configuration-page-scan-type (default #f))
621 (page-scan-interval bluetooth-configuration-page-scan-interval (default #f))
622 (page-scan-window bluetooth-configuration-page-scan-window (default #f))
623 (inquiry-scan-type bluetooth-configuration-inquiry-scan-type (default #f))
624 (inquiry-scan-interval bluetooth-configuration-inquiry-scan-interval (default #f))
625 (inquiry-scan-window bluetooth-configuration-inquiry-scan-window (default #f))
626 (link-supervision-timeout bluetooth-configuration-link-supervision-timeout (default #f))
627 (page-timeout bluetooth-configuration-page-timeout (default #f))
628 (min-sniff-interval bluetooth-configuration-min-sniff-interval (default #f))
629 (max-sniff-interval bluetooth-configuration-max-sniff-interval (default #f))
630
631 ;;; [LE]
632 (min-advertisement-interval
633 bluetooth-configuration-min-advertisement-interval (default #f))
634 (max-advertisement-interval
635 bluetooth-configuration-max-advertisement-interval (default #f))
636 (multi-advertisement-rotation-interval
637 bluetooth-configuration-multi-advertisement-rotation-interval (default #f))
638 (scan-interval-auto-connect
639 bluetooth-configuration-scan-interval-auto-connect (default #f))
640 (scan-window-auto-connect
641 bluetooth-configuration-scan-window-auto-connect (default #f))
642 (scan-interval-suspend
643 bluetooth-configuration-scan-interval-suspend (default #f))
644 (scan-window-suspend
645 bluetooth-configuration-scan-window-suspend (default #f))
646 (scan-interval-discovery
647 bluetooth-configuration-scan-interval-discovery (default #f))
648 (scan-window-discovery
649 bluetooth-configuration-scan-window-discovery (default #f))
650 (scan-interval-adv-monitor
651 bluetooth-configuration-scan-interval-adv-monitor (default #f))
652 (scan-window-adv-monitor
653 bluetooth-configuration-scan-window-adv-monitor (default #f))
654 (scan-interval-connect
655 bluetooth-configuration-scan-interval-connect (default #f))
656 (scan-window-connect
657 bluetooth-configuration-scan-window-connect (default #f))
658 (min-connection-interval
659 bluetooth-configuration-min-connection-interval (default #f))
660 (max-connection-interval
661 bluetooth-configuration-max-connection-interval (default #f))
662 (connection-latency
663 bluetooth-configuration-connection-latency (default #f))
664 (connection-supervision-timeout
665 bluetooth-configuration-connection-supervision-timeout (default #f))
666 (autoconnect-timeout
667 bluetooth-configuration-autoconnect-timeout (default #f))
668 (adv-mon-allowlist-scan-duration
669 bluetooth-configuration-adv-mon-allowlist-scan-duration (default 300))
670 (adv-mon-no-filter-scan-duration
671 bluetooth-configuration-adv-mon-no-filter-scan-duration (default 500))
672 (enable-adv-mon-interleave-scan?
673 bluetooth-configuration-enable-adv-mon-interleave-scan (default #t))
674
675 ;;; [GATT]
676 ;;; Possible values: 'yes, 'no, 'always
677 (cache bluetooth-configuration-cache (default 'always))
678
679 ;;; Possible values: 7 ... 16, 0 (don't care)
680 (key-size bluetooth-configuration-key-size (default 0))
681
682 ;;; Possible values: 23 ... 517
683 (exchange-mtu bluetooth-configuration-exchange-mtu (default 517))
684
685 ;;; Possible values: 1 ... 5
686 (att-channels bluetooth-configuration-att-channels (default 3))
687
688 ;;; [AVDTP]
689 ;;; Possible values: 'basic, 'ertm
690 (session-mode bluetooth-configuration-session-mode (default 'basic))
691
692 ;;; Possible values: 'basic, 'streaming
693 (stream-mode bluetooth-configuration-stream-mode (default 'basic))
694
695 ;;; [Policy]
696 (reconnect-uuids bluetooth-configuration-reconnect-uuids (default '()))
697 (reconnect-attempts bluetooth-configuration-reconnect-attempts (default 7))
698 (reconnect-intervals bluetooth-configuration-reconnect-intervals
699 (default (list 1 2 4 8 16 32 64)))
700 (auto-enable? bluetooth-configuration-auto-enable? (default #f))
701 (resume-delay bluetooth-configuration-resume-delay (default 2))
702
703 ;;; [AdvMon]
704 ;;; Possible values:
705 ;;; "0x00", "0xFF",
706 ;;; "N = 0x00" ... "N = 0xFF"
707 ;;; Source: https://git.kernel.org/pub/scm/bluetooth/bluez.git/tree/src/main.conf#n286
708 (rssi-sampling-period bluetooth-configuration-rssi-sampling-period
709 (default #xFF)))
710
711(define (bluetooth-configuration-file config)
712 "Return a configuration file for the systemd bluetooth service, as a string."
713 (string-append
714 "[General]"
715 "\nName = " (bluetooth-configuration-name config)
716 "\nClass = " (string-append
717 "0x"
718 (format #f "~6,'0x" (bluetooth-configuration-class config)))
719 "\nDiscoverableTimeout = " (number->string
720 (bluetooth-configuration-discoverable-timeout
721 config))
722 "\nAlwaysPairable = " (bool (bluetooth-configuration-always-pairable?
723 config))
724 "\nPairableTimeout = " (number->string
725 (bluetooth-configuration-pairable-timeout
726 config))
727 (if (bluetooth-configuration-device-id config)
728 (string-append "\nDeviceID = " (bluetooth-configuration-device-id config))
729 "")
730 "\nReverseServiceDiscovery = " (bool
731 (bluetooth-configuration-reverse-service-discovery
732 config))
733 "\nNameResolving = " (bool (bluetooth-configuration-name-resolving? config))
734 "\nDebugKeys = " (bool (bluetooth-configuration-debug-keys? config))
735 "\nControllerMode = " (symbol->string
736 (bluetooth-configuration-controller-mode config))
737 "\nMultiProfile = " (symbol->string (bluetooth-configuration-multi-profile
738 config))
739 "\nFastConnectable = " (bool (bluetooth-configuration-fast-connectable? config))
740 "\nPrivacy = " (symbol->string (bluetooth-configuration-privacy config))
741 "\nJustWorksRepairing = " (symbol->string
742 (bluetooth-configuration-just-works-repairing config))
743 "\nTemporaryTimeout = " (number->string
744 (bluetooth-configuration-temporary-timeout config))
745 "\nRefreshDiscovery = " (bool (bluetooth-configuration-refresh-discovery config))
746 "\nExperimental = " (let ((experimental (bluetooth-configuration-experimental config)))
747 (cond ((or (eq? experimental #t)
748 (eq? experimental #f)) (bool experimental))
749 ((list? experimental)
750 (string-join (map uuid->string experimental) ","))))
751 "\nRemoteNameRequestRetryDelay = " (number->string
752 (bluetooth-configuration-remote-name-request-retry-delay
753 config))
754 "\n[BR]"
755 (if (bluetooth-configuration-page-scan-type config)
756 (string-append
757 "\nPageScanType = "
758 (number->string (bluetooth-configuration-page-scan-type config)))
759 "")
760 (if (bluetooth-configuration-page-scan-interval config)
761 (string-append
762 "\nPageScanInterval = "
763 (number->string (bluetooth-configuration-page-scan-interval config)))
764 "")
765 (if (bluetooth-configuration-page-scan-window config)
766 (string-append
767 "\nPageScanWindow = "
768 (number->string (bluetooth-configuration-page-scan-window config)))
769 "")
770 (if (bluetooth-configuration-inquiry-scan-type config)
771 (string-append
772 "\nInquiryScanType = "
773 (number->string (bluetooth-configuration-inquiry-scan-type config)))
774 "")
775 (if (bluetooth-configuration-inquiry-scan-interval config)
776 (string-append
777 "\nInquiryScanInterval = "
778 (number->string (bluetooth-configuration-inquiry-scan-interval config)))
779 "")
780 (if (bluetooth-configuration-inquiry-scan-window config)
781 (string-append
782 "\nInquiryScanWindow = "
783 (number->string (bluetooth-configuration-inquiry-scan-window config)))
784 "")
785 (if (bluetooth-configuration-link-supervision-timeout config)
786 (string-append
787 "\nLinkSupervisionTimeout = "
788 (number->string (bluetooth-configuration-link-supervision-timeout config)))
789 "")
790 (if (bluetooth-configuration-page-timeout config)
791 (string-append
792 "\nPageTimeout = "
793 (number->string (bluetooth-configuration-page-timeout config)))
794 "")
795 (if (bluetooth-configuration-min-sniff-interval config)
796 (string-append
797 "\nMinSniffInterval = "
798 (number->string (bluetooth-configuration-min-sniff-interval config)))
799 "")
800 (if (bluetooth-configuration-max-sniff-interval config)
801 (string-append
802 "\nMaxSniffInterval = "
803 (number->string (bluetooth-configuration-max-sniff-interval config)))
804 "")
805
806 "\n[LE]"
807 (if (bluetooth-configuration-min-advertisement-interval config)
808 (string-append
809 "\nMinAdvertisementInterval = "
810 (number->string (bluetooth-configuration-min-advertisement-interval config)))
811 "")
812 (if (bluetooth-configuration-max-advertisement-interval config)
813 (string-append
814 "\nMaxAdvertisementInterval = "
815 (number->string (bluetooth-configuration-max-advertisement-interval config)))
816 "")
817 (if (bluetooth-configuration-multi-advertisement-rotation-interval config)
818 (string-append
819 "\nMultiAdvertisementRotationInterval = "
820 (number->string
821 (bluetooth-configuration-multi-advertisement-rotation-interval config)))
822 "")
823 (if (bluetooth-configuration-scan-interval-auto-connect config)
824 (string-append
825 "\nScanIntervalAutoConnect = "
826 (number->string (bluetooth-configuration-scan-interval-auto-connect config)))
827 "")
828 (if (bluetooth-configuration-scan-window-auto-connect config)
829 (string-append
830 "\nScanWindowAutoConnect = "
831 (number->string (bluetooth-configuration-scan-window-auto-connect config)))
832 "")
833 (if (bluetooth-configuration-scan-interval-suspend config)
834 (string-append
835 "\nScanIntervalSuspend = "
836 (number->string (bluetooth-configuration-scan-interval-suspend config)))
837 "")
838 (if (bluetooth-configuration-scan-window-suspend config)
839 (string-append
840 "\nScanWindowSuspend = "
841 (number->string (bluetooth-configuration-scan-window-suspend config)))
842 "")
843 (if (bluetooth-configuration-scan-interval-discovery config)
844 (string-append
845 "\nScanIntervalDiscovery = "
846 (number->string (bluetooth-configuration-scan-interval-discovery config)))
847 "")
848 (if (bluetooth-configuration-scan-window-discovery config)
849 (string-append
850 "\nScanWindowDiscovery = "
851 (number->string (bluetooth-configuration-scan-window-discovery config)))
852 "")
853 (if (bluetooth-configuration-scan-interval-adv-monitor config)
854 (string-append
855 "\nScanIntervalAdvMonitor = "
856 (number->string (bluetooth-configuration-scan-interval-adv-monitor config)))
857 "")
858 (if (bluetooth-configuration-scan-window-adv-monitor config)
859 (string-append
860 "\nScanWindowAdvMonitor = "
861 (number->string (bluetooth-configuration-scan-window-adv-monitor config)))
862 "")
863 (if (bluetooth-configuration-scan-interval-connect config)
864 (string-append
865 "\nScanIntervalConnect = "
866 (number->string (bluetooth-configuration-scan-interval-connect config)))
867 "")
868 (if (bluetooth-configuration-scan-window-connect config)
869 (string-append
870 "\nScanWindowConnect = "
871 (number->string (bluetooth-configuration-scan-window-connect config)))
872 "")
873 (if (bluetooth-configuration-min-connection-interval config)
874 (string-append
875 "\nMinConnectionInterval = "
876 (number->string (bluetooth-configuration-min-connection-interval config)))
877 "")
878 (if (bluetooth-configuration-max-connection-interval config)
879 (string-append
880 "\nMaxConnectionInterval = "
881 (number->string (bluetooth-configuration-max-connection-interval config)))
882 "")
883 (if (bluetooth-configuration-connection-latency config)
884 (string-append
885 "\nConnectionLatency = "
886 (number->string (bluetooth-configuration-connection-latency config)))
887 "")
888 (if (bluetooth-configuration-connection-supervision-timeout config)
889 (string-append
890 "\nConnectionSupervisionTimeout = "
891 (number->string (bluetooth-configuration-connection-supervision-timeout config)))
892 "")
893 (if (bluetooth-configuration-autoconnect-timeout config)
894 (string-append
895 "\nAutoconnecttimeout = "
896 (number->string (bluetooth-configuration-autoconnect-timeout config)))
897 "")
898 "\nAdvMonAllowlistScanDuration = " (number->string
899 (bluetooth-configuration-adv-mon-allowlist-scan-duration
900 config))
901 "\nAdvMonNoFilterScanDuration = " (number->string
902 (bluetooth-configuration-adv-mon-no-filter-scan-duration
903 config))
904 "\nEnableAdvMonInterleaveScan = " (number->string
905 (if (eq? #t
906 (bluetooth-configuration-enable-adv-mon-interleave-scan
907 config))
908 1 0))
909
910 "\n[GATT]"
911 "\nCache = " (symbol->string (bluetooth-configuration-cache config))
912 "\nKeySize = " (number->string (bluetooth-configuration-key-size config))
913 "\nExchangeMTU = " (number->string (bluetooth-configuration-exchange-mtu config))
914 "\nChannels = " (number->string (bluetooth-configuration-att-channels config))
915
916 "\n[AVDTP]"
917 "\nSessionMode = " (symbol->string (bluetooth-configuration-session-mode config))
918 "\nStreamMode = " (symbol->string (bluetooth-configuration-stream-mode config))
919
920 "\n[Policy]"
921 (let ((uuids (bluetooth-configuration-reconnect-uuids config)))
922 (if (not (eq? '() uuids))
923 (string-append
924 "\nReconnectUUIDs = "
925 (string-join (map uuid->string uuids) ","))
926 ""))
927 "\nReconnectAttempts = " (number->string
928 (bluetooth-configuration-reconnect-attempts config))
929 "\nReconnectIntervals = " (string-join
930 (map number->string
931 (bluetooth-configuration-reconnect-intervals
932 config))
933 ",")
934 "\nAutoEnable = " (bool (bluetooth-configuration-auto-enable?
935 config))
936 "\nResumeDelay = " (number->string (bluetooth-configuration-resume-delay config))
937
938 "\n[AdvMon]"
939 "\nRSSISamplingPeriod = " (string-append
940 "0x"
941 (format #f "~2,'0x"
942 (bluetooth-configuration-rssi-sampling-period config)))))
943
944(define (bluetooth-directory config)
945 (computed-file "etc-bluetooth"
946 #~(begin
947 (mkdir #$output)
948 (chdir #$output)
949 (call-with-output-file "main.conf"
950 (lambda (port)
951 (display #$(bluetooth-configuration-file config)
952 port))))))
953
954(define (bluetooth-shepherd-service config)
955 "Return a shepherd service for @command{bluetoothd}."
956 (shepherd-service
957 (provision '(bluetooth))
958 (requirement '(user-processes dbus-system udev))
959 (documentation "Run the bluetoothd daemon.")
960 (start #~(make-forkexec-constructor
961 (list #$(file-append (bluetooth-configuration-bluez config)
962 "/libexec/bluetooth/bluetoothd"))))
963 (stop #~(make-kill-destructor))))
964
965(define bluetooth-service-type
966 (service-type
967 (name 'bluetooth)
968 (extensions
969 (list (service-extension dbus-root-service-type
970 (compose list bluetooth-configuration-bluez))
971 (service-extension udev-service-type
972 (compose list bluetooth-configuration-bluez))
973 (service-extension etc-service-type
974 (lambda (config)
975 `(("bluetooth"
976 ,(bluetooth-directory config)))))
977 (service-extension shepherd-root-service-type
978 (compose list bluetooth-shepherd-service))))
979 (default-value (bluetooth-configuration))
980 (description "Run the @command{bluetoothd} daemon, which manages all the
981Bluetooth devices and provides a number of D-Bus interfaces.")))
982
983(define-deprecated (bluetooth-service #:key (bluez bluez) (auto-enable? #f))
984 bluetooth-service-type
985 "Return a service that runs the @command{bluetoothd} daemon, which manages
986all the Bluetooth devices and provides a number of D-Bus interfaces. When
987AUTO-ENABLE? is true, the bluetooth controller is powered automatically at
988boot, which can be useful when using a bluetooth keyboard or mouse.
989"
990 (service bluetooth-service-type
991 (bluetooth-configuration
992 (bluez bluez)
993 (auto-enable? auto-enable?))))
994
995
996;;;
997;;; Colord D-Bus service.
998;;;
999
1000(define %colord-activation
1001 #~(begin
1002 (use-modules (guix build utils))
1003 (mkdir-p "/var/lib/colord")
1004 (let ((user (getpwnam "colord")))
1005 (chown "/var/lib/colord"
1006 (passwd:uid user) (passwd:gid user)))))
1007
1008(define %colord-accounts
1009 (list (user-group (name "colord") (system? #t))
1010 (user-account
1011 (name "colord")
1012 (group "colord")
1013 (system? #t)
1014 (comment "colord daemon user")
1015 (home-directory "/var/empty")
1016 (shell (file-append shadow "/sbin/nologin")))))
1017
1018(define colord-service-type
1019 (service-type (name 'colord)
1020 (extensions
1021 (list (service-extension account-service-type
1022 (const %colord-accounts))
1023 (service-extension activation-service-type
1024 (const %colord-activation))
1025
1026 ;; Colord is a D-Bus service that dbus-daemon can
1027 ;; activate.
1028 (service-extension dbus-root-service-type list)
1029
1030 ;; Colord provides "color device" rules for udev.
1031 (service-extension udev-service-type list)
1032
1033 ;; It provides polkit "actions".
1034 (service-extension polkit-service-type list)))
1035 (default-value colord)
1036 (description
1037 "Run @command{colord}, a system service with a D-Bus
1038interface to manage the color profiles of input and output devices such as
1039screens and scanners.")))
1040
1041
1042;;;
1043;;; KMonad.
1044;;;
1045
1046(define-configuration/no-serialization kmonad-configuration
1047 (kmonad
1048 (package kmonad)
1049 "The KMonad package to use.")
1050 (keymaps
1051 (list-of-file-likes '())
1052 "A list of KMonad configurations (file-like objects). See
1053@uref{https://github.com/kmonad/kmonad/blob/master/keymap/tutorial.kbd, KMonad
1054- Keymap Tutorial}"))
1055
1056;; Isolate write access to /dev/uinput to prevent privilege escalation for
1057;; users/processes that only need read access to the 'input' group.
1058(define %uinput-group
1059 (user-group
1060 (name "uinput")
1061 (system? #t)))
1062
1063(define %kmonad-group
1064 (user-group
1065 (name "kmonad")
1066 (system? #t)))
1067
1068;; OPTIONS+="static_node=uinput" triggers kmod to load the uinput module on
1069;; boot.
1070(define %kmonad-udev-rule
1071 (udev-rule
1072 "99-kmonad.rules"
1073 "KERNEL==\"uinput\", MODE=\"0660\", GROUP=\"uinput\", OPTIONS+=\"static_node=uinput\"\n"))
1074
1075(define %kmonad-user
1076 (user-account
1077 (name "kmonad")
1078 (group "kmonad")
1079 (supplementary-groups '("input" "uinput"))
1080 (system? #t)
1081 (comment "KMonad daemon user")
1082 (home-directory "/var/empty")
1083 (create-home-directory? #f)
1084 (shell (file-append shadow "/sbin/nologin"))))
1085
1086(define %kmonad-accounts
1087 (list %uinput-group %kmonad-group %kmonad-user))
1088
1089(define (kmonad-shepherd-services config)
1090 "Return a shepherd service for each @command{kmonad} configuration."
1091 (let* ((kmonad (file-append (kmonad-configuration-kmonad config)
1092 "/bin/kmonad"))
1093 (keymaps (kmonad-configuration-keymaps config)))
1094 (map (lambda (index keymap)
1095 (let ((name (string-append "kmonad-" (number->string index))))
1096 (shepherd-service
1097 (provision (list (string->symbol name)))
1098 (requirement '(user-processes udev))
1099 (documentation (string-append "Run kmonad process "
1100 (number->string index) "."))
1101 (start #~(make-forkexec-constructor
1102 (list #$kmonad "-l" "info" #$keymap)
1103 #:user "kmonad"
1104 #:group "kmonad"
1105 #:supplementary-groups '("input" "uinput")
1106 #:log-file #$(string-append "/var/log/" name ".log")))
1107 (stop #~(make-kill-destructor)))))
1108 (iota (length keymaps))
1109 keymaps)))
1110
1111(define kmonad-service-type
1112 (service-type
1113 (name 'kmonad)
1114 (extensions
1115 (list (service-extension account-service-type
1116 (const %kmonad-accounts))
1117 (service-extension shepherd-root-service-type
1118 kmonad-shepherd-services)
1119 (service-extension udev-service-type
1120 (const (list %kmonad-udev-rule)))))
1121 (description "Run the @command{kmonad} daemon, which allows customizing
1122and extending the functionalities of different keyboards.")))
1123
1124
1125;;;
1126;;; Kanata.
1127;;;
1128
1129(define-configuration/no-serialization kanata-configuration
1130 (kanata
1131 (package kanata)
1132 "The @code{kanata} package to use.")
1133 (keymaps
1134 (list-of-file-likes '())
1135 "List of @command{kanata} configuration files (file-like objects). See
1136@uref{https://jtroo.github.io/config.html#linux-only-linux-dev, Kanata's
1137device specification documentation}."))
1138
1139(define %kanata-group
1140 (user-group
1141 (name "kanata")
1142 (system? #t)))
1143
1144(define %kanata-user
1145 (user-account
1146 (name "kanata")
1147 (group "kanata")
1148 (supplementary-groups '("input" "uinput"))
1149 (system? #t)
1150 (comment "Kanata daemon user")
1151 (home-directory "/var/empty")
1152 (create-home-directory? #f)
1153 (shell (file-append shadow "/sbin/nologin"))))
1154
1155(define %kanata-accounts
1156 (list %uinput-group %kanata-group %kanata-user))
1157
1158;; OPTIONS+="static_node=uinput" triggers kmod to load the uinput module on
1159;; boot.
1160(define %kanata-udev-rule
1161 (udev-rule
1162 "99-kanata.rules"
1163 "KERNEL==\"uinput\", MODE=\"0660\", GROUP=\"uinput\", OPTIONS+=\"static_node=uinput\"\n"))
1164
1165(define (kanata-shepherd-services config)
1166 "Return a shepherd service for each @command{kanata} configuration."
1167 (let* ((kanata (file-append (kanata-configuration-kanata config)
1168 "/bin/kanata"))
1169 (keymaps (kanata-configuration-keymaps config)))
1170 (map (lambda (index keymap)
1171 (let ((name (string-append "kanata-" (number->string index))))
1172 (shepherd-service
1173 (provision (list (string->symbol name)))
1174 (requirement '(user-processes udev))
1175 (documentation (string-append "Run kanata process "
1176 (number->string index) "."))
1177 (start #~(make-forkexec-constructor
1178 ;; '--no-wait' prevents pausing on exit so
1179 ;; Shepherd can reliably restart the daemon.
1180 (list #$kanata "-c" #$keymap "--no-wait")
1181 #:user "kanata"
1182 #:group "kanata"
1183 #:supplementary-groups '("input" "uinput")
1184 #:log-file #$(string-append "/var/log/" name ".log")))
1185 (stop #~(make-kill-destructor)))))
1186 (iota (length keymaps))
1187 keymaps)))
1188
1189(define kanata-service-type
1190 (service-type
1191 (name 'kanata)
1192 (extensions
1193 (list (service-extension account-service-type
1194 (const %kanata-accounts))
1195 (service-extension shepherd-root-service-type
1196 kanata-shepherd-services)
1197 (service-extension udev-service-type
1198 (const (list %kanata-udev-rule)))))
1199 (description
1200 "Run the @command{kanata} daemon, which allows customizing and extending
1201the functionalities of different keyboards.")))
1202
1203
1204;;;
1205;;; GPU Screen Recorder.
1206;;;
1207
1208(define-record-type* <gpu-screen-recorder-configuration>
1209 gpu-screen-recorder-configuration
1210 make-gpu-screen-recorder-configuration
1211 gpu-screen-recorder-configuration?
1212 (package
1213 gpu-screen-recorder-configuration-package
1214 (default gpu-screen-recorder)))
1215
1216(define (gpu-screen-recorder-privileged-programs config)
1217 (list
1218 (privileged-program
1219 (program
1220 (file-append
1221 (gpu-screen-recorder-configuration-package config)
1222 "/bin/gsr-kms-server"))
1223 (capabilities "cap_sys_admin=ep"))))
1224
1225(define gpu-screen-recorder-service-type
1226 (service-type
1227 (name 'gpu-screen-recorder)
1228 (extensions
1229 (list
1230 (service-extension
1231 profile-service-type
1232 (compose list gpu-screen-recorder-configuration-package))
1233 (service-extension
1234 privileged-program-service-type
1235 gpu-screen-recorder-privileged-programs)))
1236 (default-value (gpu-screen-recorder-configuration))
1237 (description
1238 "Install GPU Screen Recorder and grant its @command{gsr-kms-server}
1239helper the @code{CAP_SYS_ADMIN} capability required for direct KMS
1240capture.")))
1241
1242
1243;;;
1244;;; UDisks.
1245;;;
1246
1247(define-record-type* <udisks-configuration>
1248 udisks-configuration make-udisks-configuration
1249 udisks-configuration?
1250 (udisks udisks-configuration-udisks
1251 (default udisks)))
1252
1253(define %udisks-activation
1254 (with-imported-modules '((guix build utils))
1255 #~(begin
1256 (use-modules (guix build utils))
1257
1258 (let ((run-dir "/var/run/udisks2"))
1259 (mkdir-p run-dir)
1260 (chmod run-dir #o700)))))
1261
1262(define udisks-service-type
1263 (let ((udisks-package (lambda (config)
1264 (list (udisks-configuration-udisks config)))))
1265 (service-type (name 'udisks)
1266 (extensions
1267 (list (service-extension polkit-service-type
1268 udisks-package)
1269 (service-extension dbus-root-service-type
1270 udisks-package)
1271 (service-extension udev-service-type
1272 udisks-package)
1273 (service-extension activation-service-type
1274 (const %udisks-activation))
1275
1276 ;; Profile 'udisksctl' & co. in the system profile.
1277 (service-extension profile-service-type
1278 udisks-package)))
1279 (description "Run UDisks, a @dfn{disk management} daemon
1280that provides user interfaces with notifications and ways to mount/unmount
1281disks. Programs that talk to UDisks include the @command{udisksctl} command,
1282part of UDisks, and GNOME Disks.")
1283 (default-value (udisks-configuration)))))
1284
1285(define-deprecated (udisks-service #:key (udisks udisks))
1286 udisks-service-type
1287 "Return a service for @uref{http://udisks.freedesktop.org/docs/latest/,
1288UDisks}, a @dfn{disk management} daemon that provides user interfaces with
1289notifications and ways to mount/unmount disks. Programs that talk to UDisks
1290include the @command{udisksctl} command, part of UDisks, and GNOME Disks."
1291 (service udisks-service-type
1292 (udisks-configuration (udisks udisks))))
1293
1294
1295
1296;;;
1297;;; GVfs virtual file system.
1298;;;
1299
1300(define-record-type* <gvfs-configuration>
1301 gvfs-configuration make-gvfs-configuration
1302 gvfs-configuration?
1303 (gvfs gvfs-package (default gvfs)))
1304
1305(define gvfs-service-type
1306 (service-type (name 'gvfs)
1307 (extensions
1308 (list
1309 (service-extension profile-service-type
1310 (compose list gvfs-package))
1311 ;; Required for gvfs-udisks2-volume-monitor.
1312 (service-extension udisks-service-type (const #t))))
1313 (description
1314 "Make GVfs virtual file systems (Trash, SFTP, SMB, HTTP,
1315and many other) available for GIO applications.")
1316 (default-value (gvfs-configuration))))
1317
1318
1319;;;
1320;;; Elogind login and seat management service.
1321;;;
1322
1323;;; Elogind configuration types.
1324(define-maybe boolean
1325 (prefix elogind-))
1326
1327(define (non-negative-integer? x)
1328 (and (exact-integer? x)
1329 (not (negative? x))))
1330
1331(define-maybe non-negative-integer
1332 (prefix elogind-))
1333
1334(define (non-negative-integer-and-suffix? x)
1335 (match-lambda
1336 ((x . '%)
1337 (and (non-negative-integer? x)
1338 (<= x 100)))
1339 (((? non-negative-integer?) . suffix)
1340 (member suffix '(K M G T)))
1341 (x (non-negative-integer? x))))
1342
1343(define-maybe non-negative-integer-and-suffix
1344 (prefix elogind-))
1345
1346(define char-set:user-name
1347 (string->char-set "abcdefghijklmnopqrstuvwxyz0123456789_-"))
1348
1349(define (user-name? x)
1350 (string-every char-set:user-name x))
1351
1352(define list-of-user-names?
1353 (list-of user-name?))
1354
1355(define-maybe list-of-user-names
1356 (prefix elogind-))
1357
1358(define %elogind-actions
1359 '( ignore poweroff reboot halt kexec suspend hibernate hybrid-sleep
1360 suspend-then-hibernate lock factory-reset))
1361
1362(define (action? x)
1363 (member x %elogind-actions))
1364
1365(define-maybe action
1366 (prefix elogind-))
1367
1368(define %linux-suspend-states
1369 ;; The possible suspend states supported by the Linux kernel.
1370 ;; See (info "(linux) Basic sysfs Interfaces for System Suspend and Hibernation").
1371 '(disk standby freeze mem))
1372
1373(define (string->symbol/maybe x)
1374 (if (string? x)
1375 (string->symbol x)
1376 x))
1377
1378(define (suspend-state? x)
1379 (member (string->symbol/maybe x) %linux-suspend-states))
1380
1381(define list-of-suspend-states?
1382 (list-of suspend-state?))
1383
1384(define-maybe list-of-suspend-states
1385 (prefix elogind-))
1386
1387(define %linux-suspend-modes
1388 ;; The possible suspend state variants supported by the Linux kernel.
1389 ;; See (info "(linux) Basic sysfs Interfaces for System Suspend and Hibernation").
1390 '(s2idle shallow deep))
1391
1392(define (suspend-mode? x)
1393 (member (string->symbol/maybe x) %linux-suspend-modes))
1394
1395(define list-of-suspend-modes?
1396 (list-of suspend-mode?))
1397
1398(define-maybe list-of-suspend-modes
1399 (prefix elogind-))
1400
1401(define %linux-hibernation-modes
1402 ;; The possible hibernation operating modes supported by the Linux kernel.
1403 ;; See (info "(linux) Basic sysfs Interfaces for System Suspend and Hibernation").
1404 '(platform shutdown reboot suspend test_resume))
1405
1406(define (hibernation-mode? x)
1407 (member (string->symbol/maybe x) %linux-hibernation-modes))
1408
1409(define list-of-hibernation-modes?
1410 (list-of hibernation-mode?))
1411
1412(define-maybe list-of-hibernation-modes
1413 (prefix elogind-))
1414
1415(define-maybe list-of-strings
1416 (prefix elogind-))
1417
1418;;; Elogind serializers.
1419(define elogind-name->string
1420 (compose (lambda (name)
1421 ;; Configuration file is case sensitive, so special case those
1422 ;; few cases where pascal-case gets it wrong.
1423 (cond ((equal? name "RemoveIpc")
1424 "RemoveIPC")
1425 (else
1426 name)))
1427 pascal-case
1428 (lambda (name)
1429 (cond ((string-suffix? "?" name)
1430 (string-drop-right name 1))
1431 ((string-suffix? "seconds" name)
1432 (string-drop-right name 4))
1433 (else
1434 name)))
1435 symbol->string))
1436
1437(define (elogind-serialize-boolean name value)
1438 (format #f "~a=~:[no~;yes~]~%" (elogind-name->string name) value))
1439
1440(define (elogind-base-serializer name value)
1441 (format #f "~a=~a~%" (elogind-name->string name) value))
1442
1443(define elogind-serialize-action elogind-base-serializer)
1444(define elogind-serialize-non-negative-integer elogind-base-serializer)
1445
1446(define (elogind-serialize-non-negative-integer-and-suffix name value)
1447 (let ((name (elogind-name->string name)))
1448 (match value
1449 ((first . second)
1450 (format #f "~a=~a~a~%" name first second))
1451 (_ (format #f "~a=~a~%" name value)))))
1452
1453(define (elogind-list-serializer name value)
1454 (format #f "~a=~{~a~^ ~}~%" (elogind-name->string name) value))
1455
1456(define elogind-serialize-list-of-strings elogind-list-serializer)
1457(define elogind-serialize-list-of-user-names elogind-list-serializer)
1458(define elogind-serialize-list-of-suspend-states elogind-list-serializer)
1459(define elogind-serialize-list-of-suspend-modes elogind-list-serializer)
1460(define elogind-serialize-list-of-hibernation-modes elogind-list-serializer)
1461
1462;;; XXX: For backward-compatible/historical reasons, the configuration object
1463;;; is flat, containing the fields of both the logind.conf and sleep.conf
1464;;; files. The list below contains the fields that should be serialized to
1465;;; sleep.conf.
1466(define %elogind-configuration-sleep-fields
1467 '( suspend-state suspend-mode suspend-estimation-seconds
1468 hibernate-mode hibernate-delay-seconds
1469 allow-power-off-interrupts? allow-suspend-interrupts?
1470 broadcast-power-off-interrupts? broadcast-suspend-interrupts?))
1471
1472(define-configuration elogind-configuration
1473 (elogind
1474 (file-like elogind)
1475 "The elogind package to use."
1476 (serializer empty-serializer))
1477
1478 (system-sleep-hook-files
1479 (list-of-file-likes '())
1480 "A list of executables (file-like objects) that will be installed into the
1481@file{/etc/elogind/system-sleep} hook directory. See `Hook directories' in
1482the @samp{loginctl(1)} man page for more information."
1483 (serializer empty-serializer))
1484
1485 (system-shutdown-hook-files
1486 (list-of-file-likes '())
1487 "A list of executables (file-like objects) that will be installed into the
1488@file{/etc/elogind/system-shutdown/} hook directory."
1489 (serializer empty-serializer))
1490
1491 (allow-power-off-interrupts?
1492 (maybe-boolean #f)
1493 "Whether the executables in elogind's hook directories (see above) can
1494 cause a power-off action to be cancelled (interrupted) by printing an
1495 appropriate error message to stdout.")
1496
1497 (allow-suspend-interrupts?
1498 (maybe-boolean #f)
1499 "Likewise as the @code{allow-power-off-interrupts?} option, but for the
1500 suspend action.")
1501
1502 (broadcast-power-off-interrupts?
1503 (maybe-boolean #f)
1504 "Whether an interrupt of a power-off action is broadcasted.")
1505
1506 (broadcast-suspend-interrupts?
1507 (maybe-boolean #f)
1508 "Whether an interrupt of a suspend action is broadcasted.")
1509
1510 ;; logind.conf options.
1511 (kill-user-processes?
1512 (maybe-boolean #f)
1513 "Whether the processes of a user should be killed when the user logs
1514 out.")
1515
1516 (kill-only-users
1517 maybe-list-of-user-names
1518 "Usernames whose processes should be killed, regardless the value of
1519 @code{kill-user-processes?}.")
1520
1521 (kill-exclude-users
1522 (maybe-list-of-user-names (list "root"))
1523 "Usernames whose processes should @emph{not} be killed, regardless the
1524 value of @code{kill-user-processes?}.")
1525
1526 (inhibit-delay-max-seconds
1527 (maybe-non-negative-integer 5)
1528 "The maximum time a system shutdown or sleep request is delayed due to an
1529 inhibitor lock of type delay being active before the inhibitor is ignored and
1530 the operation executes anyway.")
1531
1532 (handle-power-key
1533 (maybe-action 'poweroff)
1534 "The action done when the power key is pressed. The compiled default is
1535 @code{'poweroff}.")
1536
1537 (handle-suspend-key
1538 (maybe-action 'suspend)
1539 "The action done when the suspend key is pressed. The ")
1540
1541 (handle-hibernate-key
1542 (maybe-action 'hibernate)
1543 "The action done when the hibernate key is pressed.")
1544
1545 (handle-lid-switch
1546 (maybe-action 'suspend)
1547 "The action done when the lid is closed.")
1548
1549 (handle-lid-switch-docked
1550 (maybe-action 'ignore)
1551 "The action done when the lid is closed and the device docked.")
1552
1553 (handle-lid-switch-external-power
1554 (maybe-action 'suspend)
1555 "The action done when the lid is closed and the device is externally
1556 powered.")
1557
1558 (power-key-ignore-inhibited?
1559 (maybe-boolean #f)
1560 "Whether to ignore high-level inhibitor locks (shutdown, reboot, sleep or
1561 idle) when the power key is pressed.")
1562
1563 (suspend-key-ignore-inhibited?
1564 (maybe-boolean #f)
1565 "Whether to ignore high-level inhibitor locks (shutdown, reboot, sleep or
1566 idle) when the suspend key is pressed.")
1567
1568 (hibernate-key-ignore-inhibited?
1569 (maybe-boolean #f)
1570 "Whether to ignore high-level inhibitor locks (shutdown, reboot, sleep or
1571 idle) when the hibernate key is pressed.")
1572
1573 (lid-switch-ignore-inhibited?
1574 (maybe-boolean #f)
1575 "Whether to ignore high-level inhibitor locks (shutdown, reboot, sleep or
1576 idle) when the lid is closed.")
1577
1578 (holdoff-timeout-seconds
1579 (maybe-non-negative-integer 30)
1580 "Specifies the number of seconds after system startup or system resume
1581during which elogind will hold off on reacting to lid events.")
1582
1583 (idle-action
1584 (maybe-action 'ignore)
1585 "Action to take when the system is idle.")
1586
1587 (idle-action-seconds
1588 maybe-non-negative-integer
1589 "The delay after which the action configured in @code{idle-action} is
1590taken after the system is idle.")
1591
1592 (runtime-directory-size
1593 (maybe-non-negative-integer-and-suffix '(10 . %))
1594 "Set the size limit on the @env{XDG_RUNTIME_DIR} runtime directory
1595for each user who logs in. The size in bytes can be given as an integer
1596and paired with symbols: K, M, G, or T. When paired with @code{'%}, the
1597integer represents the limit as a percentage share of the total amount
1598of physical @acronym{RAM, read access memory}.")
1599
1600 (remove-ipc?
1601 (maybe-boolean #t)
1602 "Whether @acronym{IPC, inter-process communication} objects belonging to
1603the user shall be removed when the user fully logs out.")
1604
1605 ;; sleep.conf options.
1606 ;; CAUTION: all sleep.conf option names must be registered in the above
1607 ;; %ELOGIND-CONFIGURATION-SLEEP-FIELDS variable: otherwise they will be
1608 ;; serialized to logind.conf instead of sleep.conf!
1609 (suspend-state
1610 (maybe-list-of-suspend-states '(mem standby freeze))
1611 "The suspend state values to be write to @file{/sys/power/state} by elogind
1612 when suspending the system. They will be tried in turn, until one is written
1613 without error.")
1614
1615 (suspend-mode
1616 (maybe-list-of-suspend-modes)
1617 "The suspend mode values to write to @file{/sys/power/mem_sleep} by elogind
1618 when suspending the system.")
1619
1620 (suspend-estimation-seconds
1621 (maybe-non-negative-integer (* 60 60)) ;1 hour
1622 "Cause the RTC alarm to wake the system after the specified time span to
1623 measure the system battery capacity level and estimate the battery discharging
1624 rate, which is used for estimating the time span until the system battery
1625 charge level goes down to 5%. This option is only used by elogind when using
1626 the @code{'suspend-then-hibernate} action.")
1627
1628 (hibernate-mode
1629 (maybe-list-of-hibernation-modes '(platform shutdown))
1630 "The hibernation mode values to write to @file{/sys/power/disk} by elogind
1631 when hibernating the system.")
1632
1633 (hibernate-delay-seconds
1634 maybe-non-negative-integer
1635 "The amount of time the system spends in suspend mode before the system is
1636 automatically put into hibernate mode.")
1637
1638 (prefix elogind-))
1639
1640(define (logind.conf config)
1641 (let ((logind-fields (remove (lambda (field)
1642 (memq (configuration-field-name field)
1643 %elogind-configuration-sleep-fields))
1644 elogind-configuration-fields)))
1645 (mixed-text-file
1646 "logind.conf"
1647 "[Login]\n"
1648 (serialize-configuration config logind-fields))))
1649
1650(define (sleep.conf config)
1651 (let ((sleep-fields (filter (lambda (field)
1652 (memq (configuration-field-name field)
1653 %elogind-configuration-sleep-fields))
1654 elogind-configuration-fields)))
1655 (mixed-text-file
1656 "sleep.conf"
1657 "[Sleep]\n"
1658 (serialize-configuration config sleep-fields))))
1659
1660(define (elogind-etc-directory config)
1661 "Return the /etc/elogind directory for CONFIG."
1662 (with-imported-modules (source-module-closure '((guix build utils)))
1663 (computed-file
1664 "etc-elogind"
1665
1666 #~(begin
1667 (use-modules (guix build utils))
1668
1669 (define sleep-directory (string-append #$output "/system-sleep/"))
1670 (define shutdown-directory (string-append #$output "/system-shutdown/"))
1671
1672 (define (copy-script file directory)
1673 "Copy FILE into DIRECTORY, giving rx (500) permissions."
1674 (let ((dest (string-append directory "/" (basename file))))
1675 (mkdir-p directory)
1676 (copy-file file dest)
1677 (chmod dest #o500)))
1678
1679 (mkdir-p #$output) ;in case neither directory gets created
1680
1681 ;; Symlink the main configuration files.
1682 (with-directory-excursion #$output
1683 (mkdir-p "logind.conf.d")
1684 (symlink #$(logind.conf config) "logind.conf.d/logind.conf")
1685 (mkdir-p "sleep.conf.d")
1686 (symlink #$(sleep.conf config) "sleep.conf.d/sleep.conf"))
1687
1688 (for-each (lambda (f)
1689 (copy-script f sleep-directory))
1690 '#$(elogind-configuration-system-sleep-hook-files config))
1691 (for-each (lambda (f)
1692 (copy-script f shutdown-directory))
1693 '#$(elogind-configuration-system-shutdown-hook-files
1694 config))))))
1695
1696(define (pam-extension-procedure config)
1697 "Return an extension for PAM-ROOT-SERVICE-TYPE that ensures that all the PAM
1698services use 'pam_elogind.so', a module that allows elogind to keep track of
1699logged-in users (run 'loginctl' to see elogind's world view of users and
1700seats.)"
1701 (define pam-elogind
1702 (pam-entry
1703 (control "required")
1704 (module (file-append (elogind-configuration-elogind config)
1705 "/lib/security/pam_elogind.so"))))
1706
1707 (list (pam-extension
1708 (transformer
1709 (lambda (pam)
1710 (pam-service
1711 (inherit pam)
1712 (session (cons pam-elogind (pam-service-session pam))))))
1713 (shepherd-requirements '(elogind)))))
1714
1715(define* (shepherd-configuration-action* files)
1716 "Return a 'configuration' action to display FILES, which should be the names
1717of the service's configuration files."
1718 (shepherd-action
1719 (name 'configuration)
1720 (documentation "Display the names of this service's configuration files.")
1721 (procedure #~(lambda (_)
1722 (format #t "~{~a~%~}" '#$files)
1723 '#$files))))
1724
1725(define (elogind-shepherd-service config)
1726 "Return a Shepherd service to start elogind according to @var{config}."
1727 (list (shepherd-service
1728 (requirement '(user-processes dbus-system))
1729 (provision '(elogind))
1730 (start #~(make-forkexec-constructor
1731 (list #$(file-append (elogind-configuration-elogind config)
1732 "/libexec/elogind/elogind"))))
1733 (stop #~(make-kill-destructor))
1734 (actions (list (shepherd-configuration-action*
1735 (list (logind.conf config)
1736 (sleep.conf config))))))))
1737
1738(define elogind-service-type
1739 (service-type
1740 (name 'elogind)
1741 (extensions
1742 (list (service-extension dbus-root-service-type
1743 (compose list elogind-configuration-elogind))
1744 (service-extension udev-service-type
1745 (compose list elogind-configuration-elogind))
1746 (service-extension polkit-service-type
1747 (compose list elogind-configuration-elogind))
1748
1749 ;; Start elogind from the Shepherd rather than waiting
1750 ;; for bus activation. This ensures that it can handle
1751 ;; events like lid close, etc.
1752 (service-extension shepherd-root-service-type
1753 elogind-shepherd-service)
1754
1755 ;; Provide the 'loginctl' command.
1756 (service-extension profile-service-type
1757 (compose list elogind-configuration-elogind))
1758
1759 ;; Extend PAM with pam_elogind.so.
1760 (service-extension pam-root-service-type
1761 pam-extension-procedure)
1762
1763 ;; Install sleep/shutdown hook files.
1764 (service-extension etc-service-type
1765 (lambda (config)
1766 `(("elogind"
1767 ,(elogind-etc-directory config)))))
1768
1769 ;; We need /run/user, /run/systemd, etc.
1770 (service-extension file-system-service-type
1771 (const %elogind-file-systems))))
1772 (default-value (elogind-configuration))
1773 (description "Run the @command{elogind} login and seat
1774management service. The @command{elogind} service integrates with PAM to
1775allow other system components to know the set of logged-in users as well as
1776their session types (graphical, console, remote, etc.). It can also clean up
1777after users when they log out.")))
1778
1779(define-deprecated (elogind-service #:key (config (elogind-configuration)))
1780 elogind-service-type
1781 "Return a service that runs the @command{elogind} login and seat management
1782service. The @command{elogind} service integrates with PAM to allow other
1783system components to know the set of logged-in users as well as their session
1784types (graphical, console, remote, etc.). It can also clean up after users
1785when they log out."
1786 (service elogind-service-type config))
1787
1788
1789;;;
1790;;; Gardenhostd.
1791;;;
1792
1793(define-configuration/no-serialization gardenhostd-configuration
1794 (gardenhostd
1795 (package gardenhostd)
1796 "The gardenhostd package to use."))
1797
1798(define (gardenhostd-profile config)
1799 (list (gardenhostd-configuration-gardenhostd config)))
1800
1801(define gardenhostd-service-type
1802 (service-type
1803 (name 'gardenhostd)
1804 (extensions
1805 (list
1806 (service-extension dbus-root-service-type gardenhostd-profile)
1807 (service-extension polkit-service-type gardenhostd-profile)))
1808 (default-value (gardenhostd-configuration))
1809 (description "This service provides gardenhostd, a partial
1810implementation of the systemd-hostnamed daemon. It provides the
1811org.freedesktop.hostname1 D-Bus interface, which helps applications
1812like gnome-control-center retrieve and modify the system’s hostname,
1813as well as set a pretty hostname for display.")))
1814
1815
1816;;;
1817;;; Fontconfig and other desktop file-systems.
1818;;;
1819
1820(define %fontconfig-file-system
1821 (file-system
1822 (device "none")
1823 (mount-point "/var/cache/fontconfig")
1824 (type "tmpfs")
1825 (flags '(read-only))
1826 (check? #f)))
1827
1828(define %gdm-file-system
1829 (file-system
1830 (device "none")
1831 (mount-point "/var/lib/gdm")
1832 (type "tmpfs")
1833 (check? #f)))
1834
1835;; The global fontconfig cache directory can sometimes contain stale entries,
1836;; possibly referencing fonts that have been GC'd, so mount it read-only.
1837;; As mentioned https://debbugs.gnu.org/cgi/bugreport.cgi?bug=36924#8 and
1838;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=38046#10 and elsewhere.
1839(define fontconfig-file-system-service
1840 (simple-service 'fontconfig-file-system
1841 file-system-service-type
1842 (list %fontconfig-file-system)))
1843
1844;; Avoid stale caches and stale user IDs being reused between system
1845;; reconfigurations, which would crash GDM and render the system unusable.
1846;; GDM doesn't require persisting anything valuable there anyway.
1847(define gdm-file-system-service
1848 (simple-service 'gdm-file-system
1849 file-system-service-type
1850 (list %gdm-file-system)))
1851
1852
1853;;;
1854;;; AccountsService service.
1855;;;
1856
1857(define %accountsservice-activation
1858 #~(begin
1859 (use-modules (guix build utils))
1860 (mkdir-p "/var/lib/AccountsService")))
1861
1862(define accountsservice-service-type
1863 (service-type (name 'accountsservice)
1864 (extensions
1865 (list (service-extension activation-service-type
1866 (const %accountsservice-activation))
1867 (service-extension dbus-root-service-type list)
1868 (service-extension polkit-service-type list)))
1869 (default-value accountsservice)
1870 (description "Run AccountsService, a system service available
1871over D-Bus that can list available accounts, change their passwords, and so
1872on. AccountsService integrates with PolicyKit to enable unprivileged users to
1873acquire the capability to modify their system configuration.")))
1874
1875(define-deprecated
1876 (accountsservice-service #:key (accountsservice accountsservice))
1877 accountsservice-service-type
1878 "Return a service that runs AccountsService, a system service that
1879can list available accounts, change their passwords, and so on.
1880AccountsService integrates with PolicyKit to enable unprivileged users to
1881acquire the capability to modify their system configuration.
1882@uref{https://www.freedesktop.org/wiki/Software/AccountsService/, the
1883accountsservice web site} for more information."
1884 (service accountsservice-service-type accountsservice))
1885
1886
1887;;;
1888;;; cups-pk-helper service.
1889;;;
1890
1891(define cups-pk-helper-service-type
1892 (service-type
1893 (name 'cups-pk-helper)
1894 (description
1895 "PolicyKit helper to configure CUPS with fine-grained privileges.")
1896 (extensions
1897 (list (service-extension dbus-root-service-type list)
1898 (service-extension polkit-service-type list)))
1899 (default-value cups-pk-helper)))
1900
1901
1902;;;
1903;;; Scanner access via SANE.
1904;;;
1905
1906(define %sane-accounts
1907 ;; The '60-libsane.rules' udev rules refers to the "scanner" group.
1908 (list (user-group (name "scanner") (system? #t))))
1909
1910(define (non-empty-list-of-packages? val)
1911 (and (not (null? val)) (list-of-packages? val)))
1912
1913(define-configuration/no-serialization sane-configuration
1914 (sane
1915 (package sane)
1916 "The package that provides the SANE library.")
1917 (backends
1918 (non-empty-list-of-packages (list sane-backends))
1919 "A list of packages containing SANE backends."))
1920
1921(define (sane-search-paths config)
1922 (match-record config <sane-configuration> (sane backends)
1923 (let ((backend-union (directory-union "sane-backends" backends)))
1924 (map (match-lambda
1925 (($ <search-path-specification> variable (files))
1926 (cons variable (file-append backend-union "/" files))))
1927 (package-native-search-paths sane)))))
1928
1929(define* (lift-sane-configuration config #:key warn?)
1930 (if (sane-configuration? config)
1931 config
1932 (begin
1933 (when warn?
1934 (warning (G_ "'sane' service now expects a 'sane-configuration' record~%"))
1935
1936 (when (eq? config sane-backends)
1937 (warning (G_ "'sane-backends' does not include 'hplip' backend anymore. Add it
1938explicitly when needed.~%"))))
1939
1940 (sane-configuration (backends (list config))))))
1941
1942(define sane-service-type
1943 (service-type
1944 (name 'sane)
1945 (description
1946 "This service provides access to scanners @i{via}
1947@uref{http://www.sane-project.org, SANE} by installing the necessary udev
1948rules.")
1949 (default-value (sane-configuration))
1950 (extensions
1951 (list (service-extension udev-service-type
1952 (lambda (c)
1953 (sane-configuration-backends
1954 (lift-sane-configuration c #:warn? #t))))
1955 (service-extension session-environment-service-type
1956 (lambda (c)
1957 (sane-search-paths (lift-sane-configuration c))))
1958 (service-extension account-service-type
1959 (const %sane-accounts))))))
1960
1961
1962;;;
1963;;; gnome-keyring-service-type
1964;;;
1965
1966(define-record-type* <gnome-keyring-configuration> gnome-keyring-configuration
1967 make-gnome-keyring-configuration
1968 gnome-keyring-configuration?
1969 (keyring gnome-keyring-package (default gnome-keyring))
1970 (pam-services gnome-keyring-pam-services (default '(("gdm-password" . login)
1971 ("passwd" . passwd)))))
1972
1973(define (pam-gnome-keyring config)
1974 ;; CONFIG may be either a <gnome-desktop-configuration> or a
1975 ;; <gnome-keyring-configuration>> record, when using the
1976 ;; gnome-keyring-service-type on its own.
1977 (let ((config (if (gnome-desktop-configuration? config)
1978 (gnome-desktop-configuration-keyring
1979 config)
1980 config)))
1981 (match config
1982 (#f '()) ;explicitly disabled by user
1983 (_
1984 (define (%pam-keyring-entry . arguments)
1985 (pam-entry
1986 (control "optional")
1987 (module (file-append (gnome-keyring-package config)
1988 "/lib/security/pam_gnome_keyring.so"))
1989 (arguments arguments)))
1990
1991 (list
1992 (pam-extension
1993 (transformer
1994 (lambda (service)
1995 (case (assoc-ref (gnome-keyring-pam-services config)
1996 (pam-service-name service))
1997 ((login)
1998 (pam-service
1999 (inherit service)
2000 (auth (append (pam-service-auth service)
2001 (list (%pam-keyring-entry))))
2002 (session (append (pam-service-session service)
2003 (list (%pam-keyring-entry "auto_start"))))))
2004 ((passwd)
2005 (pam-service
2006 (inherit service)
2007 (password (append (pam-service-password service)
2008 (list (%pam-keyring-entry))))))
2009 (else service))))))))))
2010
2011(define gnome-keyring-service-type
2012 (service-type
2013 (name 'gnome-keyring)
2014 (extensions (list
2015 (service-extension pam-root-service-type pam-gnome-keyring)))
2016 (default-value (gnome-keyring-configuration))
2017 (description "Return a service, that extends PAM with entries using
2018@code{pam_gnome_keyring.so}, unlocking a user's login keyring when they log in
2019or setting its password with passwd.")))
2020
2021
2022;;;
2023;;; GNOME desktop service.
2024;;;
2025
2026(define-maybe/no-serialization package)
2027
2028(define (gnome-keyring-configuration-or-#f? value)
2029 (or (gnome-keyring-configuration? value)
2030 (not value)))
2031
2032(define (extract-propagated-inputs package)
2033 ;; Drop input labels. Attempt to support outputs.
2034 (map
2035 (match-lambda
2036 ((_ (? package? pkg)) pkg)
2037 ((_ (? package? pkg) output) (list pkg output)))
2038 (package-propagated-inputs package)))
2039
2040(define-configuration/no-serialization gnome-desktop-configuration
2041 (core-services
2042 (list-of-packages (extract-propagated-inputs gnome-meta-core-services))
2043 "A list of packages that the GNOME Shell and applications may rely on.")
2044 (shell
2045 (list-of-packages (extract-propagated-inputs gnome-meta-core-shell))
2046 "A list of packages that constitute the GNOME Shell, without applications.")
2047 (utilities
2048 (list-of-packages (extract-propagated-inputs gnome-meta-core-utilities))
2049 "A list of packages that serve as applications to use on top of the \
2050GNOME Shell.")
2051 (gnome (maybe-package) "Deprecated. Do not use.")
2052 (extra-packages
2053 (list-of-packages (extract-propagated-inputs gnome-essential-extras))
2054 "A list of GNOME-adjacent packages to also include. This field is intended
2055for users to add their own packages to their GNOME experience. Note, that it
2056already includes some packages that are considered essential by some (most?)
2057GNOME users.")
2058 (udev-ignorelist
2059 (list-of-strings '())
2060 "A list of regular expressions denoting udev rules or hardware file names
2061provided by any package that should not be installed. By default, every udev
2062rule and hardware file specified by any package referenced in the other fields
2063are installed.")
2064 (polkit-ignorelist
2065 (list-of-strings '())
2066 "A list of regular expressions denoting polkit rules provided by any package
2067that should not be installed. By default, every polkit rule added by any package
2068referenced in the other fields are installed.")
2069 (keyring
2070 (gnome-keyring-configuration-or-#f (gnome-keyring-configuration))
2071 "A <gnome-keyring-configuration> record used to better integrate the GNOME
2072keyring with the system. Refer to the documentation of the
2073@code{gnome-keyring-service-type} for more information. If you'd rather avoid
2074integrating the GNOME keyring, you can set this to @code{#f}."))
2075
2076(define (gnome-package gnome name)
2077 "Return the package NAME among the GNOME package inputs. NAME can be a
2078single name or a tree-like, e.g. @code{'(\"gnome-boxes\" \"spice-gtk\")} to
2079denote the spice-gtk input of the gnome-boxes input of the GNOME meta-package."
2080 ((package-direct-input-selector name) gnome))
2081
2082(define (gnome-packages gnome names)
2083 "Return the package NAMES among the GNOME package inputs."
2084 (map (cut gnome-package gnome <>) names))
2085
2086(define (gnome-udev-configuration-files config)
2087 "Return the GNOME udev rules and hardware files as computed from its
2088dependencies by filtering out the ignorelist."
2089 (list
2090 (computed-file
2091 "gnome-udev-configurations"
2092 (with-imported-modules
2093 (source-module-closure '((guix build utils)
2094 (guix build union)))
2095 #~(begin
2096 (use-modules (guix build utils)
2097 (guix build union))
2098 ;; If rules.d or hwdb.d is not a proper directory but a symlink,
2099 ;; then it will not be possible to delete individual files in this
2100 ;; directory.
2101 (union-build #$output
2102 (search-path-as-list
2103 (list "lib/udev" "libexec/udev")
2104 (list #$@(gnome-profile config #:transitive? #t)))
2105 #:create-all-directories? #t)
2106 (for-each
2107 (lambda (pattern)
2108 (for-each
2109 delete-file-recursively
2110 (find-files #$output pattern)))
2111 (list #$@(gnome-desktop-configuration-udev-ignorelist config))))))))
2112
2113(define (gnome-polkit-settings config)
2114 "Return the list of GNOME dependencies that provide polkit actions and
2115rules."
2116 (list
2117 (computed-file
2118 "gnome-polkit-settings"
2119 (with-imported-modules
2120 (source-module-closure '((guix build utils)
2121 (guix build union)))
2122 #~(let ((output (string-append #$output "/share/polkit-1")))
2123 (use-modules (guix build utils)
2124 (guix build union))
2125 (mkdir-p (dirname output))
2126 (union-build output
2127 (search-path-as-list
2128 (list "share/polkit-1")
2129 (list #$@(gnome-profile config #:transitive? #t)))
2130 #:create-all-directories? #t)
2131 (for-each
2132 (lambda (pattern)
2133 (for-each
2134 delete-file-recursively
2135 (find-files output pattern)))
2136 (list #$@(gnome-desktop-configuration-polkit-ignorelist config))))))))
2137
2138(define* (gnome-profile config #:key transitive?)
2139 "Return the list of the packages specified in CONFIG. When TRANSITIVE? is
2140#t, also include their transitive propagated inputs. If there are transitive
2141inputs using non-default outputs, they are returned as gexp-input objects."
2142 (define gnome-packages
2143 (append
2144 (gnome-desktop-configuration-core-services config)
2145 (gnome-desktop-configuration-shell config)
2146 (gnome-desktop-configuration-utilities config)
2147 (let ((gnome-meta (gnome-desktop-configuration-gnome config)))
2148 (if (maybe-value-set? gnome-meta)
2149 (begin
2150 (warning
2151 (gnome-desktop-configuration-source-location config)
2152 (G_ "Using a meta-package for gnome-desktop is discouraged.~%"))
2153 (list gnome-meta))
2154 (list)))
2155 (gnome-desktop-configuration-extra-packages config)))
2156 (if transitive?
2157 (append gnome-packages
2158 (append-map (compose (cut map (match-lambda ;discard labels
2159 ((_ pkg) pkg)
2160 ((_ pkg out)
2161 (gexp-input pkg out)))
2162 <>)
2163 package-transitive-propagated-inputs)
2164 gnome-packages))
2165 gnome-packages))
2166
2167(define (gnome-setuid-programs config)
2168 "Return the list of setuid programs found within the packages specified in
2169CONFIG, a <gnome-desktop-configuration> object."
2170 ;; spice-gtk provides polkit actions for USB redirection in GNOME Boxes; set
2171 ;; its usb-acl-helper script setuid automatically when the gnome-boxes or
2172 ;; spice-gtk packages are added to one of the gnome-desktop-configuration
2173 ;; fields.
2174 (let* ((gnome-packages (gnome-profile config #:transitive? #t))
2175 (spice-gtk (find (compose (cut string=? "spice-gtk" <>)
2176 package-name
2177 (match-lambda ;disregard potential output
2178 ((? package? p) p)
2179 ((? gexp-input? p)
2180 (gexp-input-thing p))))
2181 gnome-packages))
2182 (files `(,@(if spice-gtk
2183 (list (file-append
2184 spice-gtk
2185 "/libexec/spice-client-glib-usb-acl-helper"))
2186 '()))))
2187 (map file-like->setuid-program files)))
2188
2189(define gnome-desktop-service-type
2190 (service-type
2191 (name 'gnome-desktop)
2192 (extensions
2193 (list (service-extension udev-service-type
2194 gnome-udev-configuration-files)
2195 (service-extension pam-root-service-type
2196 pam-gnome-keyring)
2197 (service-extension polkit-service-type
2198 gnome-polkit-settings)
2199 (service-extension privileged-program-service-type
2200 gnome-setuid-programs)
2201 (service-extension profile-service-type
2202 gnome-profile)))
2203 (default-value (gnome-desktop-configuration))
2204 (description "Run the GNOME desktop environment.")))
2205
2206
2207;;;
2208;;; MATE Desktop service.
2209;;; TODO: Add mate-screensaver.
2210
2211(define-record-type* <mate-desktop-configuration> mate-desktop-configuration
2212 make-mate-desktop-configuration
2213 mate-desktop-configuration?
2214 (mate-package mate-package (default mate)))
2215
2216(define (mate-polkit-extension config)
2217 "Return the list of packages for CONFIG's MATE package that extend polkit."
2218 (let ((mate (mate-package config)))
2219 (map (lambda (input)
2220 ((package-direct-input-selector input) mate))
2221 '("mate-system-monitor" ;kill, renice processes
2222 "mate-settings-daemon" ;date/time settings
2223 "mate-power-manager" ;modify brightness
2224 "mate-control-center" ;RandR, display properties FIXME
2225 "mate-applets")))) ;CPU frequency scaling
2226
2227(define mate-desktop-service-type
2228 (service-type
2229 (name 'mate-desktop)
2230 (extensions
2231 (list (service-extension polkit-service-type
2232 mate-polkit-extension)
2233 (service-extension profile-service-type
2234 (compose list
2235 mate-package))))
2236 (default-value (mate-desktop-configuration))
2237 (description "Run the MATE desktop environment.")))
2238
2239
2240;;;
2241;;; XFCE desktop service.
2242;;;
2243
2244(define-record-type* <xfce-desktop-configuration> xfce-desktop-configuration
2245 make-xfce-desktop-configuration
2246 xfce-desktop-configuration?
2247 (xfce xfce-package (default xfce))
2248 (allow-empty-passwords? xfce-allow-empty-passwords? (default #t)))
2249
2250(define (xfce-polkit-settings config)
2251 "Return the list of XFCE dependencies that provide polkit actions and
2252rules."
2253 (let ((xfce (xfce-package config)))
2254 (map (lambda (name)
2255 ((package-direct-input-selector name) xfce))
2256 '("thunar"
2257 "xfce4-power-manager"))))
2258
2259(define (xfce-pam-services config)
2260 (list (unix-pam-service "xfce4-screensaver"
2261 #:allow-empty-passwords?
2262 (xfce-allow-empty-passwords? config))))
2263
2264(define xfce-desktop-service-type
2265 (service-type
2266 (name 'xfce-desktop)
2267 (extensions
2268 (list (service-extension polkit-service-type
2269 xfce-polkit-settings)
2270 (service-extension pam-root-service-type
2271 xfce-pam-services)
2272 (service-extension profile-service-type
2273 (compose list xfce-package))))
2274 (default-value (xfce-desktop-configuration))
2275 (description "Run the Xfce desktop environment.")))
2276
2277
2278;;;
2279;;; Lxqt desktop service.
2280;;;
2281
2282(define-record-type* <lxqt-desktop-configuration> lxqt-desktop-configuration
2283 make-lxqt-desktop-configuration
2284 lxqt-desktop-configuration?
2285 (lxqt lxqt-package
2286 (default lxqt)))
2287
2288(define (lxqt-polkit-settings config)
2289 "Return the list of LXQt dependencies that provide polkit actions and
2290rules."
2291 (let ((lxqt (lxqt-package config)))
2292 (map (lambda (name)
2293 ((package-direct-input-selector name) lxqt))
2294 '("lxqt-admin"))))
2295
2296(define lxqt-desktop-service-type
2297 (service-type
2298 (name 'lxqt-desktop)
2299 (extensions
2300 (list (service-extension polkit-service-type
2301 lxqt-polkit-settings)
2302 (service-extension profile-service-type
2303 (compose list lxqt-package))))
2304 (default-value (lxqt-desktop-configuration))
2305 (description "Run LXQt desktop environment.")))
2306
2307
2308;;;
2309;;; Sugar desktop service.
2310;;;
2311
2312(define-record-type* <sugar-desktop-configuration> sugar-desktop-configuration
2313 make-sugar-desktop-configuration
2314 sugar-desktop-configuration?
2315 (sugar sugar-package (default sugar))
2316 (gobject-introspection
2317 sugar-gobject-introspection (default gobject-introspection))
2318 (activities
2319 sugar-activities (default (list sugar-help-activity))))
2320
2321(define (sugar-polkit-settings config)
2322 "Return the list of packages that provide polkit actions and rules."
2323 (list (sugar-package config)))
2324
2325(define sugar-desktop-service-type
2326 (service-type
2327 (name 'sugar-desktop)
2328 (extensions
2329 (list (service-extension polkit-service-type
2330 sugar-polkit-settings)
2331 (service-extension profile-service-type
2332 (lambda (config)
2333 (cons* (sugar-package config)
2334 (sugar-gobject-introspection config)
2335 (sugar-activities config))))))
2336 (default-value (sugar-desktop-configuration))
2337 (description "Run the Sugar desktop environment.")))
2338
2339
2340;;;
2341;;; X11 socket directory service
2342;;;
2343
2344(define x11-socket-directory-service-type
2345 (let ((x11-socket-directory-shepherd-service
2346 (shepherd-service
2347 (documentation "Create @file{/tmp/.X11-unix} for XWayland.")
2348 (requirement '(file-systems))
2349 (provision '(x11-socket-directory))
2350 (one-shot? #t)
2351 (start #~(lambda _
2352 (let ((directory "/tmp/.X11-unix"))
2353 (mkdir-p directory)
2354 (chmod directory #o1777)))))))
2355 (service-type
2356 (name 'x11-socket-directory-service)
2357 (extensions
2358 (list
2359 (service-extension shepherd-root-service-type
2360 (compose
2361 list
2362 (const x11-socket-directory-shepherd-service)))))
2363 (default-value #f) ; no default value required
2364 (description
2365 "Create @file{/tmp/.X11-unix} for XWayland. When using X11, libxcb
2366takes care of creating that directory however, when using XWayland, we
2367need to create it beforehand."))))
2368
2369(define-deprecated x11-socket-directory-service
2370 x11-socket-directory-service-type
2371 ;; Return a service that creates /tmp/.X11-unix. When using X11, libxcb
2372 ;; takes care of creating that directory. However, when using XWayland, we
2373 ;; need to create beforehand. Thus, create it unconditionally here.
2374 (service x11-socket-directory-service-type))
2375
2376
2377;;;
2378;;; Enlightenment desktop service.
2379;;;
2380
2381(define-record-type* <enlightenment-desktop-configuration>
2382 enlightenment-desktop-configuration make-enlightenment-desktop-configuration
2383 enlightenment-desktop-configuration?
2384 ;; <package>
2385 (enlightenment enlightenment-package
2386 (default enlightenment)))
2387
2388(define (enlightenment-privileged-programs enlightenment-desktop-configuration)
2389 (match-record enlightenment-desktop-configuration
2390 <enlightenment-desktop-configuration>
2391 (enlightenment)
2392 (map file-like->setuid-program
2393 (list (file-append enlightenment
2394 "/lib/enlightenment/utils/enlightenment_sys")
2395 (file-append enlightenment
2396 "/lib/enlightenment/utils/enlightenment_system")
2397 (file-append enlightenment
2398 "/lib/enlightenment/utils/enlightenment_ckpasswd")))))
2399
2400(define enlightenment-desktop-service-type
2401 (service-type
2402 (name 'enlightenment-desktop)
2403 (extensions
2404 (list (service-extension dbus-root-service-type
2405 (compose list
2406 (package-direct-input-selector
2407 "efl")
2408 enlightenment-package))
2409 (service-extension udev-service-type
2410 (compose list
2411 (package-direct-input-selector
2412 "ddcutil")
2413 enlightenment-package))
2414 (service-extension privileged-program-service-type
2415 enlightenment-privileged-programs)
2416 (service-extension profile-service-type
2417 (compose list
2418 enlightenment-package))))
2419 (default-value (enlightenment-desktop-configuration))
2420 (description
2421 "Return a service that adds the @code{enlightenment} package to the system
2422profile, and extends dbus with the ability for @code{efl} to generate
2423thumbnails and privileges the programs which enlightenment needs to function
2424as expected.")))
2425
2426
2427;;;
2428;;; kwallet-service-type.
2429;;;
2430
2431(define-record-type* <kwallet-configuration> kwallet-configuration
2432 make-kwallet-configuration
2433 kwallet-configuration?
2434 (wallet kwallet-package (default kwallet-pam))
2435 (pam-services kwallet-pam-services (default '(("sddm" . login)
2436 ("passwd" . passwd)))))
2437
2438(define (pam-kwallet config)
2439 "Return a PAM extension for KWallet."
2440 (match config
2441 (#f '()) ;explicitly disabled by user
2442 (_
2443 (define (%pam-keyring-entry . arguments)
2444 (pam-entry
2445 (control "optional")
2446 (module (file-append (kwallet-package config)
2447 "/lib/security/pam_kwallet5.so"))
2448 (arguments arguments)))
2449
2450 (list
2451 (pam-extension
2452 (transformer
2453 (lambda (service)
2454 (case (assoc-ref (kwallet-pam-services config)
2455 (pam-service-name service))
2456 ((login)
2457 (pam-service
2458 (inherit service)
2459 (auth (append (pam-service-auth service)
2460 (list (%pam-keyring-entry))))
2461 (session (append (pam-service-session service)
2462 (list (%pam-keyring-entry "auto_start"))))))
2463 ((passwd)
2464 (pam-service
2465 (inherit service)
2466 (password (append (pam-service-password service)
2467 (list (%pam-keyring-entry))))))
2468 (else service)))))))))
2469
2470;; TODO: consider integrating service in `<plasma-desktop-configuration>' as
2471;; done in `<gnome-desktop-configuration>'. This requires rewritting the
2472;; `<plasma-desktop-service-type>' as done for `<gnome-desktop-service-type>'.
2473(define kwallet-service-type
2474 (service-type
2475 (name 'kwallet)
2476 (extensions (list
2477 (service-extension pam-root-service-type pam-kwallet)))
2478 (default-value (kwallet-configuration))
2479 (description "Return a service that extends PAM with entries using
2480@code{pam_kwallet5.so}, unlocking the user's login keyring when they log in or
2481setting its password with @command{passwd}.")))
2482
2483
2484;;;
2485;;; KDE Plasma desktop service.
2486;;;
2487
2488(define-record-type* <plasma-desktop-configuration> plasma-desktop-configuration
2489 make-plasma-desktop-configuration
2490 plasma-desktop-configuration?
2491 (plasma-package plasma-package (default plasma)))
2492
2493(define (plasma-polkit-settings config)
2494 "Return the list of KDE Plasma dependencies that provide polkit actions and
2495rules."
2496 (let ((plasma-plasma (plasma-package config)))
2497 (map (lambda (name)
2498 ((package-direct-input-selector name) plasma-plasma))
2499 '("bolt" ;for plasma-thunderbolt
2500 "fwupd" ;for kinfocenter and discover
2501 "kde-inotify-survey"
2502 "kdeplasma-addons"
2503 "kinfocenter"
2504 "kpmcore"
2505 "ktexteditor"
2506 "kwalletmanager"
2507 "libksysguard"
2508 "packagekit" ;for discover
2509 "plasma-desktop"
2510 "plasma-disks"
2511 "plasma-firewall"
2512 "plasma-workspace"
2513 "powerdevil"))))
2514
2515(define (plasma-dbus-service config)
2516 "Return the list of KDE Plasma dependencies that provide D-Bus services."
2517 (let ((plasma-plasma (plasma-package config)))
2518 (map (lambda (name)
2519 ((package-direct-input-selector name) plasma-plasma))
2520 '("bolt" ;for plasma-thunderbolt
2521 "fwupd" ;for kinfocenter and discover
2522 "kde-inotify-survey"
2523 "kdeplasma-addons"
2524 "kinfocenter"
2525 "kpmcore"
2526 "ktexteditor"
2527 "kwalletmanager"
2528 "libksysguard"
2529 "packagekit" ;for discover
2530 "plasma-desktop"
2531 "plasma-disks"
2532 "plasma-firewall"
2533 "plasma-workspace"
2534 "powerdevil"))))
2535
2536(define (plasma-udev-configurations config)
2537 "Return the list of KDE Plasma dependencies that provide udev rules and
2538hardware files."
2539 (let ((plasma-plasma (plasma-package config)))
2540 (map (lambda (name)
2541 ((package-direct-input-selector name) plasma-plasma))
2542 '("bolt" ;for plasma-thunderbolt
2543 "fwupd")))) ;for kinfocenter and discover
2544
2545;; see https://bugs.kde.org/show_bug.cgi?id=456210
2546;; if `kde' no exits, fallback to `other', and then unlock lockscreen not work,
2547;; so add it.
2548(define (plasma-pam-services config)
2549 (list (unix-pam-service "kde")))
2550
2551(define plasma-desktop-service-type
2552 (service-type
2553 (name 'plasma-desktop)
2554 (description "Run the KDE Plasma desktop environment.")
2555 (default-value (plasma-desktop-configuration))
2556 (extensions
2557 (list (service-extension polkit-service-type
2558 plasma-polkit-settings)
2559 (service-extension dbus-root-service-type
2560 plasma-dbus-service)
2561 (service-extension pam-root-service-type
2562 plasma-pam-services)
2563 (service-extension udev-service-type
2564 plasma-udev-configurations)
2565 (service-extension profile-service-type
2566 (compose list
2567 plasma-package))))))
2568
2569
2570;;;
2571;;; inputattach-service-type
2572;;;
2573
2574(define-record-type* <inputattach-configuration>
2575 inputattach-configuration
2576 make-inputattach-configuration
2577 inputattach-configuration?
2578 (device-type inputattach-configuration-device-type
2579 (default "wacom"))
2580 (device inputattach-configuration-device
2581 (default "/dev/ttyS0"))
2582 (baud-rate inputattach-configuration-baud-rate
2583 (default #f))
2584 (log-file inputattach-configuration-log-file
2585 (default #f)))
2586
2587(define inputattach-shepherd-service
2588 (match-lambda
2589 (($ <inputattach-configuration> type device baud-rate log-file)
2590 (let ((args (append (if baud-rate
2591 (list "--baud" (number->string baud-rate))
2592 '())
2593 (list (string-append "--" type)
2594 device))))
2595 (list (shepherd-service
2596 (provision '(inputattach))
2597 (requirement '(user-processes udev))
2598 (documentation "inputattach daemon")
2599 (start #~(make-forkexec-constructor
2600 (cons (string-append #$inputattach
2601 "/bin/inputattach")
2602 (quote #$args))
2603 #:log-file #$log-file))
2604 (stop #~(make-kill-destructor))))))))
2605
2606(define inputattach-service-type
2607 (service-type
2608 (name 'inputattach)
2609 (extensions
2610 (list (service-extension shepherd-root-service-type
2611 inputattach-shepherd-service)))
2612 (default-value (inputattach-configuration))
2613 (description "Return a service that runs inputattach on a device and
2614dispatches events from it.")))
2615
2616
2617;;;
2618;;; polkit-wheel-service -- Allow wheel group to perform admin actions
2619;;;
2620
2621(define polkit-wheel
2622 (file-union
2623 "polkit-wheel"
2624 `(("share/polkit-1/rules.d/wheel.rules"
2625 ,(plain-file
2626 "wheel.rules"
2627 "polkit.addAdminRule(function(action, subject) {
2628 return [\"unix-group:wheel\"];
2629});
2630")))))
2631
2632(define polkit-wheel-service
2633 (simple-service 'polkit-wheel polkit-service-type (list polkit-wheel)))
2634
2635
2636;;;
2637;;; seatd-service-type -- minimal seat management daemon
2638;;;
2639
2640(define (seatd-group-sanitizer group-or-name)
2641 (match group-or-name
2642 ((? user-group? group) group)
2643 ((? string? group-name) (user-group (name group-name) (system? #t)))
2644 (_ (leave (G_ "seatd: '~a' is not a valid group~%") group-or-name))))
2645
2646(define-record-type* <seatd-configuration> seatd-configuration
2647 make-seatd-configuration
2648 seatd-configuration?
2649 (seatd seatd-package (default seatd))
2650 (group seatd-group ; string | <user-group>
2651 (default "seat")
2652 (sanitize seatd-group-sanitizer))
2653 (socket seatd-socket (default "/run/seatd.sock"))
2654 (logfile seatd-logfile (default "/var/log/seatd.log"))
2655 (loglevel seatd-loglevel (default "info")))
2656
2657(define (seatd-shepherd-service config)
2658 (list (shepherd-service
2659 (documentation "Minimal seat management daemon")
2660 (requirement '(user-processes))
2661 ;; TODO: once cgroups is separate dependency
2662 ;; here we should depend on it rather than elogind
2663 (provision '(seatd elogind))
2664 (start #~(make-forkexec-constructor
2665 (list #$(file-append (seatd-package config) "/bin/seatd")
2666 "-g" #$(user-group-name (seatd-group config)))
2667 #:environment-variables
2668 (list (string-append "SEATD_LOGLEVEL="
2669 #$(seatd-loglevel config))
2670 (string-append "SEATD_DEFAULTPATH="
2671 #$(seatd-socket config)))
2672 #:log-file #$(seatd-logfile config)))
2673 (stop #~(make-kill-destructor)))))
2674
2675(define seatd-accounts
2676 (match-lambda (($ <seatd-configuration> _ group) (list group))))
2677
2678(define seatd-environment
2679 (match-lambda
2680 (($ <seatd-configuration> _ _ socket)
2681 `(("SEATD_SOCK" . ,socket)))))
2682
2683(define seatd-service-type
2684 (service-type
2685 (name 'seatd)
2686 (description "Seat management takes care of mediating access
2687to shared devices (graphics, input), without requiring the
2688applications needing access to be root.")
2689 (extensions
2690 (list
2691 (service-extension account-service-type seatd-accounts)
2692 (service-extension session-environment-service-type seatd-environment)
2693 ;; TODO: once cgroups is separate dependency we should not mount it here
2694 ;; for now it is mounted here, because elogind mounts it
2695 (service-extension file-system-service-type (const %control-groups))
2696 (service-extension shepherd-root-service-type seatd-shepherd-service)))
2697 (default-value (seatd-configuration))))
2698
2699
2700;;;
2701;;; The default set of desktop services.
2702;;;
2703
2704(define* (desktop-services-for-system #:optional
2705 (system (or (%current-target-system)
2706 (%current-system))))
2707 ;; List of services typically useful for a "desktop" use case.
2708
2709 ;; FIXME: Since GDM depends on more dependencies that do not build on i686,
2710 ;; keep SDDM on it for the time being.
2711 ;; XXX: When changing login manager, also change set-xorg-configuration
2712 (cons* (if (target-64bit? system)
2713 (service gdm-service-type)
2714 (service sddm-service-type))
2715
2716 ;; Screen lockers are a pretty useful thing and these are small.
2717 (service screen-locker-service-type
2718 (screen-locker-configuration
2719 (name "slock")
2720 (program (file-append slock "/bin/slock"))))
2721 (service screen-locker-service-type
2722 (screen-locker-configuration
2723 (name "xlock")
2724 (program (file-append xlockmore "/bin/xlock"))))
2725
2726 ;; Add udev rules for MTP devices so that non-root users can access
2727 ;; them.
2728 (simple-service 'mtp udev-service-type (list libmtp))
2729 ;; Add udev rules and default backends for scanners.
2730 (service sane-service-type)
2731 ;; Add polkit rules, so that non-root users in the wheel group can
2732 ;; perform administrative tasks (similar to "sudo").
2733 polkit-wheel-service
2734
2735 ;; Allow desktop users to also mount NTFS and NFS file systems
2736 ;; without root.
2737 (simple-service 'mount-setuid-helpers privileged-program-service-type
2738 (map file-like->setuid-program
2739 (list (file-append nfs-utils "/sbin/mount.nfs")
2740 (file-append ntfs-3g "/sbin/mount.ntfs-3g"))))
2741
2742 ;; Add some of the artwork niceties for the desktop.
2743 (simple-service 'guix-artwork
2744 profile-service-type
2745 %base-packages-artwork)
2746
2747 ;; This is a volatile read-write file system mounted at /var/lib/gdm,
2748 ;; to avoid GDM stale cache and permission issues.
2749 gdm-file-system-service
2750
2751 ;; Provides a nicer experience for VTE-using terminal emulators such
2752 ;; as GNOME Console, Xfce Terminal, etc.
2753 (service vte-integration-service-type)
2754
2755 ;; The global fontconfig cache directory can sometimes contain
2756 ;; stale entries, possibly referencing fonts that have been GC'd,
2757 ;; so mount it read-only.
2758 fontconfig-file-system-service
2759
2760 ;; NetworkManager and its applet.
2761 (service network-manager-service-type)
2762 (service wpa-supplicant-service-type) ;needed by NetworkManager
2763 (simple-service 'network-manager-applet
2764 profile-service-type
2765 (list network-manager-applet))
2766 (service modem-manager-service-type)
2767 (service usb-modeswitch-service-type)
2768
2769 ;; The D-Bus clique.
2770 (service avahi-service-type)
2771 (service udisks-service-type)
2772 (service upower-service-type)
2773 (service accountsservice-service-type)
2774 (service cups-pk-helper-service-type)
2775 (service colord-service-type)
2776 (service geoclue-service-type)
2777 (service polkit-service-type)
2778 (service elogind-service-type)
2779 (service dbus-root-service-type)
2780
2781 (service ntp-service-type)
2782
2783 (service x11-socket-directory-service-type)
2784
2785 (service pulseaudio-service-type)
2786 (service alsa-service-type)
2787
2788 %base-services))
2789
2790(define-syntax %desktop-services
2791 (identifier-syntax (desktop-services-for-system)))
2792
2793;;; desktop.scm ends here