mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-25 05:48:07 -05:00
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:
parent
f15c5edb1a
commit
8d785c43ba
4 changed files with 247 additions and 6 deletions
|
@ -558,6 +558,7 @@ SCM_TESTS = \
|
||||||
tests/services/lightdm.scm \
|
tests/services/lightdm.scm \
|
||||||
tests/services/linux.scm \
|
tests/services/linux.scm \
|
||||||
tests/services/telephony.scm \
|
tests/services/telephony.scm \
|
||||||
|
tests/services/vpn.scm \
|
||||||
tests/sets.scm \
|
tests/sets.scm \
|
||||||
tests/size.scm \
|
tests/size.scm \
|
||||||
tests/status.scm \
|
tests/status.scm \
|
||||||
|
|
|
@ -32955,9 +32955,22 @@ The port on which to listen for incoming connections.
|
||||||
@item @code{dns} (default: @code{#f})
|
@item @code{dns} (default: @code{#f})
|
||||||
The DNS server(s) to announce to VPN clients via DHCP.
|
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"})
|
@item @code{private-key} (default: @code{"/etc/wireguard/private.key"})
|
||||||
The private key file for the interface. It is automatically generated if
|
The private key file for the interface. It is automatically generated
|
||||||
the file does not exist.
|
if the file does not exist.
|
||||||
|
|
||||||
@item @code{peers} (default: @code{'()})
|
@item @code{peers} (default: @code{'()})
|
||||||
The authorized peers on this interface. This is a list of
|
The authorized peers on this interface. This is a list of
|
||||||
|
|
|
@ -11,6 +11,7 @@
|
||||||
;;; Copyright © 2021 Nathan Dehnel <ncdehnel@gmail.com>
|
;;; Copyright © 2021 Nathan Dehnel <ncdehnel@gmail.com>
|
||||||
;;; Copyright © 2022 Cameron V Chaparro <cameron@cameronchaparro.com>
|
;;; Copyright © 2022 Cameron V Chaparro <cameron@cameronchaparro.com>
|
||||||
;;; Copyright © 2022 Timo Wilken <guix@twilken.net>
|
;;; Copyright © 2022 Timo Wilken <guix@twilken.net>
|
||||||
|
;;; Copyright © 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
|
@ -31,10 +32,12 @@ (define-module (gnu services vpn)
|
||||||
#:use-module (gnu services)
|
#:use-module (gnu services)
|
||||||
#:use-module (gnu services configuration)
|
#:use-module (gnu services configuration)
|
||||||
#:use-module (gnu services dbus)
|
#:use-module (gnu services dbus)
|
||||||
|
#:use-module (gnu services mcron)
|
||||||
#:use-module (gnu services shepherd)
|
#:use-module (gnu services shepherd)
|
||||||
#:use-module (gnu system shadow)
|
#:use-module (gnu system shadow)
|
||||||
#:use-module (gnu packages admin)
|
#:use-module (gnu packages admin)
|
||||||
#:use-module (gnu packages vpn)
|
#:use-module (gnu packages vpn)
|
||||||
|
#:use-module (guix modules)
|
||||||
#:use-module (guix packages)
|
#:use-module (guix packages)
|
||||||
#:use-module (guix records)
|
#:use-module (guix records)
|
||||||
#:use-module (guix gexp)
|
#:use-module (guix gexp)
|
||||||
|
@ -73,6 +76,8 @@ (define-module (gnu services vpn)
|
||||||
wireguard-configuration-addresses
|
wireguard-configuration-addresses
|
||||||
wireguard-configuration-port
|
wireguard-configuration-port
|
||||||
wireguard-configuration-dns
|
wireguard-configuration-dns
|
||||||
|
wireguard-configuration-monitor-ips?
|
||||||
|
wireguard-configuration-monitor-ips-interval
|
||||||
wireguard-configuration-private-key
|
wireguard-configuration-private-key
|
||||||
wireguard-configuration-peers
|
wireguard-configuration-peers
|
||||||
wireguard-configuration-pre-up
|
wireguard-configuration-pre-up
|
||||||
|
@ -741,6 +746,10 @@ (define-record-type* <wireguard-configuration>
|
||||||
(default '()))
|
(default '()))
|
||||||
(dns wireguard-configuration-dns ;list of strings
|
(dns wireguard-configuration-dns ;list of strings
|
||||||
(default #f))
|
(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
|
(pre-up wireguard-configuration-pre-up ;list of strings
|
||||||
(default '()))
|
(default '()))
|
||||||
(post-up wireguard-configuration-post-up ;list of strings
|
(post-up wireguard-configuration-post-up ;list of strings
|
||||||
|
@ -871,6 +880,58 @@ (define (wireguard-activation config)
|
||||||
(chmod #$private-key #o400)
|
(chmod #$private-key #o400)
|
||||||
(close-pipe pipe))))))
|
(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)
|
(define (wireguard-shepherd-service config)
|
||||||
(match-record config <wireguard-configuration>
|
(match-record config <wireguard-configuration>
|
||||||
(wireguard interface)
|
(wireguard interface)
|
||||||
|
@ -878,9 +939,7 @@ (define (wireguard-shepherd-service config)
|
||||||
(config (wireguard-configuration-file config)))
|
(config (wireguard-configuration-file config)))
|
||||||
(list (shepherd-service
|
(list (shepherd-service
|
||||||
(requirement '(networking))
|
(requirement '(networking))
|
||||||
(provision (list
|
(provision (list (wireguard-service-name interface)))
|
||||||
(symbol-append 'wireguard-
|
|
||||||
(string->symbol interface))))
|
|
||||||
(start #~(lambda _
|
(start #~(lambda _
|
||||||
(invoke #$wg-quick "up" #$config)))
|
(invoke #$wg-quick "up" #$config)))
|
||||||
(stop #~(lambda _
|
(stop #~(lambda _
|
||||||
|
@ -888,6 +947,87 @@ (define (wireguard-shepherd-service config)
|
||||||
#f)) ;stopped!
|
#f)) ;stopped!
|
||||||
(documentation "Run the Wireguard VPN tunnel"))))))
|
(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
|
(define wireguard-service-type
|
||||||
(service-type
|
(service-type
|
||||||
(name 'wireguard)
|
(name 'wireguard)
|
||||||
|
@ -898,6 +1038,8 @@ (define wireguard-service-type
|
||||||
wireguard-activation)
|
wireguard-activation)
|
||||||
(service-extension profile-service-type
|
(service-extension profile-service-type
|
||||||
(compose list
|
(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}
|
(description "Set up Wireguard @acronym{VPN, Virtual Private Network}
|
||||||
tunnels.")))
|
tunnels.")))
|
||||||
|
|
85
tests/services/vpn.scm
Normal file
85
tests/services/vpn.scm
Normal 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")
|
Loading…
Reference in a new issue