Add support for link creation

Julien LepillerTue Feb 02 00:12:04+0100 2021

ab35308

Add support for link creation

doc/guile-netlink.texi

509509 
corresponding value.  You may set more than one keyword.
510510 
@end deffn
511511 
512+
@deffn {Scheme Procedure} link-add @var{name} @var{type} [#:type-args @code{'()}]
513+
Add a new link with given name and type.  Additional arguments can be passed to
514+
control the state of the link at creation. @var{type-args} is an association
515+
list containing additional values for the given type.
516+
517+
When @var{type} is @code{"vlan"}, @var{type-args} can contain a number associated
518+
with @code{'id}: the VLAN id to be created.
519+
520+
When @var{type} is @code{"veth"}, @var{type-args} can contain a string associated
521+
with @code{'peer}: the name of the peer.
522+
523+
The following is an example in which we create a new veth (virtual ethernet)
524+
pair and give them a name:
525+
@example
526+
;; same as "ip l add v0p0 type veth peer v0p1"
527+
(link-add "v0p0" "veth" #:type-args '((peer . "v0p1")))
528+
@end example
529+
@end deffn
530+
512531 
@bye
ip/link.scm
2727 
  #:use-module (netlink standard)
2828 
  #:use-module (srfi srfi-1)
2929 
  #:use-module (srfi srfi-9)
30-
  #:export (link-set
30+
  #:export (link-add
31+
            link-set
3132 
            link-show))
3233 
3334 
(define-record-type <link>
…
265266 
        (close netnsfd))
266267 
      (close-socket sock)
267268 
      (answer-ok? (last answer)))))
269+
270+
(define* (link-add name type #:key (type-args '()))
271+
  (define request-num (random 65535))
272+
  (define type-data
273+
    (match type
274+
      ("vlan"
275+
       `(,@(if (assoc-ref type-args 'id)
276+
               (list (make-route-attr IFLA_VLAN_ID
277+
                       (make-u16-route-attr (assoc-ref type-args 'id))))
278+
               '())))
279+
      ("veth"
280+
       `(,@(if (assoc-ref type-args 'peer)
281+
               (list (make-route-attr VETH_INFO_PEER
282+
                       (make-link-message
283+
                         AF_UNSPEC 0 0 0 0
284+
                         (list
285+
                           (make-route-attr IFLA_IFNAME
286+
                             (make-string-route-attr
287+
                               (assoc-ref type-args 'peer)))))))
288+
               '())))
289+
      ;; TODO: unsupported for now
290+
      (_ '())))
291+
  (define message
292+
    (make-message
293+
      RTM_NEWLINK
294+
      (logior NLM_F_REQUEST NLM_F_ACK NLM_F_EXCL NLM_F_CREATE)
295+
      request-num
296+
      0
297+
      (make-link-message
298+
        AF_UNSPEC
299+
        0
300+
        0
301+
        0
302+
        0
303+
        (list
304+
          (make-route-attr IFLA_IFNAME
305+
            (make-string-route-attr name))
306+
          (make-route-attr IFLA_LINKINFO
307+
            (make-nested-route-attr
308+
              (list
309+
                (make-route-attr IFLA_INFO_KIND
310+
                  (make-string-route-attr type))
311+
                (make-route-attr IFLA_INFO_DATA
312+
                  (make-nested-route-attr type-data)))))))))
313+
  (let ((sock (connect-route)))
314+
    (send-msg message sock)
315+
    (let ((answer (receive-and-decode-msg sock %default-route-decoder)))
316+
      (close-socket sock)
317+
      (answer-ok? (last answer)))))
netlink/constant.scm
7171 
  IFLA_PROP_LIST IFLA_ALT_IFNAME IFLA_PERM_ADDRESS)
7272 
(define-public IFLA_TARGET_NETNSID IFLA_IF_NETNSID)
7373 
74+
(define-enum int->linkinfo
75+
  IFLA_INFO_UNSPEC IFLA_INFO_KIND IFLA_INFO_DATA IFLA_INFO_XSTATS
76+
  IFLA_INFO_SLAVE_KIND IFLA_INFO_SLAVE_DATA)
77+
78+
(define-enum int->veth-linkinfo
79+
  VETH_INFO_UNSPEC VETH_INFO_PEER)
80+
81+
(define-enum int->vlan-linkinfo
82+
  IFLA_VLAN_UNSPEC IFLA_VLAN_ID IFLA_VLAN_FLAGS IFLA_VLAN_EGRESS_QOS
83+
  IFLA_VLAN_INGRESS_QOS IFLA_VLAN_PROTOCOL)
84+
7485 
(define-enum int->addr-attr-kind
7586 
  IFA_UNSPEC IFA_ADDRESS IFA_LOCAL IFA_LABEL IFA_BROADCAST
7687 
  IFA_ANYCAST IFA_CACHEINFO IFA_MULTICAST IFA_FLAGS
netlink/deserialize.scm
5555 
    (ipv4-route-attr ,(route:deserialize-route-attr 'ipv4-route-attr)
5656 
                     ,@route:%default-route-route-ipv4-attr-decoder)
5757 
    (ipv6-route-attr ,(route:deserialize-route-attr 'ipv6-route-attr)
58-
                     ,@route:%default-route-route-ipv6-attr-decoder)))
58+
                     ,@route:%default-route-route-ipv6-attr-decoder)
59+
    (linkinfo-attr ,(route:deserialize-route-attr 'linkinfo-attr)
60+
                   ,@route:%default-route-link-info-attr-decoder)))
netlink/route.scm
1616 
;;;; 
1717 
1818 
(define-module (netlink route)
19+
  #:use-module (ice-9 match)
20+
  #:use-module (netlink data)
1921 
  #:export (align
2022 
            route-attr-list-size
2123 
            serialize-route-attr-list))
netlink/route/attrs.scm
3232 
           make-u16-route-attr
3333 
           make-u32-route-attr
3434 
           make-s32-route-attr
35+
           make-nested-route-attr
3536 
           make-string-route-attr
3637 
           make-ethernet-route-attr
3738 
           make-ipv4-route-attr
3839 
           make-ipv6-route-attr
3940 
           make-bv-route-attr
4041 
           deserialize-route-attr
41-
           deserialize-route-attr-data-string
4242 
           deserialize-route-attr-data-u8
4343 
           deserialize-route-attr-data-u16
4444 
           deserialize-route-attr-data-u32
4545 
           deserialize-route-attr-data-s32
46+
           deserialize-route-attr-data-nested
47+
           deserialize-route-attr-data-string
4648 
           deserialize-route-attr-data-ethernet
4749 
           deserialize-route-attr-data-ipv4
4850 
           deserialize-route-attr-data-ipv6
…
5052 
           %default-route-addr-ipv4-attr-decoder
5153 
           %default-route-addr-ipv6-attr-decoder
5254 
           %default-route-link-attr-decoder
55+
           %default-route-link-info-attr-decoder
5356 
           %default-route-route-ipv4-attr-decoder
5457 
           %default-route-route-ipv6-attr-decoder))
5558 
…
104107 
    (lambda (data pos bv)
105108 
      (bytevector-s32-set! bv pos data (native-endianness)))))
106109 
110+
(define (make-nested-route-attr lst)
111+
  (make-nl-data
112+
    lst
113+
    route-attr-list-size
114+
    serialize-route-attr-list))
115+
107116 
(define (make-string-route-attr str)
108117 
  (make-nl-data
109118 
    str
…
171180 
              type
172181 
              (deserialize decoder data-bv 0)))))))
173182 
183+
(define (deserialize-route-attr-data-nested attr-type)
184+
  (lambda (decoder bv pos)
185+
    (make-nested-route-attr
186+
      (deserialize-attr-list attr-type decoder bv pos))))
187+
174188 
(define (deserialize-route-attr-data-string decoder bv pos)
175189 
  (make-string-route-attr
176190 
    (or (false-if-exception (string-trim-right (utf8->string bv) #\nul))
…
228242 
    (,IFLA_LINKMODE . ,deserialize-route-attr-data-u8)
229243 
    (,IFLA_GROUP . ,deserialize-route-attr-data-u32)
230244 
    (,IFLA_TXQLEN . ,deserialize-route-attr-data-u32)
245+
    (,IFLA_LINKINFO . ,(deserialize-route-attr-data-nested 'linkinfo-attr))
231246 
    ;; TODO: struct rtnl_link_stats
232247 
    ;(,IFLA_STATS . ,deserialize-route-attr-data-stats)
233248 
    (default . ,deserialize-route-attr-data-bv)))
234249 
250+
(define %default-route-link-info-attr-decoder
251+
  `((,IFLA_INFO_KIND . ,deserialize-route-attr-data-string)
252+
    (default . ,deserialize-route-attr-data-bv)))
253+
235254 
(define (default-route-addr-attr-decoder address-decoder)
236255 
  `((,IFA_ADDRESS . ,address-decoder)
237256 
    (,IFA_LOCAL . ,address-decoder)