1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2014-2022 Ludovic Courtès <ludo@gnu.org>
3 ;;; Copyright © 2015 Andy Wingo <wingo@igalia.com>
4 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
5 ;;; Copyright © 2016 Sou Bunnbu <iyzsong@gmail.com>
6 ;;; Copyright © 2017, 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
7 ;;; Copyright © 2017 Nikita <nikita@n0.is>
8 ;;; Copyright © 2018, 2020 Efraim Flashner <efraim@flashner.co.il>
9 ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
10 ;;; Copyright © 2017, 2019 Christopher Baines <mail@cbaines.net>
11 ;;; Copyright © 2019 Tim Gesthuizen <tim.gesthuizen@yahoo.de>
12 ;;; Copyright © 2019 David Wilson <david@daviwil.com>
13 ;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
14 ;;; Copyright © 2020 Reza Alizadeh Majd <r.majd@pantherx.org>
15 ;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
17 ;;; This file is part of GNU Guix.
19 ;;; GNU Guix is free software; you can redistribute it and/or modify it
20 ;;; under the terms of the GNU General Public License as published by
21 ;;; the Free Software Foundation; either version 3 of the License, or (at
22 ;;; your option) any later version.
24 ;;; GNU Guix is distributed in the hope that it will be useful, but
25 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
26 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
27 ;;; GNU General Public License for more details.
29 ;;; You should have received a copy of the GNU General Public License
30 ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
32 (define-module (gnu services desktop)
33 #:use-module (gnu services)
34 #:use-module (gnu services shepherd)
35 #:use-module (gnu services base)
36 #:use-module (gnu services dbus)
37 #:use-module (gnu services avahi)
38 #:use-module (gnu services xorg)
39 #:use-module (gnu services networking)
40 #:use-module (gnu services sound)
41 #:use-module ((gnu system file-systems)
42 #:select (%elogind-file-systems file-system))
43 #:autoload (gnu services sddm) (sddm-service-type)
44 #:use-module (gnu system)
45 #:use-module (gnu system setuid)
46 #:use-module (gnu system shadow)
47 #:use-module (gnu system uuid)
48 #:use-module (gnu system pam)
49 #:use-module (gnu packages glib)
50 #:use-module (gnu packages admin)
51 #:use-module (gnu packages cups)
52 #:use-module (gnu packages freedesktop)
53 #:use-module (gnu packages gnome)
54 #:use-module (gnu packages xfce)
55 #:use-module (gnu packages avahi)
56 #:use-module (gnu packages xdisorg)
57 #:use-module (gnu packages scanner)
58 #:use-module (gnu packages suckless)
59 #:use-module (gnu packages linux)
60 #:use-module (gnu packages libusb)
61 #:use-module (gnu packages lxqt)
62 #:use-module (gnu packages mate)
63 #:use-module (gnu packages nfs)
64 #:use-module (gnu packages enlightenment)
65 #:use-module (guix deprecation)
66 #:use-module (guix records)
67 #:use-module (guix packages)
68 #:use-module (guix store)
69 #:use-module (guix utils)
70 #:use-module (guix gexp)
71 #:use-module (srfi srfi-1)
72 #:use-module (ice-9 format)
73 #:use-module (ice-9 match)
74 #:export (<upower-configuration>
77 upower-configuration-upower
78 upower-configuration-watts-up-pro?
79 upower-configuration-poll-batteries?
80 upower-configuration-ignore-lid?
81 upower-configuration-use-percentage-for-policy?
82 upower-configuration-percentage-low
83 upower-configuration-percentage-critical
84 upower-configuration-percentage-action
85 upower-configuration-time-low
86 upower-configuration-time-critical
87 upower-configuration-time-action
88 upower-configuration-critical-power-action
100 geoclue-configuration
101 geoclue-configuration?
102 %standard-geoclue-applications
106 bluetooth-service-type
107 bluetooth-configuration
108 bluetooth-configuration?
111 elogind-configuration
112 elogind-configuration?
116 %fontconfig-file-system
117 fontconfig-file-system-service
119 accountsservice-service-type
120 accountsservice-service
122 cups-pk-helper-service-type
125 gnome-desktop-configuration
126 gnome-desktop-configuration?
127 gnome-desktop-service
128 gnome-desktop-service-type
130 mate-desktop-configuration
131 mate-desktop-configuration?
133 mate-desktop-service-type
135 lxqt-desktop-configuration
136 lxqt-desktop-configuration?
137 lxqt-desktop-service-type
139 xfce-desktop-configuration
140 xfce-desktop-configuration?
142 xfce-desktop-service-type
144 x11-socket-directory-service
146 enlightenment-desktop-configuration
147 enlightenment-desktop-configuration?
148 enlightenment-desktop-service-type
150 inputattach-configuration
151 inputattach-configuration?
152 inputattach-service-type
156 gnome-keyring-configuration
157 gnome-keyring-configuration?
158 gnome-keyring-service-type
164 ;;; This module contains service definitions for a "desktop" environment.
174 (if value "true\n" "false\n"))
176 (define (package-direct-input-selector input)
178 (match (assoc-ref (package-direct-inputs package) input)
179 ((package . _) package))))
184 ;;; Upower D-Bus service.
187 (define-record-type* <upower-configuration>
188 upower-configuration make-upower-configuration
189 upower-configuration?
190 (upower upower-configuration-upower
192 (watts-up-pro? upower-configuration-watts-up-pro?
194 (poll-batteries? upower-configuration-poll-batteries?
196 (ignore-lid? upower-configuration-ignore-lid?
198 (use-percentage-for-policy? upower-configuration-use-percentage-for-policy?
200 (percentage-low upower-configuration-percentage-low
202 (percentage-critical upower-configuration-percentage-critical
204 (percentage-action upower-configuration-percentage-action
206 (time-low upower-configuration-time-low
208 (time-critical upower-configuration-time-critical
210 (time-action upower-configuration-time-action
212 (critical-power-action upower-configuration-critical-power-action
213 (default 'hybrid-sleep)))
215 (define* upower-configuration-file
216 ;; Return an upower-daemon configuration file.
218 (($ <upower-configuration> upower
219 watts-up-pro? poll-batteries? ignore-lid? use-percentage-for-policy?
220 percentage-low percentage-critical percentage-action time-low
221 time-critical time-action critical-power-action)
222 (plain-file "UPower.conf"
225 "EnableWattsUpPro=" (bool watts-up-pro?)
226 "NoPollBatteries=" (bool (not poll-batteries?))
227 "IgnoreLid=" (bool ignore-lid?)
228 "UsePercentageForPolicy=" (bool use-percentage-for-policy?)
229 "PercentageLow=" (number->string percentage-low) "\n"
230 "PercentageCritical=" (number->string percentage-critical) "\n"
231 "PercentageAction=" (number->string percentage-action) "\n"
232 "TimeLow=" (number->string time-low) "\n"
233 "TimeCritical=" (number->string time-critical) "\n"
234 "TimeAction=" (number->string time-action) "\n"
235 "CriticalPowerAction=" (match critical-power-action
236 ('hybrid-sleep "HybridSleep")
237 ('hibernate "Hibernate")
238 ('power-off "PowerOff"))
241 (define %upower-activation
243 (use-modules (guix build utils))
244 (mkdir-p "/var/lib/upower")))
246 (define (upower-dbus-service config)
247 (list (wrapped-dbus-service (upower-configuration-upower config)
249 `(("UPOWER_CONF_FILE_NAME"
250 ,(upower-configuration-file config))))))
252 (define (upower-shepherd-service config)
253 "Return a shepherd service for UPower with CONFIG."
254 (let ((upower (upower-configuration-upower config))
255 (config (upower-configuration-file config)))
256 (list (shepherd-service
257 (documentation "Run the UPower power and battery monitor.")
258 (provision '(upower-daemon))
259 (requirement '(dbus-system udev))
261 (start #~(make-forkexec-constructor
262 (list (string-append #$upower "/libexec/upowerd"))
263 #:environment-variables
264 (list (string-append "UPOWER_CONF_FILE_NAME="
266 (stop #~(make-kill-destructor))))))
268 (define upower-service-type
269 (let ((upower-package (compose list upower-configuration-upower)))
270 (service-type (name 'upower)
272 "Run @command{upowerd}}, a system-wide monitor for power
273 consumption and battery levels, with the given configuration settings. It
274 implements the @code{org.freedesktop.UPower} D-Bus interface, and is notably
277 (list (service-extension dbus-root-service-type
279 (service-extension shepherd-root-service-type
280 upower-shepherd-service)
281 (service-extension activation-service-type
282 (const %upower-activation))
283 (service-extension udev-service-type
286 ;; Make the 'upower' command visible.
287 (service-extension profile-service-type
289 (default-value (upower-configuration)))))
293 ;;; GeoClue D-Bus service.
297 (define-record-type* <geoclue-configuration>
298 geoclue-configuration make-geoclue-configuration
299 geoclue-configuration?
300 (geoclue geoclue-configuration-geoclue
302 (whitelist geoclue-configuration-whitelist)
303 (wifi-geolocation-url geoclue-configuration-wifi-geolocation-url)
304 (submit-data? geoclue-configuration-submit-data?)
305 (wifi-submission-url geoclue-configuration-wifi-submission-url)
306 (submission-nick geoclue-configuration-submission-nick)
307 (applications geoclue-configuration-applications))
309 (define* (geoclue-application name #:key (allowed? #t) system? (users '()))
310 "Configure default GeoClue access permissions for an application. NAME is
311 the Desktop ID of the application, without the .desktop part. If ALLOWED? is
312 true, the application will have access to location information by default.
313 The boolean SYSTEM? value indicates that an application is a system component
314 or not. Finally USERS is a list of UIDs of all users for which this
315 application is allowed location info access. An empty users list means all
319 "allowed=" (bool allowed?)
320 "system=" (bool system?)
321 "users=" (string-join users ";") "\n"))
323 (define %standard-geoclue-applications
324 (list (geoclue-application "gnome-datetime-panel" #:system? #t)
325 (geoclue-application "epiphany" #:system? #f)
326 (geoclue-application "firefox" #:system? #f)))
328 (define* (geoclue-configuration-file config)
329 "Return a geoclue configuration file."
330 (plain-file "geoclue.conf"
334 (string-join (geoclue-configuration-whitelist config)
337 "url=" (geoclue-configuration-wifi-geolocation-url config) "\n"
338 "submit-data=" (bool (geoclue-configuration-submit-data? config))
340 (geoclue-configuration-wifi-submission-url config) "\n"
342 (geoclue-configuration-submission-nick config)
344 (string-join (geoclue-configuration-applications config)
347 (define (geoclue-dbus-service config)
348 (list (wrapped-dbus-service (geoclue-configuration-geoclue config)
350 `(("GEOCLUE_CONFIG_FILE"
351 ,(geoclue-configuration-file config))))))
353 (define %geoclue-accounts
354 (list (user-group (name "geoclue") (system? #t))
359 (comment "GeoClue daemon user")
360 (home-directory "/var/empty")
361 (shell "/run/current-system/profile/sbin/nologin"))))
363 (define geoclue-service-type
364 (service-type (name 'geoclue)
366 (list (service-extension dbus-root-service-type
367 geoclue-dbus-service)
368 (service-extension account-service-type
369 (const %geoclue-accounts))))
370 (description "Run the @command{geoclue} location service.
371 This service provides a D-Bus interface to allow applications to request
372 access to a user's physical location, and optionally to add information to
373 online location databases.")))
375 (define* (geoclue-service #:key (geoclue geoclue)
377 (wifi-geolocation-url
378 ;; Mozilla geolocation service:
379 "https://location.services.mozilla.com/v1/geolocate?key=geoclue")
382 "https://location.services.mozilla.com/v1/submit?key=geoclue")
383 (submission-nick "geoclue")
384 (applications %standard-geoclue-applications))
385 "Return a service that runs the @command{geoclue} location service. This
386 service provides a D-Bus interface to allow applications to request access to
387 a user's physical location, and optionally to add information to online
388 location databases. By default, only the GNOME date-time panel and the Icecat
389 and Epiphany web browsers are able to ask for the user's location, and in the
390 case of Icecat and Epiphany, both will ask the user for permission first. See
391 @uref{https://wiki.freedesktop.org/www/Software/GeoClue/, the geoclue web
392 site} for more information."
393 (service geoclue-service-type
394 (geoclue-configuration
396 (whitelist whitelist)
397 (wifi-geolocation-url wifi-geolocation-url)
398 (submit-data? submit-data?)
399 (wifi-submission-url wifi-submission-url)
400 (submission-nick submission-nick)
401 (applications applications))))
408 (define-record-type* <bluetooth-configuration>
409 bluetooth-configuration make-bluetooth-configuration
410 bluetooth-configuration?
411 (bluez bluetooth-configuration-bluez (default bluez))
414 (name bluetooth-configuration-name (default "BlueZ"))
415 (class bluetooth-configuration-class (default #x000000))
416 (discoverable-timeout
417 bluetooth-configuration-discoverable-timeout (default 180))
418 (always-pairable? bluetooth-configuration-always-pairable? (default #f))
419 (pairable-timeout bluetooth-configuration-pairable-timeout (default 0))
421 ;;; MAYBE: Exclude into separate <device-id> record-type?
422 (device-id bluetooth-configuration-device-id (default #f))
423 (reverse-service-discovery?
424 bluetooth-configuration-reverse-service-discovery (default #t))
425 (name-resolving? bluetooth-configuration-name-resolving? (default #t))
426 (debug-keys? bluetooth-configuration-debug-keys? (default #f))
429 ;;; 'dual, 'bredr, 'le
430 (controller-mode bluetooth-configuration-controller-mode (default 'dual))
433 ;;; 'off, 'single, 'multiple
434 (multi-profile bluetooth-configuration-multi-profile (default 'off))
435 (fast-connectable? bluetooth-configuration-fast-connectable? (default #f))
438 ;;; for LE mode: 'off, 'network/on, 'device
439 ;;; for Dual mode: 'off, 'network/on', 'device, 'limited-network, 'limited-device
440 ;;; Source: https://git.kernel.org/pub/scm/bluetooth/bluez.git/tree/src/main.conf#n68
441 (privacy bluetooth-configuration-privacy (default 'off))
444 ;;; 'never, 'confirm, 'always
445 (just-works-repairing
446 bluetooth-configuration-just-works-repairing (default 'never))
447 (temporary-timeout bluetooth-configuration-temporary-timeout (default 30))
448 (refresh-discovery? bluetooth-configuration-refresh-discovery (default #t))
450 ;;; Possible values: #t, #f, (uuid <uuid>)
452 ;;; d4992530-b9ec-469f-ab01-6c481c47da1c (BlueZ Experimental Debug)
453 ;;; 671b10b5-42c0-4696-9227-eb28d1b049d6 (BlueZ Experimental Simultaneous Central and Peripheral)
454 ;;; 15c0a148-c273-11ea-b3de-0242ac130004 (BlueZ Experimental LL privacy)
455 ;;; 330859bc-7506-492d-9370-9a6f0614037f (BlueZ Experimental Bluetooth Quality Report)
456 ;;; a6695ace-ee7f-4fb9-881a-5fac66c629af (BlueZ Experimental Offload Codecs)
457 ;;; Source: https://git.kernel.org/pub/scm/bluetooth/bluez.git/tree/src/main.conf#n110
458 (experimental bluetooth-configuration-experimental (default #f))
459 (remote-name-request-retry-delay
460 bluetooth-configuration-remote-name-request-retry-delay (default 300))
463 (page-scan-type bluetooth-configuration-page-scan-type (default #f))
464 (page-scan-interval bluetooth-configuration-page-scan-interval (default #f))
465 (page-scan-window bluetooth-configuration-page-scan-window (default #f))
466 (inquiry-scan-type bluetooth-configuration-inquiry-scan-type (default #f))
467 (inquiry-scan-interval bluetooth-configuration-inquiry-scan-interval (default #f))
468 (inquiry-scan-window bluetooth-configuration-inquiry-scan-window (default #f))
469 (link-supervision-timeout bluetooth-configuration-link-supervision-timeout (default #f))
470 (page-timeout bluetooth-configuration-page-timeout (default #f))
471 (min-sniff-interval bluetooth-configuration-min-sniff-interval (default #f))
472 (max-sniff-interval bluetooth-configuration-max-sniff-interval (default #f))
475 (min-advertisement-interval
476 bluetooth-configuration-min-advertisement-interval (default #f))
477 (max-advertisement-interval
478 bluetooth-configuration-max-advertisement-interval (default #f))
479 (multi-advertisement-rotation-interval
480 bluetooth-configuration-multi-advertisement-rotation-interval (default #f))
481 (scan-interval-auto-connect
482 bluetooth-configuration-scan-interval-auto-connect (default #f))
483 (scan-window-auto-connect
484 bluetooth-configuration-scan-window-auto-connect (default #f))
485 (scan-interval-suspend
486 bluetooth-configuration-scan-interval-suspend (default #f))
488 bluetooth-configuration-scan-window-suspend (default #f))
489 (scan-interval-discovery
490 bluetooth-configuration-scan-interval-discovery (default #f))
491 (scan-window-discovery
492 bluetooth-configuration-scan-window-discovery (default #f))
493 (scan-interval-adv-monitor
494 bluetooth-configuration-scan-interval-adv-monitor (default #f))
495 (scan-window-adv-monitor
496 bluetooth-configuration-scan-window-adv-monitor (default #f))
497 (scan-interval-connect
498 bluetooth-configuration-scan-interval-connect (default #f))
500 bluetooth-configuration-scan-window-connect (default #f))
501 (min-connection-interval
502 bluetooth-configuration-min-connection-interval (default #f))
503 (max-connection-interval
504 bluetooth-configuration-max-connection-interval (default #f))
506 bluetooth-configuration-connection-latency (default #f))
507 (connection-supervision-timeout
508 bluetooth-configuration-connection-supervision-timeout (default #f))
510 bluetooth-configuration-autoconnect-timeout (default #f))
511 (adv-mon-allowlist-scan-duration
512 bluetooth-configuration-adv-mon-allowlist-scan-duration (default 300))
513 (adv-mon-no-filter-scan-duration
514 bluetooth-configuration-adv-mon-no-filter-scan-duration (default 500))
515 (enable-adv-mon-interleave-scan?
516 bluetooth-configuration-enable-adv-mon-interleave-scan (default #t))
519 ;;; Possible values: 'yes, 'no, 'always
520 (cache bluetooth-configuration-cache (default 'always))
522 ;;; Possible values: 7 ... 16, 0 (don't care)
523 (key-size bluetooth-configuration-key-size (default 0))
525 ;;; Possible values: 23 ... 517
526 (exchange-mtu bluetooth-configuration-exchange-mtu (default 517))
528 ;;; Possible values: 1 ... 5
529 (att-channels bluetooth-configuration-att-channels (default 3))
532 ;;; Possible values: 'basic, 'ertm
533 (session-mode bluetooth-configuration-session-mode (default 'basic))
535 ;;; Possible values: 'basic, 'streaming
536 (stream-mode bluetooth-configuration-stream-mode (default 'basic))
539 (reconnect-uuids bluetooth-configuration-reconnect-uuids (default '()))
540 (reconnect-attempts bluetooth-configuration-reconnect-attempts (default 7))
541 (reconnect-intervals bluetooth-configuration-reconnect-intervals
542 (default (list 1 2 4 8 16 32 64)))
543 (auto-enable? bluetooth-configuration-auto-enable? (default #f))
544 (resume-delay bluetooth-configuration-resume-delay (default 2))
549 ;;; "N = 0x00" ... "N = 0xFF"
550 ;;; Source: https://git.kernel.org/pub/scm/bluetooth/bluez.git/tree/src/main.conf#n286
551 (rssi-sampling-period bluetooth-configuration-rssi-sampling-period
554 (define (bluetooth-configuration-file config)
555 "Return a configuration file for the systemd bluetooth service, as a string."
558 "\nName = " (bluetooth-configuration-name config)
559 "\nClass = " (string-append
561 (format #f "~6,'0x" (bluetooth-configuration-class config)))
562 "\nDiscoverableTimeout = " (number->string
563 (bluetooth-configuration-discoverable-timeout
565 "\nAlwaysPairable = " (bool (bluetooth-configuration-always-pairable?
567 "\nPairableTimeout = " (number->string
568 (bluetooth-configuration-pairable-timeout
570 (if (bluetooth-configuration-device-id config)
571 (string-append "\nDeviceID = " (bluetooth-configuration-device-id config))
573 "\nReverseServiceDiscovery = " (bool
574 (bluetooth-configuration-reverse-service-discovery
576 "\nNameResolving = " (bool (bluetooth-configuration-name-resolving? config))
577 "\nDebugKeys = " (bool (bluetooth-configuration-debug-keys? config))
578 "\nControllerMode = " (symbol->string
579 (bluetooth-configuration-controller-mode config))
580 "\nMultiProfile = " (symbol->string (bluetooth-configuration-multi-profile
582 "\nFastConnectable = " (bool (bluetooth-configuration-fast-connectable? config))
583 "\nPrivacy = " (symbol->string (bluetooth-configuration-privacy config))
584 "\nJustWorksRepairing = " (symbol->string
585 (bluetooth-configuration-just-works-repairing config))
586 "\nTemporaryTimeout = " (number->string
587 (bluetooth-configuration-temporary-timeout config))
588 "\nRefreshDiscovery = " (bool (bluetooth-configuration-refresh-discovery config))
589 "\nExperimental = " (let ((experimental (bluetooth-configuration-experimental config)))
590 (cond ((or (eq? experimental #t)
591 (eq? experimental #f)) (bool experimental))
592 ((list? experimental)
593 (string-join (map uuid->string experimental) ","))))
594 "\nRemoteNameRequestRetryDelay = " (number->string
595 (bluetooth-configuration-remote-name-request-retry-delay
598 (if (bluetooth-configuration-page-scan-type config)
601 (number->string (bluetooth-configuration-page-scan-type config)))
603 (if (bluetooth-configuration-page-scan-interval config)
605 "\nPageScanInterval = "
606 (number->string (bluetooth-configuration-page-scan-interval config)))
608 (if (bluetooth-configuration-page-scan-window config)
610 "\nPageScanWindow = "
611 (number->string (bluetooth-configuration-page-scan-window config)))
613 (if (bluetooth-configuration-inquiry-scan-type config)
615 "\nInquiryScanType = "
616 (number->string (bluetooth-configuration-inquiry-scan-type config)))
618 (if (bluetooth-configuration-inquiry-scan-interval config)
620 "\nInquiryScanInterval = "
621 (number->string (bluetooth-configuration-inquiry-scan-interval config)))
623 (if (bluetooth-configuration-inquiry-scan-window config)
625 "\nInquiryScanWindow = "
626 (number->string (bluetooth-configuration-inquiry-scan-window config)))
628 (if (bluetooth-configuration-link-supervision-timeout config)
630 "\nLinkSupervisionTimeout = "
631 (number->string (bluetooth-configuration-link-supervision-timeout config)))
633 (if (bluetooth-configuration-page-timeout config)
636 (number->string (bluetooth-configuration-page-timeout config)))
638 (if (bluetooth-configuration-min-sniff-interval config)
640 "\nMinSniffInterval = "
641 (number->string (bluetooth-configuration-min-sniff-interval config)))
643 (if (bluetooth-configuration-max-sniff-interval config)
645 "\nMaxSniffInterval = "
646 (number->string (bluetooth-configuration-max-sniff-interval config)))
650 (if (bluetooth-configuration-min-advertisement-interval config)
652 "\nMinAdvertisementInterval = "
653 (number->string (bluetooth-configuration-min-advertisement-interval config)))
655 (if (bluetooth-configuration-max-advertisement-interval config)
657 "\nMaxAdvertisementInterval = "
658 (number->string (bluetooth-configuration-max-advertisement-interval config)))
660 (if (bluetooth-configuration-multi-advertisement-rotation-interval config)
662 "\nMultiAdvertisementRotationInterval = "
664 (bluetooth-configuration-multi-advertisement-rotation-interval config)))
666 (if (bluetooth-configuration-scan-interval-auto-connect config)
668 "\nScanIntervalAutoConnect = "
669 (number->string (bluetooth-configuration-scan-interval-auto-connect config)))
671 (if (bluetooth-configuration-scan-window-auto-connect config)
673 "\nScanWindowAutoConnect = "
674 (number->string (bluetooth-configuration-scan-window-auto-connect config)))
676 (if (bluetooth-configuration-scan-interval-suspend config)
678 "\nScanIntervalSuspend = "
679 (number->string (bluetooth-configuration-scan-interval-suspend config)))
681 (if (bluetooth-configuration-scan-window-suspend config)
683 "\nScanWindowSuspend = "
684 (number->string (bluetooth-configuration-scan-window-suspend config)))
686 (if (bluetooth-configuration-scan-interval-discovery config)
688 "\nScanIntervalDiscovery = "
689 (number->string (bluetooth-configuration-scan-interval-discovery config)))
691 (if (bluetooth-configuration-scan-window-discovery config)
693 "\nScanWindowDiscovery = "
694 (number->string (bluetooth-configuration-scan-window-discovery config)))
696 (if (bluetooth-configuration-scan-interval-adv-monitor config)
698 "\nScanIntervalAdvMonitor = "
699 (number->string (bluetooth-configuration-scan-interval-adv-monitor config)))
701 (if (bluetooth-configuration-scan-window-adv-monitor config)
703 "\nScanWindowAdvMonitor = "
704 (number->string (bluetooth-configuration-scan-window-adv-monitor config)))
706 (if (bluetooth-configuration-scan-interval-connect config)
708 "\nScanIntervalConnect = "
709 (number->string (bluetooth-configuration-scan-interval-connect config)))
711 (if (bluetooth-configuration-scan-window-connect config)
713 "\nScanWindowConnect = "
714 (number->string (bluetooth-configuration-scan-window-connect config)))
716 (if (bluetooth-configuration-min-connection-interval config)
718 "\nMinConnectionInterval = "
719 (number->string (bluetooth-configuration-min-connection-interval config)))
721 (if (bluetooth-configuration-max-connection-interval config)
723 "\nMaxConnectionInterval = "
724 (number->string (bluetooth-configuration-max-connection-interval config)))
726 (if (bluetooth-configuration-connection-latency config)
728 "\nConnectionLatency = "
729 (number->string (bluetooth-configuration-connection-latency config)))
731 (if (bluetooth-configuration-connection-supervision-timeout config)
733 "\nConnectionSupervisionTimeout = "
734 (number->string (bluetooth-configuration-connection-supervision-timeout config)))
736 (if (bluetooth-configuration-autoconnect-timeout config)
738 "\nAutoconnecttimeout = "
739 (number->string (bluetooth-configuration-autoconnect-timeout config)))
741 "\nAdvMonAllowlistScanDuration = " (number->string
742 (bluetooth-configuration-adv-mon-allowlist-scan-duration
744 "\nAdvMonNoFilterScanDuration = " (number->string
745 (bluetooth-configuration-adv-mon-no-filter-scan-duration
747 "\nEnableAdvMonInterleaveScan = " (number->string
749 (bluetooth-configuration-enable-adv-mon-interleave-scan
754 "\nCache = " (symbol->string (bluetooth-configuration-cache config))
755 "\nKeySize = " (number->string (bluetooth-configuration-key-size config))
756 "\nExchangeMTU = " (number->string (bluetooth-configuration-exchange-mtu config))
757 "\nChannels = " (number->string (bluetooth-configuration-att-channels config))
760 "\nSessionMode = " (symbol->string (bluetooth-configuration-session-mode config))
761 "\nStreamMode = " (symbol->string (bluetooth-configuration-stream-mode config))
764 (let ((uuids (bluetooth-configuration-reconnect-uuids config)))
765 (if (not (eq? '() uuids))
767 "\nReconnectUUIDs = "
768 (string-join (map uuid->string uuids) ","))
770 "\nReconnectAttempts = " (number->string
771 (bluetooth-configuration-reconnect-attempts config))
772 "\nReconnectIntervals = " (string-join
774 (bluetooth-configuration-reconnect-intervals
777 "\nAutoEnable = " (bool (bluetooth-configuration-auto-enable?
779 "\nResumeDelay = " (number->string (bluetooth-configuration-resume-delay config))
782 "\nRSSISamplingPeriod = " (string-append
785 (bluetooth-configuration-rssi-sampling-period config)))))
787 (define (bluetooth-directory config)
788 (computed-file "etc-bluetooth"
792 (call-with-output-file "main.conf"
794 (display #$(bluetooth-configuration-file config)
797 (define (bluetooth-shepherd-service config)
798 "Return a shepherd service for @command{bluetoothd}."
800 (provision '(bluetooth))
801 (requirement '(dbus-system udev))
802 (documentation "Run the bluetoothd daemon.")
803 (start #~(make-forkexec-constructor
804 (list #$(file-append (bluetooth-configuration-bluez config)
805 "/libexec/bluetooth/bluetoothd"))))
806 (stop #~(make-kill-destructor))))
808 (define bluetooth-service-type
812 (list (service-extension dbus-root-service-type
813 (compose list bluetooth-configuration-bluez))
814 (service-extension udev-service-type
815 (compose list bluetooth-configuration-bluez))
816 (service-extension etc-service-type
819 ,(bluetooth-directory config)))))
820 (service-extension shepherd-root-service-type
821 (compose list bluetooth-shepherd-service))))
822 (default-value (bluetooth-configuration))
823 (description "Run the @command{bluetoothd} daemon, which manages all the
824 Bluetooth devices and provides a number of D-Bus interfaces.")))
826 (define* (bluetooth-service #:key (bluez bluez) (auto-enable? #f))
827 "Return a service that runs the @command{bluetoothd} daemon, which manages
828 all the Bluetooth devices and provides a number of D-Bus interfaces. When
829 AUTO-ENABLE? is true, the bluetooth controller is powered automatically at
832 Users need to be in the @code{lp} group to access the D-Bus service.
834 (service bluetooth-service-type
835 (bluetooth-configuration
837 (auto-enable? auto-enable?))))
841 ;;; Colord D-Bus service.
844 (define %colord-activation
846 (use-modules (guix build utils))
847 (mkdir-p "/var/lib/colord")
848 (let ((user (getpwnam "colord")))
849 (chown "/var/lib/colord"
850 (passwd:uid user) (passwd:gid user)))))
852 (define %colord-accounts
853 (list (user-group (name "colord") (system? #t))
858 (comment "colord daemon user")
859 (home-directory "/var/empty")
860 (shell (file-append shadow "/sbin/nologin")))))
862 (define colord-service-type
863 (service-type (name 'colord)
865 (list (service-extension account-service-type
866 (const %colord-accounts))
867 (service-extension activation-service-type
868 (const %colord-activation))
870 ;; Colord is a D-Bus service that dbus-daemon can
872 (service-extension dbus-root-service-type list)
874 ;; Colord provides "color device" rules for udev.
875 (service-extension udev-service-type list)
877 ;; It provides polkit "actions".
878 (service-extension polkit-service-type list)))
879 (default-value colord)
881 "Run @command{colord}, a system service with a D-Bus
882 interface to manage the color profiles of input and output devices such as
883 screens and scanners.")))
890 (define-record-type* <udisks-configuration>
891 udisks-configuration make-udisks-configuration
892 udisks-configuration?
893 (udisks udisks-configuration-udisks
896 (define %udisks-activation
897 (with-imported-modules '((guix build utils))
899 (use-modules (guix build utils))
901 (let ((run-dir "/var/run/udisks2"))
903 (chmod run-dir #o700)))))
905 (define udisks-service-type
906 (let ((udisks-package (lambda (config)
907 (list (udisks-configuration-udisks config)))))
908 (service-type (name 'udisks)
910 (list (service-extension polkit-service-type
912 (service-extension dbus-root-service-type
914 (service-extension udev-service-type
916 (service-extension activation-service-type
917 (const %udisks-activation))
919 ;; Profile 'udisksctl' & co. in the system profile.
920 (service-extension profile-service-type
922 (description "Run UDisks, a @dfn{disk management} daemon
923 that provides user interfaces with notifications and ways to mount/unmount
924 disks. Programs that talk to UDisks include the @command{udisksctl} command,
925 part of UDisks, and GNOME Disks."))))
927 (define* (udisks-service #:key (udisks udisks))
928 "Return a service for @uref{http://udisks.freedesktop.org/docs/latest/,
929 UDisks}, a @dfn{disk management} daemon that provides user interfaces with
930 notifications and ways to mount/unmount disks. Programs that talk to UDisks
931 include the @command{udisksctl} command, part of UDisks, and GNOME Disks."
932 (service udisks-service-type
933 (udisks-configuration (udisks udisks))))
937 ;;; Elogind login and seat management service.
940 (define-record-type* <elogind-configuration> elogind-configuration
941 make-elogind-configuration
942 elogind-configuration?
943 (elogind elogind-package
945 (kill-user-processes? elogind-kill-user-processes?
947 (kill-only-users elogind-kill-only-users
949 (kill-exclude-users elogind-kill-exclude-users
951 (inhibit-delay-max-seconds elogind-inhibit-delay-max-seconds
953 (handle-power-key elogind-handle-power-key
955 (handle-suspend-key elogind-handle-suspend-key
957 (handle-hibernate-key elogind-handle-hibernate-key
958 ;; (default 'hibernate)
959 ;; XXX Ignore it for now, since we don't
960 ;; yet handle resume-from-hibernation in
963 (handle-lid-switch elogind-handle-lid-switch
965 (handle-lid-switch-docked elogind-handle-lid-switch-docked
967 (handle-lid-switch-external-power elogind-handle-lid-switch-external-power
969 (power-key-ignore-inhibited? elogind-power-key-ignore-inhibited?
971 (suspend-key-ignore-inhibited? elogind-suspend-key-ignore-inhibited?
973 (hibernate-key-ignore-inhibited? elogind-hibernate-key-ignore-inhibited?
975 (lid-switch-ignore-inhibited? elogind-lid-switch-ignore-inhibited?
977 (holdoff-timeout-seconds elogind-holdoff-timeout-seconds
979 (idle-action elogind-idle-action
981 (idle-action-seconds elogind-idle-action-seconds
983 (runtime-directory-size-percent elogind-runtime-directory-size-percent
985 (runtime-directory-size elogind-runtime-directory-size
987 (remove-ipc? elogind-remove-ipc?
990 (suspend-state elogind-suspend-state
991 (default '("mem" "standby" "freeze")))
992 (suspend-mode elogind-suspend-mode
994 (hibernate-state elogind-hibernate-state
996 (hibernate-mode elogind-hibernate-mode
997 (default '("platform" "shutdown")))
998 (hybrid-sleep-state elogind-hybrid-sleep-state
1000 (hybrid-sleep-mode elogind-hybrid-sleep-mode
1002 '("suspend" "platform" "shutdown"))))
1004 (define (elogind-configuration-file config)
1009 (_ (error "expected #t or #f, instead got:" x))))
1010 (define char-set:user-name
1011 (string->char-set "abcdefghijklmnopqrstuvwxyz0123456789_-"))
1012 (define (valid-list? l pred)
1013 (and-map (lambda (x) (string-every pred x)) l))
1014 (define (user-name-list users)
1015 (unless (valid-list? users char-set:user-name)
1016 (error "invalid user list" users))
1017 (string-join users " "))
1018 (define (enum val allowed)
1019 (unless (memq val allowed)
1020 (error "invalid value" val allowed))
1021 (symbol->string val))
1022 (define (non-negative-integer x)
1023 (unless (exact-integer? x) (error "not an integer" x))
1024 (when (negative? x) (error "negative number not allowed" x))
1026 (define handle-actions
1027 '(ignore poweroff reboot halt kexec suspend hibernate hybrid-sleep lock))
1028 (define (handle-action x)
1029 (enum x handle-actions))
1030 (define (sleep-list tokens)
1031 (unless (valid-list? tokens char-set:user-name)
1032 (error "invalid sleep list" tokens))
1033 (string-join tokens " "))
1034 (define-syntax ini-file-clause
1036 ((_ config (prop (parser getter)))
1037 (string-append prop "=" (parser (getter config)) "\n"))
1039 (string-append str "\n"))))
1040 (define-syntax-rule (ini-file config file clause ...)
1041 (plain-file file (string-append (ini-file-clause config clause) ...)))
1043 config "logind.conf"
1045 ("KillUserProcesses" (yesno elogind-kill-user-processes?))
1046 ("KillOnlyUsers" (user-name-list elogind-kill-only-users))
1047 ("KillExcludeUsers" (user-name-list elogind-kill-exclude-users))
1048 ("InhibitDelayMaxSec" (non-negative-integer elogind-inhibit-delay-max-seconds))
1049 ("HandlePowerKey" (handle-action elogind-handle-power-key))
1050 ("HandleSuspendKey" (handle-action elogind-handle-suspend-key))
1051 ("HandleHibernateKey" (handle-action elogind-handle-hibernate-key))
1052 ("HandleLidSwitch" (handle-action elogind-handle-lid-switch))
1053 ("HandleLidSwitchDocked" (handle-action elogind-handle-lid-switch-docked))
1054 ("HandleLidSwitchExternalPower" (handle-action elogind-handle-lid-switch-external-power))
1055 ("PowerKeyIgnoreInhibited" (yesno elogind-power-key-ignore-inhibited?))
1056 ("SuspendKeyIgnoreInhibited" (yesno elogind-suspend-key-ignore-inhibited?))
1057 ("HibernateKeyIgnoreInhibited" (yesno elogind-hibernate-key-ignore-inhibited?))
1058 ("LidSwitchIgnoreInhibited" (yesno elogind-lid-switch-ignore-inhibited?))
1059 ("HoldoffTimeoutSec" (non-negative-integer elogind-holdoff-timeout-seconds))
1060 ("IdleAction" (handle-action elogind-idle-action))
1061 ("IdleActionSec" (non-negative-integer elogind-idle-action-seconds))
1062 ("RuntimeDirectorySize"
1065 (match (elogind-runtime-directory-size-percent config)
1066 (#f (non-negative-integer (elogind-runtime-directory-size config)))
1067 (percent (string-append (non-negative-integer percent) "%"))))))
1068 ("RemoveIPC" (yesno elogind-remove-ipc?))
1070 ("SuspendState" (sleep-list elogind-suspend-state))
1071 ("SuspendMode" (sleep-list elogind-suspend-mode))
1072 ("HibernateState" (sleep-list elogind-hibernate-state))
1073 ("HibernateMode" (sleep-list elogind-hibernate-mode))
1074 ("HybridSleepState" (sleep-list elogind-hybrid-sleep-state))
1075 ("HybridSleepMode" (sleep-list elogind-hybrid-sleep-mode))))
1077 (define (elogind-dbus-service config)
1078 "Return a @file{org.freedesktop.login1.service} file that tells D-Bus how to
1079 \"start\" elogind. In practice though, our elogind is started when booting by
1080 shepherd. Thus, the @code{Exec} line of this @file{.service} file does not
1081 explain how to start elogind; instead, it spawns a wrapper that waits for the
1082 @code{elogind} shepherd service. This avoids a race condition where both
1083 @command{shepherd} and @command{dbus-daemon} would attempt to start elogind."
1084 ;; For more info on the elogind startup race, see
1085 ;; <https://issues.guix.gnu.org/55444>.
1088 (elogind-package config))
1091 (program-file "elogind-dbus-shepherd-sync"
1092 (with-imported-modules '((gnu services herd))
1094 (use-modules (gnu services herd)
1097 (guard (c ((service-not-found-error? c)
1098 (format (current-error-port)
1099 "no elogind shepherd service~%")
1101 ((shepherd-error? c)
1102 (format (current-error-port)
1103 "elogind shepherd service not \
1106 (wait-for-service 'elogind))))))
1109 (with-imported-modules '((guix build utils))
1111 (use-modules (guix build utils)
1114 (define service-directory
1115 "/share/dbus-1/system-services")
1117 (mkdir-p (dirname (string-append #$output service-directory)))
1118 (copy-recursively (string-append #$elogind service-directory)
1119 (string-append #$output service-directory))
1120 (symlink (string-append #$elogind "/etc") ;for etc/dbus-1
1121 (string-append #$output "/etc"))
1123 ;; Replace the "Exec=" line of the 'org.freedesktop.login1.service'
1124 ;; file with one that refers to WRAPPER instead of elogind.
1125 (match (find-files #$output "\\.service$")
1128 (("Exec[[:blank:]]*=.*" _)
1129 (string-append "Exec=" #$wrapper "\n"))))))))
1131 (list (computed-file "elogind-dbus-service-wrapper" build)))
1133 (define (pam-extension-procedure config)
1134 "Return an extension for PAM-ROOT-SERVICE-TYPE that ensures that all the PAM
1135 services use 'pam_elogind.so', a module that allows elogind to keep track of
1136 logged-in users (run 'loginctl' to see elogind's world view of users and
1140 (control "required")
1141 (module (file-append (elogind-package config)
1142 "/lib/security/pam_elogind.so"))))
1147 (session (cons pam-elogind (pam-service-session pam)))))))
1149 (define (elogind-shepherd-service config)
1150 "Return a Shepherd service to start elogind according to @var{config}."
1151 (list (shepherd-service
1152 (requirement '(dbus-system))
1153 (provision '(elogind))
1154 (start #~(make-forkexec-constructor
1155 (list #$(file-append (elogind-package config)
1156 "/libexec/elogind/elogind"))
1157 #:environment-variables
1158 (list (string-append "ELOGIND_CONF_FILE="
1159 #$(elogind-configuration-file
1161 (stop #~(make-kill-destructor)))))
1163 (define elogind-service-type
1164 (service-type (name 'elogind)
1166 (list (service-extension dbus-root-service-type
1167 elogind-dbus-service)
1168 (service-extension udev-service-type
1169 (compose list elogind-package))
1170 (service-extension polkit-service-type
1171 (compose list elogind-package))
1173 ;; Start elogind from the Shepherd rather than waiting
1174 ;; for bus activation. This ensures that it can handle
1175 ;; events like lid close, etc.
1176 (service-extension shepherd-root-service-type
1177 elogind-shepherd-service)
1179 ;; Provide the 'loginctl' command.
1180 (service-extension profile-service-type
1181 (compose list elogind-package))
1183 ;; Extend PAM with pam_elogind.so.
1184 (service-extension pam-root-service-type
1185 pam-extension-procedure)
1187 ;; We need /run/user, /run/systemd, etc.
1188 (service-extension file-system-service-type
1189 (const %elogind-file-systems))))
1190 (default-value (elogind-configuration))
1191 (description "Run the @command{elogind} login and seat
1192 management service. The @command{elogind} service integrates with PAM to
1193 allow other system components to know the set of logged-in users as well as
1194 their session types (graphical, console, remote, etc.). It can also clean up
1195 after users when they log out.")))
1197 (define* (elogind-service #:key (config (elogind-configuration)))
1198 "Return a service that runs the @command{elogind} login and seat management
1199 service. The @command{elogind} service integrates with PAM to allow other
1200 system components to know the set of logged-in users as well as their session
1201 types (graphical, console, remote, etc.). It can also clean up after users
1203 (service elogind-service-type config))
1207 ;;; Fontconfig and other desktop file-systems.
1210 (define %fontconfig-file-system
1213 (mount-point "/var/cache/fontconfig")
1215 (flags '(read-only))
1218 ;; The global fontconfig cache directory can sometimes contain stale entries,
1219 ;; possibly referencing fonts that have been GC'd, so mount it read-only.
1220 ;; As mentioned https://debbugs.gnu.org/cgi/bugreport.cgi?bug=36924#8 and
1221 ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=38046#10 and elsewhere.
1222 (define fontconfig-file-system-service
1223 (simple-service 'fontconfig-file-system
1224 file-system-service-type
1225 (list %fontconfig-file-system)))
1228 ;;; AccountsService service.
1231 (define %accountsservice-activation
1233 (use-modules (guix build utils))
1234 (mkdir-p "/var/lib/AccountsService")))
1236 (define accountsservice-service-type
1237 (service-type (name 'accountsservice)
1239 (list (service-extension activation-service-type
1240 (const %accountsservice-activation))
1241 (service-extension dbus-root-service-type list)
1242 (service-extension polkit-service-type list)))
1243 (default-value accountsservice)
1244 (description "Run AccountsService, a system service available
1245 over D-Bus that can list available accounts, change their passwords, and so
1246 on. AccountsService integrates with PolicyKit to enable unprivileged users to
1247 acquire the capability to modify their system configuration.")))
1249 (define* (accountsservice-service #:key (accountsservice accountsservice))
1250 "Return a service that runs AccountsService, a system service that
1251 can list available accounts, change their passwords, and so on.
1252 AccountsService integrates with PolicyKit to enable unprivileged users to
1253 acquire the capability to modify their system configuration.
1254 @uref{https://www.freedesktop.org/wiki/Software/AccountsService/, the
1255 accountsservice web site} for more information."
1256 (service accountsservice-service-type accountsservice))
1260 ;;; cups-pk-helper service.
1263 (define cups-pk-helper-service-type
1265 (name 'cups-pk-helper)
1267 "PolicyKit helper to configure CUPS with fine-grained privileges.")
1269 (list (service-extension dbus-root-service-type list)
1270 (service-extension polkit-service-type list)))
1271 (default-value cups-pk-helper)))
1275 ;;; Scanner access via SANE.
1278 (define %sane-accounts
1279 ;; The '60-libsane.rules' udev rules refers to the "scanner" group.
1280 (list (user-group (name "scanner") (system? #t))))
1282 (define sane-service-type
1286 "This service provides access to scanners @i{via}
1287 @uref{http://www.sane-project.org, SANE} by installing the necessary udev
1289 (default-value sane-backends-minimal)
1291 (list (service-extension udev-service-type list)
1292 (service-extension account-service-type
1293 (const %sane-accounts))))))
1298 ;;; GNOME desktop service.
1301 (define-record-type* <gnome-desktop-configuration> gnome-desktop-configuration
1302 make-gnome-desktop-configuration
1303 gnome-desktop-configuration?
1304 (gnome gnome-package (default gnome)))
1306 (define (gnome-packages config packages)
1307 "Return the list of GNOME dependencies from CONFIG which names are part of
1308 the given PACKAGES list."
1309 (let ((gnome (gnome-package config)))
1311 ((package-direct-input-selector name) gnome))
1314 (define (gnome-udev-rules config)
1315 "Return the list of GNOME dependencies that provide udev rules."
1316 (gnome-packages config '("gnome-settings-daemon")))
1318 (define (gnome-polkit-settings config)
1319 "Return the list of GNOME dependencies that provide polkit actions and
1321 (gnome-packages config
1322 '("gnome-settings-daemon"
1323 "gnome-control-center"
1324 "gnome-system-monitor"
1327 (define gnome-desktop-service-type
1329 (name 'gnome-desktop)
1331 (list (service-extension udev-service-type
1333 (service-extension polkit-service-type
1334 gnome-polkit-settings)
1335 (service-extension profile-service-type
1338 (default-value (gnome-desktop-configuration))
1339 (description "Run the GNOME desktop environment.")))
1341 (define-deprecated (gnome-desktop-service #:key (config
1342 (gnome-desktop-configuration)))
1343 gnome-desktop-service-type
1344 "Return a service that adds the @code{gnome} package to the system profile,
1345 and extends polkit with the actions from @code{gnome-settings-daemon}."
1346 (service gnome-desktop-service-type config))
1348 ;; MATE Desktop service.
1349 ;; TODO: Add mate-screensaver.
1351 (define-record-type* <mate-desktop-configuration> mate-desktop-configuration
1352 make-mate-desktop-configuration
1353 mate-desktop-configuration?
1354 (mate-package mate-package (default mate)))
1356 (define (mate-polkit-extension config)
1357 "Return the list of packages for CONFIG's MATE package that extend polkit."
1358 (let ((mate (mate-package config)))
1359 (map (lambda (input)
1360 ((package-direct-input-selector input) mate))
1361 '("mate-system-monitor" ;kill, renice processes
1362 "mate-settings-daemon" ;date/time settings
1363 "mate-power-manager" ;modify brightness
1364 "mate-control-center" ;RandR, display properties FIXME
1365 "mate-applets")))) ;CPU frequency scaling
1367 (define mate-desktop-service-type
1369 (name 'mate-desktop)
1371 (list (service-extension polkit-service-type
1372 mate-polkit-extension)
1373 (service-extension profile-service-type
1376 (default-value (mate-desktop-configuration))
1377 (description "Run the MATE desktop environment.")))
1379 (define-deprecated (mate-desktop-service #:key
1381 (mate-desktop-configuration)))
1382 mate-desktop-service-type
1383 "Return a service that adds the @code{mate} package to the system profile,
1384 and extends polkit with the actions from @code{mate-settings-daemon}."
1385 (service mate-desktop-service-type config))
1389 ;;; XFCE desktop service.
1392 (define-record-type* <xfce-desktop-configuration> xfce-desktop-configuration
1393 make-xfce-desktop-configuration
1394 xfce-desktop-configuration?
1395 (xfce xfce-package (default xfce)))
1397 (define (xfce-polkit-settings config)
1398 "Return the list of XFCE dependencies that provide polkit actions and
1400 (let ((xfce (xfce-package config)))
1402 ((package-direct-input-selector name) xfce))
1404 "xfce4-power-manager"))))
1406 (define xfce-desktop-service-type
1408 (name 'xfce-desktop)
1410 (list (service-extension polkit-service-type
1411 xfce-polkit-settings)
1412 (service-extension profile-service-type
1413 (compose list xfce-package))))
1414 (default-value (xfce-desktop-configuration))
1415 (description "Run the Xfce desktop environment.")))
1417 (define-deprecated (xfce-desktop-service #:key (config
1418 (xfce-desktop-configuration)))
1419 xfce-desktop-service-type
1420 "Return a service that adds the @code{xfce} package to the system profile,
1421 and extends polkit with the ability for @code{thunar} to manipulate the file
1422 system as root from within a user session, after the user has authenticated
1423 with the administrator's password."
1424 (service xfce-desktop-service-type config))
1428 ;;; Lxqt desktop service.
1431 (define-record-type* <lxqt-desktop-configuration> lxqt-desktop-configuration
1432 make-lxqt-desktop-configuration
1433 lxqt-desktop-configuration?
1437 (define (lxqt-polkit-settings config)
1438 "Return the list of LXQt dependencies that provide polkit actions and
1440 (let ((lxqt (lxqt-package config)))
1442 ((package-direct-input-selector name) lxqt))
1445 (define lxqt-desktop-service-type
1447 (name 'lxqt-desktop)
1449 (list (service-extension polkit-service-type
1450 lxqt-polkit-settings)
1451 (service-extension profile-service-type
1452 (compose list lxqt-package))))
1453 (default-value (lxqt-desktop-configuration))
1454 (description "Run LXQt desktop environment.")))
1458 ;;; X11 socket directory service
1461 (define x11-socket-directory-service
1462 ;; Return a service that creates /tmp/.X11-unix. When using X11, libxcb
1463 ;; takes care of creating that directory. However, when using XWayland, we
1464 ;; need to create beforehand. Thus, create it unconditionally here.
1465 (simple-service 'x11-socket-directory
1466 activation-service-type
1467 (with-imported-modules '((guix build utils))
1469 (use-modules (guix build utils))
1470 (let ((directory "/tmp/.X11-unix"))
1472 (chmod directory #o1777))))))
1475 ;;; Enlightenment desktop service.
1478 (define-record-type* <enlightenment-desktop-configuration>
1479 enlightenment-desktop-configuration make-enlightenment-desktop-configuration
1480 enlightenment-desktop-configuration?
1482 (enlightenment enlightenment-package
1483 (default enlightenment)))
1485 (define (enlightenment-setuid-programs enlightenment-desktop-configuration)
1486 (match-record enlightenment-desktop-configuration
1487 <enlightenment-desktop-configuration>
1489 (map file-like->setuid-program
1490 (list (file-append enlightenment
1491 "/lib/enlightenment/utils/enlightenment_sys")
1492 (file-append enlightenment
1493 "/lib/enlightenment/utils/enlightenment_system")
1494 (file-append enlightenment
1495 "/lib/enlightenment/utils/enlightenment_ckpasswd")))))
1497 (define enlightenment-desktop-service-type
1499 (name 'enlightenment-desktop)
1501 (list (service-extension dbus-root-service-type
1503 (package-direct-input-selector
1505 enlightenment-package))
1506 (service-extension setuid-program-service-type
1507 enlightenment-setuid-programs)
1508 (service-extension profile-service-type
1510 enlightenment-package))))
1511 (default-value (enlightenment-desktop-configuration))
1513 "Return a service that adds the @code{enlightenment} package to the system
1514 profile, and extends dbus with the ability for @code{efl} to generate
1515 thumbnails and makes setuid the programs which enlightenment needs to function
1520 ;;; inputattach-service-type
1523 (define-record-type* <inputattach-configuration>
1524 inputattach-configuration
1525 make-inputattach-configuration
1526 inputattach-configuration?
1527 (device-type inputattach-configuration-device-type
1529 (device inputattach-configuration-device
1530 (default "/dev/ttyS0"))
1531 (baud-rate inputattach-configuration-baud-rate
1533 (log-file inputattach-configuration-log-file
1536 (define inputattach-shepherd-service
1538 (($ <inputattach-configuration> type device baud-rate log-file)
1539 (let ((args (append (if baud-rate
1540 (list "--baud" (number->string baud-rate))
1542 (list (string-append "--" type)
1544 (list (shepherd-service
1545 (provision '(inputattach))
1546 (requirement '(udev))
1547 (documentation "inputattach daemon")
1548 (start #~(make-forkexec-constructor
1549 (cons (string-append #$inputattach
1552 #:log-file #$log-file))
1553 (stop #~(make-kill-destructor))))))))
1555 (define inputattach-service-type
1559 (list (service-extension shepherd-root-service-type
1560 inputattach-shepherd-service)))
1561 (default-value (inputattach-configuration))
1562 (description "Return a service that runs inputattach on a device and
1563 dispatches events from it.")))
1567 ;;; gnome-keyring-service-type
1570 (define-record-type* <gnome-keyring-configuration> gnome-keyring-configuration
1571 make-gnome-keyring-configuration
1572 gnome-keyring-configuration?
1573 (keyring gnome-keyring-package (default gnome-keyring))
1574 (pam-services gnome-keyring-pam-services (default '(("gdm-password" . login)
1575 ("passwd" . passwd)))))
1577 (define (pam-gnome-keyring config)
1578 (define (%pam-keyring-entry . arguments)
1580 (control "optional")
1581 (module (file-append (gnome-keyring-package config)
1582 "/lib/security/pam_gnome_keyring.so"))
1583 (arguments arguments)))
1587 (case (assoc-ref (gnome-keyring-pam-services config)
1588 (pam-service-name service))
1592 (auth (append (pam-service-auth service)
1593 (list (%pam-keyring-entry))))
1594 (session (append (pam-service-session service)
1595 (list (%pam-keyring-entry "auto_start"))))))
1599 (password (append (pam-service-password service)
1600 (list (%pam-keyring-entry))))))
1603 (define gnome-keyring-service-type
1605 (name 'gnome-keyring)
1607 (service-extension pam-root-service-type pam-gnome-keyring)))
1608 (default-value (gnome-keyring-configuration))
1609 (description "Return a service, that adds the @code{gnome-keyring} package
1610 to the system profile and extends PAM with entries using
1611 @code{pam_gnome_keyring.so}, unlocking a user's login keyring when they log in
1612 or setting its password with passwd.")))
1616 ;;; polkit-wheel-service -- Allow wheel group to perform admin actions
1619 (define polkit-wheel
1622 `(("share/polkit-1/rules.d/wheel.rules"
1625 "polkit.addAdminRule(function(action, subject) {
1626 return [\"unix-group:wheel\"];
1630 (define polkit-wheel-service
1631 (simple-service 'polkit-wheel polkit-service-type (list polkit-wheel)))
1635 ;;; The default set of desktop services.
1638 (define* (desktop-services-for-system #:optional
1639 (system (or (%current-target-system)
1640 (%current-system))))
1641 ;; List of services typically useful for a "desktop" use case.
1643 ;; Since GDM depends on Rust (gdm -> gnome-shell -> gjs -> mozjs -> rust)
1644 ;; and Rust is currently unavailable on non-x86_64 platforms, default to
1645 ;; SDDM there (FIXME).
1646 (cons* (if (string-prefix? "x86_64" system)
1647 (service gdm-service-type)
1648 (service sddm-service-type))
1650 ;; Screen lockers are a pretty useful thing and these are small.
1651 (screen-locker-service slock)
1652 (screen-locker-service xlockmore "xlock")
1654 ;; Add udev rules for MTP devices so that non-root users can access
1656 (simple-service 'mtp udev-service-type (list libmtp))
1657 ;; Add udev rules for scanners.
1658 (service sane-service-type)
1659 ;; Add polkit rules, so that non-root users in the wheel group can
1660 ;; perform administrative tasks (similar to "sudo").
1661 polkit-wheel-service
1663 ;; Allow desktop users to also mount NTFS and NFS file systems
1665 (simple-service 'mount-setuid-helpers setuid-program-service-type
1666 (map (lambda (program)
1669 (list (file-append nfs-utils "/sbin/mount.nfs")
1670 (file-append ntfs-3g "/sbin/mount.ntfs-3g"))))
1672 ;; The global fontconfig cache directory can sometimes contain
1673 ;; stale entries, possibly referencing fonts that have been GC'd,
1674 ;; so mount it read-only.
1675 fontconfig-file-system-service
1677 ;; NetworkManager and its applet.
1678 (service network-manager-service-type)
1679 (service wpa-supplicant-service-type) ;needed by NetworkManager
1680 (simple-service 'network-manager-applet
1681 profile-service-type
1682 (list network-manager-applet))
1683 (service modem-manager-service-type)
1684 (service usb-modeswitch-service-type)
1686 ;; The D-Bus clique.
1687 (service avahi-service-type)
1689 (service upower-service-type)
1690 (accountsservice-service)
1691 (service cups-pk-helper-service-type)
1692 (service colord-service-type)
1694 (service polkit-service-type)
1698 (service ntp-service-type)
1700 x11-socket-directory-service
1702 (service pulseaudio-service-type)
1703 (service alsa-service-type)
1707 (define-syntax %desktop-services
1708 (identifier-syntax (desktop-services-for-system)))
1710 ;;; desktop.scm ends here