diff mbox series

[bug#63402,v5,2/5] services: wireguard: Implement a dynamic IP monitoring feature.

Message ID bfaae8df952aabc4e1b00bf7154dc7aa239860b3.1684461197.git.maxim.cournoyer@gmail.com
State New
Headers show
Series Implement a dynamic IP monitoring feature. | expand

Commit Message

Maxim Cournoyer May 19, 2023, 1:59 a.m. UTC
* 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

Comments

Ludovic Courtès May 22, 2023, 3:03 p.m. UTC | #1
Hi,

Maxim Cournoyer <maxim.cournoyer@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’.
Maxim Cournoyer May 22, 2023, 11:32 p.m. UTC | #2
Hi Ludovic,

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

> Hi,
>
> Maxim Cournoyer <maxim.cournoyer@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').
Ludovic Courtès May 24, 2023, 2:53 p.m. UTC | #3
Maxim Cournoyer <maxim.cournoyer@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’.
Bruno Victal May 24, 2023, 5:25 p.m. UTC | #4
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@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.
Bruno Victal May 24, 2023, 10:12 p.m. UTC | #5
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)
Maxim Cournoyer May 25, 2023, 3:13 p.m. UTC | #6
Hi Ludovic,

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

> Maxim Cournoyer <maxim.cournoyer@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.
Maxim Cournoyer July 21, 2023, 3:55 a.m. UTC | #7
Hi Bruno,

Bruno Victal <mirai@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.
Bruno Victal July 21, 2023, 1:23 p.m. UTC | #8
Hi Maxim,

On 2023-07-21 04:55, Maxim Cournoyer wrote:
> 
> Bruno Victal <mirai@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.
Maxim Cournoyer July 21, 2023, 3:56 p.m. UTC | #9
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.
Maxim Cournoyer July 21, 2023, 4:18 p.m. UTC | #10
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!
diff mbox series

Patch

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@gmail.com>
 ;;; Copyright © 2022 Cameron V Chaparro <cameron@cameronchaparro.com>
 ;;; Copyright © 2022 Timo Wilken <guix@twilken.net>
+;;; Copyright © 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -31,10 +32,12 @@  (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@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")