Use srfi-34/35 conditions

Julien LepillerSun Nov 14 23:02:39+0100 2021

0c5aa03

Use srfi-34/35 conditions

Makefile.am

44 
  netlink/connection.scm \
55 
  netlink/constant.scm \
66 
  netlink/data.scm \
7+
  netlink/error.scm \
78 
  netlink/message.scm \
89 
  netlink/standard.scm \
910 
  netlink/deserialize.scm \

ip/link.scm

2323 
  #:use-module (netlink connection)
2424 
  #:use-module (netlink constant)
2525 
  #:use-module (netlink data)
26+
  #:use-module (netlink error)
2627 
  #:use-module (netlink deserialize)
2728 
  #:use-module (netlink message)
2829 
  #:use-module (netlink standard)
2930 
  #:use-module (srfi srfi-1)
3031 
  #:use-module (srfi srfi-9)
32+
  #:use-module (srfi srfi-34)
33+
  #:use-module (srfi srfi-35)
3134 
  #:export (link-add
3235 
            link-del
3336 
            link-set

ip/utils.scm

1919 
  #:use-module (ice-9 match)
2020 
  #:use-module (netlink constant)
2121 
  #:use-module (netlink data)
22+
  #:use-module (netlink error)
2223 
  #:use-module (netlink message)
2324 
  #:use-module (netlink route attrs)
2425 
  #:use-module (netlink standard)
26+
  #:use-module (srfi srfi-34)
27+
  #:use-module (srfi srfi-35)
2528 
  #:export (answer-ok?
2629 
            get-attr
2730 
            split-flags

…

3841 
           (let ((err (error-message-err data)))
3942 
             (if (equal? err 0)
4043 
                 #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)))))))))
4546 
4647 
(define (get-attr attrs type)
4748 
  (let ((attrs (filter (lambda (attr) (equal? (route-attr-kind attr) type)) attrs)))
…
6667 
  (match (string-split str #\/)
6768 
    ((addr) addr)
6869 
    ((addr prefix) addr)
69-
    (_ (throw 'incorrect-cidr-notation str))))
70+
    (_ (raise (condition (&netlink-cidr-error (str str)))))))
7071 
7172 
(define (cidr->prefix str)
7273 
  (match (string-split str #\/)
7374 
    ((addr) #f)
7475 
    ((addr prefix) (string->number prefix))
75-
    (_ (throw 'incorrect-cidr-notation str))))
76+
    (_ (raise (condition (&netlink-cidr-error (str str)))))))
netlink/connection.scm
1818 
(define-module (netlink connection)
1919 
  #:use-module (netlink constant)
2020 
  #:use-module (netlink data)
21+
  #:use-module (netlink error)
2122 
  #:use-module (netlink message)
2223 
  #:use-module (rnrs bytevectors)
2324 
  #:use-module (system foreign)
2425 
  #:use-module (srfi srfi-9)
26+
  #:use-module (srfi srfi-34)
27+
  #:use-module (srfi srfi-35)
2528 
  #:export (connect
2629 
            connect-route
2730 
            close-socket
…
9699 
97100 
(define* (send-msg msg sock #:key (addr (get-addr AF_NETLINK 0 0)))
98101 
  (unless (message? msg)
99-
    (throw 'cannot-send-not-message-type))
102+
    (raise (condition (&netlink-message-type-error
103+
                        (message msg)))))
100104 
101105 
  (let* ((len (data-size msg))
102106 
         (bv (make-bytevector len)))
…
114118 
         (size (ffi-recvmsg (socket-num sock) msghdr 0))
115119 
         (answer (make-bytevector size)))
116120 
    (when (> size (* 1024 32))
117-
      (throw 'answer-too-big))
121+
      (raise (condition (&netlink-answer-too-big-error (size size)))))
118122 
    (when (> size 0)
119123 
      (bytevector-copy! bv 0 answer 0 size))
120124 
    answer))
netlink/data.scm
1717 
1818 
(define-module (netlink data)
1919 
  #:use-module (ice-9 match)
20+
  #:use-module (netlink error)
2021 
  #:use-module (srfi srfi-9)
22+
  #:use-module (srfi srfi-34)
23+
  #:use-module (srfi srfi-35)
2124 
  #:export (make-nl-data
2225 
            nl-data-data nl-data-size-proc nl-data-serialize-proc
2326 
            data-size ensure-data-size
…
4952 
    ((_ . type-alist)
5053 
     (or (assoc-ref type-alist target-type)
5154 
         (assoc-ref type-alist 'default)))
52-
    (#f (throw 'no-decoder current-type))))
55+
    (#f (raise (condition (&netlink-decoder-error
56+
                            (type current-type)))))))
5357 
  
5458 
(define (get-current-deserialize decoder current-type)
5559 
  (match (assoc-ref decoder current-type)
5660 
    ((current-deserialize . _) current-deserialize)
57-
    (#f (throw 'no-decoder current-type))))
61+
    (#f (raise (condition (&netlink-decoder-error
62+
                            (type current-type)))))))
5863 
5964 
(define (deserialize type decoder bv pos)
6065 
  (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
1818 
(define-module (netlink route addr)
1919 
  #:use-module (ice-9 match)
2020 
  #:use-module (netlink data)
21+
  #:use-module (netlink error)
2122 
  #:use-module (netlink route)
2223 
  #:use-module (netlink route attrs)
2324 
  #:use-module (srfi srfi-9)
…
6364 
        (cond
6465 
          ((equal? family AF_INET) 'ipv4-addr-attr)
6566 
          ((equal? family AF_INET6) 'ipv6-addr-attr)
66-
          (else (throw 'unknown-family family)))
67+
          (else (raise (condition (&netlink-family-error (family family))))))
6768 
        decoder bv (+ pos 8)))))
netlink/route/route.scm
1818 
(define-module (netlink route route)
1919 
  #:use-module (ice-9 match)
2020 
  #:use-module (netlink data)
21+
  #:use-module (netlink error)
2122 
  #:use-module (netlink route)
2223 
  #:use-module (netlink route attrs)
2324 
  #:use-module (srfi srfi-9)
25+
  #:use-module (srfi srfi-34)
26+
  #:use-module (srfi srfi-35)
2427 
  #:use-module (rnrs bytevectors)
2528 
  #:export (make-route-message
2629 
            route-message?
…
8083 
        (cond
8184 
          ((equal? family AF_INET) 'ipv4-route-attr)
8285 
          ((equal? family AF_INET6) 'ipv6-route-attr)
83-
          (else (throw 'unknown-family family)))
86+
          (else (raise (condition (&netlink-family-error (family family))))))
8487 
        decoder bv (+ pos 12)))))