GNU bug report logs - #63402
[PATCH 0/1] Add a dynamic IP monitoring option to Wireguard service

Previous Next

Package: guix-patches;

Reported by: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>

Date: Wed, 10 May 2023 01:10:02 UTC

Severity: normal

Tags: patch

Merged with 63403

Done: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>

Bug is archived. No further changes may be made.

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 63402 in the body.
You can then email your comments to 63402 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

View this report as an mbox folder, status mbox, maintainer mbox


Report forwarded to guix-patches <at> gnu.org:
bug#63402; Package guix-patches. (Wed, 10 May 2023 01:10:02 GMT) Full text and rfc822 format available.

Acknowledgement sent to Maxim Cournoyer <maxim.cournoyer <at> gmail.com>:
New bug report received and forwarded. Copy sent to guix-patches <at> gnu.org. (Wed, 10 May 2023 01:10:02 GMT) Full text and rfc822 format available.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
To: guix-patches <at> gnu.org,
	maxim.cournoyer <at> gmail.com
Subject: [PATCH 0/1] Add a dynamic IP monitoring option to Wireguard service
Date: Tue,  9 May 2023 21:08:59 -0400
Hi,

This change adds an option to monitor dynamic IP hosts used as
endpoints in Wireguard peer configuration and restart the service when
the IP captured by Wireguard has changed.

We have a keep-alive option already but this doesn't completely
prevent a connection from becoming stale, for example when the
Wireguard *server* is hosted on a machine with a dynamic IP and the
Wireguard *clients* are the ones initiating the connection to it.

When the Wireguard server disappears (in my case my ISP resets my IP
once per day, which breaks active connections), the keep-alives are
interrupted and the clients are stuck with a stale IP.

I've tested this with a duckdns.org dynamic host name that I use to
reach my private machine from the Internet, and it seems to work.
I'll report after a few days of usage.

Maxim Cournoyer (1):
  services: wireguard: Implement a dynamic IP monitoring feature.

 Makefile.am            |   1 +
 doc/guix.texi          |  18 +++++-
 gnu/services/vpn.scm   | 122 +++++++++++++++++++++++++++++++++++++++--
 tests/services/vpn.scm |  80 +++++++++++++++++++++++++++
 4 files changed, 215 insertions(+), 6 deletions(-)
 create mode 100644 tests/services/vpn.scm


base-commit: 7f89eee664c18d4d8214abf17cdad0e24096a5e7
-- 
2.39.2





Forcibly Merged 63402 63403. Request was from Maxim Cournoyer <maxim.cournoyer <at> gmail.com> to control <at> debbugs.gnu.org. (Wed, 10 May 2023 01:13:02 GMT) Full text and rfc822 format available.

Information forwarded to guix-patches <at> gnu.org:
bug#63402; Package guix-patches. (Mon, 15 May 2023 16:14:02 GMT) Full text and rfc822 format available.

Message #10 received at 63402 <at> debbugs.gnu.org (full text, mbox):

From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
To: 63402 <at> debbugs.gnu.org
Cc: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
Subject: [PATCH v2] services: wireguard: Implement a dynamic IP monitoring
 feature.
Date: Mon, 15 May 2023 12:13:02 -0400
* 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?)
(peers->endpoint-host-names)
(wireguard-monitoring-jobs): New procedures.
(wireguard-service-type): Register it.
* tests/services/vpn.scm: New file.
* Makefile.am (SCM_TESTS): Register it.
* doc/guix.texi (VPN Services): Update doc.
---
 Makefile.am            |   1 +
 doc/guix.texi          |  18 +++++-
 gnu/services/vpn.scm   | 123 +++++++++++++++++++++++++++++++++++++++--
 tests/services/vpn.scm |  80 +++++++++++++++++++++++++++
 4 files changed, 216 insertions(+), 6 deletions(-)
 create mode 100644 tests/services/vpn.scm

diff --git a/Makefile.am b/Makefile.am
index 13718e4353..fb6e4f57cd 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -553,6 +553,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 60972f408d..4499a911d6 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -32591,9 +32591,23 @@ 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, restarting the service when there is
+a mismatch between the endpoint IPs in actual use versus those freshly
+resolved from their host names.  Set this to @code{#t} if one or more
+endpoints use host names provided by a dynamic DNS service to keep
+connections working.
+
+@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..e21f999bc0 100644
--- a/gnu/services/vpn.scm
+++ b/gnu/services/vpn.scm
@@ -11,6 +11,7 @@
 ;;; Copyright © 2021 Nathan Dehnel <ncdehnel <at> gmail.com>
 ;;; Copyright © 2022 Cameron V Chaparro <cameron <at> cameronchaparro.com>
 ;;; Copyright © 2022 Timo Wilken <guix <at> twilken.net>
+;;; Copyright © 2023 Maxim Cournoyer <maxim.cournoyer <at> 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,49 @@ (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 (peers->endpoint-host-names peers)
+  "Return host names used as the endpoints of PEERS, if any.  Any \":PORT\"
+suffixes are stripped."
+  (map strip-port/maybe
+       (filter host-name? (filter-map wireguard-peer-endpoint peers))))
+
 (define (wireguard-shepherd-service config)
   (match-record config <wireguard-configuration>
     (wireguard interface)
@@ -878,9 +930,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 +938,69 @@ (define (wireguard-shepherd-service config)
                        #f))                       ;stopped!
              (documentation "Run the Wireguard VPN tunnel"))))))
 
+(define (wireguard-monitoring-jobs config)
+  (match-record config <wireguard-configuration>
+    (interface monitor-ips? monitor-ips-interval peers)
+    (let ((host-names (peers->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)))
+                       #~(begin
+                           (use-modules (gnu services herd)
+                                        (ice-9 popen)
+                                        (ice-9 textual-ports)
+                                        (srfi srfi-1)
+                                        (srfi srfi-26))
+
+                           (define (host-name->ip 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))))
+
+                           #$(procedure-source strip-port/maybe)
+
+                           (define service-name '#$(wireguard-service-name
+                                                    interface))
+
+                           (when (start-service service-name)
+                             (let* ((resolved-ips (map host-name->ip
+                                                       '#$host-names))
+                                    (pipe (open-pipe*
+                                           OPEN_READ
+                                           #$(file-append wireguard-tools
+                                                          "/bin/wg")
+                                           "show" #$interface "endpoints"))
+                                    (lines (string-split (get-string-all pipe)
+                                                         #\newline))
+                                    (used-ips (map (compose
+                                                    strip-port/maybe
+                                                    last
+                                                    (cut string-split <> #\tab))
+                                                   lines)))
+                               (close-pipe pipe)
+                               (unless (every (cut member <> used-ips)
+                                              resolved-ips)
+                                 (format #t "restarting ~a service due to \
+stale endpoint IPs~%" service-name)
+                                 (restart-service service-name))))))))))
+          '()))))                       ;monitor-ips? is #f
+
 (define wireguard-service-type
   (service-type
    (name 'wireguard)
@@ -898,6 +1011,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..9c6fa65df6
--- /dev/null
+++ b/tests/services/vpn.scm
@@ -0,0 +1,80 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2023 Maxim Cournoyer <maxim.cournoyer <at> 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 peers->endpoint-host-names
+  (@@ (gnu services vpn) peers->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 "peers->endpoint-host-names"
+  '("some.dynamic-dns.service" "example.org")
+  (peers->endpoint-host-names %wireguard-peers))
+
+(test-end "vpn-services")

base-commit: 7b00b155d8f474d493a22ff7cccbeec311b9bbc8
-- 
2.39.2





Information forwarded to guix-patches <at> gnu.org:
bug#63402; Package guix-patches. (Tue, 16 May 2023 04:11:02 GMT) Full text and rfc822 format available.

Message #13 received at 63402 <at> debbugs.gnu.org (full text, mbox):

From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
To: 63402 <at> debbugs.gnu.org
Cc: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
Subject: [PATCH v3 1/3] services: wireguard: Implement a dynamic IP monitoring
 feature.
Date: Tue, 16 May 2023 00:09:06 -0400
* 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?)
(peers->endpoint-host-names)
(wireguard-monitoring-jobs): New procedures.
(wireguard-service-type): Register it.
* tests/services/vpn.scm: New file.
* Makefile.am (SCM_TESTS): Register it.
* doc/guix.texi (VPN Services): Update doc.
---
 Makefile.am            |   1 +
 doc/guix.texi          |  18 +++++-
 gnu/services/vpn.scm   | 123 +++++++++++++++++++++++++++++++++++++++--
 tests/services/vpn.scm |  80 +++++++++++++++++++++++++++
 4 files changed, 216 insertions(+), 6 deletions(-)
 create mode 100644 tests/services/vpn.scm

diff --git a/Makefile.am b/Makefile.am
index 13718e4353..fb6e4f57cd 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -553,6 +553,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 60972f408d..4499a911d6 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -32591,9 +32591,23 @@ 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, restarting the service when there is
+a mismatch between the endpoint IPs in actual use versus those freshly
+resolved from their host names.  Set this to @code{#t} if one or more
+endpoints use host names provided by a dynamic DNS service to keep
+connections working.
+
+@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..e21f999bc0 100644
--- a/gnu/services/vpn.scm
+++ b/gnu/services/vpn.scm
@@ -11,6 +11,7 @@
 ;;; Copyright © 2021 Nathan Dehnel <ncdehnel <at> gmail.com>
 ;;; Copyright © 2022 Cameron V Chaparro <cameron <at> cameronchaparro.com>
 ;;; Copyright © 2022 Timo Wilken <guix <at> twilken.net>
+;;; Copyright © 2023 Maxim Cournoyer <maxim.cournoyer <at> 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,49 @@ (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 (peers->endpoint-host-names peers)
+  "Return host names used as the endpoints of PEERS, if any.  Any \":PORT\"
+suffixes are stripped."
+  (map strip-port/maybe
+       (filter host-name? (filter-map wireguard-peer-endpoint peers))))
+
 (define (wireguard-shepherd-service config)
   (match-record config <wireguard-configuration>
     (wireguard interface)
@@ -878,9 +930,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 +938,69 @@ (define (wireguard-shepherd-service config)
                        #f))                       ;stopped!
              (documentation "Run the Wireguard VPN tunnel"))))))
 
+(define (wireguard-monitoring-jobs config)
+  (match-record config <wireguard-configuration>
+    (interface monitor-ips? monitor-ips-interval peers)
+    (let ((host-names (peers->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)))
+                       #~(begin
+                           (use-modules (gnu services herd)
+                                        (ice-9 popen)
+                                        (ice-9 textual-ports)
+                                        (srfi srfi-1)
+                                        (srfi srfi-26))
+
+                           (define (host-name->ip 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))))
+
+                           #$(procedure-source strip-port/maybe)
+
+                           (define service-name '#$(wireguard-service-name
+                                                    interface))
+
+                           (when (start-service service-name)
+                             (let* ((resolved-ips (map host-name->ip
+                                                       '#$host-names))
+                                    (pipe (open-pipe*
+                                           OPEN_READ
+                                           #$(file-append wireguard-tools
+                                                          "/bin/wg")
+                                           "show" #$interface "endpoints"))
+                                    (lines (string-split (get-string-all pipe)
+                                                         #\newline))
+                                    (used-ips (map (compose
+                                                    strip-port/maybe
+                                                    last
+                                                    (cut string-split <> #\tab))
+                                                   lines)))
+                               (close-pipe pipe)
+                               (unless (every (cut member <> used-ips)
+                                              resolved-ips)
+                                 (format #t "restarting ~a service due to \
+stale endpoint IPs~%" service-name)
+                                 (restart-service service-name))))))))))
+          '()))))                       ;monitor-ips? is #f
+
 (define wireguard-service-type
   (service-type
    (name 'wireguard)
@@ -898,6 +1011,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..9c6fa65df6
--- /dev/null
+++ b/tests/services/vpn.scm
@@ -0,0 +1,80 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2023 Maxim Cournoyer <maxim.cournoyer <at> 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 peers->endpoint-host-names
+  (@@ (gnu services vpn) peers->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 "peers->endpoint-host-names"
+  '("some.dynamic-dns.service" "example.org")
+  (peers->endpoint-host-names %wireguard-peers))
+
+(test-end "vpn-services")

base-commit: 242cc93438d67f5b35602d5add02e230850b0b43
-- 
2.39.2





Information forwarded to guix-patches <at> gnu.org:
bug#63402; Package guix-patches. (Tue, 16 May 2023 04:11:03 GMT) Full text and rfc822 format available.

Message #16 received at 63402 <at> debbugs.gnu.org (full text, mbox):

From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
To: 63402 <at> debbugs.gnu.org
Cc: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
Subject: [PATCH v3 2/3] services: wireguard: Clean-up configuration file
 serializer.
Date: Tue, 16 May 2023 00:09:07 -0400
Previously, the generated config file would contain arbitrary whitespace that
made it look ugly.

* gnu/services/vpn.scm (<wireguard-configuration>) [dns]: Change default value
from #f to '().
(wireguard-configuration-file): Use match-record.  Format each line
individually, assembling the lines at the end to avoid extraneous white space.
* doc/guix.texi (VPN Services): Update doc.
---
 doc/guix.texi        |   2 +-
 gnu/services/vpn.scm | 119 ++++++++++++++++---------------------------
 2 files changed, 46 insertions(+), 75 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 4499a911d6..51c75a7dfc 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -32588,7 +32588,7 @@ VPN Services
 @item @code{port} (default: @code{51820})
 The port on which to listen for incoming connections.
 
-@item @code{dns} (default: @code{#f})
+@item @code{dns} (default: @code{'())})
 The DNS server(s) to announce to VPN clients via DHCP.
 
 @item @code{monitor-ips?} (default: @code{#f})
diff --git a/gnu/services/vpn.scm b/gnu/services/vpn.scm
index e21f999bc0..3f66db79de 100644
--- a/gnu/services/vpn.scm
+++ b/gnu/services/vpn.scm
@@ -44,6 +44,7 @@ (define-module (gnu services vpn)
   #:use-module (guix i18n)
   #:use-module (guix deprecation)
   #:use-module (srfi srfi-1)
+  #:use-module (ice-9 format)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
   #:export (openvpn-client-service  ; deprecated
@@ -745,7 +746,7 @@ (define-record-type* <wireguard-configuration>
   (peers              wireguard-configuration-peers ;list of <wiregard-peer>
                       (default '()))
   (dns                wireguard-configuration-dns ;list of strings
-                      (default #f))
+                      (default '()))
   (monitor-ips?       wireguard-configuration-monitor-ips? ;boolean
                       (default #f))
   (monitor-ips-interval wireguard-configuration-monitor-ips-interval
@@ -763,24 +764,15 @@ (define-record-type* <wireguard-configuration>
 
 (define (wireguard-configuration-file config)
   (define (peer->config peer)
-    (let ((name (wireguard-peer-name peer))
-          (public-key (wireguard-peer-public-key peer))
-          (endpoint (wireguard-peer-endpoint peer))
-          (allowed-ips (wireguard-peer-allowed-ips peer))
-          (keep-alive (wireguard-peer-keep-alive peer)))
-      (format #f "[Peer] #~a
-PublicKey = ~a
-AllowedIPs = ~a
-~a~a"
-              name
-              public-key
-              (string-join allowed-ips ",")
-              (if endpoint
-                  (format #f "Endpoint = ~a\n" endpoint)
-                  "")
-              (if keep-alive
-                  (format #f "PersistentKeepalive = ~a\n" keep-alive)
-                  "\n"))))
+    (match-record peer <wireguard-peer>
+      (name public-key endpoint allowed-ips keep-alive)
+      (let ((lines (list
+                    (format #f "[Peer]   #~a" name)
+                    (format #f "PublicKey = ~a" public-key)
+                    (format #f "AllowedIPs = ~{~a~^, ~}" allowed-ips)
+                    (format #f "~@[Endpoint = ~a~]" endpoint)
+                    (format #f "~@[PersistentKeepalive = ~a~]" keep-alive))))
+        (string-join (remove string-null? lines) "\n"))))
 
   (define (peers->preshared-keys peer keys)
     (let ((public-key (wireguard-peer-public-key peer))
@@ -799,65 +791,44 @@ (define (wireguard-configuration-file config)
             (computed-file
              "wireguard-config"
              #~(begin
+                 (use-modules (ice-9 format)
+                              (srfi srfi-1))
+
+                 (define lines
+                   (list
+                    "[Interface]"
+                    #$@(if (null? addresses)
+                           '()
+                           (list (format #f "Address = ~{~a~^, ~}"
+                                         addresses)))
+                    (format #f "~@[Table = ~a~]" #$table)
+                    #$@(if (null? pre-up)
+                           '()
+                           (list (format #f "~{PreUp = ~a~%~}" pre-up)))
+                    (format #f "PostUp = ~a set %i private-key ~a\
+~{ peer ~a preshared-key ~a~}" #$(file-append wireguard "/bin/wg")
+#$private-key '#$peer-keys)
+                    #$@(if (null? post-up)
+                           '()
+                           (list (format #f "~{PostUp = ~a~%~}" post-up)))
+                    #$@(if (null? pre-down)
+                           '()
+                           (list (format #f "~{PreDown = ~a~%~}" pre-down)))
+                    #$@(if (null? post-down)
+                           '()
+                           (list (format #f "~{PostDown = ~a~%~}" post-down)))
+                    (format #f "~@[ListenPort = ~a~]" #$port)
+                    #$@(if (null? dns)
+                           '()
+                           (list (format #f "~{DNS = ~{~a~^, ~}" dns)))))
+
                  (mkdir #$output)
                  (chdir #$output)
                  (call-with-output-file #$config-file
                    (lambda (port)
-                     (let ((format (@ (ice-9 format) format)))
-                       (format port "[Interface]
-Address = ~a
-~a
-~a
-PostUp = ~a set %i private-key ~a~{ peer ~a preshared-key ~a~}
-~a
-~a
-~a
-~a
-~a
-~{~a~^~%~}"
-                               #$(string-join addresses ",")
-                               #$(if table
-                                     (format #f "Table = ~a" table)
-                                     "")
-                               #$(if (null? pre-up)
-                                     ""
-                                     (string-join
-                                      (map (lambda (command)
-                                             (format #f "PreUp = ~a" command))
-                                           pre-up)
-                                      "\n"))
-                               #$(file-append wireguard "/bin/wg")
-                               #$private-key
-                               '#$peer-keys
-                               #$(if (null? post-up)
-                                     ""
-                                     (string-join
-                                      (map (lambda (command)
-                                             (format #f "PostUp = ~a" command))
-                                           post-up)
-                                      "\n"))
-                               #$(if (null? pre-down)
-                                     ""
-                                     (string-join
-                                      (map (lambda (command)
-                                             (format #f "PreDown = ~a" command))
-                                           pre-down)
-                                      "\n"))
-                               #$(if (null? post-down)
-                                     ""
-                                     (string-join
-                                      (map (lambda (command)
-                                             (format #f "PostDown = ~a" command))
-                                           post-down)
-                                      "\n"))
-                               #$(if port
-                                     (format #f "ListenPort = ~a" port)
-                                     "")
-                               #$(if dns
-                                     (format #f "DNS = ~a"
-                                             (string-join dns ","))
-                                     "")
-                               (list #$@peers)))))))))
+                     (format port "~a~%~%~{~a~%~^~%~}"
+                             (string-join (remove string-null? lines) "\n")
+                             '#$peers)))))))
       (file-append config "/" config-file))))
 
 (define (wireguard-activation config)
-- 
2.39.2





Information forwarded to guix-patches <at> gnu.org:
bug#63402; Package guix-patches. (Tue, 16 May 2023 04:11:03 GMT) Full text and rfc822 format available.

Message #19 received at 63402 <at> debbugs.gnu.org (full text, mbox):

From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
To: 63402 <at> debbugs.gnu.org
Cc: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
Subject: [PATCH v3 3/3] services: wireguard: Workaround keep-alives bug.
Date: Tue, 16 May 2023 00:09:08 -0400
* gnu/services/vpn.scm (wireguard-configuration-file): Add the
'persistent-keepalive' option to the PostUp script to workaround a bug.
---
 gnu/services/vpn.scm | 24 +++++++++++++++---------
 1 file changed, 15 insertions(+), 9 deletions(-)

diff --git a/gnu/services/vpn.scm b/gnu/services/vpn.scm
index 3f66db79de..587bfcfc0e 100644
--- a/gnu/services/vpn.scm
+++ b/gnu/services/vpn.scm
@@ -774,18 +774,19 @@ (define (wireguard-configuration-file config)
                     (format #f "~@[PersistentKeepalive = ~a~]" keep-alive))))
         (string-join (remove string-null? lines) "\n"))))
 
-  (define (peers->preshared-keys peer keys)
-    (let ((public-key (wireguard-peer-public-key peer))
-          (preshared-key (wireguard-peer-preshared-key peer)))
-      (if preshared-key
-          (cons* public-key preshared-key keys)
-          keys)))
+  (define (peers->preshared-keys+keep-alive peer data)
+    (match-record peer <wireguard-peer>
+      (public-key preshared-key keep-alive)
+      (if (or preshared-key keep-alive)
+          (cons* public-key preshared-key keep-alive data)
+          data)))
 
   (match-record config <wireguard-configuration>
     (wireguard interface addresses port private-key peers dns
                pre-up post-up pre-down post-down table)
     (let* ((config-file (string-append interface ".conf"))
-           (peer-keys (fold peers->preshared-keys (list) peers))
+           (peer-keys+keep-alive (fold peers->preshared-keys+keep-alive
+                                       '() peers))
            (peers (map peer->config peers))
            (config
             (computed-file
@@ -805,9 +806,14 @@ (define (wireguard-configuration-file config)
                     #$@(if (null? pre-up)
                            '()
                            (list (format #f "~{PreUp = ~a~%~}" pre-up)))
+                    ;; Duplicate the persistent-keepalive setting here, to
+                    ;; workaround a bug in WireGuard where keep-alives are not
+                    ;; sent when an interface is initially brought up without
+                    ;; a private key.
                     (format #f "PostUp = ~a set %i private-key ~a\
-~{ peer ~a preshared-key ~a~}" #$(file-append wireguard "/bin/wg")
-#$private-key '#$peer-keys)
+~{ peer ~a~@[ preshared-key ~a~]~@[ persistent-keepalive ~a~]~}"
+                            #$(file-append wireguard "/bin/wg")
+                            #$private-key '#$peer-keys+keep-alive)
                     #$@(if (null? post-up)
                            '()
                            (list (format #f "~{PostUp = ~a~%~}" post-up)))
-- 
2.39.2





Information forwarded to leo <at> famulari.name, me <at> tobias.gr, guix-patches <at> gnu.org:
bug#63402; Package guix-patches. (Thu, 18 May 2023 17:49:01 GMT) Full text and rfc822 format available.

Message #22 received at 63402 <at> debbugs.gnu.org (full text, mbox):

From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
To: 63402 <at> debbugs.gnu.org
Cc: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
Subject: [PATCH v4 0/4] Implement a dynamic IP monitoring feature.
Date: Thu, 18 May 2023 13:48:38 -0400
Hello,

This fourth revision reworks the monitoring script to use 'wg set' to
reset the affected endpoint instead of restarting the whole service.

It also applies an upstream patch to the kernel that resolves the bug
where keep-alive would not work to (re)establish a session after it
was lost (e.g. when the listener's dynamic IP changed with an
interruption to its Internet service), instead of applying a
workaround to our PostUp command.

Thanks,

Maxim Cournoyer (4):
  services: wireguard: Implement a dynamic IP monitoring feature.
  services: wireguard: Clean-up configuration file serializer.
  services: wireguard: Add a 'configuration' action.
  gnu: linux-libre: Apply wireguard patch fixing keep-alive bug.

 Makefile.am                                   |   1 +
 doc/guix.texi                                 |  19 +-
 gnu/local.mk                                  |   1 +
 gnu/packages/linux.scm                        |  27 +-
 ...linux-libre-wireguard-postup-privkey.patch | 119 ++++++++
 gnu/services/vpn.scm                          | 265 +++++++++++++-----
 tests/services/vpn.scm                        |  83 ++++++
 7 files changed, 427 insertions(+), 88 deletions(-)
 create mode 100644 gnu/packages/patches/linux-libre-wireguard-postup-privkey.patch
 create mode 100644 tests/services/vpn.scm


base-commit: 5b700945fb0b33eec410de8979cae2fbf0d4f118
-- 
2.39.2





Information forwarded to guix-patches <at> gnu.org:
bug#63402; Package guix-patches. (Thu, 18 May 2023 17:49:02 GMT) Full text and rfc822 format available.

Message #25 received at 63402 <at> debbugs.gnu.org (full text, mbox):

From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
To: 63402 <at> debbugs.gnu.org
Cc: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
Subject: [PATCH v4 1/4] services: wireguard: Implement a dynamic IP monitoring
 feature.
Date: Thu, 18 May 2023 13:48:39 -0400
* 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.
---
 Makefile.am            |   1 +
 doc/guix.texi          |  17 ++++-
 gnu/services/vpn.scm   | 147 +++++++++++++++++++++++++++++++++++++++--
 tests/services/vpn.scm |  83 +++++++++++++++++++++++
 4 files changed, 242 insertions(+), 6 deletions(-)
 create mode 100644 tests/services/vpn.scm

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 60972f408d..ef96d064ed 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -32591,9 +32591,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..c11faed879 100644
--- a/gnu/services/vpn.scm
+++ b/gnu/services/vpn.scm
@@ -11,6 +11,7 @@
 ;;; Copyright © 2021 Nathan Dehnel <ncdehnel <at> gmail.com>
 ;;; Copyright © 2022 Cameron V Chaparro <cameron <at> cameronchaparro.com>
 ;;; Copyright © 2022 Timo Wilken <guix <at> twilken.net>
+;;; Copyright © 2023 Maxim Cournoyer <maxim.cournoyer <at> 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,86 @@ (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 (start-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 +1035,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 <at> 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.39.2





Information forwarded to guix-patches <at> gnu.org:
bug#63402; Package guix-patches. (Thu, 18 May 2023 17:50:03 GMT) Full text and rfc822 format available.

Message #28 received at 63402 <at> debbugs.gnu.org (full text, mbox):

From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
To: 63402 <at> debbugs.gnu.org
Cc: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
Subject: [PATCH v4 2/4] services: wireguard: Clean-up configuration file
 serializer.
Date: Thu, 18 May 2023 13:48:40 -0400
Previously, the generated config file would contain arbitrary whitespace that
made it look ugly.

* gnu/services/vpn.scm (<wireguard-configuration>) [dns]: Change default value
from #f to '().
(wireguard-configuration-file): Use match-record.  Format each line
individually, assembling the lines at the end to avoid extraneous white space.
* doc/guix.texi (VPN Services): Update doc.
---
 doc/guix.texi        |   2 +-
 gnu/services/vpn.scm | 119 ++++++++++++++++---------------------------
 2 files changed, 46 insertions(+), 75 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index ef96d064ed..b61a2ceb5b 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -32588,7 +32588,7 @@ VPN Services
 @item @code{port} (default: @code{51820})
 The port on which to listen for incoming connections.
 
-@item @code{dns} (default: @code{#f})
+@item @code{dns} (default: @code{'())})
 The DNS server(s) to announce to VPN clients via DHCP.
 
 @item @code{monitor-ips?} (default: @code{#f})
diff --git a/gnu/services/vpn.scm b/gnu/services/vpn.scm
index c11faed879..a34889a6cc 100644
--- a/gnu/services/vpn.scm
+++ b/gnu/services/vpn.scm
@@ -44,6 +44,7 @@ (define-module (gnu services vpn)
   #:use-module (guix i18n)
   #:use-module (guix deprecation)
   #:use-module (srfi srfi-1)
+  #:use-module (ice-9 format)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
   #:export (openvpn-client-service  ; deprecated
@@ -745,7 +746,7 @@ (define-record-type* <wireguard-configuration>
   (peers              wireguard-configuration-peers ;list of <wiregard-peer>
                       (default '()))
   (dns                wireguard-configuration-dns ;list of strings
-                      (default #f))
+                      (default '()))
   (monitor-ips?       wireguard-configuration-monitor-ips? ;boolean
                       (default #f))
   (monitor-ips-interval wireguard-configuration-monitor-ips-interval
@@ -763,24 +764,15 @@ (define-record-type* <wireguard-configuration>
 
 (define (wireguard-configuration-file config)
   (define (peer->config peer)
-    (let ((name (wireguard-peer-name peer))
-          (public-key (wireguard-peer-public-key peer))
-          (endpoint (wireguard-peer-endpoint peer))
-          (allowed-ips (wireguard-peer-allowed-ips peer))
-          (keep-alive (wireguard-peer-keep-alive peer)))
-      (format #f "[Peer] #~a
-PublicKey = ~a
-AllowedIPs = ~a
-~a~a"
-              name
-              public-key
-              (string-join allowed-ips ",")
-              (if endpoint
-                  (format #f "Endpoint = ~a\n" endpoint)
-                  "")
-              (if keep-alive
-                  (format #f "PersistentKeepalive = ~a\n" keep-alive)
-                  "\n"))))
+    (match-record peer <wireguard-peer>
+      (name public-key endpoint allowed-ips keep-alive)
+      (let ((lines (list
+                    (format #f "[Peer]   #~a" name)
+                    (format #f "PublicKey = ~a" public-key)
+                    (format #f "AllowedIPs = ~{~a~^, ~}" allowed-ips)
+                    (format #f "~@[Endpoint = ~a~]" endpoint)
+                    (format #f "~@[PersistentKeepalive = ~a~]" keep-alive))))
+        (string-join (remove string-null? lines) "\n"))))
 
   (define (peers->preshared-keys peer keys)
     (let ((public-key (wireguard-peer-public-key peer))
@@ -799,65 +791,44 @@ (define (wireguard-configuration-file config)
             (computed-file
              "wireguard-config"
              #~(begin
+                 (use-modules (ice-9 format)
+                              (srfi srfi-1))
+
+                 (define lines
+                   (list
+                    "[Interface]"
+                    #$@(if (null? addresses)
+                           '()
+                           (list (format #f "Address = ~{~a~^, ~}"
+                                         addresses)))
+                    (format #f "~@[Table = ~a~]" #$table)
+                    #$@(if (null? pre-up)
+                           '()
+                           (list (format #f "~{PreUp = ~a~%~}" pre-up)))
+                    (format #f "PostUp = ~a set %i private-key ~a\
+~{ peer ~a preshared-key ~a~}" #$(file-append wireguard "/bin/wg")
+#$private-key '#$peer-keys)
+                    #$@(if (null? post-up)
+                           '()
+                           (list (format #f "~{PostUp = ~a~%~}" post-up)))
+                    #$@(if (null? pre-down)
+                           '()
+                           (list (format #f "~{PreDown = ~a~%~}" pre-down)))
+                    #$@(if (null? post-down)
+                           '()
+                           (list (format #f "~{PostDown = ~a~%~}" post-down)))
+                    (format #f "~@[ListenPort = ~a~]" #$port)
+                    #$@(if (null? dns)
+                           '()
+                           (list (format #f "~{DNS = ~{~a~^, ~}" dns)))))
+
                  (mkdir #$output)
                  (chdir #$output)
                  (call-with-output-file #$config-file
                    (lambda (port)
-                     (let ((format (@ (ice-9 format) format)))
-                       (format port "[Interface]
-Address = ~a
-~a
-~a
-PostUp = ~a set %i private-key ~a~{ peer ~a preshared-key ~a~}
-~a
-~a
-~a
-~a
-~a
-~{~a~^~%~}"
-                               #$(string-join addresses ",")
-                               #$(if table
-                                     (format #f "Table = ~a" table)
-                                     "")
-                               #$(if (null? pre-up)
-                                     ""
-                                     (string-join
-                                      (map (lambda (command)
-                                             (format #f "PreUp = ~a" command))
-                                           pre-up)
-                                      "\n"))
-                               #$(file-append wireguard "/bin/wg")
-                               #$private-key
-                               '#$peer-keys
-                               #$(if (null? post-up)
-                                     ""
-                                     (string-join
-                                      (map (lambda (command)
-                                             (format #f "PostUp = ~a" command))
-                                           post-up)
-                                      "\n"))
-                               #$(if (null? pre-down)
-                                     ""
-                                     (string-join
-                                      (map (lambda (command)
-                                             (format #f "PreDown = ~a" command))
-                                           pre-down)
-                                      "\n"))
-                               #$(if (null? post-down)
-                                     ""
-                                     (string-join
-                                      (map (lambda (command)
-                                             (format #f "PostDown = ~a" command))
-                                           post-down)
-                                      "\n"))
-                               #$(if port
-                                     (format #f "ListenPort = ~a" port)
-                                     "")
-                               #$(if dns
-                                     (format #f "DNS = ~a"
-                                             (string-join dns ","))
-                                     "")
-                               (list #$@peers)))))))))
+                     (format port "~a~%~%~{~a~%~^~%~}"
+                             (string-join (remove string-null? lines) "\n")
+                             '#$peers)))))))
       (file-append config "/" config-file))))
 
 (define (wireguard-activation config)
-- 
2.39.2





Information forwarded to guix-patches <at> gnu.org:
bug#63402; Package guix-patches. (Thu, 18 May 2023 17:50:03 GMT) Full text and rfc822 format available.

Message #31 received at 63402 <at> debbugs.gnu.org (full text, mbox):

From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
To: 63402 <at> debbugs.gnu.org
Cc: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
Subject: [PATCH v4 3/4] services: wireguard: Add a 'configuration' action.
Date: Thu, 18 May 2023 13:48:41 -0400
* gnu/services/vpn.scm (wireguard-shepherd-service) [actions]: New field.
---
 gnu/services/vpn.scm | 1 +
 1 file changed, 1 insertion(+)

diff --git a/gnu/services/vpn.scm b/gnu/services/vpn.scm
index a34889a6cc..c3fe82a063 100644
--- a/gnu/services/vpn.scm
+++ b/gnu/services/vpn.scm
@@ -914,6 +914,7 @@ (define (wireguard-shepherd-service config)
              (stop #~(lambda _
                        (invoke #$wg-quick "down" #$config)
                        #f))                       ;stopped!
+             (actions (list (shepherd-configuration-action config)))
              (documentation "Run the Wireguard VPN tunnel"))))))
 
 (define (wireguard-monitoring-jobs config)
-- 
2.39.2





Information forwarded to leo <at> famulari.name, me <at> tobias.gr, guix-patches <at> gnu.org:
bug#63402; Package guix-patches. (Thu, 18 May 2023 17:50:03 GMT) Full text and rfc822 format available.

Message #34 received at 63402 <at> debbugs.gnu.org (full text, mbox):

From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
To: 63402 <at> debbugs.gnu.org
Cc: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
Subject: [PATCH v4 4/4] gnu: linux-libre: Apply wireguard patch fixing
 keep-alive bug.
Date: Thu, 18 May 2023 13:48:42 -0400
* gnu/packages/patches/linux-libre-wireguard-postup-privkey.patch: New patch.
* gnu/local.mk (dist_patch_DATA): Register it.
* gnu/packages/linux.scm (linux-libre-6.3-source, linux-libre-6.2-source)
(linux-libre-6.1-source, linux-libre-5.15-source)
(linux-libre-5.10-source): Apply it.
---
 gnu/local.mk                                  |   1 +
 gnu/packages/linux.scm                        |  27 ++--
 ...linux-libre-wireguard-postup-privkey.patch | 119 ++++++++++++++++++
 3 files changed, 139 insertions(+), 8 deletions(-)
 create mode 100644 gnu/packages/patches/linux-libre-wireguard-postup-privkey.patch

diff --git a/gnu/local.mk b/gnu/local.mk
index 42514ded8e..0b0aafa016 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -1515,6 +1515,7 @@ dist_patch_DATA =						\
   %D%/packages/patches/linphone-desktop-without-sdk.patch	\
   %D%/packages/patches/linux-libre-infodocs-target.patch	\
   %D%/packages/patches/linux-libre-support-for-Pinebook-Pro.patch \
+  %D%/packages/patches/linux-libre-wireguard-postup-privkey.patch \
   %D%/packages/patches/linux-pam-no-setfsuid.patch		\
   %D%/packages/patches/linux-pam-unix_chkpwd.patch		\
   %D%/packages/patches/linuxdcpp-openssl-1.1.patch		\
diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm
index c38287e16b..6440e358c0 100644
--- a/gnu/packages/linux.scm
+++ b/gnu/packages/linux.scm
@@ -34,7 +34,7 @@
 ;;; Copyright © 2018 Vasile Dumitrascu <va511e <at> yahoo.com>
 ;;; Copyright © 2019 Tim Gesthuizen <tim.gesthuizen <at> yahoo.de>
 ;;; Copyright © 2019 mikadoZero <mikadozero <at> yandex.com>
-;;; Copyright © 2019, 2020, 2021, 2022 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
+;;; Copyright © 2019, 2020, 2021, 2022, 2023 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
 ;;; Copyright © 2019 Stefan Stefanović <stefanx2ovic <at> gmail.com>
 ;;; Copyright © 2019-2022 Brice Waegeneire <brice <at> waegenei.re>
 ;;; Copyright © 2019 Kei Kebreau <kkebreau <at> posteo.net>
@@ -639,28 +639,39 @@ (define (source-with-patches source patches)
 (define-public linux-libre-6.3-source
   (source-with-patches linux-libre-6.3-pristine-source
                        (list %boot-logo-patch
-                             %linux-libre-arm-export-__sync_icache_dcache-patch)))
+                             %linux-libre-arm-export-__sync_icache_dcache-patch
+                             (search-patch
+                              "linux-libre-wireguard-postup-privkey.patch"))))
 
 (define-public linux-libre-6.2-source
   (source-with-patches linux-libre-6.2-pristine-source
                        (list %boot-logo-patch
-                             %linux-libre-arm-export-__sync_icache_dcache-patch)))
+                             %linux-libre-arm-export-__sync_icache_dcache-patch
+                             (search-patch
+                              "linux-libre-wireguard-postup-privkey.patch"))))
 
 (define-public linux-libre-6.1-source
   (source-with-patches linux-libre-6.1-pristine-source
-                       (list %boot-logo-patch
-                             %linux-libre-arm-export-__sync_icache_dcache-patch
-                             (search-patch "linux-libre-infodocs-target.patch"))))
+                       (append
+                        (list %boot-logo-patch
+                              %linux-libre-arm-export-__sync_icache_dcache-patch)
+                        (search-patches
+                         "linux-libre-infodocs-target.patch"
+                         "linux-libre-wireguard-postup-privkey.patch"))))
 
 (define-public linux-libre-5.15-source
   (source-with-patches linux-libre-5.15-pristine-source
                        (list %boot-logo-patch
-                             %linux-libre-arm-export-__sync_icache_dcache-patch)))
+                             %linux-libre-arm-export-__sync_icache_dcache-patch
+                             (search-patch
+                              "linux-libre-wireguard-postup-privkey.patch"))))
 
 (define-public linux-libre-5.10-source
   (source-with-patches linux-libre-5.10-pristine-source
                        (list %boot-logo-patch
-                             %linux-libre-arm-export-__sync_icache_dcache-patch)))
+                             %linux-libre-arm-export-__sync_icache_dcache-patch
+                             (search-patch
+                              "linux-libre-wireguard-postup-privkey.patch"))))
 
 (define-public linux-libre-5.4-source
   (source-with-patches linux-libre-5.4-pristine-source
diff --git a/gnu/packages/patches/linux-libre-wireguard-postup-privkey.patch b/gnu/packages/patches/linux-libre-wireguard-postup-privkey.patch
new file mode 100644
index 0000000000..a6050499e1
--- /dev/null
+++ b/gnu/packages/patches/linux-libre-wireguard-postup-privkey.patch
@@ -0,0 +1,119 @@
+From 3ac1bf099766f1e9735883d5127148054cd5b30a Mon Sep 17 00:00:00 2001
+From: "Jason A. Donenfeld" <Jason <at> zx2c4.com>
+Date: Thu, 18 May 2023 03:08:44 +0200
+Subject: wireguard: netlink: send staged packets when setting initial private
+ key
+
+Packets bound for peers can queue up prior to the device private key
+being set. For example, if persistent keepalive is set, a packet is
+queued up to be sent as soon as the device comes up. However, if the
+private key hasn't been set yet, the handshake message never sends, and
+no timer is armed to retry, since that would be pointless.
+
+But, if a user later sets a private key, the expectation is that those
+queued packets, such as a persistent keepalive, are actually sent. So
+adjust the configuration logic to account for this edge case, and add a
+test case to make sure this works.
+
+Maxim noticed this with a wg-quick(8) config to the tune of:
+
+    [Interface]
+    PostUp = wg set %i private-key somefile
+
+    [Peer]
+    PublicKey = ...
+    Endpoint = ...
+    PersistentKeepalive = 25
+
+Here, the private key gets set after the device comes up using a PostUp
+script, triggering the bug.
+
+Fixes: e7096c131e51 ("net: WireGuard secure network tunnel")
+Cc: stable <at> vger.kernel.org
+Reported-by: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
+Link: https://lore.kernel.org/wireguard/87fs7xtqrv.fsf <at> gmail.com/
+Signed-off-by: Jason A. Donenfeld <Jason <at> zx2c4.com>
+---
+ drivers/net/wireguard/netlink.c            | 14 +++++++++-----
+ tools/testing/selftests/wireguard/netns.sh | 30 ++++++++++++++++++++++++++----
+ 2 files changed, 35 insertions(+), 9 deletions(-)
+
+diff --git a/drivers/net/wireguard/netlink.c b/drivers/net/wireguard/netlink.c
+index 43c8c84e7ea8..6d1bd9f52d02 100644
+--- a/drivers/net/wireguard/netlink.c
++++ b/drivers/net/wireguard/netlink.c
+@@ -546,6 +546,7 @@ static int wg_set_device(struct sk_buff *skb, struct genl_info *info)
+ 		u8 *private_key = nla_data(info->attrs[WGDEVICE_A_PRIVATE_KEY]);
+ 		u8 public_key[NOISE_PUBLIC_KEY_LEN];
+ 		struct wg_peer *peer, *temp;
++		bool send_staged_packets;
+ 
+ 		if (!crypto_memneq(wg->static_identity.static_private,
+ 				   private_key, NOISE_PUBLIC_KEY_LEN))
+@@ -564,14 +565,17 @@ static int wg_set_device(struct sk_buff *skb, struct genl_info *info)
+ 		}
+ 
+ 		down_write(&wg->static_identity.lock);
+-		wg_noise_set_static_identity_private_key(&wg->static_identity,
+-							 private_key);
+-		list_for_each_entry_safe(peer, temp, &wg->peer_list,
+-					 peer_list) {
++		send_staged_packets = !wg->static_identity.has_identity && netif_running(wg->dev);
++		wg_noise_set_static_identity_private_key(&wg->static_identity, private_key);
++		send_staged_packets = send_staged_packets && wg->static_identity.has_identity;
++
++		wg_cookie_checker_precompute_device_keys(&wg->cookie_checker);
++		list_for_each_entry_safe(peer, temp, &wg->peer_list, peer_list) {
+ 			wg_noise_precompute_static_static(peer);
+ 			wg_noise_expire_current_peer_keypairs(peer);
++			if (send_staged_packets)
++				wg_packet_send_staged_packets(peer);
+ 		}
+-		wg_cookie_checker_precompute_device_keys(&wg->cookie_checker);
+ 		up_write(&wg->static_identity.lock);
+ 	}
+ skip_set_private_key:
+diff --git a/tools/testing/selftests/wireguard/netns.sh b/tools/testing/selftests/wireguard/netns.sh
+index 69c7796c7ca9..405ff262ca93 100755
+--- a/tools/testing/selftests/wireguard/netns.sh
++++ b/tools/testing/selftests/wireguard/netns.sh
+@@ -514,10 +514,32 @@ n2 bash -c 'printf 0 > /proc/sys/net/ipv4/conf/all/rp_filter'
+ n1 ping -W 1 -c 1 192.168.241.2
+ [[ $(n2 wg show wg0 endpoints) == "$pub1	10.0.0.3:1" ]]
+ 
+-ip1 link del veth1
+-ip1 link del veth3
+-ip1 link del wg0
+-ip2 link del wg0
++ip1 link del dev veth3
++ip1 link del dev wg0
++ip2 link del dev wg0
++
++# Make sure persistent keep alives are sent when an adapter comes up
++ip1 link add dev wg0 type wireguard
++n1 wg set wg0 private-key <(echo "$key1") peer "$pub2" endpoint 10.0.0.1:1 persistent-keepalive 1
++read _ _ tx_bytes < <(n1 wg show wg0 transfer)
++[[ $tx_bytes -eq 0 ]]
++ip1 link set dev wg0 up
++read _ _ tx_bytes < <(n1 wg show wg0 transfer)
++[[ $tx_bytes -gt 0 ]]
++ip1 link del dev wg0
++# This should also happen even if the private key is set later
++ip1 link add dev wg0 type wireguard
++n1 wg set wg0 peer "$pub2" endpoint 10.0.0.1:1 persistent-keepalive 1
++read _ _ tx_bytes < <(n1 wg show wg0 transfer)
++[[ $tx_bytes -eq 0 ]]
++ip1 link set dev wg0 up
++read _ _ tx_bytes < <(n1 wg show wg0 transfer)
++[[ $tx_bytes -eq 0 ]]
++n1 wg set wg0 private-key <(echo "$key1")
++read _ _ tx_bytes < <(n1 wg show wg0 transfer)
++[[ $tx_bytes -gt 0 ]]
++ip1 link del dev veth1
++ip1 link del dev wg0
+ 
+ # We test that Netlink/IPC is working properly by doing things that usually cause split responses
+ ip0 link add dev wg0 type wireguard
+-- 
+cgit v1.2.3-59-g8ed1b
+
-- 
2.39.2





Information forwarded to leo <at> famulari.name, me <at> tobias.gr, guix-patches <at> gnu.org:
bug#63402; Package guix-patches. (Fri, 19 May 2023 02:00:02 GMT) Full text and rfc822 format available.

Message #37 received at 63402 <at> debbugs.gnu.org (full text, mbox):

From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
To: 63402 <at> debbugs.gnu.org
Cc: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
Subject: [PATCH v5 0/5] Implement a dynamic IP monitoring feature.
Date: Thu, 18 May 2023 21:59:12 -0400
Hi,

Compared to v4, this series adds a new 'current-service' procedure to
(gnu services herd) and makes use of it to check if the current
wireguard service is already running without causing it to restart if
it was stopped, via something like:

  (live-service-running (current-service 'wireguard-wg0))

Thanks,

Maxim Cournoyer (5):
  services: herd: Add a new 'current-service' procedure.
  services: wireguard: Implement a dynamic IP monitoring feature.
  services: wireguard: Clean-up configuration file serializer.
  services: wireguard: Add a 'configuration' action.
  gnu: linux-libre: Apply wireguard patch fixing keep-alive bug.

 Makefile.am                                   |   1 +
 doc/guix.texi                                 |  19 +-
 gnu/local.mk                                  |   1 +
 gnu/packages/linux.scm                        |  27 +-
 ...linux-libre-wireguard-postup-privkey.patch | 119 ++++++++
 gnu/services/herd.scm                         |  52 ++--
 gnu/services/vpn.scm                          | 266 +++++++++++++-----
 tests/services/vpn.scm                        |  83 ++++++
 8 files changed, 461 insertions(+), 107 deletions(-)
 create mode 100644 gnu/packages/patches/linux-libre-wireguard-postup-privkey.patch
 create mode 100644 tests/services/vpn.scm


base-commit: deda3cc9057f20b1e3d34d63a64da0bdd6ca1998
-- 
2.40.1





Information forwarded to guix-patches <at> gnu.org:
bug#63402; Package guix-patches. (Fri, 19 May 2023 02:01:02 GMT) Full text and rfc822 format available.

Message #40 received at 63402 <at> debbugs.gnu.org (full text, mbox):

From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
To: 63402 <at> debbugs.gnu.org
Cc: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
Subject: [PATCH v5 1/5] services: herd: Add a new 'current-service' procedure.
Date: Thu, 18 May 2023 21:59:13 -0400
* gnu/services/herd.scm (current-service): New procedure, mostly reusing the
existing current-services.
(current-services): Implement in terms of the above procedure.
---
 gnu/services/herd.scm | 52 +++++++++++++++++++++++++++----------------
 1 file changed, 33 insertions(+), 19 deletions(-)

diff --git a/gnu/services/herd.scm b/gnu/services/herd.scm
index 48594015fc..02c2fec20f 100644
--- a/gnu/services/herd.scm
+++ b/gnu/services/herd.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016-2019, 2022-2023 Ludovic Courtès <ludo <at> gnu.org>
 ;;; Copyright © 2017, 2020 Mathieu Othacehe <m.othacehe <at> gmail.com>
+;;; Copyright © 2023 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -51,6 +52,7 @@ (define-module (gnu services herd)
             live-service-canonical-name
 
             with-shepherd-action
+            current-service
             current-services
             unload-services
             unload-service
@@ -208,31 +210,43 @@ (define (live-service-canonical-name service)
   "Return the 'canonical name' of SERVICE."
   (first (live-service-provision service)))
 
-(define (current-services)
-  "Return the list of currently defined Shepherd services, represented as
-<live-service> objects.  Return #f if the list of services could not be
-obtained."
-  (with-shepherd-action 'root ('status) results
-    ;; We get a list of results, one for each service with the name 'root'.
+(define (current-service name)
+  "Return the currently defined Shepherd service NAME, as a <live-service>
+object.  Return #f if the service could not be obtained.  As a special case,
+@code{(current-service 'root)} returns all the current services."
+  (define (process-services services)
+    (resolve-transients
+     (map (lambda (service)
+            (alist-let* service (provides requires running transient?)
+              ;; The Shepherd 0.9.0 would not provide 'transient?' in
+              ;; its status sexp.  Thus, when it's missing, query it
+              ;; via an "eval" request.
+              (live-service provides requires
+                            (if (sloppy-assq 'transient? service)
+                                transient?
+                                (and running *unspecified*))
+                            running)))
+          services)))
+
+  (with-shepherd-action name ('status) results
+    ;; We get a list of results, one for each service with the name NAME.
     ;; In practice there's only one such service though.
     (match results
       ((services _ ...)
        (match services
          ((('service ('version 0 _ ...) _ ...) ...)
-          (resolve-transients
-           (map (lambda (service)
-                  (alist-let* service (provides requires running transient?)
-                    ;; The Shepherd 0.9.0 would not provide 'transient?' in its
-                    ;; status sexp.  Thus, when it's missing, query it via an
-                    ;; "eval" request.
-                    (live-service provides requires
-                                  (if (sloppy-assq 'transient? service)
-                                      transient?
-                                      (and running *unspecified*))
-                                  running)))
-                services)))
+          ;; Summary of all services (when NAME is 'root or 'shepherd).
+          (process-services services))
+         (('service ('version 0 _ ...) _ ...) ;single service
+          (first (process-services (list services))))
          (x
-          #f))))))
+          #f))))))                ;singleton
+
+(define (current-services)
+  "Return the list of currently defined Shepherd services, represented as
+<live-service> objects.  Return #f if the list of services could not be
+obtained."
+  (current-service 'root))
 
 (define (resolve-transients services)
   "Resolve the subset of SERVICES whose 'transient?' field is undefined.  This
-- 
2.40.1





Information forwarded to guix-patches <at> gnu.org:
bug#63402; Package guix-patches. (Fri, 19 May 2023 02:02:02 GMT) Full text and rfc822 format available.

Message #43 received at 63402 <at> debbugs.gnu.org (full text, mbox):

From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
To: 63402 <at> debbugs.gnu.org
Cc: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
Subject: [PATCH v5 2/5] services: wireguard: Implement a dynamic IP monitoring
 feature.
Date: Thu, 18 May 2023 21:59:14 -0400
* 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.
---
 Makefile.am            |   1 +
 doc/guix.texi          |  17 ++++-
 gnu/services/vpn.scm   | 148 +++++++++++++++++++++++++++++++++++++++--
 tests/services/vpn.scm |  83 +++++++++++++++++++++++
 4 files changed, 243 insertions(+), 6 deletions(-)
 create mode 100644 tests/services/vpn.scm

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 <at> gmail.com>
 ;;; Copyright © 2022 Cameron V Chaparro <cameron <at> cameronchaparro.com>
 ;;; Copyright © 2022 Timo Wilken <guix <at> twilken.net>
+;;; Copyright © 2023 Maxim Cournoyer <maxim.cournoyer <at> 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 <at> 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





Information forwarded to guix-patches <at> gnu.org:
bug#63402; Package guix-patches. (Fri, 19 May 2023 02:02:02 GMT) Full text and rfc822 format available.

Message #46 received at 63402 <at> debbugs.gnu.org (full text, mbox):

From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
To: 63402 <at> debbugs.gnu.org
Cc: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
Subject: [PATCH v5 3/5] services: wireguard: Clean-up configuration file
 serializer.
Date: Thu, 18 May 2023 21:59:15 -0400
Previously, the generated config file would contain arbitrary whitespace that
made it look ugly.

* gnu/services/vpn.scm (<wireguard-configuration>) [dns]: Change default value
from #f to '().
(wireguard-configuration-file): Use match-record.  Format each line
individually, assembling the lines at the end to avoid extraneous white space.
* doc/guix.texi (VPN Services): Update doc.
---
 doc/guix.texi        |   2 +-
 gnu/services/vpn.scm | 119 ++++++++++++++++---------------------------
 2 files changed, 46 insertions(+), 75 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index b19ba887a1..e2f46852e2 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -32639,7 +32639,7 @@ VPN Services
 @item @code{port} (default: @code{51820})
 The port on which to listen for incoming connections.
 
-@item @code{dns} (default: @code{#f})
+@item @code{dns} (default: @code{'())})
 The DNS server(s) to announce to VPN clients via DHCP.
 
 @item @code{monitor-ips?} (default: @code{#f})
diff --git a/gnu/services/vpn.scm b/gnu/services/vpn.scm
index 9cf08c194a..8740722b6f 100644
--- a/gnu/services/vpn.scm
+++ b/gnu/services/vpn.scm
@@ -44,6 +44,7 @@ (define-module (gnu services vpn)
   #:use-module (guix i18n)
   #:use-module (guix deprecation)
   #:use-module (srfi srfi-1)
+  #:use-module (ice-9 format)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
   #:export (openvpn-client-service  ; deprecated
@@ -745,7 +746,7 @@ (define-record-type* <wireguard-configuration>
   (peers              wireguard-configuration-peers ;list of <wiregard-peer>
                       (default '()))
   (dns                wireguard-configuration-dns ;list of strings
-                      (default #f))
+                      (default '()))
   (monitor-ips?       wireguard-configuration-monitor-ips? ;boolean
                       (default #f))
   (monitor-ips-interval wireguard-configuration-monitor-ips-interval
@@ -763,24 +764,15 @@ (define-record-type* <wireguard-configuration>
 
 (define (wireguard-configuration-file config)
   (define (peer->config peer)
-    (let ((name (wireguard-peer-name peer))
-          (public-key (wireguard-peer-public-key peer))
-          (endpoint (wireguard-peer-endpoint peer))
-          (allowed-ips (wireguard-peer-allowed-ips peer))
-          (keep-alive (wireguard-peer-keep-alive peer)))
-      (format #f "[Peer] #~a
-PublicKey = ~a
-AllowedIPs = ~a
-~a~a"
-              name
-              public-key
-              (string-join allowed-ips ",")
-              (if endpoint
-                  (format #f "Endpoint = ~a\n" endpoint)
-                  "")
-              (if keep-alive
-                  (format #f "PersistentKeepalive = ~a\n" keep-alive)
-                  "\n"))))
+    (match-record peer <wireguard-peer>
+      (name public-key endpoint allowed-ips keep-alive)
+      (let ((lines (list
+                    (format #f "[Peer]   #~a" name)
+                    (format #f "PublicKey = ~a" public-key)
+                    (format #f "AllowedIPs = ~{~a~^, ~}" allowed-ips)
+                    (format #f "~@[Endpoint = ~a~]" endpoint)
+                    (format #f "~@[PersistentKeepalive = ~a~]" keep-alive))))
+        (string-join (remove string-null? lines) "\n"))))
 
   (define (peers->preshared-keys peer keys)
     (let ((public-key (wireguard-peer-public-key peer))
@@ -799,65 +791,44 @@ (define (wireguard-configuration-file config)
             (computed-file
              "wireguard-config"
              #~(begin
+                 (use-modules (ice-9 format)
+                              (srfi srfi-1))
+
+                 (define lines
+                   (list
+                    "[Interface]"
+                    #$@(if (null? addresses)
+                           '()
+                           (list (format #f "Address = ~{~a~^, ~}"
+                                         addresses)))
+                    (format #f "~@[Table = ~a~]" #$table)
+                    #$@(if (null? pre-up)
+                           '()
+                           (list (format #f "~{PreUp = ~a~%~}" pre-up)))
+                    (format #f "PostUp = ~a set %i private-key ~a\
+~{ peer ~a preshared-key ~a~}" #$(file-append wireguard "/bin/wg")
+#$private-key '#$peer-keys)
+                    #$@(if (null? post-up)
+                           '()
+                           (list (format #f "~{PostUp = ~a~%~}" post-up)))
+                    #$@(if (null? pre-down)
+                           '()
+                           (list (format #f "~{PreDown = ~a~%~}" pre-down)))
+                    #$@(if (null? post-down)
+                           '()
+                           (list (format #f "~{PostDown = ~a~%~}" post-down)))
+                    (format #f "~@[ListenPort = ~a~]" #$port)
+                    #$@(if (null? dns)
+                           '()
+                           (list (format #f "~{DNS = ~{~a~^, ~}" dns)))))
+
                  (mkdir #$output)
                  (chdir #$output)
                  (call-with-output-file #$config-file
                    (lambda (port)
-                     (let ((format (@ (ice-9 format) format)))
-                       (format port "[Interface]
-Address = ~a
-~a
-~a
-PostUp = ~a set %i private-key ~a~{ peer ~a preshared-key ~a~}
-~a
-~a
-~a
-~a
-~a
-~{~a~^~%~}"
-                               #$(string-join addresses ",")
-                               #$(if table
-                                     (format #f "Table = ~a" table)
-                                     "")
-                               #$(if (null? pre-up)
-                                     ""
-                                     (string-join
-                                      (map (lambda (command)
-                                             (format #f "PreUp = ~a" command))
-                                           pre-up)
-                                      "\n"))
-                               #$(file-append wireguard "/bin/wg")
-                               #$private-key
-                               '#$peer-keys
-                               #$(if (null? post-up)
-                                     ""
-                                     (string-join
-                                      (map (lambda (command)
-                                             (format #f "PostUp = ~a" command))
-                                           post-up)
-                                      "\n"))
-                               #$(if (null? pre-down)
-                                     ""
-                                     (string-join
-                                      (map (lambda (command)
-                                             (format #f "PreDown = ~a" command))
-                                           pre-down)
-                                      "\n"))
-                               #$(if (null? post-down)
-                                     ""
-                                     (string-join
-                                      (map (lambda (command)
-                                             (format #f "PostDown = ~a" command))
-                                           post-down)
-                                      "\n"))
-                               #$(if port
-                                     (format #f "ListenPort = ~a" port)
-                                     "")
-                               #$(if dns
-                                     (format #f "DNS = ~a"
-                                             (string-join dns ","))
-                                     "")
-                               (list #$@peers)))))))))
+                     (format port "~a~%~%~{~a~%~^~%~}"
+                             (string-join (remove string-null? lines) "\n")
+                             '#$peers)))))))
       (file-append config "/" config-file))))
 
 (define (wireguard-activation config)
-- 
2.40.1





Information forwarded to guix-patches <at> gnu.org:
bug#63402; Package guix-patches. (Fri, 19 May 2023 02:02:03 GMT) Full text and rfc822 format available.

Message #49 received at 63402 <at> debbugs.gnu.org (full text, mbox):

From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
To: 63402 <at> debbugs.gnu.org
Cc: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
Subject: [PATCH v5 4/5] services: wireguard: Add a 'configuration' action.
Date: Thu, 18 May 2023 21:59:16 -0400
* gnu/services/vpn.scm (wireguard-shepherd-service) [actions]: New field.
---
 gnu/services/vpn.scm | 1 +
 1 file changed, 1 insertion(+)

diff --git a/gnu/services/vpn.scm b/gnu/services/vpn.scm
index 8740722b6f..e1d9f5f044 100644
--- a/gnu/services/vpn.scm
+++ b/gnu/services/vpn.scm
@@ -914,6 +914,7 @@ (define (wireguard-shepherd-service config)
              (stop #~(lambda _
                        (invoke #$wg-quick "down" #$config)
                        #f))                       ;stopped!
+             (actions (list (shepherd-configuration-action config)))
              (documentation "Run the Wireguard VPN tunnel"))))))
 
 (define (wireguard-monitoring-jobs config)
-- 
2.40.1





Information forwarded to leo <at> famulari.name, me <at> tobias.gr, guix-patches <at> gnu.org:
bug#63402; Package guix-patches. (Fri, 19 May 2023 02:02:03 GMT) Full text and rfc822 format available.

Message #52 received at 63402 <at> debbugs.gnu.org (full text, mbox):

From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
To: 63402 <at> debbugs.gnu.org
Cc: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
Subject: [PATCH v5 5/5] gnu: linux-libre: Apply wireguard patch fixing
 keep-alive bug.
Date: Thu, 18 May 2023 21:59:17 -0400
* gnu/packages/patches/linux-libre-wireguard-postup-privkey.patch: New patch.
* gnu/local.mk (dist_patch_DATA): Register it.
* gnu/packages/linux.scm (linux-libre-6.3-source, linux-libre-6.2-source)
(linux-libre-6.1-source, linux-libre-5.15-source)
(linux-libre-5.10-source): Apply it.
---
 gnu/local.mk                                  |   1 +
 gnu/packages/linux.scm                        |  27 ++--
 ...linux-libre-wireguard-postup-privkey.patch | 119 ++++++++++++++++++
 3 files changed, 139 insertions(+), 8 deletions(-)
 create mode 100644 gnu/packages/patches/linux-libre-wireguard-postup-privkey.patch

diff --git a/gnu/local.mk b/gnu/local.mk
index 42514ded8e..0b0aafa016 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -1515,6 +1515,7 @@ dist_patch_DATA =						\
   %D%/packages/patches/linphone-desktop-without-sdk.patch	\
   %D%/packages/patches/linux-libre-infodocs-target.patch	\
   %D%/packages/patches/linux-libre-support-for-Pinebook-Pro.patch \
+  %D%/packages/patches/linux-libre-wireguard-postup-privkey.patch \
   %D%/packages/patches/linux-pam-no-setfsuid.patch		\
   %D%/packages/patches/linux-pam-unix_chkpwd.patch		\
   %D%/packages/patches/linuxdcpp-openssl-1.1.patch		\
diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm
index 1aa87d3965..2780aa47dc 100644
--- a/gnu/packages/linux.scm
+++ b/gnu/packages/linux.scm
@@ -34,7 +34,7 @@
 ;;; Copyright © 2018 Vasile Dumitrascu <va511e <at> yahoo.com>
 ;;; Copyright © 2019 Tim Gesthuizen <tim.gesthuizen <at> yahoo.de>
 ;;; Copyright © 2019 mikadoZero <mikadozero <at> yandex.com>
-;;; Copyright © 2019, 2020, 2021, 2022 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
+;;; Copyright © 2019, 2020, 2021, 2022, 2023 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
 ;;; Copyright © 2019 Stefan Stefanović <stefanx2ovic <at> gmail.com>
 ;;; Copyright © 2019-2022 Brice Waegeneire <brice <at> waegenei.re>
 ;;; Copyright © 2019 Kei Kebreau <kkebreau <at> posteo.net>
@@ -639,28 +639,39 @@ (define (source-with-patches source patches)
 (define-public linux-libre-6.3-source
   (source-with-patches linux-libre-6.3-pristine-source
                        (list %boot-logo-patch
-                             %linux-libre-arm-export-__sync_icache_dcache-patch)))
+                             %linux-libre-arm-export-__sync_icache_dcache-patch
+                             (search-patch
+                              "linux-libre-wireguard-postup-privkey.patch"))))
 
 (define-public linux-libre-6.2-source
   (source-with-patches linux-libre-6.2-pristine-source
                        (list %boot-logo-patch
-                             %linux-libre-arm-export-__sync_icache_dcache-patch)))
+                             %linux-libre-arm-export-__sync_icache_dcache-patch
+                             (search-patch
+                              "linux-libre-wireguard-postup-privkey.patch"))))
 
 (define-public linux-libre-6.1-source
   (source-with-patches linux-libre-6.1-pristine-source
-                       (list %boot-logo-patch
-                             %linux-libre-arm-export-__sync_icache_dcache-patch
-                             (search-patch "linux-libre-infodocs-target.patch"))))
+                       (append
+                        (list %boot-logo-patch
+                              %linux-libre-arm-export-__sync_icache_dcache-patch)
+                        (search-patches
+                         "linux-libre-infodocs-target.patch"
+                         "linux-libre-wireguard-postup-privkey.patch"))))
 
 (define-public linux-libre-5.15-source
   (source-with-patches linux-libre-5.15-pristine-source
                        (list %boot-logo-patch
-                             %linux-libre-arm-export-__sync_icache_dcache-patch)))
+                             %linux-libre-arm-export-__sync_icache_dcache-patch
+                             (search-patch
+                              "linux-libre-wireguard-postup-privkey.patch"))))
 
 (define-public linux-libre-5.10-source
   (source-with-patches linux-libre-5.10-pristine-source
                        (list %boot-logo-patch
-                             %linux-libre-arm-export-__sync_icache_dcache-patch)))
+                             %linux-libre-arm-export-__sync_icache_dcache-patch
+                             (search-patch
+                              "linux-libre-wireguard-postup-privkey.patch"))))
 
 (define-public linux-libre-5.4-source
   (source-with-patches linux-libre-5.4-pristine-source
diff --git a/gnu/packages/patches/linux-libre-wireguard-postup-privkey.patch b/gnu/packages/patches/linux-libre-wireguard-postup-privkey.patch
new file mode 100644
index 0000000000..a6050499e1
--- /dev/null
+++ b/gnu/packages/patches/linux-libre-wireguard-postup-privkey.patch
@@ -0,0 +1,119 @@
+From 3ac1bf099766f1e9735883d5127148054cd5b30a Mon Sep 17 00:00:00 2001
+From: "Jason A. Donenfeld" <Jason <at> zx2c4.com>
+Date: Thu, 18 May 2023 03:08:44 +0200
+Subject: wireguard: netlink: send staged packets when setting initial private
+ key
+
+Packets bound for peers can queue up prior to the device private key
+being set. For example, if persistent keepalive is set, a packet is
+queued up to be sent as soon as the device comes up. However, if the
+private key hasn't been set yet, the handshake message never sends, and
+no timer is armed to retry, since that would be pointless.
+
+But, if a user later sets a private key, the expectation is that those
+queued packets, such as a persistent keepalive, are actually sent. So
+adjust the configuration logic to account for this edge case, and add a
+test case to make sure this works.
+
+Maxim noticed this with a wg-quick(8) config to the tune of:
+
+    [Interface]
+    PostUp = wg set %i private-key somefile
+
+    [Peer]
+    PublicKey = ...
+    Endpoint = ...
+    PersistentKeepalive = 25
+
+Here, the private key gets set after the device comes up using a PostUp
+script, triggering the bug.
+
+Fixes: e7096c131e51 ("net: WireGuard secure network tunnel")
+Cc: stable <at> vger.kernel.org
+Reported-by: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
+Link: https://lore.kernel.org/wireguard/87fs7xtqrv.fsf <at> gmail.com/
+Signed-off-by: Jason A. Donenfeld <Jason <at> zx2c4.com>
+---
+ drivers/net/wireguard/netlink.c            | 14 +++++++++-----
+ tools/testing/selftests/wireguard/netns.sh | 30 ++++++++++++++++++++++++++----
+ 2 files changed, 35 insertions(+), 9 deletions(-)
+
+diff --git a/drivers/net/wireguard/netlink.c b/drivers/net/wireguard/netlink.c
+index 43c8c84e7ea8..6d1bd9f52d02 100644
+--- a/drivers/net/wireguard/netlink.c
++++ b/drivers/net/wireguard/netlink.c
+@@ -546,6 +546,7 @@ static int wg_set_device(struct sk_buff *skb, struct genl_info *info)
+ 		u8 *private_key = nla_data(info->attrs[WGDEVICE_A_PRIVATE_KEY]);
+ 		u8 public_key[NOISE_PUBLIC_KEY_LEN];
+ 		struct wg_peer *peer, *temp;
++		bool send_staged_packets;
+ 
+ 		if (!crypto_memneq(wg->static_identity.static_private,
+ 				   private_key, NOISE_PUBLIC_KEY_LEN))
+@@ -564,14 +565,17 @@ static int wg_set_device(struct sk_buff *skb, struct genl_info *info)
+ 		}
+ 
+ 		down_write(&wg->static_identity.lock);
+-		wg_noise_set_static_identity_private_key(&wg->static_identity,
+-							 private_key);
+-		list_for_each_entry_safe(peer, temp, &wg->peer_list,
+-					 peer_list) {
++		send_staged_packets = !wg->static_identity.has_identity && netif_running(wg->dev);
++		wg_noise_set_static_identity_private_key(&wg->static_identity, private_key);
++		send_staged_packets = send_staged_packets && wg->static_identity.has_identity;
++
++		wg_cookie_checker_precompute_device_keys(&wg->cookie_checker);
++		list_for_each_entry_safe(peer, temp, &wg->peer_list, peer_list) {
+ 			wg_noise_precompute_static_static(peer);
+ 			wg_noise_expire_current_peer_keypairs(peer);
++			if (send_staged_packets)
++				wg_packet_send_staged_packets(peer);
+ 		}
+-		wg_cookie_checker_precompute_device_keys(&wg->cookie_checker);
+ 		up_write(&wg->static_identity.lock);
+ 	}
+ skip_set_private_key:
+diff --git a/tools/testing/selftests/wireguard/netns.sh b/tools/testing/selftests/wireguard/netns.sh
+index 69c7796c7ca9..405ff262ca93 100755
+--- a/tools/testing/selftests/wireguard/netns.sh
++++ b/tools/testing/selftests/wireguard/netns.sh
+@@ -514,10 +514,32 @@ n2 bash -c 'printf 0 > /proc/sys/net/ipv4/conf/all/rp_filter'
+ n1 ping -W 1 -c 1 192.168.241.2
+ [[ $(n2 wg show wg0 endpoints) == "$pub1	10.0.0.3:1" ]]
+ 
+-ip1 link del veth1
+-ip1 link del veth3
+-ip1 link del wg0
+-ip2 link del wg0
++ip1 link del dev veth3
++ip1 link del dev wg0
++ip2 link del dev wg0
++
++# Make sure persistent keep alives are sent when an adapter comes up
++ip1 link add dev wg0 type wireguard
++n1 wg set wg0 private-key <(echo "$key1") peer "$pub2" endpoint 10.0.0.1:1 persistent-keepalive 1
++read _ _ tx_bytes < <(n1 wg show wg0 transfer)
++[[ $tx_bytes -eq 0 ]]
++ip1 link set dev wg0 up
++read _ _ tx_bytes < <(n1 wg show wg0 transfer)
++[[ $tx_bytes -gt 0 ]]
++ip1 link del dev wg0
++# This should also happen even if the private key is set later
++ip1 link add dev wg0 type wireguard
++n1 wg set wg0 peer "$pub2" endpoint 10.0.0.1:1 persistent-keepalive 1
++read _ _ tx_bytes < <(n1 wg show wg0 transfer)
++[[ $tx_bytes -eq 0 ]]
++ip1 link set dev wg0 up
++read _ _ tx_bytes < <(n1 wg show wg0 transfer)
++[[ $tx_bytes -eq 0 ]]
++n1 wg set wg0 private-key <(echo "$key1")
++read _ _ tx_bytes < <(n1 wg show wg0 transfer)
++[[ $tx_bytes -gt 0 ]]
++ip1 link del dev veth1
++ip1 link del dev wg0
+ 
+ # We test that Netlink/IPC is working properly by doing things that usually cause split responses
+ ip0 link add dev wg0 type wireguard
+-- 
+cgit v1.2.3-59-g8ed1b
+
-- 
2.40.1





Information forwarded to guix-patches <at> gnu.org:
bug#63402; Package guix-patches. (Mon, 22 May 2023 15:01:02 GMT) Full text and rfc822 format available.

Message #55 received at 63402 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
Cc: 63402 <at> debbugs.gnu.org, 63403 <at> debbugs.gnu.org
Subject: Re: bug#63403: [PATCH 1/1] services: wireguard: Implement a dynamic
 IP monitoring feature.
Date: Mon, 22 May 2023 17:00:16 +0200
Hi,

Maxim Cournoyer <maxim.cournoyer <at> gmail.com> skribis:

> * gnu/services/herd.scm (current-service): New procedure, mostly reusing the
> existing current-services.
> (current-services): Implement in terms of the above procedure.

How about having (lookup-service name) that calls the ‘status’ action on
the given service and either returns a <live-service> or #f?

‘current-services’ might be implemented as (lookup-service 'root) but
this should be kept as an implementation detail.

Ludo’.




Information forwarded to guix-patches <at> gnu.org:
bug#63402; Package guix-patches. (Mon, 22 May 2023 15:05:01 GMT) Full text and rfc822 format available.

Message #58 received at 63402 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
Cc: 63402 <at> debbugs.gnu.org, 63403 <at> debbugs.gnu.org
Subject: Re: bug#63403: [PATCH 1/1] services: wireguard: Implement a dynamic
 IP monitoring feature.
Date: Mon, 22 May 2023 17:03:57 +0200
Hi,

Maxim Cournoyer <maxim.cournoyer <at> gmail.com> skribis:

> * 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.

As discussed on IRC the other day, I tend to think that this is “not our
job” but rather upstream’s.  (As a rule of thumb, I think services
should merely expose what upstream implements.)

You mentioned that upstream has a shell script to do something similar.
Using that may not be as nice as what you propose here in terms of
integration, but the upside is that we wouldn’t have to maintain it
ourselves.

Would that be a viable option?  WDYT?

Thanks,
Ludo’.




Information forwarded to guix-patches <at> gnu.org:
bug#63402; Package guix-patches. (Mon, 22 May 2023 23:23:02 GMT) Full text and rfc822 format available.

Message #61 received at 63402 <at> debbugs.gnu.org (full text, mbox):

From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
To: Ludovic Courtès <ludo <at> gnu.org>
Cc: 63402 <at> debbugs.gnu.org, 63403 <at> debbugs.gnu.org
Subject: Re: bug#63403: [PATCH 1/1] services: wireguard: Implement a dynamic
 IP monitoring feature.
Date: Mon, 22 May 2023 19:22:23 -0400
Hi Ludovic,

Ludovic Courtès <ludo <at> gnu.org> writes:

> Hi,
>
> Maxim Cournoyer <maxim.cournoyer <at> gmail.com> skribis:
>
>> * gnu/services/herd.scm (current-service): New procedure, mostly reusing the
>> existing current-services.
>> (current-services): Implement in terms of the above procedure.
>
> How about having (lookup-service name) that calls the ‘status’ action on
> the given service and either returns a <live-service> or #f?

I'd rather keep the name 'current-service', because 'lookup-service' is
already a public procedure exported by Shepherd's (shepherd service)
module; it'd be confusing.

> ‘current-services’ might be implemented as (lookup-service 'root) but
> this should be kept as an implementation detail.

Yeah, that's my view on current-services being implemented in terms of
(current-service 'root).  It's a bit weird, but that's because the
underlying API is not symmetrical either.

Thanks for taking a look!

-- 
Thanks,
Maxim




Information forwarded to guix-patches <at> gnu.org:
bug#63402; Package guix-patches. (Mon, 22 May 2023 23:33:01 GMT) Full text and rfc822 format available.

Message #64 received at 63402 <at> debbugs.gnu.org (full text, mbox):

From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
To: Ludovic Courtès <ludo <at> gnu.org>
Cc: 63402 <at> debbugs.gnu.org, 63403 <at> debbugs.gnu.org
Subject: Re: bug#63403: [PATCH 1/1] services: wireguard: Implement a dynamic
 IP monitoring feature.
Date: Mon, 22 May 2023 19:32:08 -0400
Hi Ludovic,

Ludovic Courtès <ludo <at> gnu.org> writes:

> Hi,
>
> Maxim Cournoyer <maxim.cournoyer <at> gmail.com> skribis:
>
>> * 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.
>
> As discussed on IRC the other day, I tend to think that this is “not our
> job” but rather upstream’s.  (As a rule of thumb, I think services
> should merely expose what upstream implements.)
>
> You mentioned that upstream has a shell script to do something similar.
> Using that may not be as nice as what you propose here in terms of
> integration, but the upside is that we wouldn’t have to maintain it
> ourselves.

Yeah, upstream offers a contrib shell script called reresolve-dns.sh
[0], that works a bit differently (it's doesn't actually monitor IPs but
just keep a watch on when was the last successful handshake made).

[0]  https://github.com/WireGuard/wireguard-tools/blob/master/contrib/reresolve-dns/reresolve-dns.

> Would that be a viable option?  WDYT?

I think my Guile script is more precise in terms of what it does and
also produces useful output.  If I knew of the shell script existence
when I started I probably wouldn't have bothered re-implementing it in
Scheme, but since it's here, and better, I see no reason to not use it
:-).  I don't foresee high maintenance for the stable APIs involved
(resolving host names and setting an endpoint with 'wg set').

-- 
Thanks,
Maxim




Information forwarded to guix-patches <at> gnu.org:
bug#63402; Package guix-patches. (Wed, 24 May 2023 14:46:02 GMT) Full text and rfc822 format available.

Message #67 received at 63402 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
Cc: 63402 <at> debbugs.gnu.org, 63403 <at> debbugs.gnu.org
Subject: Re: bug#63403: [PATCH 1/1] services: wireguard: Implement a dynamic
 IP monitoring feature.
Date: Wed, 24 May 2023 16:44:40 +0200
Hi Maxim,

Maxim Cournoyer <maxim.cournoyer <at> gmail.com> skribis:

> Ludovic Courtès <ludo <at> gnu.org> writes:
>
>> Hi,
>>
>> Maxim Cournoyer <maxim.cournoyer <at> gmail.com> skribis:
>>
>>> * gnu/services/herd.scm (current-service): New procedure, mostly reusing the
>>> existing current-services.
>>> (current-services): Implement in terms of the above procedure.
>>
>> How about having (lookup-service name) that calls the ‘status’ action on
>> the given service and either returns a <live-service> or #f?
>
> I'd rather keep the name 'current-service',

There’s no notion of a “current service” in the Shepherd; that would be
confusing to me.

> because 'lookup-service' is already a public procedure exported by
> Shepherd's (shepherd service) module; it'd be confusing.

Yeah well, I think we should clarify the client/server architecture and
the context in which (shepherd …) modules are meant to be used.  I made
a first attempt:

  https://git.savannah.gnu.org/cgit/shepherd.git/commit/?id=d3d437a34bcb11fc416bf141181d8908064aeceb

However, what matters most to me is that the procedure names really
represent what they do.  With that in mind, it’s no surprise that the
procedure to look up a service is called ‘lookup-service’ in both
contexts.

Thanks,
Ludo’.




Information forwarded to guix-patches <at> gnu.org:
bug#63402; Package guix-patches. (Wed, 24 May 2023 14:55:02 GMT) Full text and rfc822 format available.

Message #70 received at 63402 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
Cc: 63402 <at> debbugs.gnu.org, 63403 <at> debbugs.gnu.org
Subject: Re: bug#63403: [PATCH 1/1] services: wireguard: Implement a dynamic
 IP monitoring feature.
Date: Wed, 24 May 2023 16:53:56 +0200
Maxim Cournoyer <maxim.cournoyer <at> gmail.com> skribis:

> Yeah, upstream offers a contrib shell script called reresolve-dns.sh
> [0], that works a bit differently (it's doesn't actually monitor IPs but
> just keep a watch on when was the last successful handshake made).
>
> [0]  https://github.com/WireGuard/wireguard-tools/blob/master/contrib/reresolve-dns/reresolve-dns.
>
>> Would that be a viable option?  WDYT?
>
> I think my Guile script is more precise in terms of what it does and
> also produces useful output.  If I knew of the shell script existence
> when I started I probably wouldn't have bothered re-implementing it in
> Scheme, but since it's here, and better, I see no reason to not use it
> :-).  I don't foresee high maintenance for the stable APIs involved
> (resolving host names and setting an endpoint with 'wg set').

I don’t doubt your script is better (first because it’s in Guile ;-)).
I’m concerned about adding non-trivial “peripheral” code that we’ll all
be responsible for going forward (the Jami services pose a similar
challenge IMO: I experienced first-hand the maintenance burden recently
when investigating system test failures.)

So I’m a bit torn.  I sympathize with the need to improve those
services, but I’m also concerned what will happen if we don’t have clear
criteria to decide what to take and what to reject.

WDYT?

Ludo’.




Information forwarded to guix-patches <at> gnu.org:
bug#63402; Package guix-patches. (Wed, 24 May 2023 17:43:01 GMT) Full text and rfc822 format available.

Message #73 received at 63402 <at> debbugs.gnu.org (full text, mbox):

From: Bruno Victal <mirai <at> makinata.eu>
To: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
Cc: 63402 <at> debbugs.gnu.org
Subject: Re: [bug#63402] [PATCH v5 2/5] services: wireguard: Implement a
 dynamic IP monitoring feature.
Date: Wed, 24 May 2023 18:25:27 +0100
On 2023-05-19 02:59, Maxim Cournoyer wrote:
> +;;; 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)))))

You should use getaddrinfo instead, reason being that inet-pton does
not work with zone-indexes or interface names in IPv6 addresses.
I expect that this snippet would get cloned and reused often which
makes it important to get it right even if zone-indexes don't happen
to be of particular interest here.

I have this snippet that you could adapt to your liking (or use as-is):

--8<---------------cut here---------------start------------->8---
(define* (ip-address? s #:optional family)
  "Check if @var{s} is a valid IP address. It optionally accepts a
@var{family} argument, either AF_INET or AF_INET6, which can be used
to exclusively check for IPv4 or IPv6 addresses."
  ;; Regrettably square brackets aren't accepted by getaddrinfo() and
  ;; must be removed beforehand.
  (let ((address (string-trim-both s (char-set #\[ #\])))
    (false-if-exception
     (->bool (getaddrinfo address #f AI_NUMERICHOST family))))))
--8<---------------cut here---------------end--------------->8---

I'd also harmonize the ipv4 check to use getaddrinfo in case you
specialize the snippet above for IPv6 only. (keeps things simpler)

> +
> +(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))))

I'd craft an artificial uri string and extract this information from a uri
record instead, since the above check is likely to reveal insufficient:

--8<---------------cut here---------------start------------->8---
scheme@(guile-user)> (use-modules (web uri))
scheme@(guile-user)> (define s "example.tld:9999")
scheme@(guile-user)> (uri-host (string->uri (string-append "dummy://" s)))
$5 = "example.tld"
scheme@(guile-user)> (define s "[2001:db8::1234]:9999")
scheme@(guile-user)> (uri-host (string->uri (string-append "dummy://" s)))
$6 = "2001:db8::1234"
--8<---------------cut here---------------end--------------->8---

>  (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 <at> 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?))

IMO, these kind of utility procedures seem useful enough that they
should go into either:
* (gnu services configuration)
* (gnu services network)
* or a new module consisting of useful predicates perhaps?
** (gnu services configuration predicates)
** (gnu services configuration utils)

> +(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")))

Are these addresses special?
If not, I'd recommend (properly) generating a random ULA prefix
and use it instead.

> +
> +(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"))

I think a comment that explains where these values were obtained from
(or how they were generated) would be helpful for anyone looking at this
in the future.


-- 
Furthermore, I consider that nonfree software must be eradicated.

Cheers,
Bruno.





Information forwarded to guix-patches <at> gnu.org:
bug#63402; Package guix-patches. (Wed, 24 May 2023 22:13:01 GMT) Full text and rfc822 format available.

Message #76 received at 63402 <at> debbugs.gnu.org (full text, mbox):

From: Bruno Victal <mirai <at> makinata.eu>
To: Ludovic Courtès <ludo <at> gnu.org>,
 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
Cc: 63402 <at> debbugs.gnu.org, 63403 <at> debbugs.gnu.org
Subject: Re: [bug#63403] [PATCH 1/1] services: wireguard: Implement a dynamic
 IP monitoring feature.
Date: Wed, 24 May 2023 23:12:26 +0100
Hi Ludo’,

On 2023-05-24 15:53, Ludovic Courtès wrote:
> I don’t doubt your script is better (first because it’s in Guile ;-)).
> I’m concerned about adding non-trivial “peripheral” code that we’ll all
> be responsible for going forward (the Jami services pose a similar
> challenge IMO: I experienced first-hand the maintenance burden recently
> when investigating system test failures.)
> 
> So I’m a bit torn.  I sympathize with the need to improve those
> services, but I’m also concerned what will happen if we don’t have clear
> criteria to decide what to take and what to reject.
> 

I think having some “indigenous” guix capabilities is a good idea,
if the guix services are to be something more than a (lossy) scheme
translation of some daemon's configuration file syntax.

IMO as long the feature in question is:
* Not overly tailored to some specific setup scenario.
* Generic (or can be reasonably refactored/extended as needed)
* Improves the overall experience of a service.

It should be acceptable to have it in Guix since it brings more value
to the service subsystem. (rather than require a user to import
$MYSTERY_CHANNEL_FROM_INTERNET_USER_5554$ or reinvent the
ω+1 iteration of the same wheel)


-- 
Furthermore, I consider that nonfree software must be eradicated.

Cheers,
Bruno.





Information forwarded to guix-patches <at> gnu.org:
bug#63402; Package guix-patches. (Thu, 25 May 2023 15:14:02 GMT) Full text and rfc822 format available.

Message #79 received at 63402 <at> debbugs.gnu.org (full text, mbox):

From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
To: Ludovic Courtès <ludo <at> gnu.org>
Cc: 63402 <at> debbugs.gnu.org, 63403 <at> debbugs.gnu.org
Subject: Re: bug#63403: [PATCH 1/1] services: wireguard: Implement a dynamic
 IP monitoring feature.
Date: Thu, 25 May 2023 11:13:10 -0400
Hi Ludovic,

Ludovic Courtès <ludo <at> gnu.org> writes:

> Maxim Cournoyer <maxim.cournoyer <at> gmail.com> skribis:
>
>> Yeah, upstream offers a contrib shell script called reresolve-dns.sh
>> [0], that works a bit differently (it's doesn't actually monitor IPs but
>> just keep a watch on when was the last successful handshake made).
>>
>> [0]  https://github.com/WireGuard/wireguard-tools/blob/master/contrib/reresolve-dns/reresolve-dns.
>>
>>> Would that be a viable option?  WDYT?
>>
>> I think my Guile script is more precise in terms of what it does and
>> also produces useful output.  If I knew of the shell script existence
>> when I started I probably wouldn't have bothered re-implementing it in
>> Scheme, but since it's here, and better, I see no reason to not use it
>> :-).  I don't foresee high maintenance for the stable APIs involved
>> (resolving host names and setting an endpoint with 'wg set').
>
> I don’t doubt your script is better (first because it’s in Guile ;-)).
> I’m concerned about adding non-trivial “peripheral” code that we’ll all
> be responsible for going forward (the Jami services pose a similar
> challenge IMO: I experienced first-hand the maintenance burden recently
> when investigating system test failures.)

I get that the Jami service is complex, but to be fair here the tests
being broken by a (good) change in the marionette behavior caused by
commit a09c7da, which also affected a few other tests, as demonstrated
in the follow-up commit f518882, rather than because it crumbled under
its own weight.  I personally think this service is a great test suite
for the service infrastructure in Guix :-)  I've now fixed the Jami test
suite with 99fc7e5.  Hopefully QA helps catching regressions like this
early in the future, avoiding the need to fix things after the facts.

> So I’m a bit torn.  I sympathize with the need to improve those
> services, but I’m also concerned what will happen if we don’t have clear
> criteria to decide what to take and what to reject.

I think this happens rarely enough that it can be left as an exercise of
judgement rather than policy; e.g. deemed to provide enough value to
justify the maintenance burden, keeping in mind that using some
'contrib' shell script from upstream is not guaranteed to be
maintenance-free.  In this case it's also not on any critical path: it'd
only affects users of the new feature; if it ever breaks only that
feature would be impacted.

-- 
Thanks,
Maxim




Information forwarded to guix-patches <at> gnu.org:
bug#63402; Package guix-patches. (Fri, 21 Jul 2023 02:16:01 GMT) Full text and rfc822 format available.

Message #82 received at 63402 <at> debbugs.gnu.org (full text, mbox):

From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
To: Ludovic Courtès <ludo <at> gnu.org>
Cc: 63402 <at> debbugs.gnu.org, 63403 <at> debbugs.gnu.org
Subject: Re: bug#63403: [PATCH 1/1] services: wireguard: Implement a dynamic
 IP monitoring feature.
Date: Thu, 20 Jul 2023 22:15:20 -0400
Hi,

Ludovic Courtès <ludo <at> gnu.org> writes:

> Hi Maxim,
>
> Maxim Cournoyer <maxim.cournoyer <at> gmail.com> skribis:
>
>> Ludovic Courtès <ludo <at> gnu.org> writes:
>>
>>> Hi,
>>>
>>> Maxim Cournoyer <maxim.cournoyer <at> gmail.com> skribis:
>>>
>>>> * gnu/services/herd.scm (current-service): New procedure, mostly reusing the
>>>> existing current-services.
>>>> (current-services): Implement in terms of the above procedure.
>>>
>>> How about having (lookup-service name) that calls the ‘status’ action on
>>> the given service and either returns a <live-service> or #f?
>>
>> I'd rather keep the name 'current-service',
>
> There’s no notion of a “current service” in the Shepherd; that would be
> confusing to me.

We already have current-services in the same module, documented as:

  Return the list of currently defined Shepherd services, represented as
  <live-service> objects.

It's already a public interface.  Here I was interested in having a
convenient way to retrieve a single live-service instead of the full
list, thus the singular version.

Does that make sense?

-- 
Thanks,
Maxim




Information forwarded to guix-patches <at> gnu.org:
bug#63402; Package guix-patches. (Fri, 21 Jul 2023 03:56:01 GMT) Full text and rfc822 format available.

Message #85 received at 63402 <at> debbugs.gnu.org (full text, mbox):

From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
To: Bruno Victal <mirai <at> makinata.eu>
Cc: 63402 <at> debbugs.gnu.org
Subject: Re: [bug#63402] [PATCH v5 2/5] services: wireguard: Implement a
 dynamic IP monitoring feature.
Date: Thu, 20 Jul 2023 23:55:18 -0400
Hi Bruno,

Bruno Victal <mirai <at> makinata.eu> writes:

> On 2023-05-19 02:59, Maxim Cournoyer wrote:
>> +;;; 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)))))
>
> You should use getaddrinfo instead, reason being that inet-pton does
> not work with zone-indexes or interface names in IPv6 addresses.
> I expect that this snippet would get cloned and reused often which
> makes it important to get it right even if zone-indexes don't happen
> to be of particular interest here.
>
> I have this snippet that you could adapt to your liking (or use as-is):
>
> (define* (ip-address? s #:optional family)
>   "Check if @var{s} is a valid IP address. It optionally accepts a
> @var{family} argument, either AF_INET or AF_INET6, which can be used
> to exclusively check for IPv4 or IPv6 addresses."
>   ;; Regrettably square brackets aren't accepted by getaddrinfo() and
>   ;; must be removed beforehand.
>   (let ((address (string-trim-both s (char-set #\[ #\])))
>     (false-if-exception
>      (->bool (getaddrinfo address #f AI_NUMERICHOST family))))))
>
>
> I'd also harmonize the ipv4 check to use getaddrinfo in case you
> specialize the snippet above for IPv6 only. (keeps things simpler)

Thanks!  I've adapted as:

--8<---------------cut here---------------start------------->8---
modified   gnu/services/vpn.scm
@@ -903,15 +903,17 @@ (define-with-source (strip-port/maybe endpoint #:key 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* (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."
--8<---------------cut here---------------end--------------->8---

Since there's some local considerations weaved in (strip-port/maybe), I
think it's fine that these live in the vpn.scm module.  When need be, we
can refactor a more general version and find a suitable home for it.

>> +
>> +(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))))
>
> I'd craft an artificial uri string and extract this information from a uri
> record instead, since the above check is likely to reveal insufficient:
>
> scheme@(guile-user)> (use-modules (web uri))
> scheme@(guile-user)> (define s "example.tld:9999")
> scheme@(guile-user)> (uri-host (string->uri (string-append "dummy://" s)))
> $5 = "example.tld"
> scheme@(guile-user)> (define s "[2001:db8::1234]:9999")
> scheme@(guile-user)> (uri-host (string->uri (string-append "dummy://" s)))
> $6 = "2001:db8::1234"

I'm not sure I understand; In the second case, I'd like it to tell me
it's *not* a host name, but it seems like uri-host happily returns IP
addresses the same as host names?

[...]

>> +(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")))
>
> Are these addresses special?
> If not, I'd recommend (properly) generating a random ULA prefix
> and use it instead.

They are not!  I derived them from actual IP addresses, adding some
fuzz.  I've now used unique local IPv6 prefixes.

>> +
>> +(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"))
>
> I think a comment that explains where these values were obtained from
> (or how they were generated) would be helpful for anyone looking at this
> in the future.

OK, I've now added a comment.

-- 
Thanks,
Maxim




Information forwarded to guix-patches <at> gnu.org:
bug#63402; Package guix-patches. (Fri, 21 Jul 2023 13:24:01 GMT) Full text and rfc822 format available.

Message #88 received at 63402 <at> debbugs.gnu.org (full text, mbox):

From: Bruno Victal <mirai <at> makinata.eu>
To: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
Cc: 63402 <at> debbugs.gnu.org
Subject: Re: [bug#63402] [PATCH v5 2/5] services: wireguard: Implement a
 dynamic IP monitoring feature.
Date: Fri, 21 Jul 2023 14:23:44 +0100
Hi Maxim,

On 2023-07-21 04:55, Maxim Cournoyer wrote:
> 
> Bruno Victal <mirai <at> makinata.eu> writes:
> 
>> On 2023-05-19 02:59, Maxim Cournoyer wrote:
> 
>>> +(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))))
>>
>> I'd craft an artificial uri string and extract this information from a uri
>> record instead, since the above check is likely to reveal insufficient:
>>
>> scheme@(guile-user)> (use-modules (web uri))
>> scheme@(guile-user)> (define s "example.tld:9999")
>> scheme@(guile-user)> (uri-host (string->uri (string-append "dummy://" s)))
>> $5 = "example.tld"
>> scheme@(guile-user)> (define s "[2001:db8::1234]:9999")
>> scheme@(guile-user)> (uri-host (string->uri (string-append "dummy://" s)))
>> $6 = "2001:db8::1234"
> 
> I'm not sure I understand; In the second case, I'd like it to tell me
> it's *not* a host name, but it seems like uri-host happily returns IP
> addresses the same as host names?

Right, I've reread the context of this more carefully and I must have been
under the impression that this was being used to extract the address part of
a "<ADDRESS>:<PORT>" string. You can disregard this.

>>> +(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")))
>>
>> Are these addresses special?
>> If not, I'd recommend (properly) generating a random ULA prefix
>> and use it instead.
> 
> They are not!  I derived them from actual IP addresses, adding some
> fuzz.  I've now used unique local IPv6 prefixes.

Actually since these are only used for testing your predicate procedure
it might be better to use the 2001:db8::/32 reserved prefix instead if
I'm interpreting RFC3849 correctly.


-- 
Furthermore, I consider that nonfree software must be eradicated.

Cheers,
Bruno.




Information forwarded to guix-patches <at> gnu.org:
bug#63402; Package guix-patches. (Fri, 21 Jul 2023 15:57:01 GMT) Full text and rfc822 format available.

Message #91 received at 63402 <at> debbugs.gnu.org (full text, mbox):

From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
To: Bruno Victal <mirai <at> makinata.eu>
Cc: 63402 <at> debbugs.gnu.org
Subject: Re: [bug#63402] [PATCH v5 2/5] services: wireguard: Implement a
 dynamic IP monitoring feature.
Date: Fri, 21 Jul 2023 11:56:08 -0400
Hi,

>>>> +(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")))
>>>
>>> Are these addresses special?
>>> If not, I'd recommend (properly) generating a random ULA prefix
>>> and use it instead.
>> 
>> They are not!  I derived them from actual IP addresses, adding some
>> fuzz.  I've now used unique local IPv6 prefixes.
>
> Actually since these are only used for testing your predicate procedure
> it might be better to use the 2001:db8::/32 reserved prefix instead if
> I'm interpreting RFC3849 correctly.

Done.

-- 
Thanks,
Maxim




Reply sent to Maxim Cournoyer <maxim.cournoyer <at> gmail.com>:
You have taken responsibility. (Fri, 21 Jul 2023 16:19:01 GMT) Full text and rfc822 format available.

Notification sent to Maxim Cournoyer <maxim.cournoyer <at> gmail.com>:
bug acknowledged by developer. (Fri, 21 Jul 2023 16:19:01 GMT) Full text and rfc822 format available.

Message #96 received at 63402-done <at> debbugs.gnu.org (full text, mbox):

From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
To: Bruno Victal <mirai <at> makinata.eu>, ludo <at> gnu.org
Cc: 63402-done <at> debbugs.gnu.org
Subject: Re: [bug#63402] [PATCH v5 2/5] services: wireguard: Implement a
 dynamic IP monitoring feature.
Date: Fri, 21 Jul 2023 12:18:04 -0400
Hi,

I've implemented most of the comments in this thread, and at last,
installed the change.  It's been used for the last months by myself and
the Wireguard tunnel has remained reachable for that time (for the
lengths my machine stayed running -- sometimes week), with the IP
changing daily.

Thanks for the comments/review!

-- 
Thanks,
Maxim




Reply sent to Maxim Cournoyer <maxim.cournoyer <at> gmail.com>:
You have taken responsibility. (Fri, 21 Jul 2023 16:19:02 GMT) Full text and rfc822 format available.

Notification sent to Maxim Cournoyer <maxim.cournoyer <at> gmail.com>:
bug acknowledged by developer. (Fri, 21 Jul 2023 16:19:02 GMT) Full text and rfc822 format available.

bug archived. Request was from Debbugs Internal Request <help-debbugs <at> gnu.org> to internal_control <at> debbugs.gnu.org. (Sat, 19 Aug 2023 11:24:05 GMT) Full text and rfc822 format available.

This bug report was last modified 244 days ago.

Previous Next


GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.