addr.scm
1 | ;;;; This file is part of Guile Netlink |
2 | ;;;; |
3 | ;;;; Copyright (C) 2020 Julien Lepiller <julien@lepiller.eu> |
4 | ;;;; |
5 | ;;;; This library is free software: you can redistribute it and/or modify |
6 | ;;;; it under the terms of the GNU General Public License as published by |
7 | ;;;; the Free Software Foundation, either version 3 of the License, or |
8 | ;;;; (at your option) any later version. |
9 | ;;;; |
10 | ;;;; This library is distributed in the hope that it will be useful, |
11 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
12 | ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
13 | ;;;; GNU General Public License for more details. |
14 | ;;;; |
15 | ;;;; You should have received a copy of the GNU General Public License |
16 | ;;;; along with this library. If not, see <https://www.gnu.org/licenses/>. |
17 | |
18 | (define-module (netlink route addr) |
19 | #:use-module (ice-9 match) |
20 | #:use-module (netlink data) |
21 | #:use-module (netlink error) |
22 | #:use-module (netlink route) |
23 | #:use-module (netlink route attrs) |
24 | #:use-module (srfi srfi-9) |
25 | #:use-module (srfi srfi-34) |
26 | #:use-module (srfi srfi-35) |
27 | #:use-module (rnrs bytevectors) |
28 | #:export (make-addr-message |
29 | addr-message? |
30 | addr-message-family |
31 | addr-message-prefix-len |
32 | addr-message-flags |
33 | addr-message-scope |
34 | addr-message-index |
35 | addr-message-attrs |
36 | deserialize-addr-message)) |
37 | |
38 | (define-data-type addr-message |
39 | (lambda (msg) |
40 | (+ 8 (route-attr-list-size (addr-message-type-attrs msg)))) |
41 | (lambda (msg pos bv) |
42 | (match msg |
43 | (($ addr-message-type family prefix-len flags scope index attrs) |
44 | (bytevector-u8-set! bv pos family) |
45 | (bytevector-u8-set! bv (+ pos 1) prefix-len) |
46 | (bytevector-u8-set! bv (+ pos 2) flags) |
47 | (bytevector-u8-set! bv (+ pos 3) scope) |
48 | (bytevector-u32-set! bv (+ pos 4) index (native-endianness)) |
49 | (serialize-route-attr-list attrs (+ pos 8) bv)))) |
50 | (family addr-message-family addr-message-type-family) |
51 | (prefix-len addr-message-prefix-len addr-message-type-prefix-len) |
52 | (flags addr-message-flags addr-message-type-flags) |
53 | (scope addr-message-scope addr-message-type-scope) |
54 | (index addr-message-index addr-message-type-index) |
55 | (attrs addr-message-attrs addr-message-type-attrs)) |
56 | |
57 | (define (deserialize-addr-message decoder bv pos) |
58 | (let ((family (bytevector-u8-ref bv pos))) |
59 | (make-addr-message |
60 | family |
61 | (bytevector-u8-ref bv (+ pos 1)) |
62 | (bytevector-u8-ref bv (+ pos 2)) |
63 | (bytevector-u8-ref bv (+ pos 3)) |
64 | (bytevector-u32-ref bv (+ pos 4) (native-endianness)) |
65 | (deserialize-attr-list |
66 | (cond |
67 | ((equal? family AF_INET) 'ipv4-addr-attr) |
68 | ((equal? family AF_INET6) 'ipv6-addr-attr) |
69 | (else (raise (condition (&netlink-family-error (family family)))))) |
70 | decoder bv (+ pos 8))))) |
71 |