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