condition.lisp - clic - Clic is an command line interactive client for gopher written in Common LISP
(HTM) git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65d7roiv6bfj7d652fid.onion/clic/
(DIR) Log
(DIR) Files
(DIR) Refs
(DIR) Tags
(DIR) README
(DIR) LICENSE
---
condition.lisp (8603B)
---
1 ;;;; -*- Mode: LISP; Base: 10; Syntax: ANSI-Common-lisp; Package: USOCKET -*-
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 applicable -
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-error c))
130 (simple-condition-format-arguments (usocket-real-error c))))
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 applicable -
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-error c))
167 (simple-condition-format-arguments (usocket-real-error c))))
168 (otherwise
169 (format stream "The condition ~A occurred." (usocket-real-error c))))))
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 body)
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)))