diff options
Diffstat (limited to 'gnu/services')
| -rw-r--r-- | gnu/services/audio.scm | 92 | ||||
| -rw-r--r-- | gnu/services/base.scm | 229 | ||||
| -rw-r--r-- | gnu/services/cuirass.scm | 5 | ||||
| -rw-r--r-- | gnu/services/dbus.scm | 48 | ||||
| -rw-r--r-- | gnu/services/desktop.scm | 59 | ||||
| -rw-r--r-- | gnu/services/dns.scm | 86 | ||||
| -rw-r--r-- | gnu/services/getmail.scm | 4 | ||||
| -rw-r--r-- | gnu/services/herd.scm | 7 | ||||
| -rw-r--r-- | gnu/services/monitoring.scm | 3 | ||||
| -rw-r--r-- | gnu/services/networking.scm | 189 | ||||
| -rw-r--r-- | gnu/services/sddm.scm | 10 | ||||
| -rw-r--r-- | gnu/services/virtualization.scm | 6 | ||||
| -rw-r--r-- | gnu/services/web.scm | 37 | ||||
| -rw-r--r-- | gnu/services/xorg.scm | 5 |
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" |