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