ip: Add support for showing addresses

Julien LepillerSun Mar 14 00:42:11+0100 2021

f689610

ip: Add support for showing addresses

doc/guile-netlink.texi

647647
flag will result in a @code{Bad address} exception from inet-pton.
648648
@end deffn
649649
650+
@deffn {Scheme Procedure} addr-show [@var{device}]
651+
Print the list of addresses for each device on standard output.  Setting
652+
@code{device} to a link name or link identifier will restrict the output
653+
to addresses of that device.
654+
@end deffn
655+
650656
@bye

ip/addr.scm

2727
  #:use-module (netlink message)
2828
  #:use-module (netlink standard)
2929
  #:use-module (srfi srfi-1)
30+
  #:use-module (srfi srfi-9)
3031
  #:export (addr-add
3132
            addr-del
3233
            addr-show))
3334
35+
(define-record-type <addr>
36+
  (make-addr family prefix flags scope link label addr brd cacheinfo)
37+
  addr?
38+
  (family    addr-family)
39+
  (prefix    addr-prefix)
40+
  (flags     addr-flags)
41+
  (scope     addr-scope)
42+
  (link      addr-link)
43+
  (label     addr-label)
44+
  (addr      addr-addr)
45+
  (brd       addr-brd)
46+
  (cacheinfo addr-cacheinfo))
47+
3448
(define (cidr->addr str)
3549
  (match (string-split str #\/)
3650
    ((addr) addr)

122136
    (let ((answer (receive-and-decode-msg sock %default-route-decoder)))
123137
      (close-socket sock)
124138
      (answer-ok? (last answer)))))
139+
140+
(define (get-addrs)
141+
  (define request-num (random 65535))
142+
  (define message
143+
    (make-message
144+
      RTM_GETADDR
145+
      (logior NLM_F_REQUEST NLM_F_DUMP)
146+
      request-num
147+
      0
148+
      (make-addr-message AF_UNSPEC 0 0 0 0 '())))
149+
  (let ((sock (connect-route)))
150+
    (send-msg message sock)
151+
    (let* ((answer (receive-and-decode-msg sock %default-route-decoder))
152+
           (addrs (filter
153+
                    (lambda (msg) (equal? (message-kind msg) RTM_NEWADDR))
154+
                    answer))
155+
           (addrs (map
156+
                    (lambda (msg)
157+
                      (let* ((data (message-data msg))
158+
                             (attrs (addr-message-attrs data)))
159+
                        (make-addr
160+
                          (addr-message-family data)
161+
                          (addr-message-prefix-len data)
162+
                          (map
163+
                            int->ifa-flag
164+
                            (split-flags (logior (addr-message-flags data)
165+
                                                 (get-attr attrs IFA_FLAGS))))
166+
                          (addr-message-scope data)
167+
                          (addr-message-index data)
168+
                          (get-attr attrs IFA_LABEL)
169+
                          (get-attr attrs IFA_ADDRESS)
170+
                          (get-attr attrs IFA_BROADCAST)
171+
                          (get-attr attrs IFA_CACHEINFO))))
172+
                    addrs)))
173+
      (close-socket sock)
174+
      addrs)))
175+
176+
(define print-addr
177+
  (match-lambda
178+
    (($ <addr> family prefix flags scope link label addr brd cacheinfo)
179+
     (format #t "    ~a ~a"
180+
             (match family (AF_INET "inet") (AF_INET6 "inet6"))
181+
             addr)
182+
     (when brd
183+
       (format #t " brd ~a" brd))
184+
     (when scope
185+
       (format #t " scope ~a"
186+
               (match scope
187+
                 (RT_SCOPE_UNIVERSE "global")
188+
                 (_ (substring (symbol->string (int->rtm-scope scope)) 8)))))
189+
190+
     (for-each
191+
       (lambda (flag)
192+
         (unless (equal? flag 'IFA_F_PERMANENT)
193+
           (format #t " ~a"
194+
                   (substring (symbol->string flag) 6))))
195+
       flags)
196+
197+
     (when label
198+
       (format #t " ~a" label))
199+
200+
     (format #t "~%")
201+
     (when cacheinfo
202+
       (if (member 'IFA_F_PERMANENT flags)
203+
           (format #t "        valid_lft forever preferred_lft forever~%")
204+
           (format #t "        valid_lft ??sec preferred_lft ??sec~%"))))))
205+
206+
207+
(define* (addr-show #:optional (device #f))
208+
  (define links (get-links))
209+
  (define index
210+
    (cond
211+
      ((number? device) device)
212+
      ((string? device) (link-name->index device))
213+
      (else #f)))
214+
  (define addrs (get-addrs))
215+
216+
  (for-each
217+
    (lambda (link)
218+
      (unless (and index (not (equal? (link-id link) index)))
219+
        (print-link link)
220+
        (for-each print-addr
221+
                  (filter (lambda (addr) (equal? (link-id link) (addr-link addr)))
222+
                          addrs))))
223+
    links))

netlink/constant.scm

250250
  IF_OPER_LOWERLAYERDOWN IF_OPER_TESTING IF_OPER_DORMANT
251251
  IF_OPER_UP)
252252
253+
;; ifa_flags
254+
(define-enum int->ifa-flag
255+
  (IFA_F_SECONDARY      #x01)
256+
  (IFA_F_TEMPORARY      #x01) 
257+
  (IFA_F_NODAD          #x02)
258+
  (IFA_F_OPTIMISTIC     #x04)
259+
  (IFA_F_DADFAILED      #x08)
260+
  (IFA_F_HOMEADDRESS    #x10)
261+
  (IFA_F_DEPRECATED     #x20)
262+
  (IFA_F_TENTATIVE      #x40)
263+
  (IFA_F_PERMANENT      #x80)
264+
  (IFA_F_MANAGETEMPADDR #x100)
265+
  (IFA_F_NOPREFIXROUTE  #x200)
266+
  (IFA_F_MCAUTOJOIN     #x400)
267+
  (IFA_F_STABLE_PRIVACY #x800))
268+
269+
253270
;; rtm_type
254271
(define-enum int->rtm-type
255272
  RTN_UNSPEC RTN_UNICAST RTN_LOCAL RTN_BROADCAST RTN_ANYCAST

netlink/route/attrs.scm

257257
    (,IFA_LABEL . ,deserialize-route-attr-data-string)
258258
    (,IFA_BROADCAST . ,address-decoder)
259259
    (,IFA_ANYCAST . ,address-decoder)
260+
    (,IFA_FLAGS . ,deserialize-route-attr-data-u32)
260261
    ;; TODO: struct ifa_cacheinfo
261262
    ;(,IFA_CACHEINFO . ,deserialize-route-attr-data-cache-info)
262263
    (default . ,deserialize-route-attr-data-bv)))