;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2016 Sou Bunnbu <iyzsong@gmail.com>
;;; Copyright © 2017 Maxim Cournoyer <maxim.cournoyer@gmail.com>
-;;; Copyright © 2017 Nils Gillmann <ng0@n0.is>
+;;; Copyright © 2017 ng0 <ng0@n0.is>
;;; Copyright © 2018 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2017, 2019 Christopher Baines <mail@cbaines.net>
+;;; Copyright © 2019 Tim Gesthuizen <tim.gesthuizen@yahoo.de>
;;;
;;; This file is part of GNU Guix.
;;;
#:use-module (gnu system pam)
#:use-module (gnu packages glib)
#:use-module (gnu packages admin)
+ #:use-module (gnu packages cups)
#:use-module (gnu packages freedesktop)
#:use-module (gnu packages gnome)
#:use-module (gnu packages xfce)
#:use-module (gnu packages libusb)
#:use-module (gnu packages mate)
#:use-module (gnu packages enlightenment)
+ #:use-module (guix deprecation)
#:use-module (guix records)
#:use-module (guix packages)
#:use-module (guix store)
#:use-module (guix gexp)
#:use-module (srfi srfi-1)
#:use-module (ice-9 match)
- #:export (upower-configuration
+ #:export (<upower-configuration>
+ upower-configuration
upower-configuration?
+ upower-configuration-upower
+ upower-configuration-watts-up-pro?
+ upower-configuration-poll-batteries?
+ upower-configuration-ignore-lid?
+ upower-configuration-use-percentage-for-policy?
+ upower-configuration-percentage-low
+ upower-configuration-percentage-critical
+ upower-configuration-percentage-action
+ upower-configuration-time-low
+ upower-configuration-time-critical
+ upower-configuration-time-action
+ upower-configuration-critical-power-action
+
upower-service
upower-service-type
udisks-service
udisks-service-type
+ colord-service-type
colord-service
geoclue-application
geoclue-service
geoclue-service-type
+ bluetooth-service-type
+ bluetooth-configuration
+ bluetooth-configuration?
bluetooth-service
elogind-configuration
accountsservice-service-type
accountsservice-service
+ cups-pk-helper-service-type
+
gnome-desktop-configuration
gnome-desktop-configuration?
gnome-desktop-service
enlightenment-desktop-configuration?
enlightenment-desktop-service-type
+ inputattach-configuration
+ inputattach-configuration?
+ inputattach-service-type
+
%desktop-services))
;;; Commentary:
((package . _) package))))
-(define (wrapped-dbus-service service program variable value)
- "Return a wrapper for @var{service}, a package containing a D-Bus service,
-where @var{program} is wrapped such that environment variable @var{variable}
-is set to @var{value} when the bus daemon launches it."
- (define wrapper
- (program-file (string-append (package-name service) "-program-wrapper")
- #~(begin
- (setenv #$variable #$value)
- (apply execl (string-append #$service "/" #$program)
- (string-append #$service "/" #$program)
- (cdr (command-line))))))
-
- (define build
- (with-imported-modules '((guix build utils))
- #~(begin
- (use-modules (guix build utils))
-
- (define service-directory
- "/share/dbus-1/system-services")
-
- (mkdir-p (dirname (string-append #$output
- service-directory)))
- (copy-recursively (string-append #$service
- service-directory)
- (string-append #$output
- service-directory))
- (symlink (string-append #$service "/etc") ;for etc/dbus-1
- (string-append #$output "/etc"))
-
- (for-each (lambda (file)
- (substitute* file
- (("Exec[[:blank:]]*=[[:blank:]]*([[:graph:]]+)(.*)$"
- _ original-program arguments)
- (string-append "Exec=" #$wrapper arguments
- "\n"))))
- (find-files #$output "\\.service$")))))
-
- (computed-file (string-append (package-name service) "-wrapper")
- build))
-
\f
;;;
;;; Upower D-Bus service.
;;;
-;; TODO: Export.
(define-record-type* <upower-configuration>
upower-configuration make-upower-configuration
upower-configuration?
- (upower upower-configuration-upower
- (default upower))
- (watts-up-pro? upower-configuration-watts-up-pro?)
- (poll-batteries? upower-configuration-poll-batteries?)
- (ignore-lid? upower-configuration-ignore-lid?)
- (use-percentage-for-policy? upower-configuration-use-percentage-for-policy?)
- (percentage-low upower-configuration-percentage-low)
- (percentage-critical upower-configuration-percentage-critical)
- (percentage-action upower-configuration-percentage-action)
- (time-low upower-configuration-time-low)
- (time-critical upower-configuration-time-critical)
- (time-action upower-configuration-time-action)
- (critical-power-action upower-configuration-critical-power-action))
+ (upower upower-configuration-upower
+ (default upower))
+ (watts-up-pro? upower-configuration-watts-up-pro?
+ (default #f))
+ (poll-batteries? upower-configuration-poll-batteries?
+ (default #t))
+ (ignore-lid? upower-configuration-ignore-lid?
+ (default #f))
+ (use-percentage-for-policy? upower-configuration-use-percentage-for-policy?
+ (default #f))
+ (percentage-low upower-configuration-percentage-low
+ (default 10))
+ (percentage-critical upower-configuration-percentage-critical
+ (default 3))
+ (percentage-action upower-configuration-percentage-action
+ (default 2))
+ (time-low upower-configuration-time-low
+ (default 1200))
+ (time-critical upower-configuration-time-critical
+ (default 300))
+ (time-action upower-configuration-time-action
+ (default 120))
+ (critical-power-action upower-configuration-critical-power-action
+ (default 'hybrid-sleep)))
(define* upower-configuration-file
;; Return an upower-daemon configuration file.
(define (upower-dbus-service config)
(list (wrapped-dbus-service (upower-configuration-upower config)
"libexec/upowerd"
- "UPOWER_CONF_FILE_NAME"
- (upower-configuration-file config))))
+ `(("UPOWER_CONF_FILE_NAME"
+ ,(upower-configuration-file config))))))
(define (upower-shepherd-service config)
"Return a shepherd service for UPower with CONFIG."
(define upower-service-type
(let ((upower-package (compose list upower-configuration-upower)))
(service-type (name 'upower)
+ (description
+ "Run @command{upowerd}}, a system-wide monitor for power
+consumption and battery levels, with the given configuration settings. It
+implements the @code{org.freedesktop.UPower} D-Bus interface, and is notably
+used by GNOME.")
(extensions
(list (service-extension dbus-root-service-type
upower-dbus-service)
;; Make the 'upower' command visible.
(service-extension profile-service-type
- upower-package))))))
-
-(define* (upower-service #:key (upower upower)
- (watts-up-pro? #f)
- (poll-batteries? #t)
- (ignore-lid? #f)
- (use-percentage-for-policy? #f)
- (percentage-low 10)
- (percentage-critical 3)
- (percentage-action 2)
- (time-low 1200)
- (time-critical 300)
- (time-action 120)
- (critical-power-action 'hybrid-sleep))
+ upower-package)))
+ (default-value (upower-configuration)))))
+
+(define-deprecated (upower-service #:key (upower upower)
+ (watts-up-pro? #f)
+ (poll-batteries? #t)
+ (ignore-lid? #f)
+ (use-percentage-for-policy? #f)
+ (percentage-low 10)
+ (percentage-critical 3)
+ (percentage-action 2)
+ (time-low 1200)
+ (time-critical 300)
+ (time-action 120)
+ (critical-power-action 'hybrid-sleep))
+ upower-service-type
"Return a service that runs @uref{http://upower.freedesktop.org/,
@command{upowerd}}, a system-wide monitor for power consumption and battery
levels, with the given configuration settings. It implements the
(define (geoclue-dbus-service config)
(list (wrapped-dbus-service (geoclue-configuration-geoclue config)
"libexec/geoclue"
- "GEOCLUE_CONFIG_FILE"
- (geoclue-configuration-file config))))
+ `(("GEOCLUE_CONFIG_FILE"
+ ,(geoclue-configuration-file config))))))
(define %geoclue-accounts
(list (user-group (name "geoclue") (system? #t))
`(("bluetooth"
,(bluetooth-directory config)))))
(service-extension shepherd-root-service-type
- (compose list bluetooth-shepherd-service))))))
+ (compose list bluetooth-shepherd-service))))
+ (description "Run the @command{bluetoothd} daemon, which manages all the
+Bluetooth devices and provides a number of D-Bus interfaces.")))
(define* (bluetooth-service #:key (bluez bluez) (auto-enable? #f))
"Return a service that runs the @command{bluetoothd} daemon, which manages
(service-extension udev-service-type list)
;; It provides polkit "actions".
- (service-extension polkit-service-type list)))))
+ (service-extension polkit-service-type list)))
+ (description
+ "Run @command{colord}, a system service with a D-Bus
+interface to manage the color profiles of input and output devices such as
+screens and scanners.")))
(define* (colord-service #:key (colord colord))
"Return a service that runs @command{colord}, a system service with a D-Bus
(define (elogind-dbus-service config)
(list (wrapped-dbus-service (elogind-package config)
"libexec/elogind/elogind"
- "ELOGIND_CONF_FILE"
- (elogind-configuration-file config))))
+ `(("ELOGIND_CONF_FILE"
+ ,(elogind-configuration-file config))))))
(define (pam-extension-procedure config)
"Return an extension for PAM-ROOT-SERVICE-TYPE that ensures that all the PAM
(service accountsservice-service-type accountsservice))
\f
+;;;
+;;; cups-pk-helper service.
+;;;
+
+(define cups-pk-helper-service-type
+ (service-type
+ (name 'cups-pk-helper)
+ (description
+ "PolicyKit helper to configure CUPS with fine-grained privileges.")
+ (extensions
+ (list (service-extension dbus-root-service-type list)
+ (service-extension polkit-service-type list)))
+ (default-value cups-pk-helper)))
+
+\f
;;;
;;; GNOME desktop service.
;;;
(service-extension profile-service-type
(compose list
gnome-package))))
+ (default-value (gnome-desktop-configuration))
(description "Run the GNOME desktop environment.")))
-(define* (gnome-desktop-service #:key (config (gnome-desktop-configuration)))
+(define-deprecated (gnome-desktop-service #:key (config
+ (gnome-desktop-configuration)))
+ gnome-desktop-service-type
"Return a service that adds the @code{gnome} package to the system profile,
and extends polkit with the actions from @code{gnome-settings-daemon}."
(service gnome-desktop-service-type config))
(service-extension profile-service-type
(compose list
mate-package))))
+ (default-value (mate-desktop-configuration))
(description "Run the MATE desktop environment.")))
-(define* (mate-desktop-service #:key (config (mate-desktop-configuration)))
+(define-deprecated (mate-desktop-service #:key
+ (config
+ (mate-desktop-configuration)))
+ mate-desktop-service-type
"Return a service that adds the @code{mate} package to the system profile,
and extends polkit with the actions from @code{mate-settings-daemon}."
(service mate-desktop-service-type config))
"thunar")
xfce-package))
(service-extension profile-service-type
- (compose list
- xfce-package))))))
+ (compose list xfce-package))))
+ (default-value (xfce-desktop-configuration))
+ (description "Run the Xfce desktop environment.")))
-(define* (xfce-desktop-service #:key (config (xfce-desktop-configuration)))
+(define-deprecated (xfce-desktop-service #:key (config
+ (xfce-desktop-configuration)))
+ xfce-desktop-service-type
"Return a service that adds the @code{xfce} package to the system profile,
and extends polkit with the ability for @code{thunar} to manipulate the file
system as root from within a user session, after the user has authenticated
as expected.")))
\f
+;;;
+;;; inputattach-service-type
+;;;
+
+(define-record-type* <inputattach-configuration>
+ inputattach-configuration
+ make-inputattach-configuration
+ inputattach-configuration?
+ (device-type inputattach-configuration-device-type
+ (default "wacom"))
+ (device inputattach-configuration-device
+ (default "/dev/ttyS0"))
+ (log-file inputattach-configuration-log-file
+ (default #f)))
+
+(define inputattach-shepherd-service
+ (match-lambda
+ (($ <inputattach-configuration> type device log-file)
+ (list (shepherd-service
+ (provision '(inputattach))
+ (requirement '(udev))
+ (documentation "inputattach daemon")
+ (start #~(make-forkexec-constructor
+ (list (string-append #$inputattach
+ "/bin/inputattach")
+ (string-append "--" #$type)
+ #$device)
+ #:log-file #$log-file))
+ (stop #~(make-kill-destructor)))))))
+
+(define inputattach-service-type
+ (service-type
+ (name 'inputattach)
+ (extensions
+ (list (service-extension shepherd-root-service-type
+ inputattach-shepherd-service)))
+ (default-value (inputattach-configuration))
+ (description "Return a service that runs inputattach on a device and
+dispatches events from it.")))
+
+\f
;;;
;;; The default set of desktop services.
;;;
(define %desktop-services
;; List of services typically useful for a "desktop" use case.
- (cons* (service slim-service-type)
+ (cons* (service gdm-service-type)
;; Screen lockers are a pretty useful thing and these are small.
(screen-locker-service slock)
;; them.
(simple-service 'mtp udev-service-type (list libmtp))
- ;; The D-Bus clique.
+ ;; NetworkManager and its applet.
(service network-manager-service-type)
(service wpa-supplicant-service-type) ;needed by NetworkManager
+ (simple-service 'network-manager-applet
+ profile-service-type
+ (list network-manager-applet))
+ (service modem-manager-service-type)
+ (service usb-modeswitch-service-type)
+
+ ;; The D-Bus clique.
(service avahi-service-type)
(udisks-service)
- (upower-service)
+ (service upower-service-type)
(accountsservice-service)
+ (service cups-pk-helper-service-type)
(colord-service)
(geoclue-service)
(service polkit-service-type)