summaryrefslogtreecommitdiff
path: root/gnu/services
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/services')
-rw-r--r--gnu/services/base.scm5
-rw-r--r--gnu/services/desktop.scm22
-rw-r--r--gnu/services/docker.scm23
-rw-r--r--gnu/services/mail.scm4
-rw-r--r--gnu/services/mcron.scm4
-rw-r--r--gnu/services/monitoring.scm7
-rw-r--r--gnu/services/networking.scm4
-rw-r--r--gnu/services/ssh.scm2
-rw-r--r--gnu/services/version-control.scm2
-rw-r--r--gnu/services/xorg.scm136
10 files changed, 148 insertions, 61 deletions
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 952f6f9ab2..f709ca5519 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -830,6 +830,7 @@ Return a service that sets up Unicode support in @var{tty} and loads
"Return the list of PAM service needed for CONF."
;; Let 'login' be known to PAM.
(list (unix-pam-service "login"
+ #:login-uid? #t
#:allow-empty-passwords?
(login-configuration-allow-empty-passwords? config)
#:motd
@@ -1293,8 +1294,8 @@ the tty to run, among other things."
(lambda args
;; There's a race with the SIGCHLD handler, which could
;; call 'waitpid' before 'close-pipe' above does. If we
- ;; get ECHILD, that means we lost the race, but that's
- ;; fine.
+ ;; get ECHILD, that means we lost the race; in that case, we
+ ;; cannot tell what the exit code was (FIXME).
(or (= ECHILD (system-error-errno args))
(apply throw args)))))
(line
diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index f31dbc112e..652f7b1b02 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -84,6 +84,7 @@
udisks-service
udisks-service-type
+ colord-service-type
colord-service
geoclue-application
@@ -93,6 +94,9 @@
geoclue-service
geoclue-service-type
+ bluetooth-service-type
+ bluetooth-configuration
+ bluetooth-configuration?
bluetooth-service
elogind-configuration
@@ -452,7 +456,9 @@ site} for more information."
`(("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
@@ -506,7 +512,11 @@ Users need to be in the @code{lp} group to access the D-Bus service.
(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
@@ -1050,9 +1060,15 @@ dispatches events from it.")))
;; 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)
+
+ ;; The D-Bus clique.
(service avahi-service-type)
(udisks-service)
(service upower-service-type)
diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm
index 8b5edf5cb0..94a04c8996 100644
--- a/gnu/services/docker.scm
+++ b/gnu/services/docker.scm
@@ -31,13 +31,25 @@
#:export (docker-configuration
docker-service-type))
+;;; We're not using serialize-configuration, but we must define this because
+;;; the define-configuration macro validates it exists.
+(define (serialize-boolean field-name val)
+ "")
+
(define-configuration docker-configuration
(docker
(package docker)
"Docker daemon package.")
(containerd
(package containerd)
- "containerd package."))
+ "containerd package.")
+ (proxy
+ (package docker-libnetwork-cmd-proxy)
+ "The proxy package to support inter-container and outside-container
+loop-back communications.")
+ (enable-proxy?
+ (boolean #t)
+ "Enable or disable the user-land proxy (enabled by default)."))
(define %docker-accounts
(list (user-group (name "docker") (system? #t))))
@@ -66,7 +78,9 @@
(stop #~(make-kill-destructor)))))
(define (docker-shepherd-service config)
- (let* ((docker (docker-configuration-docker config)))
+ (let* ((docker (docker-configuration-docker config))
+ (enable-proxy? (docker-configuration-enable-proxy? config))
+ (proxy (docker-configuration-proxy config)))
(shepherd-service
(documentation "Docker daemon.")
(provision '(dockerd))
@@ -83,7 +97,10 @@
udev))
(start #~(make-forkexec-constructor
(list (string-append #$docker "/bin/dockerd")
- "-p" "/var/run/docker.pid")
+ "-p" "/var/run/docker.pid"
+ (if #$enable-proxy? "--userland-proxy" "")
+ "--userland-proxy-path" (string-append #$proxy
+ "/bin/proxy"))
#:pid-file "/var/run/docker.pid"
#:log-file "/var/log/docker.log"))
(stop #~(make-kill-destructor)))))
diff --git a/gnu/services/mail.scm b/gnu/services/mail.scm
index 0dabfed4cb..216b2c80b0 100644
--- a/gnu/services/mail.scm
+++ b/gnu/services/mail.scm
@@ -806,8 +806,8 @@ standard facilities are supported.")
"Log unsuccessful authentication attempts and the reasons why they
failed.")
- (auth-verbose-passwords?
- (boolean #f)
+ (auth-verbose-passwords
+ (string "no")
"In case of password mismatches, log the attempted password. Valid
values are no, plain and sha1. sha1 can be useful for detecting brute
force password attempts vs. user simply trying the same password over
diff --git a/gnu/services/mcron.scm b/gnu/services/mcron.scm
index 1b232b6cba..fd84589c19 100644
--- a/gnu/services/mcron.scm
+++ b/gnu/services/mcron.scm
@@ -121,7 +121,9 @@ files."
(cons* "GUILE_AUTO_COMPILE=0"
"PATH=/run/current-system/profile/bin"
(remove (cut string-prefix? "PATH=" <>)
- (environ)))))
+ (environ)))
+
+ #:log-file "/var/log/mcron.log"))
(stop #~(make-kill-destructor))
(actions
diff --git a/gnu/services/monitoring.scm b/gnu/services/monitoring.scm
index e1b1d9b236..7276f7056d 100644
--- a/gnu/services/monitoring.scm
+++ b/gnu/services/monitoring.scm
@@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Sou Bunnbu <iyzsong@member.fsf.org>
-;;; Copyright © 2018 Gábor Boskovits <boskovits@gmail.com>
+;;; Copyright © 2018, 2019 Gábor Boskovits <boskovits@gmail.com>
;;; Copyright © 2018, 2019 Oleg Pykhalov <go.wigust@gmail.com>
;;;
;;; This file is part of GNU Guix.
@@ -102,7 +102,7 @@
(service-type
(name 'darkstat)
(description
- "Run @command{darkstat} to serve network traffic statictics reports over
+ "Run @command{darkstat} to serve network traffic statistics reports over
HTTP.")
(extensions
(list (service-extension account-service-type
@@ -141,7 +141,8 @@ prometheus.")
(extensions
(list (service-extension
shepherd-root-service-type
- (compose list prometheus-node-exporter-shepherd-service))))))
+ (compose list prometheus-node-exporter-shepherd-service))))
+ (default-value (prometheus-node-exporter-configuration))))
;;;
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index 03b2c6e1ec..082a85f63d 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -190,7 +190,9 @@ fe80::1%lo0 apps.facebook.com\n")
;; interfaces are typically down at this point. Thus we perform
;; our own interface discovery here.
(define valid?
- (negate loopback-network-interface?))
+ (lambda (interface)
+ (and (arp-network-interface? interface)
+ (not (loopback-network-interface? interface)))))
(define ifaces
(filter valid? (all-network-interface-names)))
diff --git a/gnu/services/ssh.scm b/gnu/services/ssh.scm
index 25db783420..d026c3115e 100644
--- a/gnu/services/ssh.scm
+++ b/gnu/services/ssh.scm
@@ -182,6 +182,7 @@
"Return a list of <pam-services> for lshd with CONFIG."
(list (unix-pam-service
"lshd"
+ #:login-uid? #t
#:allow-empty-passwords?
(lsh-configuration-allow-empty-passwords? config))))
@@ -506,6 +507,7 @@ of user-name/file-like tuples."
"Return a list of <pam-services> for sshd with CONFIG."
(list (unix-pam-service
"sshd"
+ #:login-uid? #t
#:allow-empty-passwords?
(openssh-configuration-allow-empty-passwords? config))))
diff --git a/gnu/services/version-control.scm b/gnu/services/version-control.scm
index e332b93096..9d53f9358d 100644
--- a/gnu/services/version-control.scm
+++ b/gnu/services/version-control.scm
@@ -157,7 +157,7 @@
(service-extension activation-service-type
git-daemon-activation)))
(description
- "Expose Git respositories over the insecure @code{git://} TCP-based
+ "Expose Git repositories over the insecure @code{git://} TCP-based
protocol.")
(default-value (git-daemon-configuration))))
diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm
index 44dcec4ec9..0a38b4013c 100644
--- a/gnu/services/xorg.scm
+++ b/gnu/services/xorg.scm
@@ -83,6 +83,8 @@
slim-configuration-shepherd
slim-configuration-auto-login-session
slim-configuration-xorg
+ slim-configuration-display
+ slim-configuration-vt
slim-configuration-sessreg
slim-service-type
@@ -488,6 +490,10 @@ desktop session from the system or user profile will be used."
(default #f))
(xorg-configuration slim-configuration-xorg
(default (xorg-configuration)))
+ (display slim-configuration-display
+ (default ":0"))
+ (vt slim-configuration-vt
+ (default "vt7"))
(sessreg slim-configuration-sessreg
(default sessreg)))
@@ -495,24 +501,31 @@ desktop session from the system or user profile will be used."
"Return a PAM service for @command{slim}."
(list (unix-pam-service
"slim"
+ #:login-uid? #t
#:allow-empty-passwords?
(slim-configuration-allow-empty-passwords? config))))
(define (slim-shepherd-service config)
- (define slim.cfg
- (let ((xinitrc (xinitrc #:fallback-session
- (slim-configuration-auto-login-session config)))
- (xauth (slim-configuration-xauth config))
- (startx (xorg-start-command (slim-configuration-xorg config)))
- (shepherd (slim-configuration-shepherd config))
- (theme-name (slim-configuration-theme-name config))
- (sessreg (slim-configuration-sessreg config)))
+ (let* ((xinitrc (xinitrc #:fallback-session
+ (slim-configuration-auto-login-session config)))
+ (xauth (slim-configuration-xauth config))
+ (startx (xorg-start-command (slim-configuration-xorg config)))
+ (display (slim-configuration-display config))
+ (vt (slim-configuration-vt config))
+ (shepherd (slim-configuration-shepherd config))
+ (theme-name (slim-configuration-theme-name config))
+ (sessreg (slim-configuration-sessreg config))
+ (lockfile (string-append "/var/run/slim-" vt ".lock")))
+ (define slim.cfg
(mixed-text-file "slim.cfg" "
default_path /run/current-system/profile/bin
default_xserver " startx "
-xserver_arguments :0 vt7
+display_name " display "
+xserver_arguments " vt "
xauth_path " xauth "/bin/xauth
-authfile /var/run/slim.auth
+authfile /var/run/slim-" vt ".auth
+lockfile " lockfile "
+logfile /var/log/slim-" vt ".log
# The login command. '%session' is replaced by the chosen session name, one
# of the names specified in the 'sessions' setting: 'wmaker', 'xfce', etc.
@@ -530,32 +543,39 @@ reboot_cmd " shepherd "/sbin/reboot\n"
"")
(if theme-name
(string-append "current_theme " theme-name "\n")
- ""))))
-
- (define theme
- (slim-configuration-theme config))
-
- (list (shepherd-service
- (documentation "Xorg display server")
- (provision '(xorg-server))
- (requirement '(user-processes host-name udev))
- (start
- #~(lambda ()
- ;; A stale lock file can prevent SLiM from starting, so remove it to
- ;; be on the safe side.
- (false-if-exception (delete-file "/var/run/slim.lock"))
-
- (fork+exec-command
- (list (string-append #$(slim-configuration-slim config)
- "/bin/slim")
- "-nodaemon")
- #:environment-variables
- (list (string-append "SLIM_CFGFILE=" #$slim.cfg)
- #$@(if theme
- (list #~(string-append "SLIM_THEMESDIR=" #$theme))
- #~())))))
- (stop #~(make-kill-destructor))
- (respawn? #t))))
+ "")))
+
+ (define theme
+ (slim-configuration-theme config))
+
+ (list (shepherd-service
+ (documentation "Xorg display server")
+ (provision (append
+ ;; For compatibility, also provide 'xorg-server'.
+ (if (string=? vt "vt7")
+ '(xorg-server)
+ '())
+
+ (list (symbol-append 'xorg-server-
+ (string->symbol vt)))))
+ (requirement '(user-processes host-name udev))
+ (start
+ #~(lambda ()
+ ;; A stale lock file can prevent SLiM from starting, so remove it to
+ ;; be on the safe side.
+ (false-if-exception (delete-file lockfile))
+
+ (fork+exec-command
+ (list (string-append #$(slim-configuration-slim config)
+ "/bin/slim")
+ "-nodaemon")
+ #:environment-variables
+ (list (string-append "SLIM_CFGFILE=" #$slim.cfg)
+ #$@(if theme
+ (list #~(string-append "SLIM_THEMESDIR=" #$theme))
+ #~())))))
+ (stop #~(make-kill-destructor))
+ (respawn? #t)))))
(define slim-service-type
(service-type (name 'slim)
@@ -754,14 +774,38 @@ the GNOME desktop environment.")
(shell (file-append shadow "/sbin/nologin")))))
(define dbus-daemon-wrapper
- (program-file "gdm-dbus-wrapper"
- #~(begin
- (setenv "XDG_CONFIG_DIRS"
- "/run/current-system/profile/etc/xdg")
- (setenv "XDG_DATA_DIRS"
- "/run/current-system/profile/share")
- (apply execl (string-append #$dbus "/bin/dbus-daemon")
- (program-arguments)))))
+ (program-file
+ "gdm-dbus-wrapper"
+ #~(begin
+ (use-modules (srfi srfi-26))
+
+ (define system-profile
+ "/run/current-system/profile")
+
+ (define user-profile
+ (and=> (getpw (getuid))
+ (lambda (pw)
+ (string-append (passwd:dir pw) "/.guix-profile"))))
+
+ ;; If we are able to find the user's profile, we can add it to
+ ;; the search paths set below. We need to do this so that D-Bus
+ ;; can start services installed by the user. This allows
+ ;; applications that require session D-Bus services (e.g,
+ ;; 'evolution') to work even if those services are only available
+ ;; in the user's profile. See <https://bugs.gnu.org/35267>.
+ (define profiles
+ (if user-profile
+ (list user-profile system-profile)
+ (list system-profile)))
+
+ (setenv "XDG_CONFIG_DIRS"
+ (string-join (map (cut string-append <> "/etc/xdg") profiles)
+ ":"))
+ (setenv "XDG_DATA_DIRS"
+ (string-join (map (cut string-append <> "/share") profiles)
+ ":"))
+ (apply execl (string-append #$dbus "/bin/dbus-daemon")
+ (program-arguments)))))
(define-record-type* <gdm-configuration>
gdm-configuration make-gdm-configuration
@@ -811,7 +855,8 @@ the GNOME desktop environment.")
"Return a PAM service for @command{gdm}."
(list
(pam-service
- (inherit (unix-pam-service "gdm-autologin"))
+ (inherit (unix-pam-service "gdm-autologin"
+ #:login-uid? #t))
(auth (list (pam-entry
(control "[success=ok default=1]")
(module (file-append (gdm-configuration-gdm config)
@@ -825,6 +870,7 @@ the GNOME desktop environment.")
(control "required")
(module "pam_permit.so")))))
(unix-pam-service "gdm-password"
+ #:login-uid? #t
#:allow-empty-passwords?
(gdm-configuration-allow-empty-passwords? config))))