From patchwork Sat Mar 22 11:36:44 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: 40588 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 9FABA27BBE9; Sat, 22 Mar 2025 11:38:40 +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 6FB8827BBEA for ; Sat, 22 Mar 2025 11:38:39 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1tvxBK-0001r1-Gb; Sat, 22 Mar 2025 07:38:26 -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 1tvxAz-0001lG-Uk for guix-patches@gnu.org; Sat, 22 Mar 2025 07:38:06 -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 1tvxAz-00006f-5E; Sat, 22 Mar 2025 07:38:05 -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=Vzal9oLBSriYCLr+1tEFaevFSXuwUjZ8YKNNEjjU8ik=; b=G9U3SELoYa0XEbkDX5MSsns9G79ycWEpVruTtrArtMiQ6Qi7toIY85deG29far/1zva36Bw4Zkqh9BcshjDZMcE29o53WSCh7PtE9AGt8nAgJ4iVxIs9qcTyvHmUAY9G7rpBG5VVWqRyCLg7uOIJmeUr0SIrXM8xtIeXaWtENvyM0o3gX++KzhgHkenRZhBT4PPKVQfHLJ9/bfDkQ0XYdKOHgtgE88yrh+Q1DQxqkFMlbmcn42WXUQgayHcuBG+bA6cXD5cRgVFynEaTQsln9wNZ6m+LVAtQPxg8OG5n8OBGwTCPGR2AYKf2qQ/7nfIwO+v09DwLDocpHrEm4+30Mg==; Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1tvxAy-0002Z0-W7; Sat, 22 Mar 2025 07:38:05 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#77041] [PATCH v2 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, 22 Mar 2025 11:38: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.17426434659707 (code B ref 77041); Sat, 22 Mar 2025 11:38:04 +0000 Received: (at 77041) by debbugs.gnu.org; 22 Mar 2025 11:37:45 +0000 Received: from localhost ([127.0.0.1]:41183 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tvxAe-0002WK-HO for submit@debbugs.gnu.org; Sat, 22 Mar 2025 07:37:45 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:44764) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tvxAP-0002U3-AC for 77041@debbugs.gnu.org; Sat, 22 Mar 2025 07:37:30 -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 1tvxAK-0008Tu-0Q; Sat, 22 Mar 2025 07:37:24 -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=Vzal9oLBSriYCLr+1tEFaevFSXuwUjZ8YKNNEjjU8ik=; b=l5E1KqcmH2VBAkh8huoX BM0V5wcdJvmnq9UJaW5LrlDo6fkVv6vERUrgJOufpz2xS+vP4QeEHfMBe7DCv8P8ZjpalAJxrqELM nuTYZEtvsRD6xTUp+jvlRQjeebOvyW5DGK8q3xapxAUWn/G6aOslpD/8nU+5gnrWJrXP+S2sSggAN BBaD5HLzzWPD6ghs+55xsDyAngAbhpOhqjJdTmfFw4I4nrQTK6YTU1XqEiz2WmWHd/28LL5eBlDoM 8Oab5yjFW9jDPDCzZEqSQz2dEuxTEN1ZhPGM1sG5CL5xj05Ivvml5/dLvLmY0RSzHjkyxLrcr0mSo UybnTvr6t4YdYw==; From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Sat, 22 Mar 2025 12:36:44 +0100 Message-ID: <7543d6be7e2f254f824af0a2823bf2160f301670.1742642743.git.ludo@gnu.org> 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 | 199 ++++++++++++++++++++++--------------------- 2 files changed, 108 insertions(+), 98 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index e194919a9d..df5378bce5 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -35749,9 +35749,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 3f1f8661d8..f97cbac7bb 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) @@ -757,7 +757,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 @@ -919,117 +919,126 @@ (define (endpoint-host-names peers) '() peers))) -(define (wireguard-shepherd-service config) +(define (wireguard-monitoring-program config) (match-record config - (wireguard interface shepherd-requirement) + (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 shepherd-requirement) (let ((wg-quick (file-append wireguard "/bin/wg-quick")) (auto-start? (wireguard-configuration-auto-start? config)) - (config (wireguard-configuration-file config))) - (list (shepherd-service + (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 ,@shepherd-requirement)) (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.")))