Toggle diff (270 lines)
diff --git a/doc/guix.texi b/doc/guix.texi
index da1c4adc0c..7f3a7ca82a 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -35654,9 +35654,10 @@ VPN Services
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-interval} (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{monitor-ips-interval} (default: @code{"*/5 * * * *"})
+This is the monitoring schedule, expressed as a string in traditional
+cron syntax or as a gexp evaluating to a Shepherd calendar event
+(@pxref{Timers,,, shepherd, The GNU Shepherd Manual}).
@item @code{private-key} (default: @code{"/etc/wireguard/private.key"})
The private key file for the interface. It is automatically generated
diff --git a/gnu/services/vpn.scm b/gnu/services/vpn.scm
index 478a0d543e..e788ebef2e 100644
--- a/gnu/services/vpn.scm
+++ b/gnu/services/vpn.scm
@@ -34,7 +34,6 @@ (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)
@@ -43,6 +42,7 @@ (define-module (gnu services vpn)
#:use-module (guix packages)
#:use-module (guix records)
#:use-module (guix gexp)
+ #:use-module (guix diagnostics)
#:use-module (guix i18n)
#:use-module (guix deprecation)
#:use-module (srfi srfi-1)
@@ -756,7 +756,7 @@ (define-record-type* <wireguard-configuration>
(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
+ (default "*/5 * * * *")) ;string | list
(pre-up wireguard-configuration-pre-up ;list of strings
(default '()))
(post-up wireguard-configuration-post-up ;list of strings
@@ -916,117 +916,126 @@ (define (endpoint-host-names peers)
'()
peers)))
-(define (wireguard-shepherd-service config)
+(define (wireguard-monitoring-program config)
(match-record config <wireguard-configuration>
- (wireguard interface)
+ (interface monitor-ips-interval peers)
+ (let ((host-names (endpoint-host-names peers)))
+ (when (null? host-names)
+ (warning (G_ "'monitor-ips?' is #t but no host name to monitor~%")))
+
+ ;; 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).
+ (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)))))))))
+
+(define (wireguard-shepherd-services config)
+ (match-record config <wireguard-configuration>
+ (wireguard interface monitor-ips? monitor-ips-interval)
(let ((wg-quick (file-append wireguard "/bin/wg-quick"))
(auto-start? (wireguard-configuration-auto-start? config))
- (config (wireguard-configuration-file config)))
- (list (shepherd-service
- (requirement '(networking))
+ (config-file (wireguard-configuration-file config)))
+ (define monitoring-service
+ (and monitor-ips?
+ (shepherd-service
+ (provision (list (symbol-append
+ (wireguard-service-name interface)
+ '-monitoring)))
+ (requirement (list 'user-processes
+ (wireguard-service-name interface)))
+ (modules '((shepherd service timer)))
+ (start #~(make-timer-constructor
+ #$(if (string? monitor-ips-interval)
+ #~(cron-string->calendar-event
+ #$monitor-ips-interval)
+ monitor-ips-interval)
+ (command '(#$(wireguard-monitoring-program config)))
+ #:wait-for-termination? #t))
+ (stop #~(make-timer-destructor))
+ (documentation "Monitor the Wireguard VPN tunnel.")
+ (actions (list shepherd-trigger-action)))))
+
+ (cons (shepherd-service
+ (requirement '(networking user-processes))
(provision (list (wireguard-service-name interface)))
(start #~(lambda _
- (invoke #$wg-quick "up" #$config)))
+ (invoke #$wg-quick "up" #$config-file)))
(stop #~(lambda _
- (invoke #$wg-quick "down" #$config)
+ (invoke #$wg-quick "down" #$config-file)
#f)) ;stopped!
- (actions (list (shepherd-configuration-action config)))
+ (actions (list (shepherd-configuration-action config-file)))
(auto-start? auto-start?)
- (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
+ (documentation "Run the Wireguard VPN tunnel"))
+ (or (and=> monitoring-service list)
+ '())))))
(define wireguard-service-type
(service-type
(name 'wireguard)
(extensions
(list (service-extension shepherd-root-service-type
- wireguard-shepherd-service)
+ wireguard-shepherd-services)
(service-extension activation-service-type
wireguard-activation)
(service-extension profile-service-type
(compose list
- wireguard-configuration-wireguard))
- (service-extension mcron-service-type
- wireguard-monitoring-jobs)))
+ wireguard-configuration-wireguard))))
(description "Set up Wireguard @acronym{VPN, Virtual Private Network}
tunnels.")))
--
2.48.1
