me
/
guix
Archived
1
0
Fork 0

services: wireguard: Implement a dynamic IP monitoring feature.

* 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?)
(endpoint-host-names): New procedure.
(wireguard-monitoring-jobs): Likewise.
(wireguard-service-type): Register it.
* tests/services/vpn.scm: New file.
* Makefile.am (SCM_TESTS): Register it.
* doc/guix.texi (VPN Services): Update doc.

Reviewed-by: Bruno Victal <mirai@makinata.eu>
Maxim Cournoyer 2023-05-09 16:52:22 -04:00
parent f15c5edb1a
commit 8d785c43ba
No known key found for this signature in database
GPG Key ID: 1260E46482E63562
4 changed files with 247 additions and 6 deletions

View File

@ -558,6 +558,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 \

View File

@ -32955,9 +32955,22 @@ The port on which to listen for incoming connections.
@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

View File

@ -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 @@
#: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 @@
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 @@ strongSwan.")))
(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,58 @@ PostUp = ~a set %i private-key ~a~{ peer ~a preshared-key ~a~}
(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? address)
"Predicate to check whether ADDRESS is a valid IPv4 address."
(let ((address (strip-port/maybe address)))
(false-if-exception
(->bool (getaddrinfo address #f AI_NUMERICHOST AF_INET)))))
(define* (ipv6-address? address)
"Predicate to check whether ADDRESS is a valid IPv6 address."
(let ((address (strip-port/maybe address #:ipv6? #t)))
(false-if-exception
(->bool (getaddrinfo address #f AI_NUMERICHOST AF_INET6)))))
(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 +939,7 @@ PostUp = ~a set %i private-key ~a~{ peer ~a preshared-key ~a~}
(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 +947,87 @@ PostUp = ~a set %i private-key ~a~{ peer ~a preshared-key ~a~}
#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 +1038,8 @@ PostUp = ~a set %i private-key ~a~{ peer ~a preshared-key ~a~}
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.")))

View File

@ -0,0 +1,85 @@
;;; 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 "[2001:db8::c05f:543]:2468"
"2001:db8::c05f:543"
"2001:db8:855b:0000:0000:0567:5673:23b5"
"2001:db8:855b::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"
;; The first element of the pair the public Wireguard key associated to a
;; host name.
'(("VlesLiEB5BFd//OD2ILKXviolfz+hodG6uZ+XjoalC8=" .
"some.dynamic-dns.service:53281")
("AlesLiEB5BFd//OD2ILKXviolfz+hodG6uZ+XgoalC9=" .
"example.org"))
(endpoint-host-names %wireguard-peers))
(test-end "vpn-services")