Toggle diff (343 lines)
diff --git a/Makefile.am b/Makefile.am
index 8b7bb4772d..e1cb1083fc 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -557,6 +557,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 b40870f42b..b19ba887a1 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -32642,9 +32642,22 @@ 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, resetting the peer endpoints using an
+IP address that no longer correspond to their freshly resolved host
+name. Set this to @code{#t} if one or more endpoints use host names
+provided by a dynamic DNS service to keep the sessions alive.
+
+@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..9cf08c194a 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,56 @@ (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 (endpoint-host-names peers)
+ "Return an association list of endpoint host names keyed by their peer
+public key, if any."
+ (reverse
+ (fold (lambda (peer host-names)
+ (let ((public-key (wireguard-peer-public-key peer))
+ (endpoint (wireguard-peer-endpoint peer)))
+ (if (and endpoint (host-name? endpoint))
+ (cons (cons public-key endpoint) host-names)
+ host-names)))
+ '()
+ peers)))
+
(define (wireguard-shepherd-service config)
(match-record config <wireguard-configuration>
(wireguard interface)
@@ -878,9 +937,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 +945,87 @@ (define (wireguard-shepherd-service config)
#f)) ;stopped!
(documentation "Run the Wireguard VPN tunnel"))))))
+(define (wireguard-monitoring-jobs config)
+ ;; Loosely based on WireGuard's own 'reresolve-dns.sh' shell script (see:
+ ;; https://raw.githubusercontent.com/WireGuard/wireguard-tools/
+ ;; master/contrib/reresolve-dns/reresolve-dns.sh).
+ (match-record config <wireguard-configuration>
+ (interface monitor-ips? monitor-ips-interval peers)
+ (let ((host-names (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)
+ (guix build utils)))
+ #~(begin
+ (use-modules (gnu services herd)
+ (guix build utils)
+ (ice-9 popen)
+ (ice-9 match)
+ (ice-9 textual-ports)
+ (srfi srfi-1)
+ (srfi srfi-26))
+
+ (define (resolve-host 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))))
+
+ (define wg #$(file-append wireguard-tools "/bin/wg"))
+
+ #$(procedure-source strip-port/maybe)
+
+ (define service-name '#$(wireguard-service-name
+ interface))
+
+ (when (live-service-running
+ (current-service service-name))
+ (let* ((pipe (open-pipe* OPEN_READ wg "show"
+ #$interface "endpoints"))
+ (lines (string-split (get-string-all pipe)
+ #\newline))
+ ;; IPS is an association list mapping
+ ;; public keys to IP addresses.
+ (ips (map (match-lambda
+ ((public-key ip)
+ (cons public-key
+ (strip-port/maybe ip))))
+ (map (cut string-split <> #\tab)
+ (remove string-null?
+ lines)))))
+ (close-pipe pipe)
+ (for-each
+ (match-lambda
+ ((key . host-name)
+ (let ((resolved-ip (resolve-host
+ (strip-port/maybe
+ host-name)))
+ (current-ip (assoc-ref ips key)))
+ (unless (string=? resolved-ip current-ip)
+ (format #t "resetting `~a' peer \
+endpoint to `~a' due to stale IP (`~a' instead of `~a')~%"
+ key host-name
+ current-ip resolved-ip)
+ (invoke wg "set" #$interface "peer" key
+ "endpoint" host-name)))))
+ '#$host-names)))))))))
+ '())))) ;monitor-ips? is #f
+
(define wireguard-service-type
(service-type
(name 'wireguard)
@@ -898,6 +1036,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..a7f4bec26b
--- /dev/null
+++ b/tests/services/vpn.scm
@@ -0,0 +1,83 @@
+;;; 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 endpoint-host-names
+ (@@ (gnu services vpn) 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 "endpoint-host-names"
+ '(("VlesLiEB5BFd//OD2ILKXviolfz+hodG6uZ+XjoalC8=" .
+ "some.dynamic-dns.service:53281")
+ ("AlesLiEB5BFd//OD2ILKXviolfz+hodG6uZ+XgoalC9=" .
+ "example.org"))
+ (endpoint-host-names %wireguard-peers))
+
+(test-end "vpn-services")
--
2.40.1
