[bug#64616] [PATCH 0/1] services: static-networking: Add support for bonds and vlans

[bug#64616] [PATCH 0/1] services: static-networking: Add support for bonds and vlans

[Alexey Abramov via Guix-patches via]

Hi Guix!

After new release of guile-netlink, I made some changes on a guix side to be
able to configure bonds and vlans using static-networking declaration.

In short, I introduced two more structures for *matching* existing interfaces:
<network-link-by-macaddress> and <network-link-by-name>. The reason for that
is that <network-link> struct creates new interfaces in network-set-up/linux.
And if we want to construct a bond we need a way to apply settings for
existing interfaces.

With these changes applied, it is passable to do something like this:

(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")))))

This example is taken from the test, where I removed interface renaming
step. You should also know that network stack in Qemu won't with this
configuration.  The purpose of the test was to check if the stack has proper
settings.  If it is not enough, Please let me know.  I can try to use
openvswitch for that

There is one thing that bothers me. Here is a comment I put in the code:

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.  As you can see I
create an interface bond0 (in case some bonds are in configuration). It is
forces netlink to load the bonding module and then delete it to free up the
'name'.

Please let me know what you think.

Alexey Abramov (1):
  services: static-networking: Add support for bonding.

 doc/guix.texi            |  61 ++++++++++++++++-
 gnu/services/base.scm    | 109 +++++++++++++++++++++++++++---
 gnu/tests/networking.scm | 141 +++++++++++++++++++++++++++++++++++++++
 3 files changed, 299 insertions(+), 12 deletions(-)

-- 
2.40.1

[bug#64616] [PATCH 1/1] services: static-networking: Add support for bonding.

[Alexey Abramov via Guix-patches via]

* 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))))))
+
 \f
 ;;;
 ;;; Inetd.
-- 
2.40.1

[bug#64616] [PATCH 0/1] services: static-networking: Add support for bonds and vlans

[Ludovic Courtès]

Hi Alexey,

Alexey Abramov <levenson@mmer.org> skribis:

> * 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

Sounds like a great addition!

Not being a networking expert, I’d like to have someone else comment on
it (Cc’ing Julien in case they’re around), but I can make some
preliminary comments:

>  @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.

I don’t understand this sentence, especially since creating a
<network-link> record will not create a new interface.

> +@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.

[...]

> +@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.

[...]

> +(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"))))

My first reaction is that a “network link matched by MAC address” is
still “a network link”.  IOW, I would find it more natural to have a
single data type; it would also mirror the data types used by the
RTnetlink layer.

To do that, what would you think of keeping just the <network-link>
record, but adding two new fields: ‘for-mac-address’ and
‘for-device’?

(As an aside, please don’t abbreviate; so ‘mac-address’ rather than
‘macaddress’.)

> +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.

Could you (1) explain in one or two sentences what bonds and VLANs are,
ideally with a cross-reference to learn more about it, and (2) explain
the example in a bit more detail?  I would also encourage you to use the
“upstream” and “downstream” rather than “master” and “slave”, due to
their obvious connotation, though I realize that Guile-Netlink and
presumably Linux/RTnetlink itself use that terminology.

> +(define (run-static-networking-advanced-test vm)

This is awesome!

Thank you!

Ludo’.

[bug#64616] [PATCH 0/1] services: static-networking: Add support for bonds and vlans

[Alexey Abramov via Guix-patches via]

Hi Ludo, Julien

Ludovic Courtès <ludo@gnu.org> writes:

> Hi Alexey,
>
> Alexey Abramov <levenson@mmer.org> skribis:
>
>> * 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
>
> Sounds like a great addition!
>
> Not being a networking expert, I’d like to have someone else comment on
> it (Cc’ing Julien in case they’re around), but I can make some
> preliminary comments:

Many thanks! 

>>  @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.
>
> I don’t understand this sentence, especially since creating a
> <network-link> record will not create a new interface.

Yeah. You right. I somehow got an impression that network-link is for
link-add.  No comments. )

[...]

> My first reaction is that a “network link matched by MAC address” is
> still “a network link”.  IOW, I would find it more natural to have a
> single data type; it would also mirror the data types used by the
> RTnetlink layer.
>
> To do that, what would you think of keeping just the <network-link>
> record, but adding two new fields: ‘for-mac-address’ and
> ‘for-device’?
>
> (As an aside, please don’t abbreviate; so ‘mac-address’ rather than
> ‘macaddress’.)

I like that, thanks.  I have a patch series where you can define the
configuration like this:

--8<---------------cut here---------------start------------->8---
(list (network-link
       (name "bond0")
       (type "bond")
       (arguments '((mode . "802.3ad")
                    (miimon . 100)
                    (lacp-active . "on")
                    (lacp-rate . "fast"))))

      (network-link
       (for-mac-address "98:11:22:33:44:55")
       (arguments '((name . "a")
                    (master . "bond0"))))
      (network-link
       (for-mac-address "98:11:22:33:44:56")
       (arguments '((name . "b")
                    (master . "bond0"))))

      (network-link
       (name "bond0.1055")
       (type "vlan")
       (arguments '((id . 1055)
                    (link . "bond0")))))
--8<---------------cut here---------------end--------------->8---

Is that what you meant?  However, after your suggestions... What do you
think if we could use the name field without type to amend existing
ones, and for example netlink with mac-address field only, to match
interfaces by mac. Something like this:

--8<---------------cut here---------------start------------->8---
(list (network-link
       (mac-address "98:11:22:33:44:55")
       (arguments '((name . "a"))))

      (network-link
       (mac-address "98:11:22:33:44:56")
       (arguments '((name . "b"))))

      (network-link
       (name "bond0")
       (type "bond")
       (arguments '((mode . "802.3ad")
                    (miimon . 100)
                    (lacp-active . "on")
                    (lacp-rate . "fast"))))
      
      (network-link
       (name "a")
       (arguments '((master . "bond0"))))

      (network-link
       (name "b")
       (arguments '((master . "bond0"))))

      (network-link
       (name "bond0.1055")
       (type "vlan")
       (arguments '((id . 1055)
                    (link . "bond0")))))
--8<---------------cut here---------------end--------------->8---

IMHO this does look better.  What do you think? 

>> +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.
>
> Could you (1) explain in one or two sentences what bonds and VLANs are,
> ideally with a cross-reference to learn more about it, and (2) explain
> the example in a bit more detail?

Got it, will do.

> I would also encourage you to use the “upstream” and “downstream”
> rather than “master” and “slave”, due to their obvious connotation,
> though I realize that Guile-Netlink and presumably Linux/RTnetlink
> itself use that terminology.

I see.  The technology is indeed uses this exact connotation.
Documentation [1] itself also uses these terms.

I personally, don't see how this change will help people with
configuration or searching for documentation.

With all respect, truly, I would like to keep master/slave terminology,
at least here.

> This is awesome!

) I am trying. 

-- 
Alexey

Footnotes:
[1]  https://www.kernel.org/doc/Documentation/networking/bonding.txt

[bug#64616] [PATCH 0/1] services: static-networking: Add support for bonds and vlans

[Ludovic Courtès]

Hi Alexey,

Alexey Abramov <levenson@mmer.org> skribis:

> Is that what you meant?  However, after your suggestions... What do you
> think if we could use the name field without type to amend existing
> ones, and for example netlink with mac-address field only, to match
> interfaces by mac. Something like this:
>
> (list (network-link
>        (mac-address "98:11:22:33:44:55")
>        (arguments '((name . "a"))))
>
>       (network-link
>        (mac-address "98:11:22:33:44:56")
>        (arguments '((name . "b"))))
>
>       (network-link
>        (name "bond0")
>        (type "bond")
>        (arguments '((mode . "802.3ad")
>                     (miimon . 100)
>                     (lacp-active . "on")
>                     (lacp-rate . "fast"))))
>       
>       (network-link
>        (name "a")
>        (arguments '((master . "bond0"))))
>
>       (network-link
>        (name "b")
>        (arguments '((master . "bond0"))))
>
>       (network-link
>        (name "bond0.1055")
>        (type "vlan")
>        (arguments '((id . 1055)
>                     (link . "bond0")))))
>
> IMHO this does look better.  What do you think? 

Yes, I like it better too.  Go for it!

Thanks,
Ludo’.

[bug#64616] [PATCH 0/1] services: static-networking: Add support for bonds and vlans

[宋文武 via Guix-patches via]

Alexey Abramov <levenson@mmer.org> writes:

> Hi Guix!
>
> After new release of guile-netlink, I made some changes on a guix side to be
> able to configure bonds and vlans using static-networking declaration.

Hello I think this is a useful feature!
>
> In short, I introduced two more structures for *matching* existing interfaces:
> <network-link-by-macaddress> and <network-link-by-name>. The reason for that
> is that <network-link> struct creates new interfaces in network-set-up/linux.
> And if we want to construct a bond we need a way to apply settings for
> existing interfaces.

If I understand correctly, this will allow we create bond interfaces in
static-networking-service-type and configure those interfaces with
static IP.  Maybe there are needs for create bond interfaces, but
configure them with dhcp dynamic IP, will we able to that with this
patch?

[bug#64616] [PATCH 0/1] services: static-networking: Add support for bonds and vlans

[Alexey Abramov via Guix-patches via]

Hi!

宋文武 <iyzsong@envs.net> writes:

> Alexey Abramov <levenson@mmer.org> writes:
>
>> Hi Guix!
>>
>> After new release of guile-netlink, I made some changes on a guix side to be
>> able to configure bonds and vlans using static-networking declaration.
>
> Hello I think this is a useful feature!
>>
>> In short, I introduced two more structures for *matching* existing interfaces:
>> <network-link-by-macaddress> and <network-link-by-name>. The reason for that
>> is that <network-link> struct creates new interfaces in network-set-up/linux.
>> And if we want to construct a bond we need a way to apply settings for
>> existing interfaces.
>
> If I understand correctly, this will allow we create bond interfaces in
> static-networking-service-type and configure those interfaces with
> static IP.  Maybe there are needs for create bond interfaces, but
> configure them with dhcp dynamic IP, will we able to that with this
> patch?

Thanks for taking the time to check it.  You absolutely right.  Running
dhcp-client and static-networking on routers, for example, is must.  This patch won't
allow this, but another one related to dhcp-client-configuration bug#64850 will. 

-- 
Alexey

[bug#64616] [PATCH v2] services: static-networking: Add support for bonding.

[Alexey Abramov via Guix-patches via]

* gnu/services/base.scm (<network-link>): Add mac-address field. Set
type field to #f by default, so it won't be mandatory. network-link
without a type will be used for existing interfaces.
(assert-network-link-mac-address, mac-address?): Add sanitizer. Allow
valid mac-address or #f.
(assert-network-link-type): Add sanitizer. Allow symbol or #f.
* gnu/services/base.scm (network-set-up/linux,
network-tear-down/linux): Adapt to new structure.
* doc/guix.texi (Networking Setup): Document it.
* gnu/tests/networking.scm (run-static-networking-advanced-test): New
variable.
---
 doc/guix.texi            |  61 +++++++++++++++-
 gnu/services/base.scm    | 134 ++++++++++++++++++++++++++++++----
 gnu/tests/networking.scm | 151 +++++++++++++++++++++++++++++++++++++++
 3 files changed, 330 insertions(+), 16 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index f49ed894a7..ba8a4a704e 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -20414,20 +20414,75 @@ 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}).  During startup, network links are employed to
+construct or modify existing or virtual ethernet links.  These ethernet
+links can be identified by their @var{name} or @var{mac-address}.  If
+there is a need to create virtual interface, @var{name} and @var{type}
+fields are required.
 
 @table @code
 @item name
-The name of the link---e.g., @code{"v0p0"}.
+The name of the link---e.g., @code{"v0p0"} (default: @code{#f}).
 
 @item type
-A symbol denoting the type of the link---e.g., @code{'veth}.
+A symbol denoting the type of the link---e.g., @code{'veth} (default: @code{#f}).
+
+@item mac-address
+The mac-address of the link---e.g., @code{"98:11:22:33:44:55"} (default: @code{#f}).
 
 @item arguments
 List of arguments for this type of link.
 @end table
 @end deftp
 
+Consider a scenario where a server equipped with a network interface
+which has multiple ports.  These ports are connected to a switch, which
+supports @uref{https://en.wikipedia.org/wiki/Link_aggregation, link
+aggregation} (also known as bonding or NIC teaming).  The switch uses
+port channels to consolidate multiple physical interfaces into one
+logical interface to provide higher bandwidth, load balancing, and link
+redundancy.  When a port is added to a LAG (or link aggregation group),
+it inherits the properties of the port-channel.  Some of these
+properties are VLAN membership, trunk status, and so on.
+
+@uref{https://en.wikipedia.org/wiki/Virtual_LAN, VLAN} (or virtual local
+area network) is a logical network that is isolated from other VLANs on
+the same physical network.  This can be used to segregate traffic,
+improve security, and simplify network management.
+
+With all that in mind let's configure our static network for the server.
+We will bond two existing interfaces together using 802.3ad schema and on
+top of it, build a VLAN interface with id 1055.  We assign a static ip
+to our new VLAN interface.
+
+@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
+               (mac-address "98:11:22:33:44:55")
+               (arguments '((master . "bond0"))))
+
+              (network-link
+               (mac-address "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 b3f2d2e8b8..aaf9ae5359 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -2642,6 +2642,33 @@ (define-compile-time-procedure (assert-valid-address (address string?))
                                 address)))))))
   address)
 
+(define (mac-address? str)
+  "Return true if STR is a valid MAC address."
+  (let ((pattern (make-regexp "^([0-9A-Fa-f]{2}:?){6}$")))
+    (false-if-exception (vector? (regexp-exec pattern str)))))
+
+(define-compile-time-procedure (assert-network-link-mac-address (value identity))
+  (cond
+   ((eq? value #f) value)
+   ((and (string? value) (mac-address? value)) value)
+   (else (raise
+          (make-compound-condition
+           (formatted-message (G_ "Value (~S) is not a valid mac address.~%")
+                              value)
+           (condition (&error-location
+                       (location (source-properties->location procedure-call-location)))))))))
+
+(define-compile-time-procedure (assert-network-link-type (value identity))
+  (match value
+    (#f value)
+    (('quote _) (datum->syntax #'value value))
+    (else
+     (raise
+      (make-compound-condition
+       (formatted-message (G_ "Value (~S) is not a symbol.~%") value)
+       (condition (&error-location
+                   (location (source-properties->location procedure-call-location)))))))))
+
 (define-record-type* <static-networking>
   static-networking make-static-networking
   static-networking?
@@ -2669,8 +2696,14 @@ (define-record-type* <network-address>
 (define-record-type* <network-link>
   network-link make-network-link
   network-link?
-  (name      network-link-name)                   ;string--e.g, "v0p0"
-  (type      network-link-type)                   ;symbol--e.g.,'veth
+  (name      network-link-name
+             (default #f))                   ;string or #f --e.g, "v0p0"
+  (type      network-link-type
+             (sanitize assert-network-link-type)
+             (default #f))                   ;symbol or #f--e.g.,'veth, 'bond
+  (mac-address network-link-mac-address
+               (sanitize assert-network-link-mac-address)
+               (default #f))
   (arguments network-link-arguments))             ;list
 
 (define-record-type* <network-route>
@@ -2795,7 +2828,77 @@ (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))
+                                  ;; Type is not mandatory
+                                  (false-if-exception
+                                   (eq? (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 mac-address arguments)
+                                  (cond
+                                   ;; Create a new interface
+                                   ((and (string? name) (symbol? type))
+                                    #~(begin
+                                        (link-add #$name (symbol->string '#$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)))
+
+                                   ;; Amend an existing interface
+                                   ((and (string? name)
+                                         (eq? type #f))
+                                    #~(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))))
+                                   ((string? mac-address)
+                                    #~(let ((link (match-link-by link-addr #$mac-address)))
+                                        (if link
+                                            (apply link-set
+                                                   (link-id link)
+                                                   (alist->keyword+value '#$arguments))
+                                            (format #t (G_ "Interface with mac-address '~a' not found~%") #$mac-address)))))))
+                                        links)
 
                        #$@(map (lambda (address)
                                  #~(begin
@@ -2814,11 +2917,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 +2961,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 +2972,17 @@ (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 mac-address arguments)
+                                  (cond
+                                   ;; We delete interfaces that were created
+                                   ((and (string? name) (symbol? type))
+                                    #~(false-if-netlink-error
+                                       (link-del #$name)))
+                                   (else #t))))
+                               links)
                        #f)))))
 
 (define (static-networking-shepherd-service config)
diff --git a/gnu/tests/networking.scm b/gnu/tests/networking.scm
index a192c7e655..52f818af48 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,156 @@ (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
+                                         (mac-address "98:11:22:33:44:55")
+                                         (arguments '((name . "a"))))
+
+                                        (network-link
+                                         (mac-address "98:11:22:33:44:56")
+                                         (arguments '((name . "b"))))
+
+                                        (network-link
+                                         (name "bond0")
+                                         (type 'bond)
+                                         (arguments '((mode . "802.3ad")
+                                                      (miimon . 100)
+                                                      (lacp-active . "on")
+                                                      (lacp-rate . "fast"))))
+
+                                        (network-link
+                                         (name "a")
+                                         (arguments '((master . "bond0"))))
+
+                                        (network-link
+                                         (name "b")
+                                         (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"))))))))
+               #:imported-modules '((gnu services herd)
+                                    (guix combinators)))))
+      (run-static-networking-advanced-test (virtual-machine os))))))
+
 \f
 ;;;
 ;;; Inetd.
-- 
2.41.0

bug#64616: [PATCH v2] services: static-networking: Add support for bonding.

[Ludovic Courtès]

Hi Alexey,

Alexey Abramov <levenson@mmer.org> skribis:

> * gnu/services/base.scm (<network-link>): Add mac-address field. Set
> type field to #f by default, so it won't be mandatory. network-link
> without a type will be used for existing interfaces.
> (assert-network-link-mac-address, mac-address?): Add sanitizer. Allow
> valid mac-address or #f.
> (assert-network-link-type): Add sanitizer. Allow symbol or #f.
> * gnu/services/base.scm (network-set-up/linux,
> network-tear-down/linux): Adapt to new structure.
> * doc/guix.texi (Networking Setup): Document it.
> * gnu/tests/networking.scm (run-static-networking-advanced-test): New
> variable.

Finally applied, thank you!

Ludo’.