diff options
Diffstat (limited to 'gnu/services')
| -rw-r--r-- | gnu/services/avahi.scm | 16 | ||||
| -rw-r--r-- | gnu/services/base.scm | 259 | ||||
| -rw-r--r-- | gnu/services/databases.scm | 40 | ||||
| -rw-r--r-- | gnu/services/games.scm | 81 | ||||
| -rw-r--r-- | gnu/services/herd.scm | 9 | ||||
| -rw-r--r-- | gnu/services/messaging.scm | 117 | ||||
| -rw-r--r-- | gnu/services/networking.scm | 113 | ||||
| -rw-r--r-- | gnu/services/nfs.scm | 2 | ||||
| -rw-r--r-- | gnu/services/shepherd.scm | 36 | ||||
| -rw-r--r-- | gnu/services/version-control.scm | 6 | ||||
| -rw-r--r-- | gnu/services/web.scm | 256 | ||||
| -rw-r--r-- | gnu/services/xorg.scm | 3 |
12 files changed, 670 insertions, 268 deletions
diff --git a/gnu/services/avahi.scm b/gnu/services/avahi.scm index d69c89f751..5de30ffb97 100644 --- a/gnu/services/avahi.scm +++ b/gnu/services/avahi.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -47,6 +47,12 @@ (default #f)) (host-name avahi-configuration-host-name) ;string (publish? avahi-configuration-publish?) ;Boolean + + ;; The default for this was #t in Avahi 0.6.31 and became #f in 0.7. For + ;; now we stick to the old default. + (publish-workstation? avahi-configuration-publish-workstation? ;Boolean + (default #t)) + (ipv4? avahi-configuration-ipv4?) ;Boolean (ipv6? avahi-configuration-ipv6?) ;Boolean (wide-area? avahi-configuration-wide-area?) ;Boolean @@ -77,7 +83,9 @@ "enable-wide-area=" (bool (avahi-configuration-wide-area? config)) "[publish]\n" "disable-publishing=" - (bool (not (avahi-configuration-publish? config)))))) + (bool (not (avahi-configuration-publish? config))) + "publish-workstation=" + (bool (avahi-configuration-publish-workstation? config))))) (define %avahi-accounts ;; Account and group for the Avahi daemon. @@ -94,7 +102,7 @@ ;; Activation gexp. #~(begin (use-modules (guix build utils)) - (mkdir-p "/var/run/avahi-daemon"))) + (mkdir-p "/run/avahi-daemon"))) (define (avahi-shepherd-service config) "Return a list of <shepherd-service> for CONFIG." @@ -111,7 +119,7 @@ "--daemonize" #$@(if debug? #~("--debug") #~()) "-f" #$config) - #:pid-file "/var/run/avahi-daemon/pid")) + #:pid-file "/run/avahi-daemon/pid")) (stop #~(make-kill-destructor)))))) (define avahi-service-type diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 8e30bcd341..69e211ffa3 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -679,9 +679,6 @@ to add @var{device} to the kernel's entropy pool. The service will fail if (logior (input-flags IUTF8) (termios-input-flags termios)))) - ;; See console_codes(4). - (display "\x1b%G" (fdes->outport fd)) - (tcsetattr fd (tcsetattr-action TCSAFLUSH) (set-utf8-input termios)) @@ -817,7 +814,7 @@ the message of the day, among other things." agetty-configuration? (agetty agetty-configuration-agetty ;<package> (default util-linux)) - (tty agetty-configuration-tty) ;string + (tty agetty-configuration-tty) ;string | #f (term agetty-term ;string | #f (default #f)) (baud-rate agetty-baud-rate ;string | #f @@ -890,6 +887,40 @@ the message of the day, among other things." ;;; (default #f)) ) +(define (default-serial-port) + "Return a gexp that determines a reasonable default serial port +to use as the tty. This is primarily useful for headless systems." + #~(begin + ;; console=device,options + ;; device: can be tty0, ttyS0, lp0, ttyUSB0 (serial). + ;; options: BBBBPNF. P n|o|e, N number of bits, + ;; F flow control (r RTS) + (let* ((not-comma (char-set-complement (char-set #\,))) + (command (linux-command-line)) + (agetty-specs (find-long-options "agetty.tty" command)) + (console-specs (filter (lambda (spec) + (and (string-prefix? "tty" spec) + (not (or + (string-prefix? "tty0" spec) + (string-prefix? "tty1" spec) + (string-prefix? "tty2" spec) + (string-prefix? "tty3" spec) + (string-prefix? "tty4" spec) + (string-prefix? "tty5" spec) + (string-prefix? "tty6" spec) + (string-prefix? "tty7" spec) + (string-prefix? "tty8" spec) + (string-prefix? "tty9" spec))))) + (find-long-options "console" command))) + (specs (append agetty-specs console-specs))) + (match specs + (() #f) + ((spec _ ...) + ;; Extract device name from first spec. + (match (string-tokenize spec not-comma) + ((device-name _ ...) + device-name))))))) + (define agetty-shepherd-service (match-lambda (($ <agetty-configuration> agetty tty term baud-rate auto-login @@ -900,8 +931,9 @@ the message of the day, among other things." 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 tty)))) + (provision (list (symbol-append 'term- (string->symbol (or tty "auto"))))) ;; Since the login prompt shows the host name, wait for the 'host-name' ;; service to be done. Also wait for udev essentially so that the tty @@ -909,113 +941,119 @@ the message of the day, among other things." ;; mingetty-shepherd-service). (requirement '(user-processes host-name udev)) - (start #~(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") - #~()) + (start #~(let ((tty #$(default-serial-port))) + (if 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 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") - #~()) - #$tty - #$@(if baud-rate - #~(#$baud-rate) - #~()) - #$@(if term - #~(#$term) - #~())))) + #$@(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") + #~()) + #$(or tty (default-serial-port)) + #$@(if baud-rate + #~(#$baud-rate) + #~()) + #$@(if term + #~(#$term) + #~())))) + (const #f))) ; never start. (stop #~(make-kill-destructor))))))) (define agetty-service-type @@ -2012,6 +2050,11 @@ This service is not part of @var{%base-services}." (cons tty %default-console-font)) '("tty1" "tty2" "tty3" "tty4" "tty5" "tty6"))) + (agetty-service (agetty-configuration + (extra-options '("-L")) ; no carrier detect + (term "vt100") + (tty #f))) ; automatic + (mingetty-service (mingetty-configuration (tty "tty1"))) (mingetty-service (mingetty-configuration diff --git a/gnu/services/databases.scm b/gnu/services/databases.scm index 6a01cb1ce6..b34a67aa95 100644 --- a/gnu/services/databases.scm +++ b/gnu/services/databases.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016 Leo Famulari <leo@famulari.name> ;;; Copyright © 2017 Christopher Baines <mail@cbaines.net> +;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -147,26 +148,33 @@ host all all ::1/128 trust")) (define postgresql-shepherd-service (match-lambda (($ <postgresql-configuration> postgresql port locale config-file data-directory) - (let ((start-script - ;; Wrapper script that switches to the 'postgres' user before - ;; launching daemon. - (program-file "start-postgres" - #~(let ((user (getpwnam "postgres")) - (postgres (string-append #$postgresql - "/bin/postgres"))) - (setgid (passwd:gid user)) - (setuid (passwd:uid user)) - (system* postgres - (string-append "--config-file=" - #$config-file) - "-p" (number->string #$port) - "-D" #$data-directory))))) + (let* ((pg_ctl-wrapper + ;; Wrapper script that switches to the 'postgres' user before + ;; launching daemon. + (program-file + "pg_ctl-wrapper" + #~(begin + (use-modules (ice-9 match) + (ice-9 format)) + (match (command-line) + ((_ mode) + (let ((user (getpwnam "postgres")) + (pg_ctl #$(file-append postgresql "/bin/pg_ctl")) + (options (format #f "--config-file=~a -p ~d" + #$config-file #$port))) + (setgid (passwd:gid user)) + (setuid (passwd:uid user)) + (execl pg_ctl pg_ctl "-D" #$data-directory "-o" options + mode))))))) + (action (lambda args + #~(lambda _ + (invoke #$pg_ctl-wrapper #$@args))))) (list (shepherd-service (provision '(postgres)) (documentation "Run the PostgreSQL daemon.") (requirement '(user-processes loopback syslogd)) - (start #~(make-forkexec-constructor #$start-script)) - (stop #~(make-kill-destructor)))))))) + (start (action "start")) + (stop (action "stop")))))))) (define postgresql-service-type (service-type (name 'postgresql) diff --git a/gnu/services/games.scm b/gnu/services/games.scm new file mode 100644 index 0000000000..b146696237 --- /dev/null +++ b/gnu/services/games.scm @@ -0,0 +1,81 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +(define-module (gnu services games) + #:use-module (gnu services) + #:use-module (gnu services shepherd) + #:use-module (gnu packages admin) + #:use-module (gnu packages games) + #:use-module (gnu system shadow) + #:use-module (guix gexp) + #:use-module (guix modules) + #:use-module (guix records) + #:use-module (ice-9 match) + #:export (wesnothd-configuration + wesnoth-configuration? + wesnothd-service-type)) + +;;; +;;; The Battle for Wesnoth server +;;; + +(define-record-type* <wesnothd-configuration> + wesnothd-configuration make-wesnothd-configuration wesnothd-configuration? + (package wesnothd-configuration-package + (default wesnoth-server)) + (port wesnothd-configuration-port + (default 15000))) + +(define %wesnothd-accounts + (list (user-account + (name "wesnothd") + (group "wesnothd") + (system? #t) + (comment "Wesnoth daemon user") + (home-directory "/var/empty") + (shell (file-append shadow "/sbin/nologin"))) + (user-group + (name "wesnothd") + (system? #t)))) + +(define wesnothd-shepherd-service + (match-lambda + (($ <wesnothd-configuration> package port) + (with-imported-modules (source-module-closure + '((gnu build shepherd))) + (shepherd-service + (documentation "The Battle for Wesnoth server") + (provision '(wesnoth-daemon)) + (requirement '(networking)) + (modules '((gnu build shepherd))) + (start #~(make-forkexec-constructor/container + (list #$(file-append package "/bin/wesnothd") + "-p" #$(number->string port)))) + (stop #~(make-kill-destructor))))))) + +(define wesnothd-service-type + (service-type + (name 'wesnothd) + (description + "Run The Battle for Wesnoth server @command{wesnothd}.") + (extensions + (list (service-extension account-service-type + (const %wesnothd-accounts)) + (service-extension shepherd-root-service-type + (compose list wesnothd-shepherd-service)))) + (default-value (wesnothd-configuration)))) diff --git a/gnu/services/herd.scm b/gnu/services/herd.scm index 5c894af6fd..d882c232cf 100644 --- a/gnu/services/herd.scm +++ b/gnu/services/herd.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> ;;; ;;; This file is part of GNU Guix. @@ -83,7 +83,12 @@ return the socket." (define-syntax-rule (with-shepherd connection body ...) "Evaluate BODY... with CONNECTION bound to an open socket to PID 1." (let ((connection (open-connection))) - body ...)) + (dynamic-wind + (const #t) + (lambda () + body ...) + (lambda () + (close-port connection))))) (define-condition-type &shepherd-error &error shepherd-error?) diff --git a/gnu/services/messaging.scm b/gnu/services/messaging.scm index a9820ed21f..427e2121f6 100644 --- a/gnu/services/messaging.scm +++ b/gnu/services/messaging.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> +;;; Copyright © 2015, 2017, 2018 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -25,6 +26,7 @@ #:use-module (gnu services configuration) #:use-module (gnu system shadow) #:use-module (guix gexp) + #:use-module (guix modules) #:use-module (guix records) #:use-module (guix packages) #:use-module (srfi srfi-1) @@ -42,7 +44,12 @@ ssl-configuration %default-modules-enabled - prosody-configuration-pidfile)) + prosody-configuration-pidfile + + bitlbee-configuration + bitlbee-configuration? + bitlbee-service + bitlbee-service-type)) ;;; Commentary: ;;; @@ -751,3 +758,111 @@ string, you could instantiate a prosody service like this: (opaque-prosody-configuration (prosody.cfg.lua \"\"))) @end example")) + + +;;; +;;; BitlBee. +;;; + +(define-record-type* <bitlbee-configuration> + bitlbee-configuration make-bitlbee-configuration + bitlbee-configuration? + (bitlbee bitlbee-configuration-bitlbee + (default bitlbee)) + (interface bitlbee-configuration-interface + (default "127.0.0.1")) + (port bitlbee-configuration-port + (default 6667)) + (extra-settings bitlbee-configuration-extra-settings + (default ""))) + +(define bitlbee-shepherd-service + (match-lambda + (($ <bitlbee-configuration> bitlbee interface port extra-settings) + (let ((conf (plain-file "bitlbee.conf" + (string-append " + [settings] + User = bitlbee + ConfigDir = /var/lib/bitlbee + DaemonInterface = " interface " + DaemonPort = " (number->string port) " +" extra-settings)))) + + (with-imported-modules (source-module-closure + '((gnu build shepherd) + (gnu system file-systems))) + (list (shepherd-service + (provision '(bitlbee)) + + ;; Note: If networking is not up, then /etc/resolv.conf + ;; doesn't get mapped in the container, hence the dependency + ;; on 'networking'. + (requirement '(user-processes networking)) + + (modules '((gnu build shepherd) + (gnu system file-systems))) + (start #~(make-forkexec-constructor/container + (list #$(file-append bitlbee "/sbin/bitlbee") + "-n" "-F" "-u" "bitlbee" "-c" #$conf) + + #:pid-file "/var/run/bitlbee.pid" + #:mappings (list (file-system-mapping + (source "/var/lib/bitlbee") + (target source) + (writable? #t))))) + (stop #~(make-kill-destructor))))))))) + +(define %bitlbee-accounts + ;; User group and account to run BitlBee. + (list (user-group (name "bitlbee") (system? #t)) + (user-account + (name "bitlbee") + (group "bitlbee") + (system? #t) + (comment "BitlBee daemon user") + (home-directory "/var/empty") + (shell (file-append shadow "/sbin/nologin"))))) + +(define %bitlbee-activation + ;; Activation gexp for BitlBee. + #~(begin + (use-modules (guix build utils)) + + ;; This directory is used to store OTR data. + (mkdir-p "/var/lib/bitlbee") + (let ((user (getpwnam "bitlbee"))) + (chown "/var/lib/bitlbee" + (passwd:uid user) (passwd:gid user))))) + +(define bitlbee-service-type + (service-type (name 'bitlbee) + (extensions + (list (service-extension shepherd-root-service-type + bitlbee-shepherd-service) + (service-extension account-service-type + (const %bitlbee-accounts)) + (service-extension activation-service-type + (const %bitlbee-activation)))) + (default-value (bitlbee-configuration)) + (description + "Run @url{http://bitlbee.org,BitlBee}, a daemon that acts as +a gateway between IRC and chat networks."))) + +(define* (bitlbee-service #:key (bitlbee bitlbee) ;deprecated + (interface "127.0.0.1") (port 6667) + (extra-settings "")) + "Return a service that runs @url{http://bitlbee.org,BitlBee}, a daemon that +acts as a gateway between IRC and chat networks. + +The daemon will listen to the interface corresponding to the IP address +specified in @var{interface}, on @var{port}. @code{127.0.0.1} means that only +local clients can connect, whereas @code{0.0.0.0} means that connections can +come from any networking interface. + +In addition, @var{extra-settings} specifies a string to append to the +configuration file." + (service bitlbee-service-type + (bitlbee-configuration + (bitlbee bitlbee) + (interface interface) (port port) + (extra-settings extra-settings)))) diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm index c3ba0787c0..5ba3c5eed6 100644 --- a/gnu/services/networking.scm +++ b/gnu/services/networking.scm @@ -74,11 +74,6 @@ tor-service tor-service-type - bitlbee-configuration - bitlbee-configuration? - bitlbee-service - bitlbee-service-type - wicd-service-type wicd-service @@ -738,114 +733,6 @@ project's documentation} for more information." ;;; -;;; BitlBee. -;;; - -(define-record-type* <bitlbee-configuration> - bitlbee-configuration make-bitlbee-configuration - bitlbee-configuration? - (bitlbee bitlbee-configuration-bitlbee - (default bitlbee)) - (interface bitlbee-configuration-interface - (default "127.0.0.1")) - (port bitlbee-configuration-port - (default 6667)) - (extra-settings bitlbee-configuration-extra-settings - (default ""))) - -(define bitlbee-shepherd-service - (match-lambda - (($ <bitlbee-configuration> bitlbee interface port extra-settings) - (let ((conf (plain-file "bitlbee.conf" - (string-append " - [settings] - User = bitlbee - ConfigDir = /var/lib/bitlbee - DaemonInterface = " interface " - DaemonPort = " (number->string port) " -" extra-settings)))) - - (with-imported-modules (source-module-closure - '((gnu build shepherd) - (gnu system file-systems))) - (list (shepherd-service - (provision '(bitlbee)) - - ;; Note: If networking is not up, then /etc/resolv.conf - ;; doesn't get mapped in the container, hence the dependency - ;; on 'networking'. - (requirement '(user-processes networking)) - - (modules '((gnu build shepherd) - (gnu system file-systems))) - (start #~(make-forkexec-constructor/container - (list #$(file-append bitlbee "/sbin/bitlbee") - "-n" "-F" "-u" "bitlbee" "-c" #$conf) - - #:pid-file "/var/run/bitlbee.pid" - #:mappings (list (file-system-mapping - (source "/var/lib/bitlbee") - (target source) - (writable? #t))))) - (stop #~(make-kill-destructor))))))))) - -(define %bitlbee-accounts - ;; User group and account to run BitlBee. - (list (user-group (name "bitlbee") (system? #t)) - (user-account - (name "bitlbee") - (group "bitlbee") - (system? #t) - (comment "BitlBee daemon user") - (home-directory "/var/empty") - (shell (file-append shadow "/sbin/nologin"))))) - -(define %bitlbee-activation - ;; Activation gexp for BitlBee. - #~(begin - (use-modules (guix build utils)) - - ;; This directory is used to store OTR data. - (mkdir-p "/var/lib/bitlbee") - (let ((user (getpwnam "bitlbee"))) - (chown "/var/lib/bitlbee" - (passwd:uid user) (passwd:gid user))))) - -(define bitlbee-service-type - (service-type (name 'bitlbee) - (extensions - (list (service-extension shepherd-root-service-type - bitlbee-shepherd-service) - (service-extension account-service-type - (const %bitlbee-accounts)) - (service-extension activation-service-type - (const %bitlbee-activation)))) - (default-value (bitlbee-configuration)) - (description - "Run @url{http://bitlbee.org,BitlBee}, a daemon that acts as -a gateway between IRC and chat networks."))) - -(define* (bitlbee-service #:key (bitlbee bitlbee) - (interface "127.0.0.1") (port 6667) - (extra-settings "")) - "Return a service that runs @url{http://bitlbee.org,BitlBee}, a daemon that -acts as a gateway between IRC and chat networks. - -The daemon will listen to the interface corresponding to the IP address -specified in @var{interface}, on @var{port}. @code{127.0.0.1} means that only -local clients can connect, whereas @code{0.0.0.0} means that connections can -come from any networking interface. - -In addition, @var{extra-settings} specifies a string to append to the -configuration file." - (service bitlbee-service-type - (bitlbee-configuration - (bitlbee bitlbee) - (interface interface) (port port) - (extra-settings extra-settings)))) - - -;;; ;;; Wicd. ;;; diff --git a/gnu/services/nfs.scm b/gnu/services/nfs.scm index 8f58920e4a..6ed4c0eabf 100644 --- a/gnu/services/nfs.scm +++ b/gnu/services/nfs.scm @@ -88,7 +88,7 @@ (define pipefs-directory (pipefs-configuration-mount-point config)) (shepherd-service - (documentation "Mount the pipefs pseudo filesystem.") + (documentation "Mount the pipefs pseudo file system.") (provision '(rpc-pipefs)) (start #~(lambda () diff --git a/gnu/services/shepherd.scm b/gnu/services/shepherd.scm index 7281746ab2..f7c6983cb0 100644 --- a/gnu/services/shepherd.scm +++ b/gnu/services/shepherd.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015, 2016, 2018 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org> ;;; ;;; This file is part of GNU Guix. @@ -66,7 +66,7 @@ (define (shepherd-boot-gexp services) - (mlet %store-monad ((shepherd-conf (shepherd-configuration-file services))) + (with-monad %store-monad (return #~(begin ;; Keep track of the booted system. (false-if-exception (delete-file "/run/booted-system")) @@ -84,7 +84,8 @@ ;; Start shepherd. (execl #$(file-append shepherd "/bin/shepherd") - "shepherd" "--config" #$shepherd-conf))))) + "shepherd" "--config" + #$(shepherd-configuration-file services)))))) (define shepherd-root-service-type (service-type @@ -203,25 +204,24 @@ stored." (define (shepherd-service-file service) "Return a file defining SERVICE." - (gexp->file (shepherd-service-file-name service) - (with-imported-modules %default-imported-modules - #~(begin - (use-modules #$@(shepherd-service-modules service)) - - (make <service> - #:docstring '#$(shepherd-service-documentation service) - #:provides '#$(shepherd-service-provision service) - #:requires '#$(shepherd-service-requirement service) - #:respawn? '#$(shepherd-service-respawn? service) - #:start #$(shepherd-service-start service) - #:stop #$(shepherd-service-stop service)))))) + (scheme-file (shepherd-service-file-name service) + (with-imported-modules %default-imported-modules + #~(begin + (use-modules #$@(shepherd-service-modules service)) + + (make <service> + #:docstring '#$(shepherd-service-documentation service) + #:provides '#$(shepherd-service-provision service) + #:requires '#$(shepherd-service-requirement service) + #:respawn? '#$(shepherd-service-respawn? service) + #:start #$(shepherd-service-start service) + #:stop #$(shepherd-service-stop service)))))) (define (shepherd-configuration-file services) "Return the shepherd configuration file for SERVICES." (assert-valid-graph services) - (mlet %store-monad ((files (mapm %store-monad - shepherd-service-file services))) + (let ((files (map shepherd-service-file services))) (define config #~(begin (use-modules (srfi srfi-34) @@ -252,7 +252,7 @@ stored." (filter shepherd-service-auto-start? services))))))) - (gexp->file "shepherd.conf" config))) + (scheme-file "shepherd.conf" config))) (define* (shepherd-service-lookup-procedure services #:optional diff --git a/gnu/services/version-control.scm b/gnu/services/version-control.scm index 6bf656949a..7166ed3d4f 100644 --- a/gnu/services/version-control.scm +++ b/gnu/services/version-control.scm @@ -263,7 +263,11 @@ access to exported repositories under @file{/srv/git}." (list (service-extension activation-service-type cgit-activation) (service-extension nginx-service-type - cgit-configuration-nginx-config))) + cgit-configuration-nginx-config) + + ;; Make sure fcgiwrap is instantiated. + (service-extension fcgiwrap-service-type + (const #t)))) (default-value (cgit-configuration)) (description "Run the Cgit web interface, which allows users to browse Git diff --git a/gnu/services/web.scm b/gnu/services/web.scm index 2371ddb6d0..beda481b0d 100644 --- a/gnu/services/web.scm +++ b/gnu/services/web.scm @@ -2,7 +2,7 @@ ;;; Copyright © 2015 David Thompson <davet@gnu.org> ;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016 ng0 <ng0@we.make.ritual.n0.is> -;;; Copyright © 2016, 2017 Julien Lepiller <julien@lepiller.eu> +;;; Copyright © 2016, 2017, 2018 Julien Lepiller <julien@lepiller.eu> ;;; Copyright © 2017 Christopher Baines <mail@cbaines.net> ;;; Copyright © 2017 nee <nee-git@hidamari.blue> ;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org> @@ -34,8 +34,36 @@ #:use-module ((guix utils) #:select (version-major)) #:use-module ((guix packages) #:select (package-version)) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) #:use-module (ice-9 match) - #:export (<nginx-configuration> + #:export (<httpd-configuration> + httpd-configuration + httpd-configuration? + httpd-configuration-package + httpd-configuration-pid-file + httpd-configuration-config + + <httpd-virtualhost> + httpd-virtualhost + httpd-virtualhost? + httpd-virtualhost-addresses-and-ports + httpd-virtualhost-contents + + <httpd-config-file> + httpd-config-file + httpd-config-file? + httpd-config-file-modules + httpd-config-file-server-root + httpd-config-file-server-name + httpd-config-file-listen + httpd-config-file-pid-file + httpd-config-file-error-log + httpd-config-file-user + httpd-config-file-group + + httpd-service-type + + <nginx-configuration> nginx-configuration nginx-configuration? nginx-configuartion-nginx @@ -125,7 +153,9 @@ php-fpm-on-demand-process-manager-configuration-process-idle-timeout php-fpm-service-type - nginx-php-location)) + nginx-php-location + + cat-avatar-generator-service)) ;;; Commentary: ;;; @@ -133,6 +163,205 @@ ;;; ;;; Code: +(define-record-type* <httpd-module> + httpd-module make-httpd-module + httpd-module? + (name httpd-load-module-name) + (file httpd-load-module-file)) + +;; Default modules for the httpd-service-type, taken from etc/httpd/httpd.conf +;; file in the httpd package. +(define %default-httpd-modules + (map (match-lambda + ((name file) + (httpd-module + (name name) + (file file)))) + '(("authn_file_module" "modules/mod_authn_file.so") + ("authn_core_module" "modules/mod_authn_core.so") + ("authz_host_module" "modules/mod_authz_host.so") + ("authz_groupfile_module" "modules/mod_authz_groupfile.so") + ("authz_user_module" "modules/mod_authz_user.so") + ("authz_core_module" "modules/mod_authz_core.so") + ("access_compat_module" "modules/mod_access_compat.so") + ("auth_basic_module" "modules/mod_auth_basic.so") + ("reqtimeout_module" "modules/mod_reqtimeout.so") + ("filter_module" "modules/mod_filter.so") + ("mime_module" "modules/mod_mime.so") + ("log_config_module" "modules/mod_log_config.so") + ("env_module" "modules/mod_env.so") + ("headers_module" "modules/mod_headers.so") + ("setenvif_module" "modules/mod_setenvif.so") + ("version_module" "modules/mod_version.so") + ("unixd_module" "modules/mod_unixd.so") + ("status_module" "modules/mod_status.so") + ("autoindex_module" "modules/mod_autoindex.so") + ("dir_module" "modules/mod_dir.so") + ("alias_module" "modules/mod_alias.so")))) + +(define-record-type* <httpd-config-file> + httpd-config-file make-httpd-config-file + httpd-config-file? + (modules httpd-config-file-modules + (default %default-httpd-modules)) + (server-root httpd-config-file-server-root + (default httpd)) + (server-name httpd-config-file-server-name + (default #f)) + (document-root httpd-config-file-document-root + (default "/srv/http")) + (listen httpd-config-file-listen + (default '("80"))) + (pid-file httpd-config-file-pid-file + (default "/var/run/httpd")) + (error-log httpd-config-file-error-log + (default "/var/log/httpd/error_log")) + (user httpd-config-file-user + (default "httpd")) + (group httpd-config-file-group + (default "httpd")) + (extra-config httpd-config-file-extra-config + (default + (list "TypesConfig etc/httpd/mime.types")))) + +(define-gexp-compiler (httpd-config-file-compiler + (file <httpd-config-file>) system target) + (match file + (($ <httpd-config-file> load-modules server-root server-name + document-root listen pid-file error-log + user group extra-config) + (gexp->derivation + "httpd.conf" + #~(call-with-output-file (ungexp output "out") + (lambda (port) + (display + (string-append + (ungexp-splicing + `(,@(append-map + (match-lambda + (($ <httpd-module> name module) + `("LoadModule " ,name " " ,module "\n"))) + load-modules) + ,@`("ServerRoot " ,server-root "\n") + ,@(if server-name + `("ServerName " ,server-name "\n") + '()) + ,@`("DocumentRoot " ,document-root "\n") + ,@(append-map + (lambda (listen-value) + `("Listen " ,listen-value "\n")) + listen) + ,@(if pid-file + `("Pidfile " ,pid-file "\n") + '()) + ,@(if error-log + `("ErrorLog " ,error-log "\n") + '()) + ,@(if user + `("User " ,user "\n") + '()) + ,@(if group + `("Group " ,group "\n") + '()) + "\n\n" + ,@extra-config))) + port))) + #:local-build? #t)))) + +(define-record-type <httpd-virtualhost> + (httpd-virtualhost addresses-and-ports contents) + httpd-virtualhost? + (addresses-and-ports httpd-virtualhost-addresses-and-ports) + (contents httpd-virtualhost-contents)) + +(define-record-type* <httpd-configuration> + httpd-configuration make-httpd-configuration + httpd-configuration? + (package httpd-configuration-package + (default httpd)) + (pid-file httpd-configuration-pid-file + (default "/var/run/httpd")) + (config httpd-configuration-config + (default (httpd-config-file)))) + +(define %httpd-accounts + (list (user-group (name "httpd") (system? #t)) + (user-account + (name "httpd") + (group "httpd") + (system? #t) + (comment "Apache HTTPD server user") + (home-directory "/var/empty") + (shell (file-append shadow "/sbin/nologin"))))) + +(define httpd-shepherd-services + (match-lambda + (($ <httpd-configuration> package pid-file config) + (list (shepherd-service + (provision '(httpd)) + (documentation "The Apache HTTP Server") + (requirement '(networking)) + (start #~(make-forkexec-constructor + `(#$(file-append package "/bin/httpd") + #$@(if config + (list "-f" config) + '())) + #:pid-file #$pid-file)) + (stop #~(make-kill-destructor))))))) + +(define httpd-activation + (match-lambda + (($ <httpd-configuration> package pid-file config) + (match-record + config + <httpd-config-file> + (error-log document-root) + #~(begin + (use-modules (guix build utils)) + + (mkdir-p #$(dirname error-log)) + (mkdir-p #$document-root)))))) + +(define (httpd-process-extensions original-config extension-configs) + (let ((config (httpd-configuration-config + original-config))) + (if (httpd-config-file? config) + (httpd-configuration + (inherit original-config) + (config + (httpd-config-file + (inherit config) + (extra-config + (append (httpd-config-file-extra-config config) + (append-map + (match-lambda + (($ <httpd-virtualhost> + addresses-and-ports + contents) + `(,(string-append + "<VirtualHost " addresses-and-ports ">\n") + ,@contents + "\n</VirtualHost>\n")) + ((? string? x) + `("\n" ,x "\n")) + ((? list? x) + `("\n" ,@x "\n"))) + extension-configs))))))))) + +(define httpd-service-type + (service-type (name 'httpd) + (extensions + (list (service-extension shepherd-root-service-type + httpd-shepherd-services) + (service-extension activation-service-type + httpd-activation) + (service-extension account-service-type + (const %httpd-accounts)))) + (compose concatenate) + (extend httpd-process-extensions) + (default-value + (httpd-configuration)))) + (define-record-type* <nginx-server-configuration> nginx-server-configuration make-nginx-server-configuration nginx-server-configuration? @@ -643,3 +872,24 @@ a webserver.") (string-append "fastcgi_pass unix:" socket ";") "fastcgi_index index.php;" (list "include " nginx-package "/share/nginx/conf/fastcgi.conf;"))))) + +(define* (cat-avatar-generator-service + #:key + (cache-dir "/var/cache/cat-avatar-generator") + (package cat-avatar-generator) + (configuration (nginx-server-configuration))) + (simple-service + 'cat-http-server nginx-service-type + (list (nginx-server-configuration + (inherit configuration) + (locations + (cons + (let ((base (nginx-php-location))) + (nginx-location-configuration + (inherit base) + (body (list (string-append "fastcgi_param CACHE_DIR \"" + cache-dir "\";") + (nginx-location-configuration-body base))))) + (nginx-server-configuration-locations configuration))) + (root #~(string-append #$package + "/share/web/cat-avatar-generator")))))) diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm index cef0d60b59..50af2408b1 100644 --- a/gnu/services/xorg.scm +++ b/gnu/services/xorg.scm @@ -318,6 +318,7 @@ desktop session from the system or user profile will be used." (use-modules (ice-9 match) (ice-9 regex) (ice-9 ftw) + (ice-9 rdelim) (srfi srfi-1) (srfi srfi-26)) @@ -590,7 +591,7 @@ theme." #:optional (program (package-name package)) #:key allow-empty-passwords?) - "Add @var{package}, a package for a screen-locker or screen-saver whose + "Add @var{package}, a package for a screen locker or screen saver whose command is @var{program}, to the set of setuid programs and add a PAM entry for it. For example: |