From cfa2de2a77df3876061c8d26c104d2ebbae2631b Mon Sep 17 00:00:00 2001
From: Maxim Cournoyer <maxim.cournoyer@gmail.com>
Date: Sat, 10 May 2025 22:54:19 +0900
Subject: services: Modernize and test nftables service.

* doc/guix.texi (Networking Services) <nftables>: Update doc.
* gnu/services/networking.scm (list-of-debug-levels?):
(debug-level?, maybe-list-of-debug-levels?):
(nftables-configuration): Rewrite using `define-configuration'.
[debug-levels]: New field.
(nftables-shepherd-service): Honor it.
* gnu/tests/networking.scm (%inetd-echo-port): Extract to top level.
(run-iptables-test): Adjust accordingly.
(make-nftables-os): New procedure.
(%default-nftables-ruleset-for-tests): New variable.
(%nftables-os): Likewise.
(%test-nftables): New test.

Change-Id: I2889603342ff6d2be6261c3de6e4fddd9a9bbe2d
---
 gnu/services/networking.scm | 49 ++++++++++++++++++++++++++++++++-------------
 1 file changed, 35 insertions(+), 14 deletions(-)

(limited to 'gnu/services/networking.scm')

diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index 67653e2cbf5..8b7bf668927 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -10,7 +10,7 @@
 ;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
 ;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
 ;;; Copyright © 2019 Florian Pelz <pelzflorian@pelzflorian.de>
-;;; Copyright © 2019, 2021, 2024 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2019, 2021, 2024, 2025 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2019 Sou Bunnbu <iyzsong@member.fsf.org>
 ;;; Copyright © 2019 Alex Griffin <a@ajgrf.com>
 ;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re>
@@ -80,6 +80,7 @@
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-43)
+  #:use-module (ice-9 format)
   #:use-module (ice-9 match)
   #:use-module (ice-9 string-fun)
   #:use-module (json)
@@ -258,6 +259,7 @@
             nftables-configuration
             nftables-configuration?
             nftables-configuration-package
+            nftables-configuration-debug-levels
             nftables-configuration-ruleset
             %default-nftables-ruleset
 
@@ -2279,12 +2281,12 @@ COMMIT
                              (compose list iptables-shepherd-service))))))
 
 ;;;
-;;; nftables
+;;; nftables.
 ;;;
 
 (define %default-nftables-ruleset
-  (plain-file "nftables.conf"
-              "# A simple and safe firewall
+  (plain-file "nftables.conf" "\
+# A simple and safe firewall
 table inet filter {
   chain input {
     type filter hook input priority 0; policy drop;
@@ -2320,25 +2322,44 @@ table inet filter {
 }
 "))
 
-(define-record-type* <nftables-configuration>
-  nftables-configuration
-  make-nftables-configuration
-  nftables-configuration?
-  (package nftables-configuration-package
-           (default nftables))
-  (ruleset nftables-configuration-ruleset ; file-like object
-           (default %default-nftables-ruleset)))
+(define (debug-level? x)
+  (member x '(scanner parser eval netlink mnl proto-ctx segtree all)))
+
+(define list-of-debug-levels?
+  (list-of debug-level?))
+
+(define-maybe/no-serialization list-of-debug-levels)
+
+(define-configuration/no-serialization nftables-configuration
+  (package
+    (file-like nftables)
+    "The @code{nftables} package to use.")
+  (debug-levels
+   maybe-list-of-debug-levels
+   "A list of debug levels, for enabling debugging output.  Valid debug level values
+are the @samp{scanner}, @samp{parser}, @samp{eval}, @samp{netlink},
+@samp{mnl}, @samp{proto-ctx}, @samp{segtree} or @samp{all} symbols.")
+  (ruleset
+   (file-like %default-nftables-ruleset)
+   "A file-like object containing the complete nftables ruleset.  The default
+ruleset rejects all incoming connections except those to TCP port 22, with
+connections from the loopback interface are allowed."))
 
 (define (nftables-shepherd-service config)
   (match-record config <nftables-configuration>
-    (package ruleset)
+                (package debug-levels ruleset)
     (let ((nft (file-append package "/sbin/nft")))
       (shepherd-service
        (documentation "Packet filtering and classification")
        (actions (list (shepherd-configuration-action ruleset)))
        (provision '(nftables))
        (start #~(lambda _
-                  (invoke #$nft "--file" #$ruleset)))
+                  (invoke #$nft
+                          #$@(if (maybe-value-set? debug-levels)
+                                 (list (format #f "--debug=~{~a~^,~}"
+                                               debug-levels))
+                                 #~())
+                          "--file" #$ruleset)))
        (stop #~(lambda _
                  (invoke #$nft "flush" "ruleset")))))))
 
-- 
cgit v1.3