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
13the feature belongs to."))
14  (:documentation "The ancestor of all errors usocket may generate
15because of insufficient support from the underlying implementation
16with respect to the arguments given to `function'.
17
18One call may signal several errors, if the caller allows processing
19to continue.
20"))
21
22(define-condition unsupported (insufficient-implementation)
23  ((minimum :initarg :minimum :reader minimum
24            :documentation "Indicates the minimal version of the
25implementation 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
33doesn't allow supporting the requested feature.
34
35When 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,
43based on the features of the underlying implementation, but hasn't
44been 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 -
89condition 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 -
136error 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 -
147condition 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 -
171error 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)))
238