On Fri, 13 Jan 2017 18:58:18 +0100
l...@gnu.org (Ludovic Courtès) wrote:

> Julien Lepiller <jul...@lepiller.eu> skribis:
> 
> > * gnu/services/vpn.scm: New file.
> > * gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
> > * doc/guix.texi (VPN Services): New section.  
> 
> Woow, neat!
> 
> Overall LGTM!  The following comments are about cosmetic issues, but I
> think it’s best to get them right.
> 
> > +@node VPN Services
> > +@subsubsection VPN Services
> > +@cindex VPN
> > +
> > +The @code{(gnu services vpn)} module provides the following
> > sevices:  
> 
> Please provide a few sentences of context and index entries, like:
> 
>   @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---allowing your machine to connect to a VPN, as well as
>   @emph{server} functionality---where your machine hosts a VPN.  Both
>   use @uref{https://openvpn.net/, OpenVPN}.
> 
> > +@deffn {Scheme Procedure} openvpn-client-service @
> > +       [#:config (openvpn-client-configuration)]
> > +
> > +Return a service that runs @var{openvpn}, a VPN daemon, as a
> > client.  
> 
> @command{openvpn} (or @command{openvpnd}, whatever it’s called), or
> OpenVPN.  @var is for variables.
> 
> > +@deffn {Scheme Procedure} openvpn-server-service @
> > +       [#:config (openvpn-server-configuration)]
> > +
> > +Return a service that runs @var{openvpn}, a VPN daemon, as a
> > server.  
> 
> Ditto.
> 
> > +            openvpn-ccd-configuration
> > +            generate-openvpn-client-documentation
> > +            generate-openvpn-server-documentation
> > +))  
> 
> No hanging parens please.  :-)
> 
> > +(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)))))  
> 
> The indentation is off in several places.  Could you run:
> 
>   ./etc/indent-code.el gnu/services/vpn.scm
> 
> (You need to have ‘emacs’ or ‘emacs-minimal’ installed but this is
> non-interactive.)
> 
> > +(define (create-ccd-directory val)
> > +  (let ((files (map (lambda (ccd)
> > +                      (list (openvpn-ccd-configuration-name ccd)
> > +                        (with-output-to-string
> > +                          (lambda ()
> > +                            (serialize-configuration
> > +                              ccd
> > openvpn-ccd-configuration-fields)))))  
> 
> Please add a docstring.  It’s not obvious what’s happening here.
> 
> > +                    val)))
> > +    (computed-file "ccd"
> > +      (with-imported-modules '((guix build utils))
> > +        #~(begin
> > +          (use-modules (guix build utils))
> > +          (mkdir-p #$output)
> > +            (for-each
> > +              (lambda (ccd)
> > +                (call-with-output-file (string-append #$output
> > "/" (car ccd))
> > +                  (lambda (port) (display (car (cdr ccd)) port))))
> > +              '#$files))))))  
> 
> Please use ‘match’ instead of (car (cdr ccd)):
> 
>   (lambda (port)
>     (match ccd
>       ((_ (thing _ ...))
>        (display thing port))))
> 
> Of course you can use an identifier more descriptive than
> ‘thing’.  ;-)
> 
> > +   (server-ipv6
> > +     (cidr6 #f)
> > +     "A CIDR notation specifying the ipv6 subnet inside the
> > virtual network.")  
> 
> It would be ideal if you could expand “CIDR” the first type.
> 
> Also, in comments and docstrings in the whole file (and thus in
> guix.texi):
> 
>   s/ipv6/IPv6/
>   s/udp/UDP/
>   s/tcp/TCP/
>   s/diffie-hellman/Diffie-Hellman/
>   s/Openvpn/OpenVPN/
> 
> > +(define (openvpn-shepherd-service role)
> > +  (lambda (config)
> > +    (let* ((config-file (openvpn-config-file role config))
> > +           ;                #$(serialize-configuration config
> > +           ;                    (match role
> > +           ;                      ('server
> > openvpn-server-configuration-fields)
> > +           ;                      ('client
> > openvpn-client-configuration-fields)))))  
> 
> Please remove the comment.
> 
> > +              (start #~(make-forkexec-constructor
> > +                         (list (string-append #$openvpn
> > "/sbin/openvpn")
> > +                               "--writepid" #$pid-file "--config"
> > #$config-file
> > +                               "--daemon")))  
> 
> Add #:pid-file #$pid-file, so that shepherd does the right thing.
> 
> > +(define %openvpn-activation
> > +  #~(begin
> > +      (mkdir-p "/var/run/openvpn")))  
> 
> ‘begin’ can be omitted.
> 
> Could you send an updated patch?

This should correct everything you reported.

> 
> Besides, could you think of a system test that would allow us to test
> both services?  Perhaps a single config that has both the OpenVPN
> server and client running?  Thoughts?

I don't think you can connect a client to itself, but you could run two
machines, one client and one server. Is it possible?

> 
> Thank you!
> 
> Ludo’.

From 8de1245e8887ae90d34e0262e1eadab091eda603 Mon Sep 17 00:00:00 2001
From: Julien Lepiller <jul...@lepiller.eu>
Date: Sat, 7 Jan 2017 20:16:00 +0100
Subject: [PATCH] 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        | 359 +++++++++++++++++++++++++++++++++++++
 gnu/local.mk         |   1 +
 gnu/services/vpn.scm | 492 +++++++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 852 insertions(+)
 create mode 100644 gnu/services/vpn.scm

diff --git a/doc/guix.texi b/doc/guix.texi
index fa07aba5a..e6f7103c1 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,363 @@ Whether the server should add its configuration to response.
 @end table
 @end deftp
 
+@node VPN Services
+@subsubsection VPN Services
+@cindex 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 21580a387..a84026c2d 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 000000000..98de130c1
--- /dev/null
+++ b/gnu/services/vpn.scm
@@ -0,0 +1,492 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2017 Julien Lepiller <jul...@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
+                       #:log-file #$log-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))
-- 
2.11.0

Reply via email to