Use srfi-34/35 conditions
Makefile.am
4 | 4 | netlink/connection.scm \ | |
5 | 5 | netlink/constant.scm \ | |
6 | 6 | netlink/data.scm \ | |
7 | + | netlink/error.scm \ | |
7 | 8 | netlink/message.scm \ | |
8 | 9 | netlink/standard.scm \ | |
9 | 10 | netlink/deserialize.scm \ |
ip/link.scm
23 | 23 | #:use-module (netlink connection) | |
24 | 24 | #:use-module (netlink constant) | |
25 | 25 | #:use-module (netlink data) | |
26 | + | #:use-module (netlink error) | |
26 | 27 | #:use-module (netlink deserialize) | |
27 | 28 | #:use-module (netlink message) | |
28 | 29 | #:use-module (netlink standard) | |
29 | 30 | #:use-module (srfi srfi-1) | |
30 | 31 | #:use-module (srfi srfi-9) | |
32 | + | #:use-module (srfi srfi-34) | |
33 | + | #:use-module (srfi srfi-35) | |
31 | 34 | #:export (link-add | |
32 | 35 | link-del | |
33 | 36 | link-set |
ip/utils.scm
19 | 19 | #:use-module (ice-9 match) | |
20 | 20 | #:use-module (netlink constant) | |
21 | 21 | #:use-module (netlink data) | |
22 | + | #:use-module (netlink error) | |
22 | 23 | #:use-module (netlink message) | |
23 | 24 | #:use-module (netlink route attrs) | |
24 | 25 | #:use-module (netlink standard) | |
26 | + | #:use-module (srfi srfi-34) | |
27 | + | #:use-module (srfi srfi-35) | |
25 | 28 | #:export (answer-ok? | |
26 | 29 | get-attr | |
27 | 30 | split-flags | |
… | |||
38 | 41 | (let ((err (error-message-err data))) | |
39 | 42 | (if (equal? err 0) | |
40 | 43 | #t | |
41 | - | (begin | |
42 | - | (format #t "RTNETLINK answers: ~a~%" (strerror (- err))) | |
43 | - | #f))) | |
44 | - | #f))))) | |
44 | + | (raise (condition (&netlink-response-error (errno (- err))))))) | |
45 | + | (raise (condition (&netlink-response-error (errno 0))))))))) | |
45 | 46 | ||
46 | 47 | (define (get-attr attrs type) | |
47 | 48 | (let ((attrs (filter (lambda (attr) (equal? (route-attr-kind attr) type)) attrs))) | |
… | |||
66 | 67 | (match (string-split str #\/) | |
67 | 68 | ((addr) addr) | |
68 | 69 | ((addr prefix) addr) | |
69 | - | (_ (throw 'incorrect-cidr-notation str)))) | |
70 | + | (_ (raise (condition (&netlink-cidr-error (str str))))))) | |
70 | 71 | ||
71 | 72 | (define (cidr->prefix str) | |
72 | 73 | (match (string-split str #\/) | |
73 | 74 | ((addr) #f) | |
74 | 75 | ((addr prefix) (string->number prefix)) | |
75 | - | (_ (throw 'incorrect-cidr-notation str)))) | |
76 | + | (_ (raise (condition (&netlink-cidr-error (str str))))))) |
netlink/connection.scm
18 | 18 | (define-module (netlink connection) | |
19 | 19 | #:use-module (netlink constant) | |
20 | 20 | #:use-module (netlink data) | |
21 | + | #:use-module (netlink error) | |
21 | 22 | #:use-module (netlink message) | |
22 | 23 | #:use-module (rnrs bytevectors) | |
23 | 24 | #:use-module (system foreign) | |
24 | 25 | #:use-module (srfi srfi-9) | |
26 | + | #:use-module (srfi srfi-34) | |
27 | + | #:use-module (srfi srfi-35) | |
25 | 28 | #:export (connect | |
26 | 29 | connect-route | |
27 | 30 | close-socket | |
… | |||
96 | 99 | ||
97 | 100 | (define* (send-msg msg sock #:key (addr (get-addr AF_NETLINK 0 0))) | |
98 | 101 | (unless (message? msg) | |
99 | - | (throw 'cannot-send-not-message-type)) | |
102 | + | (raise (condition (&netlink-message-type-error | |
103 | + | (message msg))))) | |
100 | 104 | ||
101 | 105 | (let* ((len (data-size msg)) | |
102 | 106 | (bv (make-bytevector len))) | |
… | |||
114 | 118 | (size (ffi-recvmsg (socket-num sock) msghdr 0)) | |
115 | 119 | (answer (make-bytevector size))) | |
116 | 120 | (when (> size (* 1024 32)) | |
117 | - | (throw 'answer-too-big)) | |
121 | + | (raise (condition (&netlink-answer-too-big-error (size size))))) | |
118 | 122 | (when (> size 0) | |
119 | 123 | (bytevector-copy! bv 0 answer 0 size)) | |
120 | 124 | answer)) |
netlink/data.scm
17 | 17 | ||
18 | 18 | (define-module (netlink data) | |
19 | 19 | #:use-module (ice-9 match) | |
20 | + | #:use-module (netlink error) | |
20 | 21 | #:use-module (srfi srfi-9) | |
22 | + | #:use-module (srfi srfi-34) | |
23 | + | #:use-module (srfi srfi-35) | |
21 | 24 | #:export (make-nl-data | |
22 | 25 | nl-data-data nl-data-size-proc nl-data-serialize-proc | |
23 | 26 | data-size ensure-data-size | |
… | |||
49 | 52 | ((_ . type-alist) | |
50 | 53 | (or (assoc-ref type-alist target-type) | |
51 | 54 | (assoc-ref type-alist 'default))) | |
52 | - | (#f (throw 'no-decoder current-type)))) | |
55 | + | (#f (raise (condition (&netlink-decoder-error | |
56 | + | (type current-type))))))) | |
53 | 57 | ||
54 | 58 | (define (get-current-deserialize decoder current-type) | |
55 | 59 | (match (assoc-ref decoder current-type) | |
56 | 60 | ((current-deserialize . _) current-deserialize) | |
57 | - | (#f (throw 'no-decoder current-type)))) | |
61 | + | (#f (raise (condition (&netlink-decoder-error | |
62 | + | (type current-type))))))) | |
58 | 63 | ||
59 | 64 | (define (deserialize type decoder bv pos) | |
60 | 65 | (let ((deserialize (get-current-deserialize decoder type))) |
netlink/error.scm unknown status 1
1 | + | ;;;; This file is part of Guile Netlink | |
2 | + | ;;;; | |
3 | + | ;;;; Copyright (C) 2021 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 error) | |
19 | + | #:use-module (srfi srfi-35) | |
20 | + | #:export (&netlink-error | |
21 | + | netlink-error? | |
22 | + | ||
23 | + | &netlink-decoder-error | |
24 | + | netlink-decoder-error? | |
25 | + | netlink-decoder-error-type | |
26 | + | ||
27 | + | &netlink-family-error | |
28 | + | netlink-family-error? | |
29 | + | netlink-family-error-family | |
30 | + | ||
31 | + | &netlink-cidr-error | |
32 | + | netlink-cidr-error? | |
33 | + | netlink-cidr-error-str | |
34 | + | ||
35 | + | &netlink-message-error | |
36 | + | netlink-message-error? | |
37 | + | ||
38 | + | &netlink-answer-too-big-error | |
39 | + | netlink-answer-too-big-error? | |
40 | + | netlink-answer-too-big-error-size | |
41 | + | ||
42 | + | &netlink-message-type-error | |
43 | + | netlink-message-type-error? | |
44 | + | netlink-message-type-error-message | |
45 | + | ||
46 | + | &netlink-device-error | |
47 | + | netlink-device-error? | |
48 | + | netlink-device-error-device | |
49 | + | ||
50 | + | &netlink-response-error | |
51 | + | netlink-response-error? | |
52 | + | netlink-response-error-errno)) | |
53 | + | ||
54 | + | (define-condition-type &netlink-error &error | |
55 | + | netlink-error?) | |
56 | + | ||
57 | + | ;; No decoder for type | |
58 | + | (define-condition-type &netlink-decoder-error &netlink-error | |
59 | + | netlink-decoder-error? | |
60 | + | (type netlink-decoder-error-type)) | |
61 | + | ||
62 | + | ;; Unknown protocol family | |
63 | + | (define-condition-type &netlink-family-error &netlink-error | |
64 | + | netlink-family-error? | |
65 | + | (family netlink-family-error-family)) | |
66 | + | ||
67 | + | ;; Unknow CIDR notation | |
68 | + | (define-condition-type &netlink-cidr-error &netlink-error | |
69 | + | netlink-cidr-error? | |
70 | + | (str netlink-cidr-error-str)) | |
71 | + | ||
72 | + | ;; Error when handling messages | |
73 | + | (define-condition-type &netlink-message-error &netlink-error | |
74 | + | netlink-message-error?) | |
75 | + | ||
76 | + | ;; Answer is too big to handle | |
77 | + | (define-condition-type &netlink-answer-too-big-error &netlink-message-error | |
78 | + | netlink-answer-too-big-error? | |
79 | + | (size netlink-answer-too-big-error-size)) | |
80 | + | ||
81 | + | ;; Attempting to send a message that is not a message object | |
82 | + | (define-condition-type &netlink-message-type-error &netlink-message-error | |
83 | + | netlink-message-type-error? | |
84 | + | (message netlink-message-type-error-message)) | |
85 | + | ||
86 | + | ;; No such device | |
87 | + | (define-condition-type &netlink-device-error &netlink-error | |
88 | + | netlink-device-error? | |
89 | + | (device netlink-device-error-device)) | |
90 | + | ||
91 | + | ;; Got an answer, but it is an error message | |
92 | + | (define-condition-type &netlink-response-error &netlink-error | |
93 | + | netlink-response-error? | |
94 | + | (errno netlink-response-error-errno)) |
netlink/route/addr.scm
18 | 18 | (define-module (netlink route addr) | |
19 | 19 | #:use-module (ice-9 match) | |
20 | 20 | #:use-module (netlink data) | |
21 | + | #:use-module (netlink error) | |
21 | 22 | #:use-module (netlink route) | |
22 | 23 | #:use-module (netlink route attrs) | |
23 | 24 | #:use-module (srfi srfi-9) | |
… | |||
63 | 64 | (cond | |
64 | 65 | ((equal? family AF_INET) 'ipv4-addr-attr) | |
65 | 66 | ((equal? family AF_INET6) 'ipv6-addr-attr) | |
66 | - | (else (throw 'unknown-family family))) | |
67 | + | (else (raise (condition (&netlink-family-error (family family)))))) | |
67 | 68 | decoder bv (+ pos 8))))) |
netlink/route/route.scm
18 | 18 | (define-module (netlink route route) | |
19 | 19 | #:use-module (ice-9 match) | |
20 | 20 | #:use-module (netlink data) | |
21 | + | #:use-module (netlink error) | |
21 | 22 | #:use-module (netlink route) | |
22 | 23 | #:use-module (netlink route attrs) | |
23 | 24 | #:use-module (srfi srfi-9) | |
25 | + | #:use-module (srfi srfi-34) | |
26 | + | #:use-module (srfi srfi-35) | |
24 | 27 | #:use-module (rnrs bytevectors) | |
25 | 28 | #:export (make-route-message | |
26 | 29 | route-message? | |
… | |||
80 | 83 | (cond | |
81 | 84 | ((equal? family AF_INET) 'ipv4-route-attr) | |
82 | 85 | ((equal? family AF_INET6) 'ipv6-route-attr) | |
83 | - | (else (throw 'unknown-family family))) | |
86 | + | (else (raise (condition (&netlink-family-error (family family)))))) | |
84 | 87 | decoder bv (+ pos 12))))) |