summaryrefslogtreecommitdiff
path: root/gnu/services
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/services')
-rw-r--r--gnu/services/audio.scm92
-rw-r--r--gnu/services/base.scm229
-rw-r--r--gnu/services/cuirass.scm5
-rw-r--r--gnu/services/dbus.scm48
-rw-r--r--gnu/services/desktop.scm59
-rw-r--r--gnu/services/dns.scm86
-rw-r--r--gnu/services/getmail.scm4
-rw-r--r--gnu/services/herd.scm7
-rw-r--r--gnu/services/monitoring.scm3
-rw-r--r--gnu/services/networking.scm189
-rw-r--r--gnu/services/sddm.scm10
-rw-r--r--gnu/services/virtualization.scm6
-rw-r--r--gnu/services/web.scm37
-rw-r--r--gnu/services/xorg.scm5
14 files changed, 565 insertions, 215 deletions
diff --git a/gnu/services/audio.scm b/gnu/services/audio.scm
index ebfe05abd0..345d8225b2 100644
--- a/gnu/services/audio.scm
+++ b/gnu/services/audio.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Peter Mikkelsen <petermikkelsen10@gmail.com>
+;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -23,7 +24,9 @@
#:use-module (gnu packages mpd)
#:use-module (guix records)
#:use-module (ice-9 match)
- #:export (mpd-configuration
+ #:export (mpd-output
+ mpd-output?
+ mpd-configuration
mpd-configuration?
mpd-service-type))
@@ -33,6 +36,25 @@
;;;
;;; Code:
+(define-record-type* <mpd-output>
+ mpd-output make-mpd-output
+ mpd-output?
+ (type mpd-output-type
+ (default "pulse"))
+ (name mpd-output-name
+ (default "MPD"))
+ (enabled? mpd-output-enabled?
+ (default #t))
+ (tags? mpd-output-tags?
+ (default #t))
+ (always-on? mpd-output-always-on?
+ (default #f))
+ (mixer-type mpd-output-mixer-type
+ ;; valid: hardware, software, null, none
+ (default #f))
+ (extra-options mpd-output-extra-options
+ (default '())))
+
(define-record-type* <mpd-configuration>
mpd-configuration make-mpd-configuration
mpd-configuration?
@@ -51,27 +73,56 @@
(port mpd-configuration-port
(default "6600"))
(address mpd-configuration-address
- (default "any")))
+ (default "any"))
+ (outputs mpd-configuration-outputs
+ (default (list (mpd-output)))))
+
+(define (mpd-output->string output)
+ "Convert the OUTPUT of type <mpd-output> to a configuration file snippet."
+ (let ((extra (string-join
+ (map (match-lambda
+ ((key . value)
+ (format #f " ~a \"~a\""
+ (string-map
+ (lambda (c) (if (char=? c #\-) #\_ c))
+ (symbol->string key))
+ value)))
+ (mpd-output-extra-options output))
+ "\n")))
+ (format #f "\
+audio_output {
+ type \"~a\"
+ name \"~a\"
+~:[ enabled \"no\"~%~;~]\
+~:[ tags \"no\"~%~;~]\
+~:[~; always_on \"yes\"~%~]\
+~@[ mixer_type \"~a\"~%~]\
+~a~%}~%"
+ (mpd-output-type output)
+ (mpd-output-name output)
+ (mpd-output-enabled? output)
+ (mpd-output-tags? output)
+ (mpd-output-always-on? output)
+ (mpd-output-mixer-type output)
+ extra)))
(define (mpd-config->file config)
(apply
mixed-text-file "mpd.conf"
- "audio_output {\n"
- " type \"pulse\"\n"
- " name \"MPD\"\n"
- "}\n"
"pid_file \"" (mpd-file-name config "pid") "\"\n"
- (map (match-lambda
- ((config-name config-val)
- (string-append config-name " \"" (config-val config) "\"\n")))
- `(("user" ,mpd-configuration-user)
- ("music_directory" ,mpd-configuration-music-dir)
- ("playlist_directory" ,mpd-configuration-playlist-dir)
- ("db_file" ,mpd-configuration-db-file)
- ("state_file" ,mpd-configuration-state-file)
- ("sticker_file" ,mpd-configuration-sticker-file)
- ("port" ,mpd-configuration-port)
- ("bind_to_address" ,mpd-configuration-address)))))
+ (append (map mpd-output->string
+ (mpd-configuration-outputs config))
+ (map (match-lambda
+ ((config-name config-val)
+ (string-append config-name " \"" (config-val config) "\"\n")))
+ `(("user" ,mpd-configuration-user)
+ ("music_directory" ,mpd-configuration-music-dir)
+ ("playlist_directory" ,mpd-configuration-playlist-dir)
+ ("db_file" ,mpd-configuration-db-file)
+ ("state_file" ,mpd-configuration-state-file)
+ ("sticker_file" ,mpd-configuration-sticker-file)
+ ("port" ,mpd-configuration-port)
+ ("bind_to_address" ,mpd-configuration-address))))))
(define (mpd-file-name config file)
"Return a path in /var/run/mpd/ that is writable
@@ -89,6 +140,13 @@
"--no-daemon"
#$(mpd-config->file config))
#:pid-file #$(mpd-file-name config "pid")
+ #:environment-variables
+ ;; Required to detect PulseAudio when run under a user account.
+ '(#$(string-append
+ "XDG_RUNTIME_DIR=/run/user/"
+ (number->string
+ (passwd:uid
+ (getpwnam (mpd-configuration-user config))))))
#:log-file #$(mpd-file-name config "log")))
(stop #~(make-kill-destructor))))
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index e75c56828e..b1eff89ecc 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -990,7 +990,6 @@ to use as the tty. This is primarily useful for headless systems."
erase-characters kill-characters chdir delay nice extra-options)
(list
(shepherd-service
- (modules '((ice-9 match) (gnu build linux-boot)))
(documentation "Run agetty on a tty.")
(provision (list (symbol-append 'term- (string->symbol (or tty "auto")))))
@@ -1000,122 +999,126 @@ to use as the tty. This is primarily useful for headless systems."
;; mingetty-shepherd-service).
(requirement '(user-processes host-name udev))
- (start #~(lambda args
- (let ((defaulted-tty #$(or tty (default-serial-port))))
- (apply
- (if defaulted-tty
- (make-forkexec-constructor
- (list #$(file-append util-linux "/sbin/agetty")
- #$@extra-options
- #$@(if eight-bits?
- #~("--8bits")
- #~())
- #$@(if no-reset?
- #~("--noreset")
- #~())
- #$@(if remote?
- #~("--remote")
- #~())
- #$@(if flow-control?
- #~("--flow-control")
- #~())
- #$@(if host
- #~("--host" #$host)
- #~())
- #$@(if no-issue?
- #~("--noissue")
- #~())
- #$@(if init-string
- #~("--init-string" #$init-string)
- #~())
- #$@(if no-clear?
- #~("--noclear")
- #~())
+ (modules '((ice-9 match) (gnu build linux-boot)))
+ (start
+ (with-imported-modules (source-module-closure
+ '((gnu build linux-boot)))
+ #~(lambda args
+ (let ((defaulted-tty #$(or tty (default-serial-port))))
+ (apply
+ (if defaulted-tty
+ (make-forkexec-constructor
+ (list #$(file-append util-linux "/sbin/agetty")
+ #$@extra-options
+ #$@(if eight-bits?
+ #~("--8bits")
+ #~())
+ #$@(if no-reset?
+ #~("--noreset")
+ #~())
+ #$@(if remote?
+ #~("--remote")
+ #~())
+ #$@(if flow-control?
+ #~("--flow-control")
+ #~())
+ #$@(if host
+ #~("--host" #$host)
+ #~())
+ #$@(if no-issue?
+ #~("--noissue")
+ #~())
+ #$@(if init-string
+ #~("--init-string" #$init-string)
+ #~())
+ #$@(if no-clear?
+ #~("--noclear")
+ #~())
;;; FIXME This doesn't work as expected. According to agetty(8), if this option
;;; is not passed, then the default is 'auto'. However, in my tests, when that
;;; option is selected, agetty never presents the login prompt, and the
;;; term-ttyS0 service respawns every few seconds.
- #$@(if local-line
- #~(#$(match local-line
- ('auto "--local-line=auto")
- ('always "--local-line=always")
- ('never "-local-line=never")))
- #~())
- #$@(if tty
- #~()
- #~("--keep-baud"))
- #$@(if extract-baud?
- #~("--extract-baud")
- #~())
- #$@(if skip-login?
- #~("--skip-login")
- #~())
- #$@(if no-newline?
- #~("--nonewline")
- #~())
- #$@(if login-options
- #~("--login-options" #$login-options)
- #~())
- #$@(if chroot
- #~("--chroot" #$chroot)
- #~())
- #$@(if hangup?
- #~("--hangup")
- #~())
- #$@(if keep-baud?
- #~("--keep-baud")
- #~())
- #$@(if timeout
- #~("--timeout" #$(number->string timeout))
- #~())
- #$@(if detect-case?
- #~("--detect-case")
- #~())
- #$@(if wait-cr?
- #~("--wait-cr")
- #~())
- #$@(if no-hints?
- #~("--nohints?")
- #~())
- #$@(if no-hostname?
- #~("--nohostname")
- #~())
- #$@(if long-hostname?
- #~("--long-hostname")
- #~())
- #$@(if erase-characters
- #~("--erase-chars" #$erase-characters)
- #~())
- #$@(if kill-characters
- #~("--kill-chars" #$kill-characters)
- #~())
- #$@(if chdir
- #~("--chdir" #$chdir)
- #~())
- #$@(if delay
- #~("--delay" #$(number->string delay))
- #~())
- #$@(if nice
- #~("--nice" #$(number->string nice))
- #~())
- #$@(if auto-login
- (list "--autologin" auto-login)
- '())
- #$@(if login-program
- #~("--login-program" #$login-program)
- #~())
- #$@(if login-pause?
- #~("--login-pause")
- #~())
- defaulted-tty
- #$@(if baud-rate
- #~(#$baud-rate)
- #~())
- #$@(if term
- #~(#$term)
- #~())))
- (const #f)) ; never start.
- args))))
+ #$@(if local-line
+ #~(#$(match local-line
+ ('auto "--local-line=auto")
+ ('always "--local-line=always")
+ ('never "-local-line=never")))
+ #~())
+ #$@(if tty
+ #~()
+ #~("--keep-baud"))
+ #$@(if extract-baud?
+ #~("--extract-baud")
+ #~())
+ #$@(if skip-login?
+ #~("--skip-login")
+ #~())
+ #$@(if no-newline?
+ #~("--nonewline")
+ #~())
+ #$@(if login-options
+ #~("--login-options" #$login-options)
+ #~())
+ #$@(if chroot
+ #~("--chroot" #$chroot)
+ #~())
+ #$@(if hangup?
+ #~("--hangup")
+ #~())
+ #$@(if keep-baud?
+ #~("--keep-baud")
+ #~())
+ #$@(if timeout
+ #~("--timeout" #$(number->string timeout))
+ #~())
+ #$@(if detect-case?
+ #~("--detect-case")
+ #~())
+ #$@(if wait-cr?
+ #~("--wait-cr")
+ #~())
+ #$@(if no-hints?
+ #~("--nohints?")
+ #~())
+ #$@(if no-hostname?
+ #~("--nohostname")
+ #~())
+ #$@(if long-hostname?
+ #~("--long-hostname")
+ #~())
+ #$@(if erase-characters
+ #~("--erase-chars" #$erase-characters)
+ #~())
+ #$@(if kill-characters
+ #~("--kill-chars" #$kill-characters)
+ #~())
+ #$@(if chdir
+ #~("--chdir" #$chdir)
+ #~())
+ #$@(if delay
+ #~("--delay" #$(number->string delay))
+ #~())
+ #$@(if nice
+ #~("--nice" #$(number->string nice))
+ #~())
+ #$@(if auto-login
+ (list "--autologin" auto-login)
+ '())
+ #$@(if login-program
+ #~("--login-program" #$login-program)
+ #~())
+ #$@(if login-pause?
+ #~("--login-pause")
+ #~())
+ defaulted-tty
+ #$@(if baud-rate
+ #~(#$baud-rate)
+ #~())
+ #$@(if term
+ #~(#$term)
+ #~())))
+ (const #f)) ; never start.
+ args)))))
(stop #~(make-kill-destructor)))))))
(define agetty-service-type
diff --git a/gnu/services/cuirass.scm b/gnu/services/cuirass.scm
index 914a0d337f..d92421762a 100644
--- a/gnu/services/cuirass.scm
+++ b/gnu/services/cuirass.scm
@@ -164,6 +164,7 @@
(let ((cache (cuirass-configuration-cache-directory config))
(db (dirname (cuirass-configuration-database config)))
(user (cuirass-configuration-user config))
+ (log "/var/log/cuirass")
(group (cuirass-configuration-group config)))
(with-imported-modules '((guix build utils))
#~(begin
@@ -171,11 +172,13 @@
(mkdir-p #$cache)
(mkdir-p #$db)
+ (mkdir-p #$log)
(let ((uid (passwd:uid (getpw #$user)))
(gid (group:gid (getgr #$group))))
(chown #$cache uid gid)
- (chown #$db uid gid))))))
+ (chown #$db uid gid)
+ (chown #$log uid gid))))))
(define (cuirass-log-rotations config)
"Return the list of log rotations that corresponds to CONFIG."
diff --git a/gnu/services/dbus.scm b/gnu/services/dbus.scm
index 35d7ff3c9c..7b3c8100e2 100644
--- a/gnu/services/dbus.scm
+++ b/gnu/services/dbus.scm
@@ -86,6 +86,19 @@ includes the @code{etc/dbus-1/system.d} directories of each package listed in
(use-modules (sxml simple)
(srfi srfi-1))
+ (define-syntax directives
+ (syntax-rules ()
+ ;; Expand the given directives (SXML expressions) only if their
+ ;; key names a file that exists.
+ ((_ (name directory) rest ...)
+ (let ((dir directory))
+ (if (file-exists? dir)
+ `((name ,dir)
+ ,@(directives rest ...))
+ (directives rest ...))))
+ ((_)
+ '())))
+
(define (services->sxml services)
;; Return the SXML 'includedir' clauses for DIRS.
`(busconfig
@@ -98,10 +111,13 @@ includes the @code{etc/dbus-1/system.d} directories of each package listed in
(servicedir "/etc/dbus-1/system-services")
,@(append-map (lambda (dir)
- `((includedir
- ,(string-append dir "/etc/dbus-1/system.d"))
- (servicedir ;for '.service' files
- ,(string-append dir "/share/dbus-1/services"))))
+ (directives
+ (includedir
+ (string-append dir "/etc/dbus-1/system.d"))
+ (includedir
+ (string-append dir "/share/dbus-1/system.d"))
+ (servicedir ;for '.service' files
+ (string-append dir "/share/dbus-1/services"))))
services)))
(mkdir #$output)
@@ -160,18 +176,9 @@ includes the @code{etc/dbus-1/system.d} directories of each package listed in
(unless (file-exists? "/etc/machine-id")
(format #t "creating /etc/machine-id...~%")
- (let ((prog (string-append #$(dbus-configuration-dbus config)
- "/bin/dbus-uuidgen")))
- ;; XXX: We can't use 'system' because the initrd's
- ;; guile system(3) only works when 'sh' is in $PATH.
- (let ((pid (primitive-fork)))
- (if (zero? pid)
- (call-with-output-file "/etc/machine-id"
- (lambda (port)
- (close-fdes 1)
- (dup2 (port->fdes port) 1)
- (execl prog)))
- (waitpid pid)))))))
+ (invoke (string-append #$(dbus-configuration-dbus config)
+ "/bin/dbus-uuidgen")
+ "--ensure=/etc/machine-id"))))
(define dbus-shepherd-service
(match-lambda
@@ -179,10 +186,10 @@ includes the @code{etc/dbus-1/system.d} directories of each package listed in
(list (shepherd-service
(documentation "Run the D-Bus system daemon.")
(provision '(dbus-system))
- (requirement '(user-processes))
+ (requirement '(user-processes syslogd))
(start #~(make-forkexec-constructor
(list (string-append #$dbus "/bin/dbus-daemon")
- "--nofork" "--system")
+ "--nofork" "--system" "--syslog-only")
#:pid-file "/var/run/dbus/pid"))
(stop #~(make-kill-destructor)))))))
@@ -213,7 +220,10 @@ includes the @code{etc/dbus-1/system.d} directories of each package listed in
(append (dbus-configuration-services config)
services)))))
- (default-value (dbus-configuration))))
+ (default-value (dbus-configuration))
+ (description "Run the system-wide D-Bus inter-process message
+bus. It allows programs and daemons to communicate and is also responsible
+for spawning (@dfn{activating}) D-Bus services on demand.")))
(define* (dbus-service #:key (dbus dbus) (services '()))
"Return a service that runs the \"system bus\", using @var{dbus}, with
diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index a32756e040..0152e86e8a 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -9,6 +9,7 @@
;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2017, 2019 Christopher Baines <mail@cbaines.net>
;;; Copyright © 2019 Tim Gesthuizen <tim.gesthuizen@yahoo.de>
+;;; Copyright © 2019 David Wilson <david@daviwil.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -513,12 +514,14 @@ Users need to be in the @code{lp} group to access the D-Bus service.
;; It provides polkit "actions".
(service-extension polkit-service-type list)))
+ (default-value colord)
(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))
+(define-deprecated (colord-service #:key (colord colord))
+ colord-service-type
"Return a service that runs @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. It is notably used by the GNOME Color Manager graphical
@@ -579,7 +582,7 @@ include the @command{udisksctl} command, part of UDisks, and GNOME Disks."
(define-record-type* <elogind-configuration> elogind-configuration
make-elogind-configuration
- elogind-configuration
+ elogind-configuration?
(elogind elogind-package
(default elogind))
(kill-user-processes? elogind-kill-user-processes?
@@ -833,7 +836,7 @@ accountsservice web site} for more information."
(define-record-type* <gnome-desktop-configuration> gnome-desktop-configuration
make-gnome-desktop-configuration
- gnome-desktop-configuration
+ gnome-desktop-configuration?
(gnome-package gnome-package (default gnome)))
(define (gnome-polkit-settings config)
@@ -871,7 +874,7 @@ and extends polkit with the actions from @code{gnome-settings-daemon}."
(define-record-type* <mate-desktop-configuration> mate-desktop-configuration
make-mate-desktop-configuration
- mate-desktop-configuration
+ mate-desktop-configuration?
(mate-package mate-package (default mate)))
(define mate-desktop-service-type
@@ -904,18 +907,24 @@ and extends polkit with the actions from @code{mate-settings-daemon}."
(define-record-type* <xfce-desktop-configuration> xfce-desktop-configuration
make-xfce-desktop-configuration
- xfce-desktop-configuration
+ xfce-desktop-configuration?
(xfce xfce-package (default xfce)))
+(define (xfce-polkit-settings config)
+ "Return the list of XFCE dependencies that provide polkit actions and
+rules."
+ (let ((xfce (xfce-package config)))
+ (map (lambda (name)
+ ((package-direct-input-selector name) xfce))
+ '("thunar"
+ "xfce4-power-manager"))))
+
(define xfce-desktop-service-type
(service-type
(name 'xfce-desktop)
(extensions
(list (service-extension polkit-service-type
- (compose list
- (package-direct-input-selector
- "thunar")
- xfce-package))
+ xfce-polkit-settings)
(service-extension profile-service-type
(compose list xfce-package))))
(default-value (xfce-desktop-configuration))
@@ -1021,23 +1030,29 @@ as expected.")))
(default "wacom"))
(device inputattach-configuration-device
(default "/dev/ttyS0"))
+ (baud-rate inputattach-configuration-baud-rate
+ (default #f))
(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)))))))
+ (($ <inputattach-configuration> type device baud-rate log-file)
+ (let ((args (append (if baud-rate
+ (list "--baud-rate" (number->string baud-rate))
+ '())
+ (list (string-append "--" type)
+ device))))
+ (list (shepherd-service
+ (provision '(inputattach))
+ (requirement '(udev))
+ (documentation "inputattach daemon")
+ (start #~(make-forkexec-constructor
+ (cons (string-append #$inputattach
+ "/bin/inputattach")
+ (quote #$args))
+ #:log-file #$log-file))
+ (stop #~(make-kill-destructor))))))))
(define inputattach-service-type
(service-type
@@ -1081,7 +1096,7 @@ dispatches events from it.")))
(service upower-service-type)
(accountsservice-service)
(service cups-pk-helper-service-type)
- (colord-service)
+ (service colord-service-type)
(geoclue-service)
(service polkit-service-type)
(elogind-service)
diff --git a/gnu/services/dns.scm b/gnu/services/dns.scm
index 5f37cb0782..43b6261c07 100644
--- a/gnu/services/dns.scm
+++ b/gnu/services/dns.scm
@@ -45,6 +45,9 @@
zone-file
zone-entry
+ knot-resolver-service-type
+ knot-resolver-configuration
+
dnsmasq-service-type
dnsmasq-configuration
@@ -639,6 +642,89 @@
;;;
+;;; Knot Resolver.
+;;;
+
+(define-record-type* <knot-resolver-configuration>
+ knot-resolver-configuration
+ make-knot-resolver-configuration
+ knot-resolver-configuration?
+ (package knot-resolver-configuration-package
+ (default knot-resolver))
+ (kresd-config-file knot-resolver-kresd-config-file
+ (default %kresd.conf))
+ (garbage-collection-interval knot-resolver-garbage-collection-interval
+ (default 1000)))
+
+(define %kresd.conf
+ (plain-file "kresd.conf" "-- -*- mode: lua -*-
+net = { '127.0.0.1', '::1' }
+user('knot-resolver', 'knot-resolver')
+modules = { 'hints > iterate', 'stats', 'predict' }
+cache.size = 100 * MB
+"))
+
+(define %knot-resolver-accounts
+ (list (user-group
+ (name "knot-resolver")
+ (system? #t))
+ (user-account
+ (name "knot-resolver")
+ (group "knot-resolver")
+ (system? #t)
+ (home-directory "/var/cache/knot-resolver")
+ (shell (file-append shadow "/sbin/nologin")))))
+
+(define (knot-resolver-activation config)
+ #~(begin
+ (use-modules (guix build utils))
+ (let ((rundir "/var/cache/knot-resolver")
+ (owner (getpwnam "knot-resolver")))
+ (mkdir-p rundir)
+ (chown rundir (passwd:uid owner) (passwd:gid owner)))))
+
+(define knot-resolver-shepherd-services
+ (match-lambda
+ (($ <knot-resolver-configuration> package
+ kresd-config-file
+ garbage-collection-interval)
+ (list
+ (shepherd-service
+ (provision '(kresd))
+ (requirement '(networking))
+ (documentation "Run the Knot Resolver daemon.")
+ (start #~(make-forkexec-constructor
+ '(#$(file-append package "/sbin/kresd")
+ "-c" #$kresd-config-file "-f" "1"
+ "/var/cache/knot-resolver")))
+ (stop #~(make-kill-destructor)))
+ (shepherd-service
+ (provision '(kres-cache-gc))
+ (requirement '(user-processes))
+ (documentation "Run the Knot Resolver Garbage Collector daemon.")
+ (start #~(make-forkexec-constructor
+ '(#$(file-append package "/sbin/kres-cache-gc")
+ "-d" #$(number->string garbage-collection-interval)
+ "-c" "/var/cache/knot-resolver")
+ #:user "knot-resolver"
+ #:group "knot-resolver"))
+ (stop #~(make-kill-destructor)))))))
+
+(define knot-resolver-service-type
+ (service-type
+ (name 'knot-resolver)
+ (extensions
+ (list (service-extension shepherd-root-service-type
+ knot-resolver-shepherd-services)
+ (service-extension activation-service-type
+ knot-resolver-activation)
+ (service-extension account-service-type
+ (const %knot-resolver-accounts))))
+ (default-value (knot-resolver-configuration))
+ (description "Run the Knot DNS Resolver.")))
+
+
+;;;
;;; Dnsmasq.
;;;
diff --git a/gnu/services/getmail.scm b/gnu/services/getmail.scm
index b807bb3a5d..b3d86cb65c 100644
--- a/gnu/services/getmail.scm
+++ b/gnu/services/getmail.scm
@@ -176,8 +176,8 @@ server.")
(delete-after
(non-negative-integer 0)
"Getmail will delete messages this number of days after seeing them, if
-they have not been delivered. This means messages will be left on the server
-this number of days after delivering them. A value of @samp{0} disabled this
+they have been delivered. This means messages will be left on the server this
+number of days after delivering them. A value of @samp{0} disabled this
feature.")
(delete-bigger-than
(non-negative-integer 0)
diff --git a/gnu/services/herd.scm b/gnu/services/herd.scm
index 2207b2d34b..112a7dc104 100644
--- a/gnu/services/herd.scm
+++ b/gnu/services/herd.scm
@@ -25,6 +25,7 @@
#:use-module (srfi srfi-35)
#:use-module (ice-9 match)
#:export (%shepherd-socket-file
+ shepherd-message-port
shepherd-error?
service-not-found-error?
@@ -140,8 +141,12 @@ does not denote an error."
(#f ;not an error
#t)))
+(define shepherd-message-port
+ ;; Port where messages coming from shepherd are printed.
+ (make-parameter (current-error-port)))
+
(define (display-message message)
- (format (current-error-port) "shepherd: ~a~%" message))
+ (format (shepherd-message-port) "shepherd: ~a~%" message))
(define* (invoke-action service action arguments cont)
"Invoke ACTION on SERVICE with ARGUMENTS. On success, call CONT with the
diff --git a/gnu/services/monitoring.scm b/gnu/services/monitoring.scm
index 7276f7056d..511f4fb2fe 100644
--- a/gnu/services/monitoring.scm
+++ b/gnu/services/monitoring.scm
@@ -473,7 +473,8 @@ configuration file."))
(list "
fastcgi_param PHP_VALUE \"post_max_size = 16M
max_execution_time = 300\";
-")))))))))
+")))))))
+ (listen '("80"))))
(define-configuration zabbix-front-end-configuration
;; TODO: Specify zabbix front-end package.
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index dd63009116..6485c08ff7 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -12,6 +12,7 @@
;;; Copyright © 2019 Florian Pelz <pelzflorian@pelzflorian.de>
;;; Copyright © 2019 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2019 Sou Bunnbu <iyzsong@member.fsf.org>
+;;; Copyright © 2019 Alex Griffin <a@ajgrf.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -51,6 +52,7 @@
#:use-module (guix gexp)
#:use-module (guix records)
#:use-module (guix modules)
+ #:use-module (guix packages)
#:use-module (guix deprecation)
#:use-module (rnrs enums)
#:use-module (srfi srfi-1)
@@ -110,6 +112,7 @@
network-manager-configuration
network-manager-configuration?
network-manager-configuration-dns
+ network-manager-configuration-vpn-plugins
network-manager-service-type
connman-configuration
@@ -152,7 +155,17 @@
nftables-configuration?
nftables-configuration-package
nftables-configuration-ruleset
- %default-nftables-ruleset))
+ %default-nftables-ruleset
+
+ pagekite-service-type
+ pagekite-configuration
+ pagekite-configuration?
+ pagekite-configuration-package
+ pagekite-configuration-kitename
+ pagekite-configuration-kitesecret
+ pagekite-configuration-frontend
+ pagekite-configuration-kites
+ pagekite-configuration-extra-file))
;;; Commentary:
;;;
@@ -343,7 +356,7 @@ Protocol (DHCP) client, on all the non-loopback network interfaces."
(res '()))
(if (list? x)
(fold loop res x)
- (cons (format #f "~s" x) res)))))
+ (cons (format #f "~a" x) res)))))
(match ntp-server
(($ <ntp-server> type address options)
@@ -392,15 +405,16 @@ deprecated. Please use <ntp-server> records instead.\n")
ntp-servers))))
(define ntp-shepherd-service
- (match-lambda
- (($ <ntp-configuration> ntp servers allow-large-adjustment?)
- (let ()
- ;; TODO: Add authentication support.
- (define config
- (string-append "driftfile /var/run/ntpd/ntp.drift\n"
- (string-join (map ntp-server->string servers)
- "\n")
- "
+ (lambda (config)
+ (match config
+ (($ <ntp-configuration> ntp servers allow-large-adjustment?)
+ (let ((servers (ntp-configuration-servers config)))
+ ;; TODO: Add authentication support.
+ (define config
+ (string-append "driftfile /var/run/ntpd/ntp.drift\n"
+ (string-join (map ntp-server->string servers)
+ "\n")
+ "
# Disable status queries as a workaround for CVE-2013-5211:
# <http://support.ntp.org/bin/view/Main/SecurityNotice#DRDoS_Amplification_Attack_using>.
restrict default kod nomodify notrap nopeer noquery limited
@@ -414,20 +428,20 @@ restrict -6 ::1
# option by default, as documented in the 'ntp.conf' manual.
restrict source notrap nomodify noquery\n"))
- (define ntpd.conf
- (plain-file "ntpd.conf" config))
+ (define ntpd.conf
+ (plain-file "ntpd.conf" config))
- (list (shepherd-service
- (provision '(ntpd))
- (documentation "Run the Network Time Protocol (NTP) daemon.")
- (requirement '(user-processes networking))
- (start #~(make-forkexec-constructor
- (list (string-append #$ntp "/bin/ntpd") "-n"
- "-c" #$ntpd.conf "-u" "ntpd"
- #$@(if allow-large-adjustment?
- '("-g")
- '()))))
- (stop #~(make-kill-destructor))))))))
+ (list (shepherd-service
+ (provision '(ntpd))
+ (documentation "Run the Network Time Protocol (NTP) daemon.")
+ (requirement '(user-processes networking))
+ (start #~(make-forkexec-constructor
+ (list (string-append #$ntp "/bin/ntpd") "-n"
+ "-c" #$ntpd.conf "-u" "ntpd"
+ #$@(if allow-large-adjustment?
+ '("-g")
+ '()))))
+ (stop #~(make-kill-destructor)))))))))
(define %ntp-accounts
(list (user-account
@@ -986,7 +1000,7 @@ and @command{wicd-curses} user interfaces."
(default network-manager))
(dns network-manager-configuration-dns
(default "default"))
- (vpn-plugins network-manager-vpn-plugins ;list of <package>
+ (vpn-plugins network-manager-configuration-vpn-plugins ;list of <package>
(default '())))
(define network-manager-activation
@@ -1005,6 +1019,33 @@ and @command{wicd-curses} user interfaces."
"Return a directory containing PLUGINS, the NM VPN plugins."
(directory-union "network-manager-vpn-plugins" plugins))
+(define (network-manager-accounts config)
+ "Return the list of <user-account> and <user-group> for CONFIG."
+ (define nologin
+ (file-append shadow "/sbin/nologin"))
+
+ (define accounts
+ (append-map (lambda (package)
+ (map (lambda (name)
+ (user-account (system? #t)
+ (name name)
+ (group "network-manager")
+ (comment "NetworkManager helper")
+ (home-directory "/var/empty")
+ (create-home-directory? #f)
+ (shell nologin)))
+ (or (assoc-ref (package-properties package)
+ 'user-accounts)
+ '())))
+ (network-manager-configuration-vpn-plugins config)))
+
+ (match accounts
+ (()
+ '())
+ (_
+ (cons (user-group (name "network-manager") (system? #t))
+ accounts))))
+
(define network-manager-environment
(match-lambda
(($ <network-manager-configuration> network-manager dns vpn-plugins)
@@ -1054,6 +1095,8 @@ and @command{wicd-curses} user interfaces."
(compose
list
network-manager-configuration-network-manager))
+ (service-extension account-service-type
+ network-manager-accounts)
(service-extension activation-service-type
network-manager-activation)
(service-extension session-environment-service-type
@@ -1495,4 +1538,100 @@ table inet filter {
(compose list nftables-configuration-package))))
(default-value (nftables-configuration))))
+
+;;;
+;;; PageKite
+;;;
+
+(define-record-type* <pagekite-configuration>
+ pagekite-configuration
+ make-pagekite-configuration
+ pagekite-configuration?
+ (package pagekite-configuration-package
+ (default pagekite))
+ (kitename pagekite-configuration-kitename
+ (default #f))
+ (kitesecret pagekite-configuration-kitesecret
+ (default #f))
+ (frontend pagekite-configuration-frontend
+ (default #f))
+ (kites pagekite-configuration-kites
+ (default '("http:@kitename:localhost:80:@kitesecret")))
+ (extra-file pagekite-configuration-extra-file
+ (default #f)))
+
+(define (pagekite-configuration-file config)
+ (match-record config <pagekite-configuration>
+ (package kitename kitesecret frontend kites extra-file)
+ (mixed-text-file "pagekite.rc"
+ (if extra-file
+ (string-append "optfile = " extra-file "\n")
+ "")
+ (if kitename
+ (string-append "kitename = " kitename "\n")
+ "")
+ (if kitesecret
+ (string-append "kitesecret = " kitesecret "\n")
+ "")
+ (if frontend
+ (string-append "frontend = " frontend "\n")
+ "defaults\n")
+ (string-join (map (lambda (kite)
+ (string-append "service_on = " kite))
+ kites)
+ "\n"
+ 'suffix))))
+
+(define (pagekite-shepherd-service config)
+ (match-record config <pagekite-configuration>
+ (package kitename kitesecret frontend kites extra-file)
+ (with-imported-modules (source-module-closure
+ '((gnu build shepherd)
+ (gnu system file-systems)))
+ (shepherd-service
+ (documentation "Run the PageKite service.")
+ (provision '(pagekite))
+ (requirement '(networking))
+ (modules '((gnu build shepherd)
+ (gnu system file-systems)))
+ (start #~(make-forkexec-constructor/container
+ (list #$(file-append package "/bin/pagekite")
+ "--clean"
+ "--nullui"
+ "--nocrashreport"
+ "--runas=pagekite:pagekite"
+ (string-append "--optfile="
+ #$(pagekite-configuration-file config)))
+ #:log-file "/var/log/pagekite.log"
+ #:mappings #$(if extra-file
+ #~(list (file-system-mapping
+ (source #$extra-file)
+ (target source)))
+ #~'())))
+ ;; SIGTERM doesn't always work for some reason.
+ (stop #~(make-kill-destructor SIGINT))))))
+
+(define %pagekite-accounts
+ (list (user-group (name "pagekite") (system? #t))
+ (user-account
+ (name "pagekite")
+ (group "pagekite")
+ (system? #t)
+ (comment "PageKite user")
+ (home-directory "/var/empty")
+ (shell (file-append shadow "/sbin/nologin")))))
+
+(define pagekite-service-type
+ (service-type
+ (name 'pagekite)
+ (default-value (pagekite-configuration))
+ (extensions
+ (list (service-extension shepherd-root-service-type
+ (compose list pagekite-shepherd-service))
+ (service-extension account-service-type
+ (const %pagekite-accounts))))
+ (description
+ "Run @url{https://pagekite.net/,PageKite}, a tunneling solution to make
+local servers publicly accessible on the web, even behind NATs and firewalls.")))
+
;;; networking.scm ends here
diff --git a/gnu/services/sddm.scm b/gnu/services/sddm.scm
index b0e6d40260..ac8c9a8403 100644
--- a/gnu/services/sddm.scm
+++ b/gnu/services/sddm.scm
@@ -30,6 +30,7 @@
#:use-module (gnu system shadow)
#:use-module (guix gexp)
#:use-module (guix records)
+ #:use-module (guix deprecation)
#:export (sddm-configuration
sddm-configuration?
sddm-service-type
@@ -316,9 +317,14 @@ Relogin=" (if (sddm-configuration-relogin? config)
(service-extension account-service-type
(const %sddm-accounts))
(service-extension profile-service-type
- sddm-profile-service)))))
+ sddm-profile-service)))
+ (default-value (sddm-configuration))
+ (description
+ "Run SDDM, a display and log-in manager for X11 and
+Wayland.")))
-(define* (sddm-service #:optional (config (sddm-configuration)))
+(define-deprecated (sddm-service #:optional (config (sddm-configuration)))
+ sddm-service-type
"Run the @uref{https://github.com/sddm/sddm,SSDM display manager}
with the given @var{config}, a @code{<sddm-configuration>} object."
(service sddm-service-type config))
diff --git a/gnu/services/virtualization.scm b/gnu/services/virtualization.scm
index bc8ac9b40a..2cd4e5e89c 100644
--- a/gnu/services/virtualization.scm
+++ b/gnu/services/virtualization.scm
@@ -433,9 +433,11 @@ potential infinite waits blocking libvirt."))
(start #~(make-forkexec-constructor
(list (string-append #$libvirt "/sbin/libvirtd")
"-f" #$config-file)
+ ;; For finding qemu and ip binaries.
#:environment-variables
- ;; For finding qemu binaries.
- '("PATH=/run/current-system/profile/bin")))
+ (list (string-append
+ "PATH=/run/current-system/profile/bin:"
+ "/run/current-system/profile/sbin"))))
(stop #~(make-kill-destructor))))))
(define libvirt-service-type
diff --git a/gnu/services/web.scm b/gnu/services/web.scm
index 899be1c168..3d149a105d 100644
--- a/gnu/services/web.scm
+++ b/gnu/services/web.scm
@@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 David Thompson <davet@gnu.org>
-;;; Copyright © 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 ng0 <ng0@n0.is>
;;; Copyright © 2016, 2017, 2018 Julien Lepiller <julien@lepiller.eu>
;;; Copyright © 2017 Christopher Baines <mail@cbaines.net>
@@ -9,6 +9,7 @@
;;; Copyright © 2018 Pierre-Antoine Rouby <pierre-antoine.rouby@inria.fr>
;;; Copyright © 2017, 2018, 2019 Christopher Baines <mail@cbaines.net>
;;; Copyright © 2018 Marius Bakke <mbakke@fastmail.com>
+;;; Copyright © 2019 Florian Pelz <pelzflorian@pelzflorian.de>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -95,6 +96,7 @@
nginx-configuration-upstream-blocks
nginx-configuration-server-names-hash-bucket-size
nginx-configuration-server-names-hash-bucket-max-size
+ nginx-configuration-modules
nginx-configuration-extra-content
nginx-configuration-file
@@ -522,6 +524,7 @@
(default #f))
(server-names-hash-bucket-max-size nginx-configuration-server-names-hash-bucket-max-size
(default #f))
+ (modules nginx-configuration-modules (default '()))
(extra-content nginx-configuration-extra-content
(default ""))
(file nginx-configuration-file ;#f | string | file-like
@@ -542,6 +545,9 @@ of index files."
((? string? str) (list str " ")))
names))
+(define (emit-load-module module)
+ (list "load_module " module ";\n"))
+
(define emit-nginx-location-config
(match-lambda
(($ <nginx-location-configuration> uri body)
@@ -615,12 +621,14 @@ of index files."
server-blocks upstream-blocks
server-names-hash-bucket-size
server-names-hash-bucket-max-size
+ modules
extra-content)
(apply mixed-text-file "nginx.conf"
(flatten
"user nginx nginx;\n"
"pid " run-directory "/pid;\n"
"error_log " log-directory "/error.log info;\n"
+ (map emit-load-module modules)
"http {\n"
" client_body_temp_path " run-directory "/client_body_temp;\n"
" proxy_temp_path " run-directory "/proxy_temp;\n"
@@ -1039,13 +1047,24 @@ a webserver.")
(shell (file-append shadow "/sbin/nologin")))))
(define %hpcguix-web-activation
- #~(begin
- (use-modules (guix build utils))
- (let ((home-dir "/var/cache/guix/web")
- (user (getpwnam "hpcguix-web")))
- (mkdir-p home-dir)
- (chown home-dir (passwd:uid user) (passwd:gid user))
- (chmod home-dir #o755))))
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils)
+ (ice-9 ftw))
+
+ (let ((home-dir "/var/cache/guix/web")
+ (user (getpwnam "hpcguix-web")))
+ (mkdir-p home-dir)
+ (chown home-dir (passwd:uid user) (passwd:gid user))
+ (chmod home-dir #o755)
+
+ ;; Remove stale 'packages.json.lock' file (and other lock files, if
+ ;; any) since that would prevent 'packages.json' from being updated.
+ (for-each (lambda (lock)
+ (delete-file (string-append home-dir "/" lock)))
+ (scandir home-dir
+ (lambda (file)
+ (string-suffix? ".lock" file))))))))
(define %hpcguix-web-log-file
"/var/log/hpcguix-web.log")
@@ -1425,7 +1444,7 @@ ADMINS = [
DEBUG = " #$(if debug? "True" "False") "
-ENABLE_REST_API = " #$(if enable-xmlrpc? "True" "False") "
+ENABLE_REST_API = " #$(if enable-rest-api? "True" "False") "
ENABLE_XMLRPC = " #$(if enable-xmlrpc? "True" "False") "
FORCE_HTTPS_LINKS = " #$(if force-https-links? "True" "False") "
diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm
index 1d55e388a1..9c84f7413f 100644
--- a/gnu/services/xorg.scm
+++ b/gnu/services/xorg.scm
@@ -835,6 +835,7 @@ the GNOME desktop environment.")
(allow-empty-passwords? gdm-configuration-allow-empty-passwords? (default #t))
(auto-login? gdm-configuration-auto-login? (default #f))
(dbus-daemon gdm-configuration-dbus-daemon (default dbus-daemon-wrapper))
+ (debug? gdm-configuration-debug? (default #f))
(default-user gdm-configuration-default-user (default #f))
(gnome-shell-assets gdm-configuration-gnome-shell-assets
(default (list adwaita-icon-theme font-cantarell)))
@@ -866,7 +867,9 @@ the GNOME desktop environment.")
"WaylandEnable=false\n"
"\n"
"[debug]\n"
- "#Enable=true\n"
+ "Enable=" (if (gdm-configuration-debug? config)
+ "true"
+ "false") "\n"
"\n"
"[security]\n"
"#DisallowTCP=true\n"
generated by cgit v1.2.3 (git 2.46.2) at 2024-11-10 15:31:12 +0000