tcondition.lisp - clic - Clic is an command line interactive client for gopher written in Common LISP
(HTM) git clone git://bitreich.org/clic/ git://hg6vgqziawt5s4dj.onion/clic/
(DIR) Log
(DIR) Files
(DIR) Refs
(DIR) Tags
(DIR) LICENSE
---
tcondition.lisp (8435B)
---
1 ;;;; See LICENSE for licensing information.
2
3 (in-package :usocket)
4
5 ;; Condition signalled by operations with unsupported arguments
6 ;; For trivial-sockets compatibility.
7
8 (define-condition insufficient-implementation (error)
9 ((feature :initarg :feature :reader feature)
10 (context :initarg :context :reader context
11 :documentation "String designator of the public API function which
12 the feature belongs to."))
13 (:documentation "The ancestor of all errors usocket may generate
14 because of insufficient support from the underlying implementation
15 with respect to the arguments given to `function'.
16
17 One call may signal several errors, if the caller allows processing
18 to continue.
19 "))
20
21 (define-condition unsupported (insufficient-implementation)
22 ((minimum :initarg :minimum :reader minimum
23 :documentation "Indicates the minimal version of the
24 implementation required to support the requested feature."))
25 (:report (lambda (c stream)
26 (format stream "~A in ~A is unsupported."
27 (feature c) (context c))
28 (when (minimum c)
29 (format stream " Minimum version (~A) is required."
30 (minimum c)))))
31 (:documentation "Signalled when the underlying implementation
32 doesn't allow supporting the requested feature.
33
34 When you see this error, go bug your vendor/implementation developer!"))
35
36 (define-condition unimplemented (insufficient-implementation)
37 ()
38 (:report (lambda (c stream)
39 (format stream "~A in ~A is unimplemented."
40 (feature c) (context c))))
41 (:documentation "Signalled if a certain feature might be implemented,
42 based on the features of the underlying implementation, but hasn't
43 been implemented yet."))
44
45 ;; Conditions raised by sockets operations
46
47 (define-condition socket-condition (condition)
48 ((socket :initarg :socket
49 :accessor usocket-socket))
50 ;;###FIXME: no slots (yet); should at least be the affected usocket...
51 (:documentation "Parent condition for all socket related conditions."))
52
53 (define-condition socket-error (socket-condition error)
54 () ;; no slots (yet)
55 (:documentation "Parent error for all socket related errors"))
56
57 (define-condition ns-condition (condition)
58 ((host-or-ip :initarg :host-or-ip
59 :accessor host-or-ip))
60 (:documentation "Parent condition for all name resolution conditions."))
61
62 (define-condition ns-error (ns-condition error)
63 ()
64 (:documentation "Parent error for all name resolution errors."))
65
66 (eval-when (:compile-toplevel :load-toplevel :execute)
67 (defun define-usocket-condition-class (class &rest parents)
68 `(progn
69 (define-condition ,class ,parents ())
70 (export ',class))))
71
72 (defmacro define-usocket-condition-classes (class-list parents)
73 `(progn ,@(mapcar #'(lambda (x)
74 (apply #'define-usocket-condition-class
75 x parents))
76 class-list)))
77
78 ;; Mass define and export our conditions
79 (define-usocket-condition-classes
80 (interrupted-condition)
81 (socket-condition))
82
83 (define-condition unknown-condition (socket-condition)
84 ((real-condition :initarg :real-condition
85 :accessor usocket-real-condition))
86 (:documentation "Condition raised when there's no other - more applicable -
87 condition available."))
88
89
90 ;; Mass define and export our errors
91 (define-usocket-condition-classes
92 (address-in-use-error
93 address-not-available-error
94 bad-file-descriptor-error
95 connection-refused-error
96 connection-aborted-error
97 connection-reset-error
98 invalid-argument-error
99 no-buffers-error
100 operation-not-supported-error
101 operation-not-permitted-error
102 protocol-not-supported-error
103 socket-type-not-supported-error
104 network-unreachable-error
105 network-down-error
106 network-reset-error
107 host-down-error
108 host-unreachable-error
109 shutdown-error
110 timeout-error
111 deadline-timeout-error
112 invalid-socket-error
113 invalid-socket-stream-error)
114 (socket-error))
115
116 (define-condition unknown-error (socket-error)
117 ((real-error :initarg :real-error
118 :accessor usocket-real-error
119 :initform nil)
120 (errno :initarg :errno
121 :reader usocket-errno
122 :initform 0))
123 (:report (lambda (c stream)
124 (typecase c
125 (simple-condition
126 (format stream
127 (simple-condition-format-control (usocket-real-error c))
128 (simple-condition-format-arguments (usocket-real-error c))))
129 (otherwise
130 (format stream "The condition ~A occurred with errno: ~D."
131 (usocket-real-error c)
132 (usocket-errno c))))))
133 (:documentation "Error raised when there's no other - more applicable -
134 error available."))
135
136 (define-usocket-condition-classes
137 (ns-try-again-condition)
138 (ns-condition))
139
140 (define-condition ns-unknown-condition (ns-condition)
141 ((real-condition :initarg :real-condition
142 :accessor ns-real-condition
143 :initform nil))
144 (:documentation "Condition raised when there's no other - more applicable -
145 condition available."))
146
147 (define-usocket-condition-classes
148 ;; the no-data error code in the Unix 98 api
149 ;; isn't really an error: there's just no data to return.
150 ;; with lisp, we just return NIL (indicating no data) instead of
151 ;; raising an exception...
152 (ns-host-not-found-error
153 ns-no-recovery-error)
154 (ns-error))
155
156 (define-condition ns-unknown-error (ns-error)
157 ((real-error :initarg :real-error
158 :accessor ns-real-error
159 :initform nil))
160 (:report (lambda (c stream)
161 (typecase c
162 (simple-condition
163 (format stream
164 (simple-condition-format-control (usocket-real-error c))
165 (simple-condition-format-arguments (usocket-real-error c))))
166 (otherwise
167 (format stream "The condition ~A occurred." (usocket-real-error c))))))
168 (:documentation "Error raised when there's no other - more applicable -
169 error available."))
170
171 (defmacro with-mapped-conditions ((&optional socket) &body body)
172 `(handler-bind ((condition #'(lambda (c) (handle-condition c ,socket))))
173 ,@body))
174
175 (defparameter +unix-errno-condition-map+
176 `(((11) . ns-try-again-condition) ;; EAGAIN
177 ((35) . ns-try-again-condition) ;; EDEADLCK
178 ((4) . interrupted-condition))) ;; EINTR
179
180 (defparameter +unix-errno-error-map+
181 ;;### the first column is for non-(linux or srv4) systems
182 ;; the second for linux
183 ;; the third for srv4
184 ;;###FIXME: How do I determine on which Unix we're running
185 ;; (at least in clisp and sbcl; I know about cmucl...)
186 ;; The table below works under the assumption we'll *only* see
187 ;; socket associated errors...
188 `(((48 98) . address-in-use-error)
189 ((49 99) . address-not-available-error)
190 ((9) . bad-file-descriptor-error)
191 ((61 111) . connection-refused-error)
192 ((54 104) . connection-reset-error)
193 ((53 103) . connection-aborted-error)
194 ((22) . invalid-argument-error)
195 ((55 105) . no-buffers-error)
196 ((12) . out-of-memory-error)
197 ((45 95) . operation-not-supported-error)
198 ((1) . operation-not-permitted-error)
199 ((43 92) . protocol-not-supported-error)
200 ((44 93) . socket-type-not-supported-error)
201 ((51 101) . network-unreachable-error)
202 ((50 100) . network-down-error)
203 ((52 102) . network-reset-error)
204 ((58 108) . already-shutdown-error)
205 ((60 110) . timeout-error)
206 ((64 112) . host-down-error)
207 ((65 113) . host-unreachable-error)))
208
209 (defun map-errno-condition (errno)
210 (cdr (assoc errno +unix-errno-error-map+ :test #'member)))
211
212 (defun map-errno-error (errno)
213 (cdr (assoc errno +unix-errno-error-map+ :test #'member)))
214
215 (defparameter +unix-ns-error-map+
216 `((1 . ns-host-not-found-error)
217 (2 . ns-try-again-condition)
218 (3 . ns-no-recovery-error)))
219
220 (defmacro unsupported (feature context &key minimum)
221 `(cerror "Ignore it and continue" 'unsupported
222 :feature ,feature
223 :context ,context
224 :minimum ,minimum))
225
226 (defmacro unimplemented (feature context)
227 `(signal 'unimplemented :feature ,feature :context ,context))
228
229 ;;; People may want to ignore all unsupported warnings, here it is.
230 (defmacro ignore-unsupported-warnings (&body body)
231 `(handler-bind ((unsupported
232 #'(lambda (c)
233 (declare (ignore c)) (continue))))
234 (progn ,@body)))