diff options
Diffstat (limited to 'gnu/services')
| -rw-r--r-- | gnu/services/configuration.scm | 17 | ||||
| -rw-r--r-- | gnu/services/databases.scm | 15 | ||||
| -rw-r--r-- | gnu/services/messaging.scm | 106 | ||||
| -rw-r--r-- | gnu/services/networking.scm | 102 |
4 files changed, 178 insertions, 62 deletions
diff --git a/gnu/services/configuration.scm b/gnu/services/configuration.scm index c45340f02f..707944cbe0 100644 --- a/gnu/services/configuration.scm +++ b/gnu/services/configuration.scm @@ -1,7 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015 Andy Wingo <wingo@igalia.com> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> -;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org> +;;; Copyright © 2017, 2018 Clément Lassieur <clement@lassieur.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -74,11 +74,12 @@ (documentation configuration-field-documentation)) (define (serialize-configuration config fields) - (for-each (lambda (field) - ((configuration-field-serializer field) - (configuration-field-name field) - ((configuration-field-getter field) config))) - fields)) + #~(string-append + #$@(map (lambda (field) + ((configuration-field-serializer field) + (configuration-field-name field) + ((configuration-field-getter field) config))) + fields))) (define (validate-configuration config fields) (for-each (lambda (field) @@ -105,7 +106,7 @@ (define (maybe-stem? val) (or (eq? val 'disabled) (stem? val))) (define (serialize-maybe-stem field-name val) - (when (stem? val) (serialize-stem field-name val))))))))) + (if (stem? val) (serialize-stem field-name val) "")))))))) (define-syntax define-configuration (lambda (stx) @@ -147,7 +148,7 @@ conf)))))))) (define (serialize-package field-name val) - #f) + "") ;; A little helper to make it easier to document all those fields. (define (generate-documentation documentation documentation-name) diff --git a/gnu/services/databases.scm b/gnu/services/databases.scm index b34a67aa95..3ca8f471fc 100644 --- a/gnu/services/databases.scm +++ b/gnu/services/databases.scm @@ -77,8 +77,10 @@ (default 5432)) (locale postgresql-configuration-locale (default "en_US.utf8")) - (config-file postgresql-configuration-file) - (data-directory postgresql-configuration-data-directory)) + (config-file postgresql-configuration-file + (default %default-postgres-config)) + (data-directory postgresql-configuration-data-directory + (default "/var/lib/postgresql/data"))) (define %default-postgres-hba (plain-file "pg_hba.conf" @@ -184,7 +186,8 @@ host all all ::1/128 trust")) (service-extension activation-service-type postgresql-activation) (service-extension account-service-type - (const %postgresql-accounts)))))) + (const %postgresql-accounts)))) + (default-value (postgresql-configuration)))) (define* (postgresql-service #:key (postgresql postgresql) (port 5432) @@ -466,7 +469,8 @@ FLUSH PRIVILEGES; (service-extension activation-service-type %mysql-activation) (service-extension shepherd-root-service-type - mysql-shepherd-service))))) + mysql-shepherd-service))) + (default-value (mysql-configuration)))) (define* (mysql-service #:key (config (mysql-configuration))) "Return a service that runs @command{mysqld}, the MySQL or MariaDB @@ -548,4 +552,5 @@ The optional @var{config} argument specifies the configuration for (service-extension activation-service-type redis-activation) (service-extension account-service-type - (const %redis-accounts)))))) + (const %redis-accounts)))) + (default-value (redis-configuration)))) diff --git a/gnu/services/messaging.scm b/gnu/services/messaging.scm index 427e2121f6..80ffed0f2f 100644 --- a/gnu/services/messaging.scm +++ b/gnu/services/messaging.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org> +;;; Copyright © 2017, 2018 Clément Lassieur <clement@lassieur.org> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2015, 2017, 2018 Ludovic Courtès <ludo@gnu.org> ;;; @@ -115,16 +115,9 @@ "_"))) (define (serialize-field field-name val) - (format #t "~a = ~a;\n" (uglify-field-name field-name) val)) + #~(format #f "~a = ~a;\n" #$(uglify-field-name field-name) #$val)) (define (serialize-field-list field-name val) - (serialize-field field-name - (with-output-to-string - (lambda () - (format #t "{\n") - (for-each (lambda (x) - (format #t "~a;\n" x)) - val) - (format #t "}"))))) + (serialize-field field-name #~(format #f "{\n~@{~a;\n~}}" #$@val))) (define (serialize-boolean field-name val) (serialize-field field-name (if val "true" "false"))) @@ -140,17 +133,17 @@ (define (non-negative-integer? val) (and (exact-integer? val) (not (negative? val)))) (define (serialize-non-negative-integer field-name val) - (serialize-field field-name val)) + (serialize-field field-name (number->string val))) (define-maybe non-negative-integer) (define (non-negative-integer-list? val) (and (list? val) (and-map non-negative-integer? val))) (define (serialize-non-negative-integer-list field-name val) - (serialize-field-list field-name val)) + (serialize-field-list field-name (map number->string val))) (define-maybe non-negative-integer-list) (define (enclose-quotes s) - (format #f "\"~a\"" s)) + #~(string-append "\"" #$s "\"")) (define (serialize-string field-name val) (serialize-field field-name (enclose-quotes val))) (define-maybe string) @@ -183,10 +176,22 @@ (serialize-string-list field-name val)) (define-maybe file-name) +(define (file-object? val) + (or (file-like? val) (file-name? val))) +(define (serialize-file-object field-name val) + (serialize-string field-name val)) +(define-maybe file-object) + +(define (file-object-list? val) + (and (list? val) (and-map file-object? val))) +(define (serialize-file-object-list field-name val) + (serialize-string-list field-name val)) +(define-maybe file-object) + (define (raw-content? val) (not (eq? val 'disabled))) (define (serialize-raw-content field-name val) - (format #t "~a" val)) + val) (define-maybe raw-content) (define-configuration mod-muc-configuration @@ -224,12 +229,12 @@ just joined the room.")) "Path to your certificate file.") (capath - (file-name "/etc/ssl/certs") + (file-object "/etc/ssl/certs") "Path to directory containing root certificates that you wish Prosody to trust when verifying the certificates of remote servers.") (cafile - (maybe-file-name 'disabled) + (maybe-file-object 'disabled) "Path to a file containing root certificates that you wish Prosody to trust. Similar to @code{capath} but with all certificates concatenated together.") @@ -273,9 +278,8 @@ can create such a file with: (maybe-string 'disabled) "Password for encrypted private keys.")) (define (serialize-ssl-configuration field-name val) - (format #t "ssl = {\n") - (serialize-configuration val ssl-configuration-fields) - (format #t "};\n")) + #~(format #f "ssl = {\n~a};\n" + #$(serialize-configuration val ssl-configuration-fields))) (define-maybe ssl-configuration) (define %default-modules-enabled @@ -303,20 +307,23 @@ can create such a file with: (define (virtualhost-configuration-list? val) (and (list? val) (and-map virtualhost-configuration? val))) (define (serialize-virtualhost-configuration-list l) - (for-each - (lambda (val) (serialize-virtualhost-configuration val)) l)) + #~(string-append + #$@(map (lambda (val) + (serialize-virtualhost-configuration val)) l))) (define (int-component-configuration-list? val) (and (list? val) (and-map int-component-configuration? val))) (define (serialize-int-component-configuration-list l) - (for-each - (lambda (val) (serialize-int-component-configuration val)) l)) + #~(string-append + #$@(map (lambda (val) + (serialize-int-component-configuration val)) l))) (define (ext-component-configuration-list? val) (and (list? val) (and-map ext-component-configuration? val))) (define (serialize-ext-component-configuration-list l) - (for-each - (lambda (val) (serialize-ext-component-configuration val)) l)) + #~(string-append + #$@(map (lambda (val) + (serialize-ext-component-configuration val)) l))) (define-all-configurations prosody-configuration (prosody @@ -331,7 +338,7 @@ can create such a file with: global) (plugin-paths - (file-name-list '()) + (file-object-list '()) "Additional plugin directories. They are searched in all the specified paths in order. See @url{https://prosody.im/doc/plugins_directory}." global) @@ -372,7 +379,7 @@ should you want to disable them then add them to this list." common) (groups-file - (file-name "/var/lib/prosody/sharedgroups.txt") + (file-object "/var/lib/prosody/sharedgroups.txt") "Path to a text file where the shared groups are defined. If this path is empty then @samp{mod_groups} does nothing. See @url{https://prosody.im/doc/modules/mod_groups}." @@ -566,8 +573,9 @@ See also @url{https://prosody.im/doc/modules/mod_muc}." '(domain)))) (let ((domain (virtualhost-configuration-domain config)) (rest (filter rest? virtualhost-configuration-fields))) - (format #t "VirtualHost \"~a\"\n" domain) - (serialize-configuration config rest))) + #~(string-append + #$(format #f "VirtualHost \"~a\"\n" domain) + #$(serialize-configuration config rest)))) ;; Serialize Component line first. (define (serialize-int-component-configuration config) @@ -577,8 +585,9 @@ See also @url{https://prosody.im/doc/modules/mod_muc}." (let ((hostname (int-component-configuration-hostname config)) (plugin (int-component-configuration-plugin config)) (rest (filter rest? int-component-configuration-fields))) - (format #t "Component \"~a\" \"~a\"\n" hostname plugin) - (serialize-configuration config rest))) + #~(string-append + #$(format #f "Component \"~a\" \"~a\"\n" hostname plugin) + #$(serialize-configuration config rest)))) ;; Serialize Component line first. (define (serialize-ext-component-configuration config) @@ -587,22 +596,24 @@ See also @url{https://prosody.im/doc/modules/mod_muc}." '(hostname)))) (let ((hostname (ext-component-configuration-hostname config)) (rest (filter rest? ext-component-configuration-fields))) - (format #t "Component \"~a\"\n" hostname) - (serialize-configuration config rest))) + #~(string-append + #$(format #f "Component \"~a\"\n" hostname) + #$(serialize-configuration config rest)))) ;; Serialize virtualhosts and components last. (define (serialize-prosody-configuration config) (define (rest? field) (not (memq (configuration-field-name field) '(virtualhosts int-components ext-components)))) - (let ((rest (filter rest? prosody-configuration-fields))) - (serialize-configuration config rest)) - (serialize-virtualhost-configuration-list - (prosody-configuration-virtualhosts config)) - (serialize-int-component-configuration-list - (prosody-configuration-int-components config)) - (serialize-ext-component-configuration-list - (prosody-configuration-ext-components config))) + #~(string-append + #$(let ((rest (filter rest? prosody-configuration-fields))) + (serialize-configuration config rest)) + #$(serialize-virtualhost-configuration-list + (prosody-configuration-virtualhosts config)) + #$(serialize-int-component-configuration-list + (prosody-configuration-int-components config)) + #$(serialize-ext-component-configuration-list + (prosody-configuration-ext-components config)))) (define-configuration opaque-prosody-configuration (prosody @@ -646,13 +657,12 @@ See also @url{https://prosody.im/doc/modules/mod_muc}." (default-certs-dir "/etc/prosody/certs") (data-path (prosody-configuration-data-path config)) (pidfile-dir (dirname (prosody-configuration-pidfile config))) - (config-str - (if (opaque-prosody-configuration? config) - (opaque-prosody-configuration-prosody.cfg.lua config) - (with-output-to-string - (lambda () - (serialize-prosody-configuration config))))) - (config-file (plain-file "prosody.cfg.lua" config-str))) + (config-str (if (opaque-prosody-configuration? config) + (opaque-prosody-configuration-prosody.cfg.lua config) + #~(begin + (use-modules (ice-9 format)) + #$(serialize-prosody-configuration config)))) + (config-file (mixed-text-file "prosody.cfg.lua" config-str))) #~(begin (use-modules (guix build utils)) (define %user (getpw "prosody")) diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm index 5ba3c5eed6..6ac440fd26 100644 --- a/gnu/services/networking.scm +++ b/gnu/services/networking.scm @@ -1,7 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> -;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il> +;;; Copyright © 2016, 2018 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2016 John Darrington <jmd@gnu.org> ;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org> ;;; Copyright © 2017 Thomas Danckaert <post@thomasdanckaert.be> @@ -64,6 +64,10 @@ ntp-service ntp-service-type + openntpd-configuration + openntpd-configuration? + openntpd-service-type + inetd-configuration inetd-entry inetd-service-type @@ -448,6 +452,102 @@ make an initial adjustment of more than 1,000 seconds." ;;; +;;; OpenNTPD. +;;; + +(define-record-type* <openntpd-configuration> + openntpd-configuration make-openntpd-configuration + openntpd-configuration? + (openntpd openntpd-configuration-openntpd + (default openntpd)) + (listen-on openntpd-listen-on + (default '("127.0.0.1" + "::1"))) + (query-from openntpd-query-from + (default '())) + (sensor openntpd-sensor + (default '())) + (server openntpd-server + (default %ntp-servers)) + (servers openntpd-servers + (default '())) + (constraint-from openntpd-constraint-from + (default '())) + (constraints-from openntpd-constraints-from + (default '())) + (allow-large-adjustment? openntpd-allow-large-adjustment? + (default #f))) ; upstream default + +(define (openntpd-shepherd-service config) + (match-record config <openntpd-configuration> + (openntpd listen-on query-from sensor server servers constraint-from + constraints-from allow-large-adjustment?) + (let () + (define config + (string-join + (filter-map + (lambda (field value) + (string-join + (map (cut string-append field <> "\n") + value))) + '("listen on " "query from " "sensor " "server " "servers " + "constraint from ") + (list listen-on query-from sensor server servers constraint-from)) + ;; The 'constraints from' field needs to be enclosed in double quotes. + (string-join + (map (cut string-append "constraints from \"" <> "\"\n") + constraints-from)))) + + (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 #$openntpd "/sbin/ntpd") + "-f" #$ntpd.conf + "-d" ;; don't daemonize + #$@(if allow-large-adjustment? + '("-s") + '())) + ;; When ntpd is daemonized it repeatedly tries to respawn + ;; while running, leading shepherd to disable it. To + ;; prevent spamming stderr, redirect output to logfile. + #:log-file "/var/log/ntpd")) + (stop #~(make-kill-destructor))))))) + +(define (openntpd-service-activation config) + "Return the activation gexp for CONFIG." + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils)) + + (mkdir-p "/var/db") + (mkdir-p "/var/run") + (unless (file-exists? "/var/db/ntpd.drift") + (with-output-to-file "/var/db/ntpd.drift" + (lambda _ + (format #t "0.0"))))))) + +(define openntpd-service-type + (service-type (name 'openntpd) + (extensions + (list (service-extension shepherd-root-service-type + openntpd-shepherd-service) + (service-extension account-service-type + (const %ntp-accounts)) + (service-extension activation-service-type + openntpd-service-activation))) + (default-value (openntpd-configuration)) + (description + "Run the @command{ntpd}, the Network Time Protocol (NTP) +daemon, as implemented by @uref{http://www.openntpd.org, OpenNTPD}. The +daemon will keep the system clock synchronized with that of the given servers."))) + + +;;; ;;; Inetd. ;;; |