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