-
Notifications
You must be signed in to change notification settings - Fork 2
/
condition.lisp
133 lines (109 loc) · 4.32 KB
/
condition.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
;;;; $Id$
;;;; Note: parts of this file come from Simon Leinen's cl-snmp project
(in-package :snmp)
(define-condition snmp-error (error)
())
(define-condition snmp-session-error (snmp-error)
((session :initarg :session
:reader snmp-session-error-session)))
(define-condition snmp-timeout-error (snmp-session-error)
()
(:report (lambda (c stream)
(format stream "Timeout (~D) exceeded"
(snmp-session-error-session c)))))
(define-condition snmp-query-error (snmp-session-error)
((query :initarg :query
:reader snmp-query-error-query)))
(define-condition snmp-response-error (snmp-query-error)
((response :initarg :response
:reader snmp-response-error-response)))
(define-condition snmp-malformed-response-pdu-error (snmp-response-error)
()
(:report (lambda (c stream)
(declare (ignore c))
(format stream "Malformed response PDU"))))
(define-condition snmpv1-malformed-response-pdu-error (snmp-response-error)
()
(:report (lambda (c stream)
(declare (ignore c))
(format stream "Malformed SNMPv1 response PDU"))))
(define-condition snmp-response-id-mismatch-error (snmp-response-error)
()
(:report (lambda (c stream)
(format stream "Request ID mismatch: ~S does not match query ~S"
(snmp-response-error-response c)
(snmp-query-error-query c)))))
(define-condition snmp-response-attribute-mismatch-error (snmp-response-error)
()
(:report (lambda (c stream)
(format stream "Attribute mismatch: ~S does not match query ~S"
(snmp-response-error-response c)
(snmp-query-error-query c)))))
(define-condition snmp-response-too-short-error (snmp-response-error)
()
(:report (lambda (c stream)
(declare (ignore c))
(format stream "Response too short"))))
(define-condition snmp-response-too-long-error (snmp-response-error)
()
(:report (lambda (c stream)
(declare (ignore c))
(format stream "Response too long"))))
(define-condition snmp-response-too-big-error (snmp-response-error)
()
(:report (lambda (c stream)
(declare (ignore c))
(format stream "Response too big"))))
(define-condition snmp-response-specific-variable-error (snmp-response-error)
()
(:report (lambda (c stream)
(let ((response (snmp-response-error-response c)))
(report-variable-error
c stream
(and (> (error-index-of response) 0)
(first (elt (variable-bindings-of response)
(1- (error-index-of response))))))))))
(define-condition snmp-no-such-name-error (snmp-response-specific-variable-error) ())
(defmethod report-variable-error ((c snmp-no-such-name-error) s v)
(format s "No such name: ~S" v))
(define-condition snmp-read-only-error (snmp-response-specific-variable-error) ())
(defmethod report-variable-error ((c snmp-read-only-error) s v)
(format s "~S is read-only" v))
(define-condition snmp-bad-value-error (snmp-response-error)
()
(:report (lambda (c stream)
(let* ((response (snmp-response-error-response c))
(binding (elt (variable-bindings-of response)
(error-index-of response))))
(format stream "~S is a bad value for ~S"
(second binding) (first binding))))))
(define-condition snmp-unknown-error-status-error (snmp-response-error)
()
(:report (lambda (c stream)
(format stream "Response with unknown error status ~S"
(error-status-of (snmp-response-error-response c))))))
(define-condition snmp-generic-error (snmp-response-specific-variable-error) ())
(defmethod report-variable-error ((c snmp-generic-error) s v)
(format s "Generic error~@[ for variable ~S~]" v))
(define-condition snmp-response-match-error (snmp-response-error)
()
(:report (lambda (c stream)
(format stream "Response ~S does not match query ~S"
(snmp-response-error-response c)
(snmp-query-error-query c)))))
(defun make-snmp-response-error (session query response)
(make-condition
(case (error-status-of response)
((#.+error-status-too-big+)
'snmp-too-big-error)
((#.+error-status-no-such-name+)
'snmp-no-such-name-error)
((#.+error-status-bad-value+)
'snmp-bad-value-error)
((#.+error-status-read-only+)
'snmp-read-only-error)
((#.+error-status-generic-error+)
'snmp-generic-error)
(otherwise
'snmp-unknown-error-status-error))
:session session :query query :response response))