ip: Add support for showing addresses
doc/guile-netlink.texi
647 | 647 | flag will result in a @code{Bad address} exception from inet-pton. | |
648 | 648 | @end deffn | |
649 | 649 | ||
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 | + | ||
650 | 656 | @bye |
ip/addr.scm
27 | 27 | #:use-module (netlink message) | |
28 | 28 | #:use-module (netlink standard) | |
29 | 29 | #:use-module (srfi srfi-1) | |
30 | + | #:use-module (srfi srfi-9) | |
30 | 31 | #:export (addr-add | |
31 | 32 | addr-del | |
32 | 33 | addr-show)) | |
33 | 34 | ||
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 | + | ||
34 | 48 | (define (cidr->addr str) | |
35 | 49 | (match (string-split str #\/) | |
36 | 50 | ((addr) addr) | |
… | |||
122 | 136 | (let ((answer (receive-and-decode-msg sock %default-route-decoder))) | |
123 | 137 | (close-socket sock) | |
124 | 138 | (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
250 | 250 | IF_OPER_LOWERLAYERDOWN IF_OPER_TESTING IF_OPER_DORMANT | |
251 | 251 | IF_OPER_UP) | |
252 | 252 | ||
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 | + | ||
253 | 270 | ;; rtm_type | |
254 | 271 | (define-enum int->rtm-type | |
255 | 272 | RTN_UNSPEC RTN_UNICAST RTN_LOCAL RTN_BROADCAST RTN_ANYCAST |
netlink/route/attrs.scm
257 | 257 | (,IFA_LABEL . ,deserialize-route-attr-data-string) | |
258 | 258 | (,IFA_BROADCAST . ,address-decoder) | |
259 | 259 | (,IFA_ANYCAST . ,address-decoder) | |
260 | + | (,IFA_FLAGS . ,deserialize-route-attr-data-u32) | |
260 | 261 | ;; TODO: struct ifa_cacheinfo | |
261 | 262 | ;(,IFA_CACHEINFO . ,deserialize-route-attr-data-cache-info) | |
262 | 263 | (default . ,deserialize-route-attr-data-bv))) |