[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[bug#64616] [PATCH 1/1] services: static-networking: Add support for bon
|
From: |
Alexey Abramov |
|
Subject: |
[bug#64616] [PATCH 1/1] services: static-networking: Add support for bonding. |
|
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