services: openvpn: Allow using up/down scripts bundled with OpenVPN.

This is useful for example to pull DNS settings from the server.

* gnu/services/vpn.scm (use-up-down-scripts?): New variable.
(serialize-use-up-down-scripts): New variable.
(make-up-down-config-options): New variable.
(make-script-security-cli-options): New variable.
(openvpn-client-configuration)[use-up-down-scripts?]: New field.
(openvpn-config-file): Serialize that field.
(openvpn-shepherd-service): Pass `--script-security' option to daemon.

Change-Id: I1141dd0b9bf5956f13cf1552c2718b0a7035fa86

1 files changed, 41 insertions, 4 deletions

diff --git a/gnu/services/vpn.scm b/gnu/services/vpn.scm
index f97cbac7bb..361e67fe5e 100644
--- a/gnu/services/vpn.scm
+++ b/gnu/services/vpn.scm
@@ -176,6 +176,33 @@
       (format #t "resolv-retry infinite\n")
       #f))
 
+(define use-up-down-scripts? boolean?)
+(define serialize-use-up-down-scripts empty-serializer)
+
+(define (make-up-down-config-options config)
+  (cond ((not (openvpn-client-configuration? config))
+         "")
+
+        ((openvpn-client-configuration-use-up-down-scripts? config)
+         #~(let ((openvpn #$(openvpn-client-configuration-openvpn config)))
+             (use-modules ((ice-9 format) #:select (format)))
+             (format #f "up ~a/etc/openvpn/client.up~%~@*~
+                         down ~a/etc/openvpn/client.down~%"
+                     openvpn)))
+
+        ((not (null? (openvpn-client-configuration-dns config)))
+         (warn "dns addresses specified but use-up-down-scripts? is #f")
+         "")
+
+        (else
+         "")))
+
+(define (make-script-security-cli-options config)
+  (if (and (openvpn-client-configuration? config)
+           (openvpn-client-configuration-use-up-down-scripts? config))
+      '("--script-security" "2")
+      '()))
+
 (define (serialize-tls-auth role location)
   (if location
       (serialize-field 'tls-auth
@@ -401,7 +428,11 @@ would be added to the store and readable by any user.")
 
    (remote
     (openvpn-remote-list '())
-    "A list of remote servers to connect to."))
+    "A list of remote servers to connect to.")
+
+   (use-up-down-scripts?
+    (use-up-down-scripts #f)
+    "Run client.up and client.down scripts included with OpenVPN."))
   ;; server-specific configuration
   ((tls-auth
     (tls-auth-server #f)
@@ -484,7 +515,9 @@ is truncated and rewritten every minute.")
                              ('server (display
                                        (string-append "client-config-dir "
                                                       #$ccd-dir "\n") port))
-                             ('client (display "" port)))))))))
+                             ('client (display #$(make-up-down-config-options
+                                                  config)
+                                               port)))))))))
 
 (define (openvpn-shepherd-service role)
   (lambda (config)
@@ -499,7 +532,11 @@ is truncated and rewritten every minute.")
                      config))
            (log-file (match role
                        ('server "/var/log/openvpn-server.log")
-                       ('client "/var/log/openvpn-client.log"))))
+                       ('client "/var/log/openvpn-client.log")))
+           (script-sec-opts (match role
+                              ('server '())
+                              ('client (make-script-security-cli-options
+                                        config)))))
       (list (shepherd-service
              (documentation (string-append "Run the OpenVPN "
                                            (match role
@@ -513,7 +550,7 @@ is truncated and rewritten every minute.")
              (start #~(make-forkexec-constructor
                        (list (string-append #$openvpn "/sbin/openvpn")
                              "--writepid" #$pid-file "--config" #$config-file
-                             "--daemon")
+                             #$@script-sec-opts "--daemon")
                        #:pid-file #$pid-file
                        #:log-file #$log-file))
              (stop #~(make-kill-destructor)))))))