Subject: [PATCH 1/1] services: static-networking: Add support for bonding.

From: Alexey Abramov <[email-masked]>
Date: Fri, 14 Jul 2023 17:36:38 +0200

* gnu/services/base.scm (<network-link-by-macaddress>,
<network-link-by-name>): Provide records to match *existing*
interfaces and amend them.
* gnu/services/base.scm (network-set-up/linux,
network-tear-down/linux): Add support to change settings of existing
interfaces. Move address cleanup above links cleanup.
* doc/guix.texi (Networking Setup): Document it.
* gnu/tests/networking.scm (run-static-networking-advanced-test): Add tests
---
 doc/guix.texi            |  61 ++++++++++++++++-
 gnu/services/base.scm    | 109 +++++++++++++++++++++++++++---
 gnu/tests/networking.scm | 141 +++++++++++++++++++++++++++++++++++++++
 3 files changed, 299 insertions(+), 12 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 0cdc528c1c..69712a64fb 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -20278,7 +20278,8 @@ IP address (a string) through which traffic is routed.
 
 @deftp {Data Type} network-link
 Data type for a network link (@pxref{Link,,, guile-netlink,
-Guile-Netlink Manual}).
+Guile-Netlink Manual}).  A new interface with settings, specified in
+arguments will be created.
 
 @table @code
 @item name
@@ -20292,6 +20293,64 @@ List of arguments for this type of link.
 @end table
 @end deftp
 
+@deftp {Data Type} network-link-by-macaddress
+Data type for a network link with a specific MAC address. Arguments will
+be applied to existing link matching the MAC.
+
+@table @code
+@item macaddress
+The MAC address to match a link.
+
+@item arguments
+List of arguments for the link to be applied.
+@end table
+@end deftp
+
+@deftp {Data Type} network-link-by-name
+Data type for a network link with a specific name. Arguments will be
+applied to existing link mathing the name.
+
+@table @code
+@item name
+The name of the link.
+
+@item arguments
+List of arguments for the link to be applied.
+@end table
+@end deftp
+
+Here is another example for more advance configuration with bonds and
+vlans.  The following snippet will create a bond out of two interfaces,
+rename the slaves and create a vlan 1055 on top of it.
+
+@lisp
+(static-networking
+ (links (list (network-link
+               (name "bond0")
+               (type "bond")
+               (arguments '((mode . "802.3ad")
+                            (miimon . 100)
+                            (lacp-active . "on")
+                            (lacp-rate . "fast"))))
+
+              (network-link-by-macaddress
+               (macaddress "98:11:22:33:44:55")
+               (arguments '((master . "bond0"))))
+
+              (network-link-by-macaddress
+               (macaddress "98:11:22:33:44:56")
+               (arguments '((master . "bond0"))))
+
+              (network-link
+               (name "bond0.1055")
+               (type "vlan")
+               (arguments '((id . 1055)
+                            (link . "bond0"))))))
+ (addresses (list (network-address
+                   (value "192.168.1.4/24")
+                   (device "bond0.1055")))))
+@end lisp
+
 @cindex loopback device
 @defvar %loopback-static-networking
 This is the @code{static-networking} record representing the ``loopback
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 636d827ff9..ae3b1b5dc3 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -133,6 +133,16 @@ (define-module (gnu services base)
             network-link-type
             network-link-arguments
 
+            network-link-by-macaddress
+            network-link-by-macaddress?
+            network-link-by-macaddress-maccaddress
+            network-link-by-macaddress-arguments
+
+            network-link-by-name
+            network-link-by-name?
+            network-link-by-name-name
+            network-link-by-name-arguments
+
             network-route
             network-route?
             network-route-destination
@@ -2676,6 +2686,19 @@ (define-record-type* <network-link>
   (type      network-link-type)                   ;symbol--e.g.,'veth
   (arguments network-link-arguments))             ;list
 
+(define-record-type* <network-link-by-macaddress>
+  network-link-by-macaddress make-network-link-by-macaddress
+  network-link-by-macaddress?
+  (macaddress network-link-by-macaddress-maccaddress)
+  (arguments network-link-by-macaddress-arguments))
+
+(define-record-type* <network-link-by-name>
+  network-link-by-name make-network-link-by-name
+  network-link-by-name?
+  (name network-link-by-name-name)
+  (arguments network-link-by-name-arguments))
+
+
 (define-record-type* <network-route>
   network-route make-network-route
   network-route?
@@ -2795,7 +2818,64 @@ (define (network-set-up/linux config)
     (scheme-file "set-up-network"
                  (with-extensions (list guile-netlink)
                    #~(begin
-                       (use-modules (ip addr) (ip link) (ip route))
+                       (use-modules (ip addr) (ip link) (ip route)
+                                    (srfi srfi-1)
+                                    (ice-9 format)
+                                    (ice-9 match))
+
+                       (define (match-link-by field-accessor value)
+                         (fold (lambda (link result)
+                                 (if (equal? (field-accessor link) value)
+                                     link
+                                     result))
+                               #f
+                               (get-links)))
+
+                       (define (alist->keyword+value alist)
+                         (fold (match-lambda*
+                                 (((k . v) r)
+                                  (cons* (symbol->keyword k) v r))) '() alist))
+
+                       ;; FIXME: It is interesting that "modprobe bonding" creates an
+                       ;; interface bond0 straigt away.  If we won't have bonding
+                       ;; module, and execute `ip link add name bond0 type bond' we
+                       ;; will get
+                       ;;
+                       ;; RTNETLINK answers: File exists
+                       ;;
+                       ;; This breaks our configuration if we want to
+                       ;; use `bond0' name.  Create (force modprobe
+                       ;; bonding) and delete the interface to free up
+                       ;; bond0 name.
+                       #$(let lp ((links links))
+                           (cond
+                            ((null? links) #f)
+                            ((and (network-link? (car links))
+                                  (string=? (network-link-type (car links)) "bond"))
+                             #~(begin
+                                 (false-if-exception (link-add "bond0" "bond"))
+                                 (link-del "bond0")))
+                            (else (lp (cdr links)))))
+
+                       #$@(map (match-lambda
+                                 (($ <network-link> name type arguments)
+                                  #~(begin
+                                      (link-add #$name #$type #:type-args '#$arguments)
+                                      ;; XXX: If we add routes, addresses must be already
+                                      ;; assigned, and interfaces must be up. It doesn't
+                                      ;; matter if they won't have carrier or anything
+                                      (link-set #$name #:up #t)))
+                                 (($ <network-link-by-macaddress> macaddress arguments)
+                                  #~(let ((link (match-link-by link-addr #$macaddress)))
+                                      (if link
+                                          (apply link-set (link-id link) (alist->keyword+value '#$arguments))
+                                          (format #t (G_ "Interface with macaddress '~a' not found~%") #$macaddress))))
+                                 (($ <network-link-by-name> name arguments)
+                                  #~(let ((link (match-link-by link-name #$name)))
+                                      (if link
+                                          (apply link-set (link-id link) (alist->keyword+value '#$arguments))
+                                          (format #t (G_ "Interface with name '~a' not found~%") #$name)))))
+                               links)
 
                        #$@(map (lambda (address)
                                  #~(begin
@@ -2814,11 +2894,7 @@ (define (network-set-up/linux config)
                                                #:multicast-on #t
                                                #:up #t)))
                                addresses)
-                       #$@(map (match-lambda
-                                 (($ <network-link> name type arguments)
-                                  #~(link-add #$name #$type
-                                              #:type-args '#$arguments)))
-                               links)
+
                        #$@(map (lambda (route)
                                  #~(route-add #$(network-route-destination route)
                                               #:device
@@ -2862,11 +2938,9 @@ (define-syntax-rule (false-if-netlink-error exp)
                                                #:src
                                                #$(network-route-source route))))
                                routes)
-                       #$@(map (match-lambda
-                                 (($ <network-link> name type arguments)
-                                  #~(false-if-netlink-error
-                                     (link-del #$name))))
-                               links)
+
+                       ;; Cleanup addresses first, they might be assigned to
+                       ;; created bonds, vlans or bridges.
                        #$@(map (lambda (address)
                                  #~(false-if-netlink-error
                                     (addr-del #$(network-address-device
@@ -2875,6 +2949,19 @@ (define-syntax-rule (false-if-netlink-error exp)
                                               #:ipv6?
                                               #$(network-address-ipv6? address))))
                                addresses)
+
+                       ;; It is now safe to delete some links
+                       #$@(map (match-lambda
+                                 (($ <network-link> name type arguments)
+                                  #~(false-if-netlink-error
+                                     (link-del #$name)))
+                                 ;; XXX: Here we can probably reset existing
+                                 ;; interfaces.
+                                 (($ <network-link-by-macaddress> macaddress arguments)
+                                  #f)
+                                 (($ <network-link-by-name> name arguments)
+                                  #f))
+                               links)
                        #f)))))
 
 (define (static-networking-shepherd-service config)
diff --git a/gnu/tests/networking.scm b/gnu/tests/networking.scm
index a192c7e655..b2d6ec597a 100644
--- a/gnu/tests/networking.scm
+++ b/gnu/tests/networking.scm
@@ -39,6 +39,7 @@ (define-module (gnu tests networking)
   #:use-module (gnu services shepherd)
   #:use-module (ice-9 match)
   #:export (%test-static-networking
+            %test-static-networking-advanced
             %test-inetd
             %test-openvswitch
             %test-dhcpd
@@ -124,6 +125,146 @@ (define %test-static-networking
                                     (guix combinators)))))
       (run-static-networking-test (virtual-machine os))))))
 
+(define (run-static-networking-advanced-test vm)
+  (define test
+    (with-imported-modules '((gnu build marionette)
+                             (guix build syscalls))
+      #~(begin
+          (use-modules (gnu build marionette)
+                       (guix build syscalls)
+                       (srfi srfi-64))
+
+          (define marionette
+            (make-marionette
+             '(#$vm "-net" "nic,model=e1000,macaddr=98:11:22:33:44:55"
+                    "-net" "nic,model=e1000,macaddr=98:11:22:33:44:56")))
+
+          (test-runner-current (system-test-runner #$output))
+          (test-begin "static-networking-advanced")
+
+          (test-assert "service is up"
+            (marionette-eval
+             '(begin
+                (use-modules (gnu services herd))
+                (start-service 'networking))
+             marionette))
+
+          (test-assert "network interfaces"
+            (marionette-eval
+             '(begin
+                (use-modules (guix build syscalls))
+                (network-interface-names))
+             marionette))
+
+          (test-equal "bond0 bonding mode"
+            "802.3ad 4"
+            (marionette-eval
+             '(begin
+                (use-modules (ice-9 rdelim))
+                (call-with-input-file "/sys/class/net/bond0/bonding/mode" read-line))
+             marionette))
+
+          (test-equal "bond0 bonding lacp_rate"
+            "fast 1"
+            (marionette-eval
+             '(begin
+                (use-modules (ice-9 rdelim))
+                (call-with-input-file "/sys/class/net/bond0/bonding/lacp_rate" read-line))
+             marionette))
+
+          (test-equal "bond0 bonding miimon"
+            "100"
+            (marionette-eval
+             '(begin
+                (use-modules (ice-9 rdelim))
+                (call-with-input-file "/sys/class/net/bond0/bonding/miimon" read-line))
+             marionette))
+
+          (test-equal "bond0 bonding slaves"
+            "a b"
+            (marionette-eval
+             '(begin
+                (use-modules (ice-9 rdelim))
+                (call-with-input-file "/sys/class/net/bond0/bonding/slaves" read-line))
+             marionette))
+
+          ;; The hw mac address will come from the first slave bonded to the
+          ;; channel.
+          (test-equal "bond0 mac address"
+            "98:11:22:33:44:55"
+            (marionette-eval
+             '(begin
+                (use-modules (ice-9 rdelim))
+                (call-with-input-file "/sys/class/net/bond0/address" read-line))
+             marionette))
+
+          (test-equal "bond0.1055 is up"
+            IFF_UP
+            (marionette-eval
+             '(let* ((sock  (socket AF_INET SOCK_STREAM 0))
+                     (flags (network-interface-flags sock "bond0.1055")))
+                (logand flags IFF_UP))
+             marionette))
+
+          (test-equal "bond0.1055 address is correct"
+            "192.168.1.4"
+            (marionette-eval
+             '(let* ((sock (socket AF_INET SOCK_STREAM 0))
+                     (addr (network-interface-address sock "bond0.1055")))
+                (close-port sock)
+                (inet-ntop (sockaddr:fam addr) (sockaddr:addr addr)))
+             marionette))
+
+          (test-equal "bond0.1055 netmask is correct"
+            "255.255.255.0"
+            (marionette-eval
+             '(let* ((sock (socket AF_INET SOCK_STREAM 0))
+                     (mask (network-interface-netmask sock "bond0.1055")))
+                (close-port sock)
+                (inet-ntop (sockaddr:fam mask) (sockaddr:addr mask)))
+             marionette))
+          (test-end))))
+
+  (gexp->derivation "static-networking-advanced" test))
+
+(define %test-static-networking-advanced
+  (system-test
+   (name "static-networking-advanced")
+   (description "Test the 'static-networking' service with advanced features like bonds, vlans etc...")
+   (value
+    (let ((os (marionette-operating-system
+               (simple-operating-system
+                (service static-networking-service-type
+                         (list (static-networking
+                                (links (list (network-link
+                                              (name "bond0")
+                                              (type "bond")
+                                              (arguments '((mode . "802.3ad")
+                                                           (miimon . 100)
+                                                           (lacp-active . "on")
+                                                           (lacp-rate . "fast"))))
+
+                                             (network-link-by-macaddress
+                                              (macaddress "98:11:22:33:44:55")
+                                              (arguments '((name . "a")
+                                                           (master . "bond0"))))
+                                             (network-link-by-macaddress
+                                              (macaddress "98:11:22:33:44:56")
+                                              (arguments '((name . "b")
+                                                           (master . "bond0"))))
+
+                                             (network-link
+                                              (name "bond0.1055")
+                                              (type "vlan")
+                                              (arguments '((id . 1055)
+                                                           (link . "bond0"))))))
+                                (addresses (list (network-address
+                                                  (value "192.168.1.4/24")
+                                                  (device "bond0.1055"))))))))
+               #:imported-modules '((gnu services herd)
+                                    (guix combinators)))))
+      (run-static-networking-advanced-test (virtual-machine os))))))
+
 
 ;;;
 ;;; Inetd.
-- 
2.40.1