Merge branch 'master' into core-updates

7 files changed, 1446 insertions, 44 deletions

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/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 <mthl@gnu.org>
 ;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;;
 ;;; 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") '()))
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 <davet@gnu.org>
 ;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2016 Leo Famulari <leo@famulari.name>
+;;; Copyright © 2017 Christopher Baines <mail@cbaines.net>
 ;;;
 ;;; 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{<mysql-configuration>} object."
   (service mysql-service-type config))
+
+
+;;;
+;;; Redis
+;;;
+
+(define-record-type* <redis-configuration>
+  redis-configuration make-redis-configuration
+  redis-configuration?
+  (redis             redis-configuration-redis ;<package>
+                     (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-configuration> 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-configuration> 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))))))
diff --git a/gnu/services/messaging.scm b/gnu/services/messaging.scm
new file mode 100644
index 0000000000..aa398970b6
--- /dev/null
+++ b/gnu/services/messaging.scm
@@ -0,0 +1,727 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu services 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 <shepherd-service> 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
+        (use-modules (guix build utils))
+        (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"))
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index d672ecf687..8f136f0dc1 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 <ludo@gnu.org>
+;;; 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 John Darrington <jmd@gnu.org>
@@ -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))
 
@@ -633,7 +638,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."
@@ -674,40 +684,58 @@ and @command{wicd-curses} user interfaces."
 ;;; NetworkManager
 ;;;
 
+(define-record-type* <network-manager-configuration>
+  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-configuration> 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-configuration> 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))))))
 
 
 ;;;
diff --git a/gnu/services/vpn.scm b/gnu/services/vpn.scm
new file mode 100644
index 0000000000..f577e0851e
--- /dev/null
+++ b/gnu/services/vpn.scm
@@ -0,0 +1,491 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2017 Julien Lepiller <julien@lepiller.eu>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu services 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))
diff --git a/gnu/services/web.scm b/gnu/services/web.scm
index db895405a2..11408d7b0e 100644
--- a/gnu/services/web.scm
+++ b/gnu/services/web.scm
@@ -1,8 +1,9 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
-;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2016 ng0 <ng0@we.make.ritual.n0.is>
 ;;; Copyright © 2016 Julien Lepiller <julien@lepiller.eu>
+;;; Copyright © 2017 Christopher Baines <mail@cbaines.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -33,6 +34,12 @@
             nginx-configuration?
             nginx-server-configuration
             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))
 
@@ -53,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
@@ -62,14 +71,41 @@
   (server-tokens?      nginx-server-configuration-server-tokens?
                        (default #f)))
 
+(define-record-type* <nginx-upstream-configuration>
+  nginx-upstream-configuration make-nginx-upstream-configuration
+  nginx-upstream-configuration?
+  (name                nginx-upstream-configuration-name)
+  (servers             nginx-upstream-configuration-servers))
+
+(define-record-type* <nginx-location-configuration>
+  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>
+  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>
   nginx-configuration make-nginx-configuration
   nginx-configuration?
-  (nginx         nginx-configuration-nginx)         ;<package>
-  (log-directory nginx-configuration-log-directory) ;string
-  (run-directory nginx-configuration-run-directory) ;string
-  (server-blocks nginx-configuration-server-blocks) ;list
-  (file          nginx-configuration-file))         ;string | file-like
+  (nginx         nginx-configuration-nginx          ;<package>
+                 (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 <nginx-server-configuration>
+  (upstream-blocks nginx-configuration-upstream-blocks
+                   (default '()))      ;list of <nginx-upstream-configuration>
+  (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
@@ -88,6 +124,19 @@ of index files."
         ((? string? str) (string-append str " ")))
        names)))
 
+(define nginx-location-config
+  (match-lambda
+    (($ <nginx-location-configuration> uri body)
+     (string-append
+      "      location " uri " {\n"
+      "        " (string-join body "\n    ") "\n"
+      "      }\n"))
+    (($ <nginx-named-location-configuration> name body)
+     (string-append
+      "      location @" name " {\n"
+      "        " (string-join body "\n    ") "\n"
+      "      }\n"))))
+
 (define (default-nginx-server-config server)
   (string-append
    "    server {\n"
@@ -116,11 +165,23 @@ 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"
+   (string-join
+    (map nginx-location-config (nginx-server-configuration-locations server))
+    "\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 +192,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 +218,7 @@ of index files."
 (define nginx-activation
   (match-lambda
     (($ <nginx-configuration> nginx log-directory run-directory server-blocks
-                              config-file)
+                              upstream-blocks config-file)
      #~(begin
          (use-modules (guix build utils))
 
@@ -169,13 +236,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-configuration> 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 +251,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 +283,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 +295,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))))