From patchwork Sat Mar 15 21:37:13 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 40224 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 952A127BBEA; Sat, 15 Mar 2025 21:39:52 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-7.5 required=5.0 tests=BAYES_00,DKIMWL_WL_HIGH, DKIM_SIGNED,DKIM_VALID,MAILING_LIST_MULTI,RCVD_IN_DNSWL_BLOCKED, RCVD_IN_VALIDITY_CERTIFIED,RCVD_IN_VALIDITY_RPBL,RCVD_IN_VALIDITY_SAFE, SPF_HELO_PASS,URIBL_BLOCKED,URIBL_SBL_A autolearn=ham autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 9C25727BBE9 for ; Sat, 15 Mar 2025 21:39:51 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ttZDp-0004wL-Pf; Sat, 15 Mar 2025 17:39:09 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1ttZDl-0004uB-2P for guix-patches@gnu.org; Sat, 15 Mar 2025 17:39:05 -0400 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1ttZDk-0002mb-HS; Sat, 15 Mar 2025 17:39:04 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=debbugs.gnu.org; s=debbugs-gnu-org; h=MIME-Version:References:In-Reply-To:Date:From:To:Subject; bh=5HHc/6QaCav1JRlY25M6kGMpnpvNEh7+jyVZyIqrDnQ=; b=awbPSzWqL9TTwQ9iyf+NV3raJd7upARnE7bN9BpmdyrJQfvlpmDTYbbWtI/7DbRxrjLl2bCt9RXwWgTa0rB3q4zeb7pmEXq1vM+U4Vvl4NMNY2WmdbHcXCMELDK/4FczOKbFwOxH4Ee8PcX6AXKPSClDuZrmuBqJYnHFwrJIDWpO3631j4v0jgfcz/r9dXPaLOZqvWt3Vt8I1pI3XiXy70sLWQj3eMl8J6GHbMm9Aj5jgbhJj2tkuEUh15iR/PfxGRBkSr+ZdJggFoYksR5CWOfK44n63t9zgAMhL6W7oOolMbnZ/Sex9dJ+/H9cBQqk6pnY2d9kO8v1OrjQMtFArQ==; Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1ttZDk-0004VG-2P; Sat, 15 Mar 2025 17:39:04 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#77041] [PATCH 07/16] services: wireguard: Turn monitoring into a Shepherd timer. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: ludo@gnu.org, maxim.cournoyer@gmail.com, guix-patches@gnu.org Resent-Date: Sat, 15 Mar 2025 21:39:04 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 77041 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 77041@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= , Ludovic =?utf-8?q?Court?= =?utf-8?q?=C3=A8s?= , Maxim Cournoyer X-Debbugs-Original-Xcc: Ludovic =?utf-8?q?Court=C3=A8s?= , Maxim Cournoyer Received: via spool by 77041-submit@debbugs.gnu.org id=B77041.174207472017114 (code B ref 77041); Sat, 15 Mar 2025 21:39:04 +0000 Received: (at 77041) by debbugs.gnu.org; 15 Mar 2025 21:38:40 +0000 Received: from localhost ([127.0.0.1]:43855 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ttZDL-0004Rr-Gb for submit@debbugs.gnu.org; Sat, 15 Mar 2025 17:38:40 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:55752) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1ttZCp-0004N0-1A for 77041@debbugs.gnu.org; Sat, 15 Mar 2025 17:38:08 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1ttZCj-0002hJ-LB; Sat, 15 Mar 2025 17:38:01 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=5HHc/6QaCav1JRlY25M6kGMpnpvNEh7+jyVZyIqrDnQ=; b=klfn7GQ8FFZq2oDDaCN3 031f+VT9Tpn544VB1xjhBCP1LcovSR4Bu5mSc+LatooN9+d+EsZGQFaT2cWlWUNQgy6+l+5pOqI2B UrMTYY12d/zrK/qyvjeoJtr9W44G+wP74BY6LtzqkehTIJ1aZ757IiMMX2io2rI966iUN9aApSO5D RA8TsN5xL5ZaqwE1zUUzLzeGSkGK4m3u9wuYABPQlgfDvnAu+khZOOo+ftGifIqs8UJmiCWpsa0zK MnXfsNTio5ArnCx/E4oJXon9LJNfm3rwO93Knvy2yNe1in6V4/gywoDZ9XOnkAJbMtxAf7xkutwgC vKfLYXD9MSbh6g==; From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Sat, 15 Mar 2025 22:37:13 +0100 Message-ID: X-Mailer: git-send-email 2.48.1 In-Reply-To: References: MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches * gnu/services/vpn.scm ()[schedule]: Change default value. (wireguard-monitoring-program): New procedure, with code taken from… (wireguard-monitoring-jobs): … here. Remove. (wireguard-shepherd-services): New procedure, with code taken from… (wireguard-shepherd-service): … here. Remove. * doc/guix.texi (VPN Services): Update. Change-Id: I6851ddf1eb9480bdc9e6c6c6b88958ab2e6225d7 --- doc/guix.texi | 7 +- gnu/services/vpn.scm | 201 ++++++++++++++++++++++--------------------- 2 files changed, 109 insertions(+), 99 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index da1c4adc0c..7f3a7ca82a 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -35654,9 +35654,10 @@ VPN Services name. Set this to @code{#t} if one or more endpoints use host names provided by a dynamic DNS service to keep the sessions alive. -@item @code{monitor-ips-interval} (default: @code{'(next-minute (range 0 60 5))}) -The time interval at which the IP monitoring job should run, provided as -an mcron time specification (@pxref{Guile Syntax,,,mcron}). +@item @code{monitor-ips-interval} (default: @code{"*/5 * * * *"}) +This is the monitoring schedule, expressed as a string in traditional +cron syntax or as a gexp evaluating to a Shepherd calendar event +(@pxref{Timers,,, shepherd, The GNU Shepherd Manual}). @item @code{private-key} (default: @code{"/etc/wireguard/private.key"}) The private key file for the interface. It is automatically generated diff --git a/gnu/services/vpn.scm b/gnu/services/vpn.scm index 478a0d543e..e788ebef2e 100644 --- a/gnu/services/vpn.scm +++ b/gnu/services/vpn.scm @@ -34,7 +34,6 @@ (define-module (gnu services vpn) #:use-module (gnu services) #:use-module (gnu services configuration) #:use-module (gnu services dbus) - #:use-module (gnu services mcron) #:use-module (gnu services shepherd) #:use-module (gnu system shadow) #:use-module (gnu packages admin) @@ -43,6 +42,7 @@ (define-module (gnu services vpn) #:use-module (guix packages) #:use-module (guix records) #:use-module (guix gexp) + #:use-module (guix diagnostics) #:use-module (guix i18n) #:use-module (guix deprecation) #:use-module (srfi srfi-1) @@ -756,7 +756,7 @@ (define-record-type* (monitor-ips? wireguard-configuration-monitor-ips? ;boolean (default #f)) (monitor-ips-interval wireguard-configuration-monitor-ips-interval - (default '(next-minute (range 0 60 5)))) ;string | list + (default "*/5 * * * *")) ;string | list (pre-up wireguard-configuration-pre-up ;list of strings (default '())) (post-up wireguard-configuration-post-up ;list of strings @@ -916,117 +916,126 @@ (define (endpoint-host-names peers) '() peers))) -(define (wireguard-shepherd-service config) +(define (wireguard-monitoring-program config) (match-record config - (wireguard interface) + (interface monitor-ips-interval peers) + (let ((host-names (endpoint-host-names peers))) + (when (null? host-names) + (warning (G_ "'monitor-ips?' is #t but no host name to monitor~%"))) + + ;; Loosely based on WireGuard's own 'reresolve-dns.sh' shell script + ;; (see: https://raw.githubusercontent.com/WireGuard/wireguard-tools/ + ;; master/contrib/reresolve-dns/reresolve-dns.sh). + (program-file + (format #f "wireguard-~a-monitoring" interface) + (with-imported-modules (source-module-closure + '((gnu services herd) + (guix build utils))) + #~(begin + (use-modules (gnu services herd) + (guix build utils) + (ice-9 popen) + (ice-9 match) + (ice-9 textual-ports) + (srfi srfi-1) + (srfi srfi-26)) + + (define (resolve-host name) + "Return the IP address resolved from NAME." + (let* ((ai (car (getaddrinfo name))) + (sa (addrinfo:addr ai))) + (inet-ntop (sockaddr:fam sa) + (sockaddr:addr sa)))) + + (define wg #$(file-append wireguard-tools "/bin/wg")) + + #$(procedure-source strip-port/maybe) + + (define service-name + '#$(wireguard-service-name interface)) + + (when (live-service-running + (current-service service-name)) + (let* ((pipe (open-pipe* OPEN_READ wg "show" + #$interface "endpoints")) + (lines (string-split (get-string-all pipe) + #\newline)) + ;; IPS is an association list mapping + ;; public keys to IP addresses. + (ips (map (match-lambda + ((public-key ip) + (cons public-key + (strip-port/maybe ip)))) + (map (cut string-split <> #\tab) + (remove string-null? + lines))))) + (close-pipe pipe) + (for-each + (match-lambda + ((key . host-name) + (let ((resolved-ip (resolve-host + (strip-port/maybe + host-name))) + (current-ip (assoc-ref ips key))) + (unless (string=? resolved-ip current-ip) + (format #t "resetting `~a' peer \ +endpoint to `~a' due to stale IP (`~a' instead of `~a')~%" + key host-name + current-ip resolved-ip) + (invoke wg "set" #$interface "peer" key + "endpoint" host-name))))) + '#$host-names))))))))) + +(define (wireguard-shepherd-services config) + (match-record config + (wireguard interface monitor-ips? monitor-ips-interval) (let ((wg-quick (file-append wireguard "/bin/wg-quick")) (auto-start? (wireguard-configuration-auto-start? config)) - (config (wireguard-configuration-file config))) - (list (shepherd-service - (requirement '(networking)) + (config-file (wireguard-configuration-file config))) + (define monitoring-service + (and monitor-ips? + (shepherd-service + (provision (list (symbol-append + (wireguard-service-name interface) + '-monitoring))) + (requirement (list 'user-processes + (wireguard-service-name interface))) + (modules '((shepherd service timer))) + (start #~(make-timer-constructor + #$(if (string? monitor-ips-interval) + #~(cron-string->calendar-event + #$monitor-ips-interval) + monitor-ips-interval) + (command '(#$(wireguard-monitoring-program config))) + #:wait-for-termination? #t)) + (stop #~(make-timer-destructor)) + (documentation "Monitor the Wireguard VPN tunnel.") + (actions (list shepherd-trigger-action))))) + + (cons (shepherd-service + (requirement '(networking user-processes)) (provision (list (wireguard-service-name interface))) (start #~(lambda _ - (invoke #$wg-quick "up" #$config))) + (invoke #$wg-quick "up" #$config-file))) (stop #~(lambda _ - (invoke #$wg-quick "down" #$config) + (invoke #$wg-quick "down" #$config-file) #f)) ;stopped! - (actions (list (shepherd-configuration-action config))) + (actions (list (shepherd-configuration-action config-file))) (auto-start? auto-start?) - (documentation "Run the Wireguard VPN tunnel")))))) - -(define (wireguard-monitoring-jobs config) - ;; Loosely based on WireGuard's own 'reresolve-dns.sh' shell script (see: - ;; https://raw.githubusercontent.com/WireGuard/wireguard-tools/ - ;; master/contrib/reresolve-dns/reresolve-dns.sh). - (match-record config - (interface monitor-ips? monitor-ips-interval peers) - (let ((host-names (endpoint-host-names peers))) - (if monitor-ips? - (if (null? host-names) - (begin - (warn "monitor-ips? is #t but no host name to monitor") - '()) - ;; The mcron monitor job may be a string or a list; ungexp strips - ;; one quote level, which must be added back when a list is - ;; provided. - (list - #~(job - (if (string? #$monitor-ips-interval) - #$monitor-ips-interval - '#$monitor-ips-interval) - #$(program-file - (format #f "wireguard-~a-monitoring" interface) - (with-imported-modules (source-module-closure - '((gnu services herd) - (guix build utils))) - #~(begin - (use-modules (gnu services herd) - (guix build utils) - (ice-9 popen) - (ice-9 match) - (ice-9 textual-ports) - (srfi srfi-1) - (srfi srfi-26)) - - (define (resolve-host name) - "Return the IP address resolved from NAME." - (let* ((ai (car (getaddrinfo name))) - (sa (addrinfo:addr ai))) - (inet-ntop (sockaddr:fam sa) - (sockaddr:addr sa)))) - - (define wg #$(file-append wireguard-tools "/bin/wg")) - - #$(procedure-source strip-port/maybe) - - (define service-name '#$(wireguard-service-name - interface)) - - (when (live-service-running - (current-service service-name)) - (let* ((pipe (open-pipe* OPEN_READ wg "show" - #$interface "endpoints")) - (lines (string-split (get-string-all pipe) - #\newline)) - ;; IPS is an association list mapping - ;; public keys to IP addresses. - (ips (map (match-lambda - ((public-key ip) - (cons public-key - (strip-port/maybe ip)))) - (map (cut string-split <> #\tab) - (remove string-null? - lines))))) - (close-pipe pipe) - (for-each - (match-lambda - ((key . host-name) - (let ((resolved-ip (resolve-host - (strip-port/maybe - host-name))) - (current-ip (assoc-ref ips key))) - (unless (string=? resolved-ip current-ip) - (format #t "resetting `~a' peer \ -endpoint to `~a' due to stale IP (`~a' instead of `~a')~%" - key host-name - current-ip resolved-ip) - (invoke wg "set" #$interface "peer" key - "endpoint" host-name))))) - '#$host-names))))))))) - '())))) ;monitor-ips? is #f + (documentation "Run the Wireguard VPN tunnel")) + (or (and=> monitoring-service list) + '()))))) (define wireguard-service-type (service-type (name 'wireguard) (extensions (list (service-extension shepherd-root-service-type - wireguard-shepherd-service) + wireguard-shepherd-services) (service-extension activation-service-type wireguard-activation) (service-extension profile-service-type (compose list - wireguard-configuration-wireguard)) - (service-extension mcron-service-type - wireguard-monitoring-jobs))) + wireguard-configuration-wireguard)))) (description "Set up Wireguard @acronym{VPN, Virtual Private Network} tunnels.")))