From 78cef99b9812f1bb43708f84d316d286a1599bdf Mon Sep 17 00:00:00 2001 From: Clément Lassieur Date: Sun, 8 Jan 2017 20:08:14 +0100 Subject: gnu: Add Prosody service. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/services/messaging.scm: New file. * gnu/services/configuration.scm: New exported procedures. * gnu/local.mk (GNU_SYSTEM_MODULES): Add gnu/services/messaging.scm. * doc/guix.texi (Messaging Services): New section. Signed-off-by: Ludovic Courtès --- gnu/services/configuration.scm | 3 + gnu/services/messaging.scm | 726 +++++++++++++++++++++++++++++++++++++++++ 2 files changed, 729 insertions(+) create mode 100644 gnu/services/messaging.scm (limited to 'gnu/services') diff --git a/gnu/services/configuration.scm b/gnu/services/configuration.scm index 94c5f21557..a98db64fa5 100644 --- a/gnu/services/configuration.scm +++ b/gnu/services/configuration.scm @@ -28,10 +28,13 @@ #:use-module (srfi srfi-35) #:export (configuration-field configuration-field-name + configuration-field-type configuration-missing-field configuration-field-error configuration-field-serializer configuration-field-getter + configuration-field-default-value-thunk + configuration-field-documentation serialize-configuration define-configuration validate-configuration diff --git a/gnu/services/messaging.scm b/gnu/services/messaging.scm new file mode 100644 index 0000000000..0b5aa1fae8 --- /dev/null +++ b/gnu/services/messaging.scm @@ -0,0 +1,726 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2017 Clément Lassieur +;;; +;;; 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 . + +(define-module (gnu services messaging) + #:use-module (gnu packages messaging) + #:use-module (gnu packages admin) + #:use-module (gnu services) + #:use-module (gnu services shepherd) + #:use-module (gnu services configuration) + #:use-module (gnu system shadow) + #:use-module (guix gexp) + #:use-module (guix records) + #:use-module (guix packages) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-35) + #:use-module (ice-9 match) + #:export (prosody-service-type + prosody-configuration + opaque-prosody-configuration + + virtualhost-configuration + int-component-configuration + ext-component-configuration + + mod-muc-configuration + ssl-configuration + + %default-modules-enabled)) + +;;; Commentary: +;;; +;;; Messaging services. +;;; +;;; Code: + +(define (id ctx . parts) + (datum->syntax ctx (apply symbol-append (map syntax->datum parts)))) + +(define-syntax define-maybe + (lambda (x) + (syntax-case x () + ((_ stem) + (with-syntax + ((stem? (id #'stem #'stem #'?)) + (maybe-stem? (id #'stem #'maybe- #'stem #'?)) + (serialize-stem (id #'stem #'serialize- #'stem)) + (serialize-maybe-stem (id #'stem #'serialize-maybe- #'stem))) + #'(begin + (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))))))))) + +(define-syntax define-all-configurations + (lambda (stx) + (define (make-pred arg) + (lambda (field target) + (and (memq (syntax->datum target) `(common ,arg)) field))) + (syntax-case stx () + ((_ stem (field (field-type def) doc target) ...) + (with-syntax (((new-field-type ...) + (map (lambda (field-type target) + (if (and (eq? 'common (syntax->datum target)) + (not (string-prefix? + "maybe-" + (symbol->string + (syntax->datum field-type))))) + (id #'stem #'maybe- field-type) field-type)) + #'(field-type ...) #'(target ...))) + ((new-def ...) + (map (lambda (def target) + (if (eq? 'common (syntax->datum target)) + #''disabled def)) + #'(def ...) #'(target ...))) + ((new-doc ...) + (map (lambda (doc target) + (if (eq? 'common (syntax->datum target)) + "" doc)) + #'(doc ...) #'(target ...)))) + #`(begin + (define common-fields + '(#,@(filter-map (make-pred #f) #'(field ...) #'(target ...)))) + (define-configuration prosody-configuration + #,@(filter-map (make-pred 'global) + #'((field (field-type def) doc) ...) + #'(target ...))) + (define-configuration virtualhost-configuration + #,@(filter-map (make-pred 'virtualhost) + #'((field (new-field-type new-def) new-doc) ...) + #'(target ...))) + (define-configuration int-component-configuration + #,@(filter-map (make-pred 'int-component) + #'((field (new-field-type new-def) new-doc) ...) + #'(target ...))) + (define-configuration ext-component-configuration + #,@(filter-map (make-pred 'ext-component) + #'((field (new-field-type new-def) new-doc) ...) + #'(target ...))))))))) + +(define (uglify-field-name field-name) + (let ((str (symbol->string field-name))) + (string-join (string-split (if (string-suffix? "?" str) + (substring str 0 (1- (string-length str))) + str) + #\-) + "_"))) + +(define (serialize-field field-name val) + (format #t "~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 "}"))))) + +(define (serialize-boolean field-name val) + (serialize-field field-name (if val "true" "false"))) +(define-maybe boolean) + +(define (string-or-boolean? val) + (or (string? val) (boolean? val))) +(define (serialize-string-or-boolean field-name val) + (if (string? val) + (serialize-string field-name val) + (serialize-boolean field-name val))) + +(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)) +(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)) +(define-maybe non-negative-integer-list) + +(define (enclose-quotes s) + (format #f "\"~a\"" s)) +(define (serialize-string field-name val) + (serialize-field field-name (enclose-quotes val))) +(define-maybe string) + +(define (string-list? val) + (and (list? val) + (and-map (lambda (x) + (and (string? x) (not (string-index x #\,)))) + val))) +(define (serialize-string-list field-name val) + (serialize-field-list field-name (map enclose-quotes val))) +(define-maybe string-list) + +(define (module-list? val) + (string-list? val)) +(define (serialize-module-list field-name val) + (serialize-string-list field-name (cons "posix" val))) +(define-maybe module-list) + +(define (file-name? val) + (and (string? val) + (string-prefix? "/" val))) +(define (serialize-file-name field-name val) + (serialize-string field-name val)) +(define-maybe file-name) + +(define (file-name-list? val) + (and (list? val) (and-map file-name? val))) +(define (serialize-file-name-list field-name val) + (serialize-string-list field-name val)) +(define-maybe file-name) + +(define-configuration mod-muc-configuration + (name + (string "Prosody Chatrooms") + "The name to return in service discovery responses.") + + (restrict-room-creation + (string-or-boolean #f) + "If @samp{#t}, this will only allow admins to create new chatrooms. +Otherwise anyone can create a room. The value @samp{\"local\"} restricts room +creation to users on the service's parent domain. E.g. @samp{user@@example.com} +can create rooms on @samp{rooms.example.com}. The value @samp{\"admin\"} +restricts to service administrators only.") + + (max-history-messages + (non-negative-integer 20) + "Maximum number of history messages that will be sent to the member that has +just joined the room.")) +(define (serialize-mod-muc-configuration field-name val) + (serialize-configuration val mod-muc-configuration-fields)) +(define-maybe mod-muc-configuration) + +(define-configuration ssl-configuration + (protocol + (maybe-string 'disabled) + "This determines what handshake to use.") + + (key + (file-name "/etc/prosody/certs/key.pem") + "Path to your private key file, relative to @code{/etc/prosody}.") + + (certificate + (file-name "/etc/prosody/certs/cert.pem") + "Path to your certificate file, relative to @code{/etc/prosody}.") + + (capath + (file-name "/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) + "Path to a file containing root certificates that you wish Prosody to trust. +Similar to @code{capath} but with all certificates concatenated together.") + + (verify + (maybe-string-list 'disabled) + "A list of verification options (these mostly map to OpenSSL's +@code{set_verify()} flags).") + + (options + (maybe-string-list 'disabled) + "A list of general options relating to SSL/TLS. These map to OpenSSL's +@code{set_options()}. For a full list of options available in LuaSec, see the +LuaSec source.") + + (depth + (maybe-non-negative-integer 'disabled) + "How long a chain of certificate authorities to check when looking for a +trusted root certificate.") + + (ciphers + (maybe-string 'disabled) + "An OpenSSL cipher string. This selects what ciphers Prosody will offer to +clients, and in what order.") + + (dhparam + (maybe-file-name 'disabled) + "A path to a file containing parameters for Diffie-Hellman key exchange. You +can create such a file with: +@code{openssl dhparam -out /etc/prosody/certs/dh-2048.pem 2048}") + + (curve + (maybe-string 'disabled) + "Curve for Elliptic curve Diffie-Hellman. Prosody's default is +@samp{\"secp384r1\"}.") + + (verifyext + (maybe-string-list 'disabled) + "A list of \"extra\" verification options.") + + (password + (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")) +(define-maybe ssl-configuration) + +(define %default-modules-enabled + '("roster" + "saslauth" + "tls" + "dialback" + "disco" + "private" + "vcard" + "version" + "uptime" + "time" + "ping" + "pep" + "register" + "admin_adhoc")) + +;; Guile bug. Use begin wrapper, because otherwise virtualhost-configuration +;; is assumed to be a function. See +;; https://www.gnu.org/software/guile/manual/html_node/R6RS-Incompatibilities.html +(begin + (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)) + + (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)) + + (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)) + + (define-all-configurations prosody-configuration + (prosody + (package prosody) + "The Prosody package." + global) + + (data-path + (file-name "/var/lib/prosody") + "Location of the Prosody data storage directory. See +@url{http://prosody.im/doc/configure}." + global) + + (plugin-paths + (file-name-list '()) + "Additional plugin directories. They are searched in all the specified +paths in order. See @url{http://prosody.im/doc/plugins_directory}." + global) + + (admins + (string-list '()) + "This is a list of accounts that are admins for the server. Note that you +must create the accounts separately. See @url{http://prosody.im/doc/admins} and +@url{http://prosody.im/doc/creating_accounts}. +Example: @code{(admins '(\"user1@@example.com\" \"user2@@example.net\"))}" + common) + + (use-libevent? + (boolean #f) + "Enable use of libevent for better performance under high load. See +@url{http://prosody.im/doc/libevent}." + common) + + (modules-enabled + (module-list %default-modules-enabled) + "This is the list of modules Prosody will load on startup. It looks for +@code{mod_modulename.lua} in the plugins folder, so make sure that exists too. +Documentation on modules can be found at: @url{http://prosody.im/doc/modules}. +Defaults to @samp{%default-modules-enabled}." + common) + + (modules-disabled + (string-list '()) + "@samp{\"offline\"}, @samp{\"c2s\"} and @samp{\"s2s\"} are auto-loaded, but +should you want to disable them then add them to this list." + common) + + (groups-file + (file-name "/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{http://prosody.im/doc/modules/mod_groups}." + common) + + (allow-registration? + (boolean #f) + "Disable account creation by default, for security. See +@url{http://prosody.im/doc/creating_accounts}." + common) + + (ssl + (maybe-ssl-configuration (ssl-configuration)) + "These are the SSL/TLS-related settings. Most of them are disabled so to +use Prosody's defaults. If you do not completely understand these options, do +not add them to your config, it is easy to lower the security of your server +using them. See @url{http://prosody.im/doc/advanced_ssl_config}." + common) + + (c2s-require-encryption? + (boolean #f) + "Whether to force all client-to-server connections to be encrypted or not. +See @url{http://prosody.im/doc/modules/mod_tls}." + common) + + (s2s-require-encryption? + (boolean #f) + "Whether to force all server-to-server connections to be encrypted or not. +See @url{http://prosody.im/doc/modules/mod_tls}." + common) + + (s2s-secure-auth? + (boolean #f) + "Whether to require encryption and certificate authentication. This +provides ideal security, but requires servers you communicate with to support +encryption AND present valid, trusted certificates. See +@url{http://prosody.im/doc/s2s#security}." + common) + + (s2s-insecure-domains + (string-list '()) + "Many servers don't support encryption or have invalid or self-signed +certificates. You can list domains here that will not be required to +authenticate using certificates. They will be authenticated using DNS. See +@url{http://prosody.im/doc/s2s#security}." + common) + + (s2s-secure-domains + (string-list '()) + "Even if you leave @code{s2s-secure-auth?} disabled, you can still require +valid certificates for some domains by specifying a list here. See +@url{http://prosody.im/doc/s2s#security}." + common) + + (authentication + (string "internal_plain") + "Select the authentication backend to use. The default provider stores +passwords in plaintext and uses Prosody's configured data storage to store the +authentication data. If you do not trust your server please see +@url{http://prosody.im/doc/modules/mod_auth_internal_hashed} for information +about using the hashed backend. See also +@url{http://prosody.im/doc/authentication}" + common) + + ;; TODO: Handle more complicated log structures. + (log + (maybe-string "*syslog") + "Set logging options. Advanced logging configuration is not yet supported +by the GuixSD Prosody Service. See @url{http://prosody.im/doc/logging}." + common) + + (pidfile + (file-name "/var/run/prosody/prosody.pid") + "File to write pid in. See @url{http://prosody.im/doc/modules/mod_posix}." + global) + + (virtualhosts + (virtualhost-configuration-list + (list (virtualhost-configuration + (domain "localhost")))) + "A host in Prosody is a domain on which user accounts can be created. For +example if you want your users to have addresses like +@samp{\"john.smith@@example.com\"} then you need to add a host +@samp{\"example.com\"}. All options in this list will apply only to this host. + +Note: the name \"virtual\" host is used in configuration to avoid confusion with +the actual physical host that Prosody is installed on. A single Prosody +instance can serve many domains, each one defined as a VirtualHost entry in +Prosody's configuration. Conversely a server that hosts a single domain would +have just one VirtualHost entry. + +See @url{http://prosody.im/doc/configure#virtual_host_settings}." + global) + + (int-components + (int-component-configuration-list '()) + "Components are extra services on a server which are available to clients, +usually on a subdomain of the main server (such as +@samp{\"mycomponent.example.com\"}). Example components might be chatroom +servers, user directories, or gateways to other protocols. + +Internal components are implemented with Prosody-specific plugins. To add an +internal component, you simply fill the hostname field, and the plugin you wish +to use for the component. + +See @url{http://prosody.im/doc/components}." + global) + + (ext-components + (ext-component-configuration-list '()) + "External components use XEP-0114, which most standalone components +support. To add an external component, you simply fill the hostname field. See +@url{http://prosody.im/doc/components}." + global) + + (component-secret + (string (configuration-missing-field 'ext-component 'component-secret)) + "Password which the component will use to log in." + ext-component) + + (component-ports + (non-negative-integer-list '(5347)) + "Port(s) Prosody listens on for component connections." + global) + + (component-interface + (string "127.0.0.1") + "Interface Prosody listens on for component connections." + global) + + (domain + (string (configuration-missing-field 'virtualhost 'domain)) + "Domain you wish Prosody to serve." + virtualhost) + + (hostname + (string (configuration-missing-field 'int-component 'hostname)) + "Hostname of the component." + int-component) + + (plugin + (string (configuration-missing-field 'int-component 'plugin)) + "Plugin you wish to use for the component." + int-component) + + (mod-muc + (maybe-mod-muc-configuration 'disabled) + "Multi-user chat (MUC) is Prosody's module for allowing you to create +hosted chatrooms/conferences for XMPP users. + +General information on setting up and using multi-user chatrooms can be found +in the \"Chatrooms\" documentation (@url{http://prosody.im/doc/chatrooms}), +which you should read if you are new to XMPP chatrooms. + +See also @url{http://prosody.im/doc/modules/mod_muc}." + int-component) + + (hostname + (string (configuration-missing-field 'ext-component 'hostname)) + "Hostname of the component." + ext-component))) + +;; Serialize Virtualhost line first. +(define (serialize-virtualhost-configuration config) + (define (rest? field) + (not (memq (configuration-field-name field) + '(domain)))) + (let ((domain (virtualhost-configuration-domain config)) + (rest (filter rest? virtualhost-configuration-fields))) + (format #t "VirtualHost \"~a\"\n" domain) + (serialize-configuration config rest))) + +;; Serialize Component line first. +(define (serialize-int-component-configuration config) + (define (rest? field) + (not (memq (configuration-field-name field) + '(hostname plugin)))) + (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))) + +;; Serialize Component line first. +(define (serialize-ext-component-configuration config) + (define (rest? field) + (not (memq (configuration-field-name field) + '(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))) + +;; 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))) + +(define-configuration opaque-prosody-configuration + (prosody + (package prosody) + "The prosody package.") + + (prosody.cfg.lua + (string (configuration-missing-field 'opaque-prosody-configuration + 'prosody.cfg.lua)) + "The contents of the @code{prosody.cfg.lua} to use.")) + +(define (prosody-shepherd-service config) + "Return a for Prosody with CONFIG." + (let* ((prosody (if (opaque-prosody-configuration? config) + (opaque-prosody-configuration-prosody config) + (prosody-configuration-prosody config))) + (prosodyctl-bin (file-append prosody "/bin/prosodyctl")) + (prosodyctl-action (lambda args + #~(lambda _ + (zero? (system* #$prosodyctl-bin #$@args)))))) + (list (shepherd-service + (documentation "Run the Prosody XMPP server") + (provision '(prosody)) + (requirement '(networking syslogd user-processes)) + (start (prosodyctl-action "start")) + (stop (prosodyctl-action "stop")))))) + +(define %prosody-accounts + (list (user-group (name "prosody") (system? #t)) + (user-account + (name "prosody") + (group "prosody") + (system? #t) + (comment "Prosody daemon user") + (home-directory "/var/empty") + (shell (file-append shadow "/sbin/nologin"))))) + +(define (prosody-activation config) + "Return the activation gexp for CONFIG." + (let* ((config-dir "/etc/prosody") + (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))) + #~(begin + (define %user (getpw "prosody")) + + (mkdir-p #$config-dir) + (chown #$config-dir (passwd:uid %user) (passwd:gid %user)) + (copy-file #$config-file (string-append #$config-dir + "/prosody.cfg.lua")) + + (mkdir-p #$default-certs-dir) + (chown #$default-certs-dir (passwd:uid %user) (passwd:gid %user)) + (chmod #$default-certs-dir #o750) + + (mkdir-p #$data-path) + (chown #$data-path (passwd:uid %user) (passwd:gid %user)) + (chmod #$data-path #o750) + + (mkdir-p #$pidfile-dir) + (chown #$pidfile-dir (passwd:uid %user) (passwd:gid %user))))) + +(define prosody-service-type + (service-type (name 'prosody) + (extensions + (list (service-extension shepherd-root-service-type + prosody-shepherd-service) + (service-extension account-service-type + (const %prosody-accounts)) + (service-extension activation-service-type + prosody-activation))))) + +;; A little helper to make it easier to document all those fields. +(define (generate-documentation) + (define documentation + `((prosody-configuration + ,prosody-configuration-fields + (ssl ssl-configuration) + (virtualhosts virtualhost-configuration) + (int-components int-component-configuration) + (ext-components ext-component-configuration)) + (ssl-configuration ,ssl-configuration-fields) + (int-component-configuration ,int-component-configuration-fields + (mod-muc mod-muc-configuration)) + (ext-component-configuration ,ext-component-configuration-fields) + (mod-muc-configuration ,mod-muc-configuration-fields) + (virtualhost-configuration ,virtualhost-configuration-fields) + (opaque-prosody-configuration ,opaque-prosody-configuration-fields))) + (define (generate configuration-name) + (match (assq-ref documentation configuration-name) + ((fields . sub-documentation) + (format #t "\nAvailable @code{~a} fields are:\n\n" configuration-name) + (when (memq configuration-name + '(virtualhost-configuration + int-component-configuration + ext-component-configuration)) + (format #t "all these @code{prosody-configuration} fields: ~a, plus:\n" + (string-join (map (lambda (s) + (format #f "@code{~a}" s)) common-fields) + ", "))) + (for-each + (lambda (f) + (let ((field-name (configuration-field-name f)) + (field-type (configuration-field-type f)) + (field-docs (string-trim-both + (configuration-field-documentation f))) + (default (catch #t + (configuration-field-default-value-thunk f) + (lambda _ 'nope)))) + (define (escape-chars str chars escape) + (with-output-to-string + (lambda () + (string-for-each (lambda (c) + (when (char-set-contains? chars c) + (display escape)) + (display c)) + str)))) + (define (show-default? val) + (or (string? default) (number? default) (boolean? default) + (and (list? val) (and-map show-default? val)))) + (format #t "@deftypevr {@code{~a} parameter} ~a ~a\n~a\n" + configuration-name field-type field-name field-docs) + (when (show-default? default) + (format #t "Defaults to @samp{~a}.\n" + (escape-chars (format #f "~s" default) + (char-set #\@ #\{ #\}) + #\@))) + (for-each generate (or (assq-ref sub-documentation field-name) '())) + (format #t "@end deftypevr\n\n"))) + (filter (lambda (f) + (not (string=? "" (configuration-field-documentation f)))) + fields))))) + (generate 'prosody-configuration) + (format #t "It could be that you just want to get a @code{prosody.cfg.lua} +up and running. In that case, you can pass an +@code{opaque-prosody-configuration} record as the value of +@code{prosody-service-type}. As its name indicates, an opaque configuration +does not have easy reflective capabilities.") + (generate 'opaque-prosody-configuration) + (format #t "For example, if your @code{prosody.cfg.lua} is just the empty +string, you could instantiate a prosody service like this: + +@example +(service prosody-service-type + (opaque-prosody-configuration + (prosody.cfg.lua \"\"))) +@end example")) -- cgit v1.2.3 From 69323016d31547356c7322682943b22af4df74ed Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 11 Jan 2017 11:16:14 +0100 Subject: services: wicd: Create /var/run/wpa_supplicant. * gnu/services/networking.scm (%wicd-activation): Create /var/run/wpa_supplicant. --- gnu/services/networking.scm | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) (limited to 'gnu/services') diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm index d672ecf687..ac011f1286 100644 --- a/gnu/services/networking.scm +++ b/gnu/services/networking.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès +;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès ;;; Copyright © 2015 Mark H Weaver ;;; Copyright © 2016 Efraim Flashner ;;; Copyright © 2016 John Darrington @@ -633,7 +633,12 @@ configuration file." (let ((file-name "/etc/wicd/dhclient.conf.template.default")) (unless (file-exists? file-name) (copy-file (string-append #$wicd file-name) - file-name))))) + file-name))) + + ;; Wicd invokes 'wpa_supplicant', which needs this directory for its + ;; named socket files. + (mkdir-p "/var/run/wpa_supplicant") + (chmod "/var/run/wpa_supplicant" #o750))) (define (wicd-shepherd-service wicd) "Return a shepherd service for WICD." -- cgit v1.2.3 From 67cadaca4746f847fbbea5ef69f6cc65d1eb3acc Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Tue, 10 Jan 2017 07:24:01 +0000 Subject: services: Add 'redis-service-type'. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/services/database.scm (): New record type. (%redis-accounts, redis-service-type): New variables. (default-redis.conf, redis-activation, redis-shepherd-service): New procedures. * doc/guix.texi (Database Services): Document the new redis service. Signed-off-by: Ludovic Courtès --- doc/guix.texi | 24 ++++++++++++++ gnu/services/databases.scm | 81 +++++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 104 insertions(+), 1 deletion(-) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index 086895996f..c495e39f42 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -10331,6 +10331,30 @@ TCP port on which the database server listens for incoming connections. @end table @end deftp +@defvr {Scheme Variable} redis-service-type +This is the service type for the @uref{https://redis.io/, Redis} +key/value store, whose value is a @code{redis-configuration} object. +@end defvr + +@deftp {Data Type} redis-configuration +Data type representing the configuration of redis. + +@table @asis +@item @code{redis} (default: @code{redis}) +The Redis package to use. + +@item @code{bind} (default: @code{"127.0.0.1"}) +Network interface on which to listen. + +@item @code{port} (default: @code{6379}) +Port on which to accept connections on, a value of 0 will disable +listining on a TCP socket. + +@item @code{working-directory} (default: @code{"/var/lib/redis"}) +Directory in which to store the database and related files. +@end table +@end deftp + @node Mail Services @subsubsection Mail Services diff --git a/gnu/services/databases.scm b/gnu/services/databases.scm index d88c839f7d..3ecc8aff78 100644 --- a/gnu/services/databases.scm +++ b/gnu/services/databases.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2015 David Thompson ;;; Copyright © 2015, 2016 Ludovic Courtès ;;; Copyright © 2016 Leo Famulari +;;; Copyright © 2017 Christopher Baines ;;; ;;; This file is part of GNU Guix. ;;; @@ -35,7 +36,11 @@ mysql-service mysql-service-type mysql-configuration - mysql-configuration?)) + mysql-configuration? + + redis-configuration + redis-configuration? + redis-service-type)) ;;; Commentary: ;;; @@ -287,3 +292,77 @@ database server. The optional @var{config} argument specifies the configuration for @command{mysqld}, which should be a @code{} object." (service mysql-service-type config)) + + +;;; +;;; Redis +;;; + +(define-record-type* + redis-configuration make-redis-configuration + redis-configuration? + (redis redis-configuration-redis ; + (default redis)) + (bind redis-configuration-bind + (default "127.0.0.1")) + (port redis-configuration-port + (default 6379)) + (working-directory redis-configuration-working-directory + (default "/var/lib/redis")) + (config-file redis-configuration-config-file + (default #f))) + +(define (default-redis.conf bind port working-directory) + (mixed-text-file "redis.conf" + "bind " bind "\n" + "port " (number->string port) "\n" + "dir " working-directory "\n" + "daemonize no\n")) + +(define %redis-accounts + (list (user-group (name "redis") (system? #t)) + (user-account + (name "redis") + (group "redis") + (system? #t) + (comment "Redis server user") + (home-directory "/var/empty") + (shell (file-append shadow "/sbin/nologin"))))) + +(define redis-activation + (match-lambda + (($ redis bind port working-directory config-file) + #~(begin + (use-modules (guix build utils) + (ice-9 match)) + + (let ((user (getpwnam "redis"))) + (mkdir-p #$working-directory) + (chown #$working-directory (passwd:uid user) (passwd:gid user))))))) + +(define redis-shepherd-service + (match-lambda + (($ redis bind port working-directory config-file) + (let ((config-file + (or config-file + (default-redis.conf bind port working-directory)))) + (list (shepherd-service + (provision '(redis)) + (documentation "Run the Redis daemon.") + (requirement '(user-processes syslogd)) + (start #~(make-forkexec-constructor + '(#$(file-append redis "/bin/redis-server") + #$config-file) + #:user "redis" + #:group "redis")) + (stop #~(make-kill-destructor)))))))) + +(define redis-service-type + (service-type (name 'redis) + (extensions + (list (service-extension shepherd-root-service-type + redis-shepherd-service) + (service-extension activation-service-type + redis-activation) + (service-extension account-service-type + (const %redis-accounts)))))) -- cgit v1.2.3 From 2be1b4712d362fa9face12a731e75038ae9d59ba Mon Sep 17 00:00:00 2001 From: Julien Lepiller Date: Sat, 7 Jan 2017 20:16:00 +0100 Subject: gnu: Add openvpn service. * gnu/services/vpn.scm: New file. * gnu/local.mk (GNU_SYSTEM_MODULES): Add it. * doc/guix.texi (VPN Services): New section. --- doc/guix.texi | 360 +++++++++++++++++++++++++++++++++++++ gnu/local.mk | 1 + gnu/services/vpn.scm | 491 +++++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 852 insertions(+) create mode 100644 gnu/services/vpn.scm (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index fa07aba5ad..55657ec81c 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -208,6 +208,7 @@ Services * Messaging Services:: Messaging services. * Kerberos Services:: Kerberos services. * Web Services:: Web servers. +* VPN Services:: VPN daemons. * Network File System:: NFS related services. * Continuous Integration:: The Cuirass service. * Miscellaneous Services:: Other services. @@ -8120,6 +8121,7 @@ declaration. * Messaging Services:: Messaging services. * Kerberos Services:: Kerberos services. * Web Services:: Web servers. +* VPN Services:: VPN daemons. * Network File System:: NFS related services. * Continuous Integration:: The Cuirass service. * Miscellaneous Services:: Other services. @@ -12354,6 +12356,364 @@ Whether the server should add its configuration to response. @end table @end deftp +@node VPN Services +@subsubsection VPN Services +@cindex VPN (virtual private network) +@cindex virtual private network (VPN) + +The @code{(gnu services vpn)} module provides services related to +@dfn{virtual private networks} (VPNs). It provides a @emph{client} service for +your machine to connect to a VPN, and a @emph{servire} service for your machine +to host a VPN. Both services use @uref{https://openvpn.net/, OpenVPN}. + +@deffn {Scheme Procedure} openvpn-client-service @ + [#:config (openvpn-client-configuration)] + +Return a service that runs @command{openvpn}, a VPN daemon, as a client. +@end deffn + +@deffn {Scheme Procedure} openvpn-server-service @ + [#:config (openvpn-server-configuration)] + +Return a service that runs @command{openvpn}, a VPN daemon, as a server. + +Both can be run simultaneously. +@end deffn + +@c %automatically generated documentation + +Available @code{openvpn-client-configuration} fields are: + +@deftypevr @code{openvpn-client-configuration} parameter package openvpn +The OpenVPN package. + +@end deftypevr + +@deftypevr @code{openvpn-client-configuration} parameter string pid-file +The OpenVPN pid file. + +Defaults to @samp{"/var/run/openvpn/openvpn.pid"}. + +@end deftypevr + +@deftypevr @code{openvpn-client-configuration} parameter proto proto +The protocol (UDP or TCP) used to open a channel between clients and +servers. + +Defaults to @samp{udp}. + +@end deftypevr + +@deftypevr @code{openvpn-client-configuration} parameter dev dev +The device type used to represent the VPN connection. + +Defaults to @samp{tun}. + +@end deftypevr + +@deftypevr @code{openvpn-client-configuration} parameter string ca +The certificate authority to check connections against. + +Defaults to @samp{"/etc/openvpn/ca.crt"}. + +@end deftypevr + +@deftypevr @code{openvpn-client-configuration} parameter string cert +The certificate of the machine the daemon is running on. It should be +signed by the authority given in @code{ca}. + +Defaults to @samp{"/etc/openvpn/client.crt"}. + +@end deftypevr + +@deftypevr @code{openvpn-client-configuration} parameter string key +The key of the machine the daemon is running on. It must be the key whose +certificate is @code{cert}. + +Defaults to @samp{"/etc/openvpn/client.key"}. + +@end deftypevr + +@deftypevr @code{openvpn-client-configuration} parameter boolean comp-lzo? +Whether to use the lzo compression algorithm. + +Defaults to @samp{#t}. + +@end deftypevr + +@deftypevr @code{openvpn-client-configuration} parameter boolean persist-key? +Don't re-read key files across SIGUSR1 or --ping-restart. + +Defaults to @samp{#t}. + +@end deftypevr + +@deftypevr @code{openvpn-client-configuration} parameter boolean persist-tun? +Don't close and reopen TUN/TAP device or run up/down scripts across +SIGUSR1 or --ping-restart restarts. + +Defaults to @samp{#t}. + +@end deftypevr + +@deftypevr @code{openvpn-client-configuration} parameter number verbosity +Verbosity level. + +Defaults to @samp{3}. + +@end deftypevr + +@deftypevr @code{openvpn-client-configuration} parameter tls-auth-client tls-auth +Add an additional layer of HMAC authentication on top of the TLS control +channel to protect against DoS attacks. + +Defaults to @samp{#f}. + +@end deftypevr + +@deftypevr @code{openvpn-client-configuration} parameter key-usage verify-key-usage? +Whether to check the server certificate has server usage extension. + +Defaults to @samp{#t}. + +@end deftypevr + +@deftypevr @code{openvpn-client-configuration} parameter bind bind? +Bind to a specific local port number. + +Defaults to @samp{#f}. + +@end deftypevr + +@deftypevr @code{openvpn-client-configuration} parameter resolv-retry resolv-retry? +Retry resolving server address. + +Defaults to @samp{#t}. + +@end deftypevr + +@deftypevr @code{openvpn-client-configuration} parameter openvpn-remote-list remote +A list of remote servers to connect to. + +Defaults to @samp{()}. + +Available @code{openvpn-remote-configuration} fields are: + +@deftypevr @code{openvpn-remote-configuration} parameter string name +Server name. + +Defaults to @samp{"my-server"}. + +@end deftypevr + +@deftypevr @code{openvpn-remote-configuration} parameter number port +Port number the server listens to. + +Defaults to @samp{1194}. + +@end deftypevr + +@end deftypevr +@c %end of automatic openvpn-client documentation + +@c %automatically generated documentation + +Available @code{openvpn-server-configuration} fields are: + +@deftypevr @code{openvpn-server-configuration} parameter package openvpn +The OpenVPN package. + +@end deftypevr + +@deftypevr @code{openvpn-server-configuration} parameter string pid-file +The OpenVPN pid file. + +Defaults to @samp{"/var/run/openvpn/openvpn.pid"}. + +@end deftypevr + +@deftypevr @code{openvpn-server-configuration} parameter proto proto +The protocol (UDP or TCP) used to open a channel between clients and +servers. + +Defaults to @samp{udp}. + +@end deftypevr + +@deftypevr @code{openvpn-server-configuration} parameter dev dev +The device type used to represent the VPN connection. + +Defaults to @samp{tun}. + +@end deftypevr + +@deftypevr @code{openvpn-server-configuration} parameter string ca +The certificate authority to check connections against. + +Defaults to @samp{"/etc/openvpn/ca.crt"}. + +@end deftypevr + +@deftypevr @code{openvpn-server-configuration} parameter string cert +The certificate of the machine the daemon is running on. It should be +signed by the authority given in @code{ca}. + +Defaults to @samp{"/etc/openvpn/client.crt"}. + +@end deftypevr + +@deftypevr @code{openvpn-server-configuration} parameter string key +The key of the machine the daemon is running on. It must be the key whose +certificate is @code{cert}. + +Defaults to @samp{"/etc/openvpn/client.key"}. + +@end deftypevr + +@deftypevr @code{openvpn-server-configuration} parameter boolean comp-lzo? +Whether to use the lzo compression algorithm. + +Defaults to @samp{#t}. + +@end deftypevr + +@deftypevr @code{openvpn-server-configuration} parameter boolean persist-key? +Don't re-read key files across SIGUSR1 or --ping-restart. + +Defaults to @samp{#t}. + +@end deftypevr + +@deftypevr @code{openvpn-server-configuration} parameter boolean persist-tun? +Don't close and reopen TUN/TAP device or run up/down scripts across +SIGUSR1 or --ping-restart restarts. + +Defaults to @samp{#t}. + +@end deftypevr + +@deftypevr @code{openvpn-server-configuration} parameter number verbosity +Verbosity level. + +Defaults to @samp{3}. + +@end deftypevr + +@deftypevr @code{openvpn-server-configuration} parameter tls-auth-server tls-auth +Add an additional layer of HMAC authentication on top of the TLS control +channel to protect against DoS attacks. + +Defaults to @samp{#f}. + +@end deftypevr + +@deftypevr @code{openvpn-server-configuration} parameter number port +Specifies the port number on which the server listens. + +Defaults to @samp{1194}. + +@end deftypevr + +@deftypevr @code{openvpn-server-configuration} parameter ip-mask server +An ip and mask specifying the subnet inside the virtual network. + +Defaults to @samp{"10.8.0.0 255.255.255.0"}. + +@end deftypevr + +@deftypevr @code{openvpn-server-configuration} parameter cidr6 server-ipv6 +A CIDR notation specifying the IPv6 subnet inside the virtual network. + +Defaults to @samp{#f}. + +@end deftypevr + +@deftypevr @code{openvpn-server-configuration} parameter string dh +The Diffie-Hellman parameters file. + +Defaults to @samp{"/etc/openvpn/dh2048.pem"}. + +@end deftypevr + +@deftypevr @code{openvpn-server-configuration} parameter string ifconfig-pool-persist +The file that records client IPs. + +Defaults to @samp{"/etc/openvpn/ipp.txt"}. + +@end deftypevr + +@deftypevr @code{openvpn-server-configuration} parameter gateway redirect-gateway? +When true, the server will act as a gateway for its clients. + +Defaults to @samp{#f}. + +@end deftypevr + +@deftypevr @code{openvpn-server-configuration} parameter boolean client-to-client? +When true, clients are alowed to talk to each other inside the VPN. + +Defaults to @samp{#f}. + +@end deftypevr + +@deftypevr @code{openvpn-server-configuration} parameter keepalive keepalive +Causes ping-like messages to be sent back and forth over the link so +that each side knows when the other side has gone down. @code{keepalive} +requires a pair. The first element is the period of the ping sending, +and the second element is the timeout before considering the other side +down. + +@end deftypevr + +@deftypevr @code{openvpn-server-configuration} parameter number max-clients +The maximum number of clients. + +Defaults to @samp{100}. + +@end deftypevr + +@deftypevr @code{openvpn-server-configuration} parameter string status +The status file. This file shows a small report on current connection. +It is trunkated and rewritten every minute. + +Defaults to @samp{"/var/run/openvpn/status"}. + +@end deftypevr + +@deftypevr @code{openvpn-server-configuration} parameter openvpn-ccd-list client-config-dir +The list of configuration for some clients. + +Defaults to @samp{()}. + +Available @code{openvpn-ccd-configuration} fields are: + +@deftypevr @code{openvpn-ccd-configuration} parameter string name +Client name. + +Defaults to @samp{"client"}. + +@end deftypevr + +@deftypevr @code{openvpn-ccd-configuration} parameter ip-mask iroute +Client own network + +Defaults to @samp{#f}. + +@end deftypevr + +@deftypevr @code{openvpn-ccd-configuration} parameter ip-mask ifconfig-push +Client VPN IP. + +Defaults to @samp{#f}. + +@end deftypevr + +@end deftypevr + + +@c %end of automatic openvpn-server documentation + + @node Network File System @subsubsection Network File System @cindex NFS diff --git a/gnu/local.mk b/gnu/local.mk index d378872372..81d774eb6a 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -424,6 +424,7 @@ GNU_SYSTEM_MODULES = \ %D%/services/spice.scm \ %D%/services/ssh.scm \ %D%/services/version-control.scm \ + %D%/services/vpn.scm \ %D%/services/web.scm \ %D%/services/xorg.scm \ \ diff --git a/gnu/services/vpn.scm b/gnu/services/vpn.scm new file mode 100644 index 0000000000..c21995453e --- /dev/null +++ b/gnu/services/vpn.scm @@ -0,0 +1,491 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2017 Julien Lepiller +;;; +;;; 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 . + +(define-module (gnu services vpn) + #:use-module (gnu services) + #:use-module (gnu services configuration) + #:use-module (gnu services shepherd) + #:use-module (gnu system shadow) + #:use-module (gnu packages admin) + #:use-module (gnu packages vpn) + #:use-module (guix packages) + #:use-module (guix records) + #:use-module (guix gexp) + #:use-module (srfi srfi-1) + #:use-module (ice-9 match) + #:use-module (ice-9 regex) + #:export (openvpn-client-service + openvpn-server-service + openvpn-client-service-type + openvpn-server-service-type + openvpn-client-configuration + openvpn-server-configuration + openvpn-remote-configuration + openvpn-ccd-configuration + generate-openvpn-client-documentation + generate-openvpn-server-documentation)) + +;;; +;;; OpenVPN. +;;; + +(define (uglify-field-name name) + (match name + ('verbosity "verb") + (_ (let ((str (symbol->string name))) + (if (string-suffix? "?" str) + (substring str 0 (1- (string-length str))) + str))))) + +(define (serialize-field field-name val) + (if (eq? field-name 'pid-file) + (format #t "") + (format #t "~a ~a\n" (uglify-field-name field-name) val))) +(define serialize-string serialize-field) +(define (serialize-boolean field-name val) + (if val + (serialize-field field-name val) + (format #t ""))) + +(define (ip-mask? val) + (and (string? val) + (if (string-match "^([0-9]+\\.){3}[0-9]+ ([0-9]+\\.){3}[0-9]+$" val) + (let ((numbers (string-tokenize val char-set:digit))) + (all-lte numbers (list 255 255 255 255 255 255 255 255))) + #f))) +(define serialize-ip-mask serialize-string) + +(define-syntax define-enumerated-field-type + (lambda (x) + (define (id-append ctx . parts) + (datum->syntax ctx (apply symbol-append (map syntax->datum parts)))) + (syntax-case x () + ((_ name (option ...)) + #`(begin + (define (#,(id-append #'name #'name #'?) x) + (memq x '(option ...))) + (define (#,(id-append #'name #'serialize- #'name) field-name val) + (serialize-field field-name val))))))) + +(define-enumerated-field-type proto + (udp tcp udp6 tcp6)) +(define-enumerated-field-type dev + (tun tap)) + +(define key-usage? boolean?) +(define (serialize-key-usage field-name value) + (if value + (format #t "remote-cert-tls server\n") + #f)) + +(define bind? boolean?) +(define (serialize-bind field-name value) + (if value + #f + (format #t "nobind\n"))) + +(define resolv-retry? boolean?) +(define (serialize-resolv-retry field-name value) + (if value + (format #t "resolv-retry infinite\n") + #f)) + +(define (serialize-tls-auth role location) + (serialize-field 'tls-auth + (string-append location " " (match role + ('server "0") + ('client "1"))))) +(define (tls-auth? val) + (or (eq? val #f) + (string? val))) +(define (serialize-tls-auth-server field-name val) + (serialize-tls-auth 'server val)) +(define (serialize-tls-auth-client field-name val) + (serialize-tls-auth 'client val)) +(define tls-auth-server? tls-auth?) +(define tls-auth-client? tls-auth?) + +(define (serialize-number field-name val) + (serialize-field field-name (number->string val))) + +(define (all-lte left right) + (if (eq? left '()) + (eq? right '()) + (and (<= (string->number (car left)) (car right)) + (all-lte (cdr left) (cdr right))))) + +(define (cidr4? val) + (if (string? val) + (if (string-match "^([0-9]+\\.){3}[0-9]+/[0-9]+$" val) + (let ((numbers (string-tokenize val char-set:digit))) + (all-lte numbers (list 255 255 255 255 32))) + #f) + (eq? val #f))) + +(define (cidr6? val) + (if (string? val) + (string-match "^([0-9a-f]{0,4}:){0,8}/[0-9]{1,3}$" val) + (eq? val #f))) + +(define (serialize-cidr4 field-name val) + (if (eq? val #f) #f (serialize-field field-name val))) + +(define (serialize-cidr6 field-name val) + (if (eq? val #f) #f (serialize-field field-name val))) + +(define (ip? val) + (if (string? val) + (if (string-match "^([0-9]+\\.){3}[0-9]+$" val) + (let ((numbers (string-tokenize val char-set:digit))) + (all-lte numbers (list 255 255 255 255))) + #f) + (eq? val #f))) +(define (serialize-ip field-name val) + (if (eq? val #f) #f (serialize-field field-name val))) + +(define (keepalive? val) + (and (list? val) + (and (number? (car val)) + (number? (car (cdr val)))))) +(define (serialize-keepalive field-name val) + (format #t "~a ~a ~a\n" (uglify-field-name field-name) + (number->string (car val)) (number->string (car (cdr val))))) + +(define gateway? boolean?) +(define (serialize-gateway field-name val) + (and val + (format #t "push \"redirect-gateway\"\n"))) + + +(define-configuration openvpn-remote-configuration + (name + (string "my-server") + "Server name.") + (port + (number 1194) + "Port number the server listens to.")) + +(define-configuration openvpn-ccd-configuration + (name + (string "client") + "Client name.") + (iroute + (ip-mask #f) + "Client own network") + (ifconfig-push + (ip-mask #f) + "Client VPN IP.")) + +(define (openvpn-remote-list? val) + (and (list? val) + (or (eq? val '()) + (and (openvpn-remote-configuration? (car val)) + (openvpn-remote-list? (cdr val)))))) +(define (serialize-openvpn-remote-list field-name val) + (for-each (lambda (remote) + (format #t "remote ~a ~a\n" (openvpn-remote-configuration-name remote) + (number->string (openvpn-remote-configuration-port remote)))) + val)) + +(define (openvpn-ccd-list? val) + (and (list? val) + (or (eq? val '()) + (and (openvpn-ccd-configuration? (car val)) + (openvpn-ccd-list? (cdr val)))))) +(define (serialize-openvpn-ccd-list field-name val) + #f) + +(define (create-ccd-directory val) + "Create a ccd directory containing files for the ccd configuration option +of OpenVPN. Each file in this directory represents particular settings for a +client. Each file is named after the name of the client." + (let ((files (map (lambda (ccd) + (list (openvpn-ccd-configuration-name ccd) + (with-output-to-string + (lambda () + (serialize-configuration + ccd openvpn-ccd-configuration-fields))))) + val))) + (computed-file "ccd" + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils)) + (use-modules (ice-9 match)) + (mkdir-p #$output) + (for-each + (lambda (ccd) + (match ccd + ((name config-string) + (call-with-output-file + (string-append #$output "/" name) + (lambda (port) (display config-string port)))))) + '#$files)))))) + +(define-syntax define-split-configuration + (lambda (x) + (syntax-case x () + ((_ name1 name2 (common-option ...) (first-option ...) (second-option ...)) + #`(begin + (define-configuration #,#'name1 + common-option ... + first-option ...) + (define-configuration #,#'name2 + common-option ... + second-option ...)))))) + +(define-split-configuration openvpn-client-configuration + openvpn-server-configuration + ((openvpn + (package openvpn) + "The OpenVPN package.") + + (pid-file + (string "/var/run/openvpn/openvpn.pid") + "The OpenVPN pid file.") + + (proto + (proto 'udp) + "The protocol (UDP or TCP) used to open a channel between clients and +servers.") + + (dev + (dev 'tun) + "The device type used to represent the VPN connection.") + + (ca + (string "/etc/openvpn/ca.crt") + "The certificate authority to check connections against.") + + (cert + (string "/etc/openvpn/client.crt") + "The certificate of the machine the daemon is running on. It should be signed +by the authority given in @code{ca}.") + + (key + (string "/etc/openvpn/client.key") + "The key of the machine the daemon is running on. It must be the whose +certificate is @code{cert}.") + + (comp-lzo? + (boolean #t) + "Whether to use the lzo compression algorithm.") + + (persist-key? + (boolean #t) + "Don't re-read key files across SIGUSR1 or --ping-restart.") + + (persist-tun? + (boolean #t) + "Don't close and reopen TUN/TAP device or run up/down scripts across +SIGUSR1 or --ping-restart restarts.") + + (verbosity + (number 3) + "Verbosity level.")) + ;; client-specific configuration + ((tls-auth + (tls-auth-client #f) + "Add an additional layer of HMAC authentication on top of the TLS control +channel to protect against DoS attacks.") + + (verify-key-usage? + (key-usage #t) + "Whether to check the server certificate has server usage extension.") + + (bind? + (bind #f) + "Bind to a specific local port number.") + + (resolv-retry? + (resolv-retry #t) + "Retry resolving server address.") + + (remote + (openvpn-remote-list '()) + "A list of remote servers to connect to.")) + ;; server-specific configuration + ((tls-auth + (tls-auth-server #f) + "Add an additional layer of HMAC authentication on top of the TLS control +channel to protect against DoS attacks.") + + (port + (number 1194) + "Specifies the port number on which the server listens.") + + (server + (ip-mask "10.8.0.0 255.255.255.0") + "An ip and mask specifying the subnet inside the virtual network.") + + (server-ipv6 + (cidr6 #f) + "A CIDR notation specifying the IPv6 subnet inside the virtual network.") + + (dh + (string "/etc/openvpn/dh2048.pem") + "The Diffie-Hellman parameters file.") + + (ifconfig-pool-persist + (string "/etc/openvpn/ipp.txt") + "The file that records client IPs.") + + (redirect-gateway? + (gateway #f) + "When true, the server will act as a gateway for its clients.") + + (client-to-client? + (boolean #f) + "When true, clients are alowed to talk to each other inside the VPN.") + + (keepalive + (keepalive '(10 120)) + "Causes ping-like messages to be sent back and forth over the link so that +each side knows when the other side has gone down. @code{keepalive} requires +a pair. The first element is the period of the ping sending, and the second +element is the timeout before considering the other side down.") + + (max-clients + (number 100) + "The maximum number of clients.") + + (status + (string "/var/run/openvpn/status") + "The status file. This file shows a small report on current connection. It +is trunkated and rewritten every minute.") + + (client-config-dir + (openvpn-ccd-list '()) + "The list of configuration for some clients."))) + +(define (openvpn-config-file role config) + (let ((config-str + (with-output-to-string + (lambda () + (serialize-configuration config + (match role + ('server + openvpn-server-configuration-fields) + ('client + openvpn-client-configuration-fields)))))) + (ccd-dir (match role + ('server (create-ccd-directory + (openvpn-server-configuration-client-config-dir + config))) + ('client #f)))) + (computed-file "openvpn.conf" + #~(begin + (use-modules (ice-9 match)) + (call-with-output-file #$output + (lambda (port) + (match '#$role + ('server (display "" port)) + ('client (display "client\n" port))) + (display #$config-str port) + (match '#$role + ('server (display + (string-append "client-config-dir " + #$ccd-dir "\n") port)) + ('client (display "" port))))))))) + +(define (openvpn-shepherd-service role) + (lambda (config) + (let* ((config-file (openvpn-config-file role config)) + (pid-file ((match role + ('server openvpn-server-configuration-pid-file) + ('client openvpn-client-configuration-pid-file)) + config)) + (openvpn ((match role + ('server openvpn-server-configuration-openvpn) + ('client openvpn-client-configuration-openvpn)) + config)) + (log-file (match role + ('server "/var/log/openvpn-server.log") + ('client "/var/log/openvpn-client.log")))) + (list (shepherd-service + (documentation (string-append "Run the OpenVPN " + (match role + ('server "server") + ('client "client")) + " daemon.")) + (provision (match role + ('server '(vpn-server)) + ('client '(vpn-client)))) + (requirement '(networking)) + (start #~(make-forkexec-constructor + (list (string-append #$openvpn "/sbin/openvpn") + "--writepid" #$pid-file "--config" #$config-file + "--daemon") + #:pid-file #$pid-file)) + (stop #~(make-kill-destructor))))))) + +(define %openvpn-accounts + (list (user-group (name "openvpn") (system? #t)) + (user-account + (name "openvpn") + (group "openvpn") + (system? #t) + (comment "Openvpn daemon user") + (home-directory "/var/empty") + (shell (file-append shadow "/sbin/nologin"))))) + +(define %openvpn-activation + #~(mkdir-p "/var/run/openvpn")) + +(define openvpn-server-service-type + (service-type (name 'openvpn-server) + (extensions + (list (service-extension shepherd-root-service-type + (openvpn-shepherd-service 'server)) + (service-extension account-service-type + (const %openvpn-accounts)) + (service-extension activation-service-type + (const %openvpn-activation)))))) + +(define openvpn-client-service-type + (service-type (name 'openvpn-client) + (extensions + (list (service-extension shepherd-root-service-type + (openvpn-shepherd-service 'client)) + (service-extension account-service-type + (const %openvpn-accounts)) + (service-extension activation-service-type + (const %openvpn-activation)))))) + +(define* (openvpn-client-service #:key (config (openvpn-client-configuration))) + (validate-configuration config openvpn-client-configuration-fields) + (service openvpn-client-service-type config)) + +(define* (openvpn-server-service #:key (config (openvpn-server-configuration))) + (validate-configuration config openvpn-server-configuration-fields) + (service openvpn-server-service-type config)) + +(define (generate-openvpn-server-documentation) + (generate-documentation + `((openvpn-server-configuration + ,openvpn-server-configuration-fields + (ccd openvpn-ccd-configuration)) + (openvpn-ccd-configuration ,openvpn-ccd-configuration-fields)) + 'openvpn-server-configuration)) + +(define (generate-openvpn-client-documentation) + (generate-documentation + `((openvpn-client-configuration + ,openvpn-client-configuration-fields + (remote openvpn-remote-configuration)) + (openvpn-remote-configuration ,openvpn-remote-configuration-fields)) + 'openvpn-client-configuration)) -- cgit v1.2.3 From cb341293fa22cdbc4ffb869b9b2a94a0d8c8798b Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Wed, 18 Jan 2017 08:08:06 +0000 Subject: services: nginx: Add support the 'upstream' module. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/services/web.scm (): New record type. (): Add new field upstream-blocks. (nginx-upstream): New function. (default-nginx-config): Add upstream-list parameter. (nginx-service): Add optional upstream list keyword argument. * doc/guix.texi (Web Services): Document the new nginx-upstream-configuration data type and changes to the nginx function. Signed-off-by: Ludovic Courtès --- doc/guix.texi | 26 ++++++++++++++++++++++++-- gnu/services/web.scm | 42 ++++++++++++++++++++++++++++++++++-------- 2 files changed, 58 insertions(+), 10 deletions(-) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index 2687716c6c..256e6f55cf 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -12323,6 +12323,7 @@ The @code{(gnu services web)} module provides the following service: [#:log-directory ``/var/log/nginx''] @ [#:run-directory ``/var/run/nginx''] @ [#:server-list '()] @ + [#:upstream-list '()] @ [#:config-file @code{#f}] Return a service that runs @var{nginx}, the nginx web server. @@ -12334,8 +12335,10 @@ arguments should match what is in @var{config-file} to ensure that the directories are created when the service is activated. As an alternative to using a @var{config-file}, @var{server-list} can be -used to specify the list of @dfn{server blocks} required on the host. For -this to work, use the default value for @var{config-file}. +used to specify the list of @dfn{server blocks} required on the host and +@var{upstream-list} can be used to specify a list of @dfn{upstream +blocks} to configure. For this to work, use the default value for +@var{config-file}. @end deffn @@ -12753,6 +12756,25 @@ Defaults to @samp{#f}. @c %end of automatic openvpn-server documentation +@deftp {Data Type} nginx-upstream-configuration +Data type representing the configuration of an nginx @code{upstream} +block. This type has the following parameters: + +@table @asis +@item @code{name} +Name for this group of servers. + +@item @code{servers} +Specify the addresses of the servers in the group. The address can be +specified as a IP address (e.g. @samp{127.0.0.1}), domain name +(e.g. @samp{backend1.example.com}) or a path to a UNIX socket using the +prefix @samp{unix:}. For addresses using an IP address or domain name, +the default port is 80, and a different port can be specified +explicitly. + +@end table +@end deftp + @node Network File System @subsubsection Network File System @cindex NFS diff --git a/gnu/services/web.scm b/gnu/services/web.scm index db895405a2..1477bf88d6 100644 --- a/gnu/services/web.scm +++ b/gnu/services/web.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2015, 2016 Ludovic Courtès ;;; Copyright © 2016 ng0 ;;; Copyright © 2016 Julien Lepiller +;;; Copyright © 2017 Christopher Baines ;;; ;;; This file is part of GNU Guix. ;;; @@ -33,6 +34,8 @@ nginx-configuration? nginx-server-configuration nginx-server-configuration? + nginx-upstream-configuration + nginx-upstream-configuration? nginx-service nginx-service-type)) @@ -62,6 +65,12 @@ (server-tokens? nginx-server-configuration-server-tokens? (default #f))) +(define-record-type* + nginx-upstream-configuration make-nginx-upstream-configuration + nginx-upstream-configuration? + (name nginx-upstream-configuration-name) + (servers nginx-upstream-configuration-servers)) + (define-record-type* nginx-configuration make-nginx-configuration nginx-configuration? @@ -69,6 +78,7 @@ (log-directory nginx-configuration-log-directory) ;string (run-directory nginx-configuration-run-directory) ;string (server-blocks nginx-configuration-server-blocks) ;list + (upstream-blocks nginx-configuration-upstream-blocks) ;list (file nginx-configuration-file)) ;string | file-like (define (config-domain-strings names) @@ -116,11 +126,19 @@ of index files." " index " (config-index-strings (nginx-server-configuration-index server)) ";\n" " server_tokens " (if (nginx-server-configuration-server-tokens? server) "on" "off") ";\n" + " }\n")) + +(define (nginx-upstream-config upstream) + (string-append + " upstream " (nginx-upstream-configuration-name upstream) " {\n" + (string-concatenate + (map (lambda (server) + (simple-format #f " server ~A;\n" server)) + (nginx-upstream-configuration-servers upstream))) " }\n")) -(define (default-nginx-config log-directory run-directory server-list) - (plain-file "nginx.conf" - (string-append +(define (default-nginx-config log-directory run-directory server-list upstream-list) + (mixed-text-file "nginx.conf" "user nginx nginx;\n" "pid " run-directory "/pid;\n" "error_log " log-directory "/error.log info;\n" @@ -131,12 +149,18 @@ of index files." " uwsgi_temp_path " run-directory "/uwsgi_temp;\n" " scgi_temp_path " run-directory "/scgi_temp;\n" " access_log " log-directory "/access.log;\n" + "\n" + (string-join + (filter (lambda (section) (not (null? section))) + (map nginx-upstream-config upstream-list)) + "\n") + "\n" (let ((http (map default-nginx-server-config server-list))) (do ((http http (cdr http)) (block "" (string-append (car http) "\n" block ))) ((null? http) block))) "}\n" - "events {}\n"))) + "events {}\n")) (define %nginx-accounts (list (user-group (name "nginx") (system? #t)) @@ -151,7 +175,7 @@ of index files." (define nginx-activation (match-lambda (($ nginx log-directory run-directory server-blocks - config-file) + upstream-blocks config-file) #~(begin (use-modules (guix build utils)) @@ -169,13 +193,13 @@ of index files." (system* (string-append #$nginx "/sbin/nginx") "-c" #$(or config-file (default-nginx-config log-directory - run-directory server-blocks)) + run-directory server-blocks upstream-blocks)) "-t"))))) (define nginx-shepherd-service (match-lambda (($ nginx log-directory run-directory server-blocks - config-file) + upstream-blocks config-file) (let* ((nginx-binary (file-append nginx "/sbin/nginx")) (nginx-action (lambda args @@ -184,7 +208,7 @@ of index files." (system* #$nginx-binary "-c" #$(or config-file (default-nginx-config log-directory - run-directory server-blocks)) + run-directory server-blocks upstream-blocks)) #$@args)))))) ;; TODO: Add 'reload' action. @@ -216,6 +240,7 @@ of index files." (log-directory "/var/log/nginx") (run-directory "/var/run/nginx") (server-list '()) + (upstream-list '()) (config-file #f)) "Return a service that runs NGINX, the nginx web server. @@ -227,4 +252,5 @@ files in LOG-DIRECTORY, and stores temporary runtime files in RUN-DIRECTORY." (log-directory log-directory) (run-directory run-directory) (server-blocks server-list) + (upstream-blocks upstream-list) (file config-file)))) -- cgit v1.2.3 From 9c557a69aebe49bba12009a01cfaabf88ec3f665 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Wed, 18 Jan 2017 08:08:07 +0000 Subject: services: nginx: Add support for 'location' blocks. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/services/web.scm (): Add field 'locations'. (): New record type. (): New record type. (nginx-location-config): New function. (default-nginx-server-config): Include locations. * doc/guix.texi (Web Services): Document the new nginx-location-configuration and nginx-named-location-configuration data types, as well as the changes to the nginx-server-configuration. Signed-off-by: Ludovic Courtès --- doc/guix.texi | 43 +++++++++++++++++++++++++++++++++++++++++++ gnu/services/web.scm | 39 ++++++++++++++++++++++++++++++++++++++- 2 files changed, 81 insertions(+), 1 deletion(-) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index 256e6f55cf..7cd9cd046a 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -12380,6 +12380,11 @@ default server for connections matching no other server. @item @code{root} (default: @code{"/srv/http"}) Root of the website nginx will serve. +@item @code{locations} (default: @code{'()}) +A list of @dfn{nginx-location-configuration} or +@dfn{nginx-named-location-configuration} records to use within this +server block. + @item @code{index} (default: @code{(list "index.html")}) Index files to look for when clients ask for a directory. If it cannot be found, Nginx will send the list of files in the directory. @@ -12775,6 +12780,44 @@ explicitly. @end table @end deftp +@deftp {Data Type} nginx-location-configuration +Data type representing the configuration of an nginx @code{location} +block. This type has the following parameters: + +@table @asis +@item @code{uri} +URI which this location block matches. + +@anchor{nginx-location-configuration body} +@item @code{body} +Body of the location block, specified as a string. This can contain many +configuration directives. For example, to pass requests to a upstream +server group defined using an @code{nginx-upstream-configuration} block, +the following directive would be specified in the body @samp{proxy_pass +http://upstream-name;}. + +@end table +@end deftp + +@deftp {Data Type} nginx-named-location-configuration +Data type representing the configuration of an nginx named location +block. Named location blocks are used for request redirection, and not +used for regular request processing. This type has the following +parameters: + +@table @asis +@item @code{name} +Name to identify this location block. + +@item @code{body} +@xref{nginx-location-configuration body}, as the body for named location +blocks can be used in a similar way to the +@code{nginx-location-configuration body}. One restriction is that the +body of a named location block cannot contain location blocks. + +@end table +@end deftp + @node Network File System @subsubsection Network File System @cindex NFS diff --git a/gnu/services/web.scm b/gnu/services/web.scm index 1477bf88d6..ec308976d7 100644 --- a/gnu/services/web.scm +++ b/gnu/services/web.scm @@ -36,6 +36,10 @@ nginx-server-configuration? nginx-upstream-configuration nginx-upstream-configuration? + nginx-location-configuration + nginx-location-configuration? + nginx-named-location-configuration + nginx-named-location-configuration? nginx-service nginx-service-type)) @@ -56,6 +60,8 @@ (default (list 'default))) (root nginx-server-configuration-root (default "/srv/http")) + (locations nginx-server-configuration-locations + (default '())) (index nginx-server-configuration-index (default (list "index.html"))) (ssl-certificate nginx-server-configuration-ssl-certificate @@ -71,6 +77,20 @@ (name nginx-upstream-configuration-name) (servers nginx-upstream-configuration-servers)) +(define-record-type* + nginx-location-configuration make-nginx-location-configuration + nginx-location-configuration? + (uri nginx-location-configuration-uri + (default #f)) + (body nginx-location-configuration-body)) + +(define-record-type* + nginx-named-location-configuration make-nginx-named-location-configuration + nginx-named-location-configuration? + (name nginx-named-location-configuration-name + (default #f)) + (body nginx-named-location-configuration-body)) + (define-record-type* nginx-configuration make-nginx-configuration nginx-configuration? @@ -98,6 +118,19 @@ of index files." ((? string? str) (string-append str " "))) names))) +(define nginx-location-config + (match-lambda + (($ uri body) + (string-append + " location " uri " {\n" + " " (string-join body "\n ") "\n" + " }\n")) + (($ name body) + (string-append + " location @" name " {\n" + " " (string-join body "\n ") "\n" + " }\n")))) + (define (default-nginx-server-config server) (string-append " server {\n" @@ -126,7 +159,11 @@ of index files." " index " (config-index-strings (nginx-server-configuration-index server)) ";\n" " server_tokens " (if (nginx-server-configuration-server-tokens? server) "on" "off") ";\n" - " }\n")) + "\n" + (string-join + (map nginx-location-config (nginx-server-configuration-locations server)) + "\n") + " }\n")) (define (nginx-upstream-config upstream) (string-append -- cgit v1.2.3 From dc72a7f7f7bddb9c7ed377a8e16179a7a8a37af5 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 19 Jan 2017 14:40:04 +0100 Subject: services: nginx: Add default values for fields. * gnu/services/web.scm ()[nginx, log-directory] [run-directory, server-blocks, upstream-blocks, file]: Add default values. --- gnu/services/web.scm | 20 +++++++++++++------- 1 file changed, 13 insertions(+), 7 deletions(-) (limited to 'gnu/services') diff --git a/gnu/services/web.scm b/gnu/services/web.scm index ec308976d7..11408d7b0e 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 -;;; Copyright © 2015, 2016 Ludovic Courtès +;;; Copyright © 2015, 2016, 2017 Ludovic Courtès ;;; Copyright © 2016 ng0 ;;; Copyright © 2016 Julien Lepiller ;;; Copyright © 2017 Christopher Baines @@ -94,12 +94,18 @@ (define-record-type* nginx-configuration make-nginx-configuration nginx-configuration? - (nginx nginx-configuration-nginx) ; - (log-directory nginx-configuration-log-directory) ;string - (run-directory nginx-configuration-run-directory) ;string - (server-blocks nginx-configuration-server-blocks) ;list - (upstream-blocks nginx-configuration-upstream-blocks) ;list - (file nginx-configuration-file)) ;string | file-like + (nginx nginx-configuration-nginx ; + (default nginx)) + (log-directory nginx-configuration-log-directory ;string + (default "/var/log/nginx")) + (run-directory nginx-configuration-run-directory ;string + (default "/var/run/nginx")) + (server-blocks nginx-configuration-server-blocks + (default '())) ;list of + (upstream-blocks nginx-configuration-upstream-blocks + (default '())) ;list of + (file nginx-configuration-file ;#f | string | file-like + (default #f))) (define (config-domain-strings names) "Return a string denoting the nginx config representation of NAMES, a list -- cgit v1.2.3 From b726096bc5fcef1b96554c679b81a34d49265f9c Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Fri, 20 Jan 2017 21:43:53 +0800 Subject: services: network-manager: Use record for configuration. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/services/network-manager.scm (): New record type. (network-manager-shpeherd-service): Change to use the network-manager-configuration record, rather than a package. Generate a simple configuration file from the network-manager-configuration record. (network-manager-service-type): Update extensions to take the network-manager-configuration rather than a package. (network-manager-service): Remove function, the network-manager-service-type can be used instead, and this avoids keeping the function signature and value coresponding to the service type in sync. * doc/guix.texi (Networking Services): Remove documentation for the removed network-manager-service procedure, and add documentation of the network-manager-service-type variable and network-manager-configuration record. Signed-off-by: 宋文武 --- doc/guix.texi | 40 ++++++++++++++++++++--- gnu/services/networking.scm | 77 +++++++++++++++++++++++++++++---------------- 2 files changed, 85 insertions(+), 32 deletions(-) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index 7cd9cd046a..1f0bd7568d 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -8758,11 +8758,41 @@ and @command{wicd-curses} user interfaces. @end deffn @cindex NetworkManager -@deffn {Scheme Procedure} network-manager-service @ - [#:network-manager @var{network-manager}] -Return a service that runs NetworkManager, a network connection manager -attempting to keep network connectivity active when available. -@end deffn + +@defvr {Scheme Variable} network-manager-service-type +This is the service type for the +@uref{https://wiki.gnome.org/Projects/NetworkManager, NetworkManager} +service. The value for this service type is a +@code{network-manager-configuration} record. +@end defvr + +@deftp {Data Type} network-manager-configuration +Data type representing the configuration of NetworkManager. + +@table @asis +@item @code{network-manager} (default: @code{network-manager}) +The NetworkManager package to use. + +@item @code{dns} (default: @code{"default"}) +Processing mode for DNS, which affects how NetworkManager uses the +@code{resolv.conf} configuration file. + +@table @samp +@item default +NetworkManager will update @code{resolv.conf} to reflect the nameservers +provided by currently active connections. + +@item dnsmasq +NetworkManager will run @code{dnsmasq} as a local caching nameserver, +using a "split DNS" configuration if you are connected to a VPN, and +then update @code{resolv.conf} to point to the local nameserver. + +@item none +NetworkManager will not modify @code{resolv.conf}. +@end table + +@end table +@end deftp @cindex Connman @deffn {Scheme Procedure} connman-service @ diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm index ac011f1286..8f136f0dc1 100644 --- a/gnu/services/networking.scm +++ b/gnu/services/networking.scm @@ -64,7 +64,12 @@ wicd-service-type wicd-service - network-manager-service + + network-manager-configuration + network-manager-configuration? + network-manager-configuration-dns + network-manager-service-type + connman-service wpa-supplicant-service-type)) @@ -679,40 +684,58 @@ and @command{wicd-curses} user interfaces." ;;; NetworkManager ;;; +(define-record-type* + network-manager-configuration make-network-manager-configuration + network-manager-configuration? + (network-manager network-manager-configuration-network-manager + (default network-manager)) + (dns network-manager-configuration-dns + (default "default"))) + (define %network-manager-activation ;; Activation gexp for NetworkManager. #~(begin (use-modules (guix build utils)) (mkdir-p "/etc/NetworkManager/system-connections"))) -(define (network-manager-shepherd-service network-manager) - "Return a shepherd service for NETWORK-MANAGER." - (list (shepherd-service - (documentation "Run the NetworkManager.") - (provision '(networking)) - (requirement '(user-processes dbus-system wpa-supplicant loopback)) - (start #~(make-forkexec-constructor - (list (string-append #$network-manager - "/sbin/NetworkManager") - "--no-daemon"))) - (stop #~(make-kill-destructor))))) +(define network-manager-shepherd-service + (match-lambda + (($ network-manager dns) + (let + ((conf (plain-file "NetworkManager.conf" + (string-append " +[main] +dns=" dns " +")))) + (list (shepherd-service + (documentation "Run the NetworkManager.") + (provision '(networking)) + (requirement '(user-processes dbus-system wpa-supplicant loopback)) + (start #~(make-forkexec-constructor + (list (string-append #$network-manager + "/sbin/NetworkManager") + (string-append "--config=" #$conf) + "--no-daemon"))) + (stop #~(make-kill-destructor)))))))) (define network-manager-service-type - (service-type (name 'network-manager) - (extensions - (list (service-extension shepherd-root-service-type - network-manager-shepherd-service) - (service-extension dbus-root-service-type list) - (service-extension polkit-service-type list) - (service-extension activation-service-type - (const %network-manager-activation)) - ;; Add network-manager to the system profile. - (service-extension profile-service-type list))))) - -(define* (network-manager-service #:key (network-manager network-manager)) - "Return a service that runs NetworkManager, a network connection manager -that attempting to keep active network connectivity when available." - (service network-manager-service-type network-manager)) + (let + ((config->package + (match-lambda + (($ network-manager) + (list network-manager))))) + + (service-type + (name 'network-manager) + (extensions + (list (service-extension shepherd-root-service-type + network-manager-shepherd-service) + (service-extension dbus-root-service-type config->package) + (service-extension polkit-service-type config->package) + (service-extension activation-service-type + (const %network-manager-activation)) + ;; Add network-manager to the system profile. + (service-extension profile-service-type config->package)))))) ;;; -- cgit v1.2.3 From be051880c435d19e7788d5df56c062f7797e0a49 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 20 Jan 2017 14:44:34 +0100 Subject: services: Reindent vpn.scm. This fixes indentation of 'match' forms. * gnu/services/vpn.scm: Pass through 'indent-code.el'. --- gnu/services/vpn.scm | 70 ++++++++++++++++++++++++++-------------------------- 1 file changed, 35 insertions(+), 35 deletions(-) (limited to 'gnu/services') diff --git a/gnu/services/vpn.scm b/gnu/services/vpn.scm index c21995453e..f577e0851e 100644 --- a/gnu/services/vpn.scm +++ b/gnu/services/vpn.scm @@ -46,11 +46,11 @@ (define (uglify-field-name name) (match name - ('verbosity "verb") - (_ (let ((str (symbol->string name))) - (if (string-suffix? "?" str) - (substring str 0 (1- (string-length str))) - str))))) + ('verbosity "verb") + (_ (let ((str (symbol->string name))) + (if (string-suffix? "?" str) + (substring str 0 (1- (string-length str))) + str))))) (define (serialize-field field-name val) (if (eq? field-name 'pid-file) @@ -108,8 +108,8 @@ (define (serialize-tls-auth role location) (serialize-field 'tls-auth (string-append location " " (match role - ('server "0") - ('client "1"))))) + ('server "0") + ('client "1"))))) (define (tls-auth? val) (or (eq? val #f) (string? val))) @@ -230,10 +230,10 @@ client. Each file is named after the name of the client." (for-each (lambda (ccd) (match ccd - ((name config-string) - (call-with-output-file - (string-append #$output "/" name) - (lambda (port) (display config-string port)))))) + ((name config-string) + (call-with-output-file + (string-append #$output "/" name) + (lambda (port) (display config-string port)))))) '#$files)))))) (define-syntax define-split-configuration @@ -378,53 +378,53 @@ is trunkated and rewritten every minute.") (lambda () (serialize-configuration config (match role - ('server - openvpn-server-configuration-fields) - ('client - openvpn-client-configuration-fields)))))) + ('server + openvpn-server-configuration-fields) + ('client + openvpn-client-configuration-fields)))))) (ccd-dir (match role - ('server (create-ccd-directory - (openvpn-server-configuration-client-config-dir - config))) - ('client #f)))) + ('server (create-ccd-directory + (openvpn-server-configuration-client-config-dir + config))) + ('client #f)))) (computed-file "openvpn.conf" #~(begin (use-modules (ice-9 match)) (call-with-output-file #$output (lambda (port) (match '#$role - ('server (display "" port)) - ('client (display "client\n" port))) + ('server (display "" port)) + ('client (display "client\n" port))) (display #$config-str port) (match '#$role - ('server (display - (string-append "client-config-dir " - #$ccd-dir "\n") port)) - ('client (display "" port))))))))) + ('server (display + (string-append "client-config-dir " + #$ccd-dir "\n") port)) + ('client (display "" port))))))))) (define (openvpn-shepherd-service role) (lambda (config) (let* ((config-file (openvpn-config-file role config)) (pid-file ((match role - ('server openvpn-server-configuration-pid-file) - ('client openvpn-client-configuration-pid-file)) + ('server openvpn-server-configuration-pid-file) + ('client openvpn-client-configuration-pid-file)) config)) (openvpn ((match role - ('server openvpn-server-configuration-openvpn) - ('client openvpn-client-configuration-openvpn)) + ('server openvpn-server-configuration-openvpn) + ('client openvpn-client-configuration-openvpn)) config)) (log-file (match role - ('server "/var/log/openvpn-server.log") - ('client "/var/log/openvpn-client.log")))) + ('server "/var/log/openvpn-server.log") + ('client "/var/log/openvpn-client.log")))) (list (shepherd-service (documentation (string-append "Run the OpenVPN " (match role - ('server "server") - ('client "client")) + ('server "server") + ('client "client")) " daemon.")) (provision (match role - ('server '(vpn-server)) - ('client '(vpn-client)))) + ('server '(vpn-server)) + ('client '(vpn-client)))) (requirement '(networking)) (start #~(make-forkexec-constructor (list (string-append #$openvpn "/sbin/openvpn") -- cgit v1.2.3 From 11b7717deba42b1f8286158e1cf4b58dec533859 Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Sun, 22 Jan 2017 15:40:57 +0100 Subject: services: cuirass: Add port to cuirass configuration * gnu/services/cuirass.scm (): Add port field. (cuirass-shepherd-service): Honor it. * doc/guix.texi (Continuous Integration): Document it. Signed-off-by: Mathieu Lirzin --- doc/guix.texi | 6 +++++- gnu/services/cuirass.scm | 5 +++++ 2 files changed, 10 insertions(+), 1 deletion(-) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index 1f0bd7568d..18ab662823 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -30,7 +30,8 @@ Copyright @copyright{} 2016 ng0@* Copyright @copyright{} 2016 Jan Nieuwenhuizen@* Copyright @copyright{} 2016 Julien Lepiller@* Copyright @copyright{} 2016 Alex ter Weele@* -Copyright @copyright{} 2017 Clément Lassieur +Copyright @copyright{} 2017 Clément Lassieur@* +Copyright @copyright{} 2017 Mathieu Othacehe Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, Version 1.3 or @@ -13032,6 +13033,9 @@ Cuirass jobs. Location of sqlite database which contains the build results and previously added specifications. +@item @code{port} (default: @code{8080}) +Port number used by the HTTP server. + @item @code{specifications} (default: @code{#~'()}) A gexp (@pxref{G-Expressions}) that evaluates to a list of specifications, where a specification is an association list diff --git a/gnu/services/cuirass.scm b/gnu/services/cuirass.scm index c15a846bad..1194133f63 100644 --- a/gnu/services/cuirass.scm +++ b/gnu/services/cuirass.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016 Mathieu Lirzin ;;; Copyright © 2016, 2017 Ludovic Courtès +;;; Copyright © 2017 Mathieu Othacehe ;;; ;;; This file is part of GNU Guix. ;;; @@ -56,6 +57,8 @@ (default 60)) (database cuirass-configuration-database ;string (file-name) (default "/var/run/cuirass/cuirass.db")) + (port cuirass-configuration-port ;integer (port) + (default 8080)) (specifications cuirass-configuration-specifications) ;gexp that evaluates to specification-alist (use-substitutes? cuirass-configuration-use-substitutes? ;boolean @@ -74,6 +77,7 @@ (group (cuirass-configuration-group config)) (interval (cuirass-configuration-interval config)) (database (cuirass-configuration-database config)) + (port (cuirass-configuration-port config)) (specs (cuirass-configuration-specifications config)) (use-substitutes? (cuirass-configuration-use-substitutes? config)) (one-shot? (cuirass-configuration-one-shot? config))) @@ -87,6 +91,7 @@ "--specifications" #$(scheme-file "cuirass-specs.scm" specs) "--database" #$database + "--port" #$(number->string port) "--interval" #$(number->string interval) #$@(if use-substitutes? '("--use-substitutes") '()) #$@(if one-shot? '("--one-shot") '())) -- cgit v1.2.3 From 87508d9a0b0384ccd3c1cc82aebba3296630c700 Mon Sep 17 00:00:00 2001 From: Clément Lassieur Date: Fri, 20 Jan 2017 00:57:47 +0100 Subject: services: prosody: Fix activation script. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/services/messaging.scm (prosody-activation): Import (guix build utils) for 'mkdir-p'. Signed-off-by: Ludovic Courtès --- gnu/services/messaging.scm | 1 + 1 file changed, 1 insertion(+) (limited to 'gnu/services') diff --git a/gnu/services/messaging.scm b/gnu/services/messaging.scm index 0b5aa1fae8..aa398970b6 100644 --- a/gnu/services/messaging.scm +++ b/gnu/services/messaging.scm @@ -621,6 +621,7 @@ See also @url{http://prosody.im/doc/modules/mod_muc}." (serialize-prosody-configuration config))))) (config-file (plain-file "prosody.cfg.lua" config-str))) #~(begin + (use-modules (guix build utils)) (define %user (getpw "prosody")) (mkdir-p #$config-dir) -- cgit v1.2.3