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>
This commit is contained in:
Maxim Cournoyer
parent
f15c5edb1a
commit
8d785c43ba
|
|
@ -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 \
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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.")))
|
||||
|
|
|
|||
|
|
@ -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")
|
||||
Loading…
Reference in New Issue