diff mbox series

[bug#63402,v3,1/3] services: wireguard: Implement a dynamic IP monitoring feature.

Message ID 76b34e5229e0e97068cb3bd42152f29630a8dbfc.1684210148.git.maxim.cournoyer@gmail.com
State New
Headers show
Series [bug#63402,v3,1/3] services: wireguard: Implement a dynamic IP monitoring feature. | expand

Commit Message

Maxim Cournoyer May 16, 2023, 4:09 a.m. UTC
* gnu/services/vpn.scm (<wireguard-configuration>)
[monitor-ips?, monitor-ips-internal]: New fields.
* gnu/services/vpn.scm (define-with-source): New syntax.
(wireguard-service-name, strip-port/maybe)
(ipv4-address?, ipv6-address?, host-name?)
(peers->endpoint-host-names)
(wireguard-monitoring-jobs): New procedures.
(wireguard-service-type): Register it.
* tests/services/vpn.scm: New file.
* Makefile.am (SCM_TESTS): Register it.
* doc/guix.texi (VPN Services): Update doc.
---
 Makefile.am            |   1 +
 doc/guix.texi          |  18 +++++-
 gnu/services/vpn.scm   | 123 +++++++++++++++++++++++++++++++++++++++--
 tests/services/vpn.scm |  80 +++++++++++++++++++++++++++
 4 files changed, 216 insertions(+), 6 deletions(-)
 create mode 100644 tests/services/vpn.scm


base-commit: 242cc93438d67f5b35602d5add02e230850b0b43
diff mbox series

Patch

diff --git a/Makefile.am b/Makefile.am
index 13718e4353..fb6e4f57cd 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -553,6 +553,7 @@  SCM_TESTS =					\
   tests/services/lightdm.scm			\
   tests/services/linux.scm			\
   tests/services/telephony.scm			\
+  tests/services/vpn.scm			\
   tests/sets.scm				\
   tests/size.scm				\
   tests/status.scm				\
diff --git a/doc/guix.texi b/doc/guix.texi
index 60972f408d..4499a911d6 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -32591,9 +32591,23 @@  VPN Services
 @item @code{dns} (default: @code{#f})
 The DNS server(s) to announce to VPN clients via DHCP.
 
+@item @code{monitor-ips?} (default: @code{#f})
+@cindex Dynamic IP, with Wireguard
+@cindex dyndns, usage with Wireguard
+Whether to monitor the resolved Internet addresses (IPs) of the
+endpoints of the configured peers, restarting the service when there is
+a mismatch between the endpoint IPs in actual use versus those freshly
+resolved from their host names.  Set this to @code{#t} if one or more
+endpoints use host names provided by a dynamic DNS service to keep
+connections working.
+
+@item @code{monitor-ips-internal} (default: @code{'(next-minute (range 0 60 5))})
+The time interval at which the IP monitoring job should run, provided as
+an mcron time specification (@pxref{Guile Syntax,,,mcron}).
+
 @item @code{private-key} (default: @code{"/etc/wireguard/private.key"})
-The private key file for the interface.  It is automatically generated if
-the file does not exist.
+The private key file for the interface.  It is automatically generated
+if the file does not exist.
 
 @item @code{peers} (default: @code{'()})
 The authorized peers on this interface.  This is a list of
diff --git a/gnu/services/vpn.scm b/gnu/services/vpn.scm
index a884d71eb2..e21f999bc0 100644
--- a/gnu/services/vpn.scm
+++ b/gnu/services/vpn.scm
@@ -11,6 +11,7 @@ 
 ;;; Copyright © 2021 Nathan Dehnel <ncdehnel@gmail.com>
 ;;; Copyright © 2022 Cameron V Chaparro <cameron@cameronchaparro.com>
 ;;; Copyright © 2022 Timo Wilken <guix@twilken.net>
+;;; Copyright © 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -31,10 +32,12 @@  (define-module (gnu services vpn)
   #:use-module (gnu services)
   #:use-module (gnu services configuration)
   #:use-module (gnu services dbus)
+  #:use-module (gnu services mcron)
   #:use-module (gnu services shepherd)
   #:use-module (gnu system shadow)
   #:use-module (gnu packages admin)
   #:use-module (gnu packages vpn)
+  #:use-module (guix modules)
   #:use-module (guix packages)
   #:use-module (guix records)
   #:use-module (guix gexp)
@@ -73,6 +76,8 @@  (define-module (gnu services vpn)
             wireguard-configuration-addresses
             wireguard-configuration-port
             wireguard-configuration-dns
+            wireguard-configuration-monitor-ips?
+            wireguard-configuration-monitor-ips-interval
             wireguard-configuration-private-key
             wireguard-configuration-peers
             wireguard-configuration-pre-up
@@ -741,6 +746,10 @@  (define-record-type* <wireguard-configuration>
                       (default '()))
   (dns                wireguard-configuration-dns ;list of strings
                       (default #f))
+  (monitor-ips?       wireguard-configuration-monitor-ips? ;boolean
+                      (default #f))
+  (monitor-ips-interval wireguard-configuration-monitor-ips-interval
+                        (default '(next-minute (range 0 60 5)))) ;string | list
   (pre-up             wireguard-configuration-pre-up ;list of strings
                       (default '()))
   (post-up            wireguard-configuration-post-up ;list of strings
@@ -871,6 +880,49 @@  (define (wireguard-activation config)
             (chmod #$private-key #o400)
             (close-pipe pipe))))))
 
+;;; XXX: Copied from (guix scripts pack), changing define to define*.
+(define-syntax-rule (define-with-source (variable args ...) body body* ...)
+  "Bind VARIABLE to a procedure accepting ARGS defined as BODY, also setting
+its source property."
+  (begin
+    (define* (variable args ...)
+      body body* ...)
+    (eval-when (load eval)
+      (set-procedure-property! variable 'source
+                               '(define* (variable args ...) body body* ...)))))
+
+(define (wireguard-service-name interface)
+  "Return the WireGuard service name (a symbol) configured to use INTERFACE."
+  (symbol-append 'wireguard- (string->symbol interface)))
+
+(define-with-source (strip-port/maybe endpoint #:key ipv6?)
+  "Strip the colon and port, if present in ENDPOINT, a string."
+  (if ipv6?
+      (if (string-prefix? "[" endpoint)
+          (first (string-split (string-drop endpoint 1) #\])) ;ipv6
+          endpoint)
+      (first (string-split endpoint #\:)))) ;ipv4
+
+(define (ipv4-address? str)
+  "Return true if STR denotes an IPv4 address."
+  (false-if-exception
+   (->bool (inet-pton AF_INET (strip-port/maybe str)))))
+
+(define (ipv6-address? str)
+  "Return true if STR denotes an IPv6 address."
+  (false-if-exception
+   (->bool (inet-pton AF_INET6 (strip-port/maybe str #:ipv6? #t)))))
+
+(define (host-name? name)
+  "Predicate to check whether NAME is a host name, i.e. not an IP address."
+  (not (or (ipv6-address? name) (ipv4-address? name))))
+
+(define (peers->endpoint-host-names peers)
+  "Return host names used as the endpoints of PEERS, if any.  Any \":PORT\"
+suffixes are stripped."
+  (map strip-port/maybe
+       (filter host-name? (filter-map wireguard-peer-endpoint peers))))
+
 (define (wireguard-shepherd-service config)
   (match-record config <wireguard-configuration>
     (wireguard interface)
@@ -878,9 +930,7 @@  (define (wireguard-shepherd-service config)
           (config (wireguard-configuration-file config)))
       (list (shepherd-service
              (requirement '(networking))
-             (provision (list
-                         (symbol-append 'wireguard-
-                                        (string->symbol interface))))
+             (provision (list (wireguard-service-name interface)))
              (start #~(lambda _
                        (invoke #$wg-quick "up" #$config)))
              (stop #~(lambda _
@@ -888,6 +938,69 @@  (define (wireguard-shepherd-service config)
                        #f))                       ;stopped!
              (documentation "Run the Wireguard VPN tunnel"))))))
 
+(define (wireguard-monitoring-jobs config)
+  (match-record config <wireguard-configuration>
+    (interface monitor-ips? monitor-ips-interval peers)
+    (let ((host-names (peers->endpoint-host-names peers)))
+      (if monitor-ips?
+          (if (null? host-names)
+              (begin
+                (warn "monitor-ips? is #t but no host name to monitor")
+                '())
+              ;; The mcron monitor job may be a string or a list; ungexp strips
+              ;; one quote level, which must be added back when a list is
+              ;; provided.
+              (list
+               #~(job
+                  (if (string? #$monitor-ips-interval)
+                      #$monitor-ips-interval
+                      '#$monitor-ips-interval)
+                  #$(program-file
+                     (format #f "wireguard-~a-monitoring" interface)
+                     (with-imported-modules (source-module-closure
+                                             '((gnu services herd)))
+                       #~(begin
+                           (use-modules (gnu services herd)
+                                        (ice-9 popen)
+                                        (ice-9 textual-ports)
+                                        (srfi srfi-1)
+                                        (srfi srfi-26))
+
+                           (define (host-name->ip name)
+                             "Return the IP address resolved from NAME."
+                             (let* ((ai (car (getaddrinfo name)))
+                                    (sa (addrinfo:addr ai)))
+                               (inet-ntop (sockaddr:fam sa)
+                                          (sockaddr:addr sa))))
+
+                           #$(procedure-source strip-port/maybe)
+
+                           (define service-name '#$(wireguard-service-name
+                                                    interface))
+
+                           (when (start-service service-name)
+                             (let* ((resolved-ips (map host-name->ip
+                                                       '#$host-names))
+                                    (pipe (open-pipe*
+                                           OPEN_READ
+                                           #$(file-append wireguard-tools
+                                                          "/bin/wg")
+                                           "show" #$interface "endpoints"))
+                                    (lines (string-split (get-string-all pipe)
+                                                         #\newline))
+                                    (used-ips (map (compose
+                                                    strip-port/maybe
+                                                    last
+                                                    (cut string-split <> #\tab))
+                                                   lines)))
+                               (close-pipe pipe)
+                               (unless (every (cut member <> used-ips)
+                                              resolved-ips)
+                                 (format #t "restarting ~a service due to \
+stale endpoint IPs~%" service-name)
+                                 (restart-service service-name))))))))))
+          '()))))                       ;monitor-ips? is #f
+
 (define wireguard-service-type
   (service-type
    (name 'wireguard)
@@ -898,6 +1011,8 @@  (define wireguard-service-type
                              wireguard-activation)
           (service-extension profile-service-type
                              (compose list
-                                      wireguard-configuration-wireguard))))
+                                      wireguard-configuration-wireguard))
+          (service-extension mcron-service-type
+                             wireguard-monitoring-jobs)))
    (description "Set up Wireguard @acronym{VPN, Virtual Private Network}
 tunnels.")))
diff --git a/tests/services/vpn.scm b/tests/services/vpn.scm
new file mode 100644
index 0000000000..9c6fa65df6
--- /dev/null
+++ b/tests/services/vpn.scm
@@ -0,0 +1,80 @@ 
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;;
+;;; 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 (tests services vpn)
+  #:use-module (gnu packages vpn)
+  #:use-module (gnu services vpn)
+  #:use-module (guix gexp)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-64))
+
+;;; Commentary:
+;;;
+;;; Unit tests for the (gnu services vpn) module.
+;;;
+;;; Code:
+
+;;; Access some internals for whitebox testing.
+(define ipv4-address? (@@ (gnu services vpn) ipv4-address?))
+(define ipv6-address? (@@ (gnu services vpn) ipv6-address?))
+(define host-name? (@@ (gnu services vpn) host-name?))
+(define peers->endpoint-host-names
+  (@@ (gnu services vpn) peers->endpoint-host-names))
+
+(test-begin "vpn-services")
+
+(test-assert "ipv4-address?"
+  (every ipv4-address?
+         (list "192.95.5.67:1234"
+               "10.0.0.1")))
+
+(test-assert "ipv6-address?"
+  (every ipv6-address?
+         (list "[2607:5300:60:6b0::c05f:543]:2468"
+               "2607:5300:60:6b0::c05f:543"
+               "2345:0425:2CA1:0000:0000:0567:5673:23b5"
+               "2345:0425:2CA1::0567:5673:23b5")))
+
+(define %wireguard-peers
+  (list (wireguard-peer
+         (name "dummy1")
+         (public-key "VlesLiEB5BFd//OD2ILKXviolfz+hodG6uZ+XjoalC8=")
+         (endpoint "some.dynamic-dns.service:53281")
+         (allowed-ips '()))
+        (wireguard-peer
+         (name "dummy2")
+         (public-key "AlesLiEB5BFd//OD2ILKXviolfz+hodG6uZ+XgoalC9=")
+         (endpoint "example.org")
+         (allowed-ips '()))
+        (wireguard-peer
+         (name "dummy3")
+         (public-key "BlesLiEB5BFd//OD2ILKXviolfz+hodG6uZ+XgoalC7=")
+         (endpoint "10.0.0.7:7777")
+         (allowed-ips '()))
+        (wireguard-peer
+         (name "dummy4")
+         (public-key "ClesLiEB5BFd//OD2ILKXviolfz+hodG6uZ+XgoalC6=")
+         (endpoint "[2345:0425:2CA1::0567:5673:23b5]:44444")
+         (allowed-ips '()))))
+
+(test-equal "peers->endpoint-host-names"
+  '("some.dynamic-dns.service" "example.org")
+  (peers->endpoint-host-names %wireguard-peers))
+
+(test-end "vpn-services")