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

3 files changed, 172 insertions, 30 deletions

diff --git a/doc/guix.texi b/doc/guix.texi
index 65c64f022ef..d69e6ed215b 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -22632,32 +22632,48 @@ objects}).
 @end deftp
 
 @cindex nftables
+@cindex firewall, nftables
 @defvar nftables-service-type
-This is the service type to set up a nftables configuration.  nftables is a
-netfilter project that aims to replace the existing iptables, ip6tables,
+This is the service type to set up a nftables configuration.  nftables
+is a netfilter project that aims to replace the iptables, ip6tables,
 arptables and ebtables framework.  It provides a new packet filtering
-framework, a new user-space utility @command{nft}, and a compatibility layer
-for iptables.  This service comes with a default ruleset
-@code{%default-nftables-ruleset} that rejecting all incoming connections
-except those to the ssh port 22.  To use it, simply write:
+framework, a new user-space utility @command{nft}, and a compatibility
+layer for iptables.  This service comes with a default ruleset,
+@code{%default-nftables-ruleset}, that rejects all incoming connections
+except those to the SSH port 22 (TCP).  To use it, simply write:
 
 @lisp
 (service nftables-service-type)
 @end lisp
 @end defvar
 
+@c %start of fragment
+
 @deftp {Data Type} nftables-configuration
-The data type representing the configuration of nftables.
+Available @code{nftables-configuration} fields are:
 
 @table @asis
-@item @code{package} (default: @code{nftables})
-The nftables package that provides @command{nft}.
-@item @code{ruleset} (default: @code{%default-nftables-ruleset})
-The nftables ruleset to use.  This may be any ``file-like'' object
-(@pxref{G-Expressions, file-like objects}).
+@item @code{package} (default: @code{nftables}) (type: file-like)
+The @code{nftables} package to use.
+
+@item @code{debug-levels} (type: 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.
+
+@item @code{ruleset} (type: file-like)
+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.
+
 @end table
+
 @end deftp
 
+
+@c %end of fragment
+
 @cindex NTP (Network Time Protocol), service
 @cindex ntpd, service for the Network Time Protocol daemon
 @cindex real time clock
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")))))))
 
diff --git a/gnu/tests/networking.scm b/gnu/tests/networking.scm
index 25f61034c66..2865e6ff350 100644
--- a/gnu/tests/networking.scm
+++ b/gnu/tests/networking.scm
@@ -5,6 +5,7 @@
 ;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
 ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
 ;;; Copyright © 2021, 2023-2024 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2025 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -29,6 +30,7 @@
   #:use-module (gnu services base)
   #:use-module (gnu services dns)
   #:use-module (gnu services networking)
+  #:use-module (gnu services ssh)
   #:use-module (guix gexp)
   #:use-module (guix store)
   #:use-module (guix monads)
@@ -50,6 +52,7 @@
             %test-dnsmasq
             %test-tor
             %test-iptables
+            %test-nftables
             %test-ipfs))
 
 
@@ -968,6 +971,8 @@ subnet 192.168.1.0 netmask 255.255.255.0 {
    (description "Test a running Tor daemon configuration.")
    (value (run-tor-test))))
 
+(define %inetd-echo-port 7)
+
 (define* (run-iptables-test)
   "Run tests of 'iptables-service-type'."
   (define iptables-rules
@@ -988,8 +993,6 @@ COMMIT
 COMMIT
 ")
 
-  (define inetd-echo-port 7)
-
   (define os
     (marionette-operating-system
      (simple-operating-system
@@ -1065,7 +1068,8 @@ COMMIT
 
           (test-error "iptables firewall blocks access to inetd echo service"
                       'misc-error
-                      (wait-for-tcp-port inetd-echo-port marionette #:timeout 5))
+                      (wait-for-tcp-port #$%inetd-echo-port marionette
+                                         #:timeout 5))
 
           ;; TODO: This test freezes up at the login prompt without any
           ;; relevant messages on the console. Perhaps it is waiting for some
@@ -1077,7 +1081,7 @@ COMMIT
           ;;         (use-modules (gnu services herd))
           ;;         (stop-service 'iptables))
           ;;      marionette)
-          ;;     (wait-for-tcp-port inetd-echo-port marionette #:timeout 5)))
+          ;;     (wait-for-tcp-port #$%inetd-echo-port marionette #:timeout 5)))
 
           (test-end))))
 
@@ -1091,6 +1095,107 @@ COMMIT
 
 
 ;;;
+;;; nftables.
+;;;
+
+(define (make-nftables-os ruleset)
+  (simple-operating-system
+   (service dhcp-client-service-type)
+   (service inetd-service-type
+            (inetd-configuration
+             (entries (list
+                       (inetd-entry
+                        (name "echo")
+                        (socket-type 'stream)
+                        (protocol "tcp")
+                        (wait? #f)
+                        (user "root"))))))
+   (service openssh-service-type)
+   (service nftables-service-type
+            (nftables-configuration
+             (debug-levels '(all))
+             (ruleset ruleset)))))
+
+(define %default-nftables-ruleset-for-tests
+  ;; This is like the %default-nftables-ruleset, but without allowing any
+  ;; connections from the loopback interface.
+  (plain-file "nftables.conf" "\
+table inet filter {
+  chain input {
+    type filter hook input priority 0; policy drop;
+
+    # early drop of invalid connections
+    ct state invalid drop
+
+    # allow established/related connections
+    ct state { established, related } accept
+
+    # allow from loopback
+    # iif lo accept   # COMMENTED OUT FOR TESTS
+    # drop connections to lo not coming from lo
+    iif != lo ip daddr 127.0.0.1/8 drop
+    iif != lo ip6 daddr ::1/128 drop
+
+    # allow icmp
+    ip protocol icmp accept
+    ip6 nexthdr icmpv6 accept
+
+    # allow ssh
+    tcp dport ssh accept
+
+    # reject everything else
+    reject with icmpx type port-unreachable
+  }
+  chain forward {
+    type filter hook forward priority 0; policy drop;
+  }
+  chain output {
+    type filter hook output priority 0; policy accept;
+  }
+}"))
+
+(define %nftables-os
+  (make-nftables-os %default-nftables-ruleset-for-tests))
+
+(define (run-nftables-test)
+  (define os
+    (marionette-operating-system
+     %nftables-os
+     #:imported-modules '((gnu services herd))
+     #:requirements '(inetd nftables ssh)))
+
+  (define test
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (use-modules (gnu build marionette)
+                       (srfi srfi-64))
+          (define marionette
+            (make-marionette (list #$(virtual-machine os))))
+
+          (test-runner-current (system-test-runner #$output))
+          (test-begin "nftables")
+
+          (test-error "nftables blocks access to inetd echo service"
+                      'misc-error
+                      (wait-for-tcp-port #$%inetd-echo-port marionette
+                                         #:timeout 5))
+
+          (test-assert "nftables allows access to SSH TCP port 22"
+            (wait-for-tcp-port 22 marionette))
+
+          (test-end))))
+
+  (gexp->derivation "nftables-test" test))
+
+(define %test-nftables
+  (system-test
+   (name "nftables")
+   (description "Test the nftables service properly allow or block
+connection to ports.")
+   (value (run-nftables-test))))
+
+
+;;;
 ;;; IPFS service
 ;;;