Support more argument in link-set.

Julien LepillerMon Feb 01 15:36:46+0100 2021

8699322

Support more argument in link-set.

doc/guile-netlink.texi

484484 
family of commands, from @code{iproute2}.
485485 
486486 
@deffn {Scheme Procedure} link-set @var{device} [#:up @code{#f}] @
487-
  [#:down @code{#f}] [#:type @code{#f}]
487+
  [#:down @code{#f}] [#:type @code{#f}] [#:arp-on @code{#f}] @
488+
  [#:arp-off @code{#f}] [#:dynamic-on @code{#f}] [#:dynamic-off @code{#f}] @
489+
  [#:multicast-on @code{#f}] [#:multicast-off @code{#f}] @
490+
  [#:allmulticast-on @code{#f}] [#:allmulticast-off @code{#f}] @
491+
  [#:promisc-on @code{#f}] [#:promisc-off @code{#f}] [#:trailers-on @code{#f}] @
492+
  [#:trailers-off @code{#f}] [#:carrier-on @code{#f}] [#:carrier-off @code{#f}] @
493+
  [#:txqueuelen @code{#f}] [#:name @code{#f}] [#:address @code{#f}] @
494+
  [#:broadcast @code{#f}] [#:mtu @code{#f}] [#:netns @code{#f}]
488495 
Modify an existing link and set its flags and attributes to the ones specified
489496 
by the various keywords.  When a keyword is omited, the corresponding attribute
490497 
is not changed.
491498 
492499 
@var{device} can be a device index (as a number) or a device name (as a string).
493500 
494-
Do not set @code{#:up} and @code{#:down} at the same time.
501+
Do not set @code{#:up} and @code{#:down} at the same time.  Do not set
502+
@code{*-on} and @code{*-off} at the same time.
495503 
@end deffn
496504 
497505 
@deffn {Scheme Procedure} link-show [#:device @code{#f}] [#:group @code{#f}] @
ip/link.scm
8080 
    (let* ((answer (receive-and-decode-msg sock %default-route-decoder))
8181 
           (links (filter
8282 
                    (lambda (msg) (equal? (message-kind msg) RTM_NEWLINK))
83-
                    answer)))
84-
      (map
85-
        (lambda (msg)
86-
          (let* ((data (message-data msg))
87-
                 (attrs (link-message-attrs data)))
88-
          (make-link
89-
            (get-attr attrs IFLA_IFNAME)
90-
            (link-message-index data)
91-
            (link-message-kind data)
92-
            (split-flags (link-message-flags data))
93-
            (get-attr attrs IFLA_MTU)
94-
            (get-attr attrs IFLA_QDISC)
95-
            (get-attr attrs IFLA_OPERSTATE)
96-
            (get-attr attrs IFLA_LINKMODE)
97-
            (get-attr attrs IFLA_GROUP)
98-
            (get-attr attrs IFLA_TXQLEN)
99-
            (get-attr attrs IFLA_ADDRESS)
100-
            (get-attr attrs IFLA_BROADCAST))))
101-
        links))))
83+
                    answer))
84+
           (links
85+
             (map
86+
               (lambda (msg)
87+
                 (let* ((data (message-data msg))
88+
                        (attrs (link-message-attrs data)))
89+
                 (make-link
90+
                   (get-attr attrs IFLA_IFNAME)
91+
                   (link-message-index data)
92+
                   (link-message-kind data)
93+
                   (split-flags (link-message-flags data))
94+
                   (get-attr attrs IFLA_MTU)
95+
                   (get-attr attrs IFLA_QDISC)
96+
                   (get-attr attrs IFLA_OPERSTATE)
97+
                   (get-attr attrs IFLA_LINKMODE)
98+
                   (get-attr attrs IFLA_GROUP)
99+
                   (get-attr attrs IFLA_TXQLEN)
100+
                   (get-attr attrs IFLA_ADDRESS)
101+
                   (get-attr attrs IFLA_BROADCAST))))
102+
               links)))
103+
      (close-socket sock)
104+
      links)))
102105 
103106 
(define* (link-show #:key (device #f) (group #f) (up #f) (master #f) (vrf #f)
104107 
                    (type #f))
…
153156 
  (let loop ((links (get-links)))
154157 
    (match links
155158 
      (() (throw 'no-such-device device))
156-
      ((link links)
159+
      ((link links ...)
157160 
       (if (equal? (link-name link) device)
158161 
           (link-id link)
159162 
           (loop links))))))
160163 
161-
(define* (link-set device #:key (up #f) (down #f) (type #f))
164+
(define* (link-set device #:key (up #f) (down #f) (type #f)
165+
                   (arp-on #f) (arp-off #f)
166+
                   (dynamic-on #f) (dynamic-off #f)
167+
                   (multicast-on #f) (multicast-off #f)
168+
                   (allmulticast-on #f) (allmulticast-off #f)
169+
                   (promisc-on #f) (promisc-off #f)
170+
                   (trailers-on #f) (trailers-off #f)
171+
                   (carrier-on #f) (carrier-off #f)
172+
                   (txqueuelen #f) (name #f) (address #f)
173+
                   (broadcast #f) (mtu #f) (netns #f))
162174 
  (define request-num (random 65535))
163175 
  (define id (if (number? device) device (link-name->index device)))
176+
  (define netnsfd (cond
177+
                    ((string? netns)
178+
                     (open (string-append "/var/run/netns/" netns) O_RDONLY))
179+
                    ((number? netns)
180+
                     (open (string-append "/var/run/netns/" (number->string netns))
181+
                           O_RDONLY))
182+
                    (else
183+
                      #f)))
164184 
  (define message
165185 
    (make-message
166186 
      RTM_NEWLINK
…
171191 
        AF_UNSPEC
172192 
        (or type 0)
173193 
        id
174-
        (+ (if up IFF_UP 0))
175-
        (+ (if (or up down) IFF_UP 0))
176-
        '())))
194+
        (+ (if up IFF_UP 0)
195+
           (if arp-off IFF_NOARP 0)
196+
           (if dynamic-on IFF_DYNAMIC 0)
197+
           (if multicast-on IFF_MULTICAST 0)
198+
           (if allmulticast-on IFF_ALLMULTI 0)
199+
           (if promisc-on IFF_PROMISC 0)
200+
           (if trailers-off IFF_NOTRAILERS 0))
201+
        (+ (if (or up down) IFF_UP 0)
202+
           (if (or arp-on arp-off) IFF_NOARP 0)
203+
           (if (or dynamic-on dynamic-off) IFF_DYNAMIC 0)
204+
           (if (or multicast-on multicast-off) IFF_MULTICAST 0)
205+
           (if (or allmulticast-on allmulticast-off) IFF_ALLMULTI 0)
206+
           (if (or promisc-on promisc-off) IFF_PROMISC 0)
207+
           (if (or trailers-on trailers-off) IFF_NOTRAILERS 0))
208+
        `(,@(if (or carrier-on carrier-off)
209+
                (list
210+
                  (make-route-attr IFLA_CARRIER
211+
                    (make-u32-route-attr (if carrier-on 1 0))))
212+
                '())
213+
          ,@(if txqueuelen
214+
                (list
215+
                  (make-route-attr IFLA_TXQLEN
216+
                    (make-u32-route-attr txqueuelen)))
217+
                '())
218+
          ,@(if name
219+
                (list
220+
                  (make-route-attr IFLA_TXQLEN
221+
                    (make-u32-route-attr txqueuelen)))
222+
                '())
223+
          ,@(if address
224+
                (list
225+
                  (make-route-attr IFLA_ADDRESS
226+
                    (make-ethernet-route-attr address)))
227+
                '())
228+
          ,@(if broadcast
229+
                (list
230+
                  (make-route-attr IFLA_BROADCAST
231+
                    (make-ethernet-route-attr broadcast)))
232+
                '())
233+
          ,@(if mtu
234+
                (list
235+
                  (make-route-attr IFLA_MTU
236+
                    (make-u32-route-attr mtu)))
237+
                '())
238+
          ,@(if netns
239+
                (list
240+
                  (make-route-attr IFLA_NET_NS_FD
241+
                    (make-u32-route-attr
242+
                      (fileno netnsfd))))
243+
                '())))))
177244 
  (let ((sock (connect-route)))
178245 
    (send-msg message sock)
179246 
    (let ((answer (receive-and-decode-msg sock %default-route-decoder)))
247+
      (when netnsfd
248+
        (close netnsfd))
180249 
      (close-socket sock)
181250 
      answer)))