Coverage report: /home/ellis/.stash/quicklisp/dists/ultralisp/software/usocket-usocket-20250208033134/condition.lisp

KindCoveredAll%
expression0104 0.0
branch02 0.0
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
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
            :documentation "Socket that raised the condition"))
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
   ((socket :initarg :socket
65
            :accessor usocket-socket))
66
   (:documentation "Parent error for all name resolution errors."))
67
 
68
 (eval-when (:compile-toplevel :load-toplevel :execute)
69
   (defun define-usocket-condition-class (class &rest parents)
70
     `(progn
71
        (define-condition ,class ,parents ())
72
        (eval-when (:load-toplevel :execute)
73
          (export ',class)))))
74
 
75
 (defmacro define-usocket-condition-classes (class-list parents)
76
   `(progn ,@(mapcar #'(lambda (x)
77
                         (apply #'define-usocket-condition-class
78
                                x parents))
79
                     class-list)))
80
 
81
 ;; Mass define and export our conditions
82
 (define-usocket-condition-classes
83
   (interrupted-condition)
84
   (socket-condition))
85
 
86
 (define-condition unknown-condition (socket-condition)
87
   ((real-condition :initarg :real-condition
88
                    :accessor usocket-real-condition))
89
   (:documentation "Condition raised when there's no other - more applicable -
90
 condition available."))
91
 
92
 ;; Mass define and export our errors
93
 (define-usocket-condition-classes
94
   (address-in-use-error
95
    address-not-available-error
96
    already-shutdown-error
97
    bad-file-descriptor-error
98
    connection-refused-error
99
    connection-aborted-error
100
    connection-reset-error
101
    invalid-argument-error
102
    no-buffers-error
103
    operation-not-supported-error
104
    operation-not-permitted-error
105
    protocol-not-supported-error
106
    socket-type-not-supported-error
107
    network-unreachable-error
108
    network-down-error
109
    network-reset-error
110
    host-down-error
111
    host-unreachable-error
112
    out-of-memory-error
113
    shutdown-error
114
    timeout-error
115
    deadline-timeout-error
116
    invalid-socket-error
117
    invalid-socket-stream-error)
118
   (socket-error))
119
 
120
 ;; This is obsolated. USOCKET no more raises it inside HANDLE-CONDITION (from backends),
121
 ;; so that code patterns like below becomes possible: (previously on SBCL, my-error was
122
 ;; captured by HANDLE-CONDITION and was packed into UNKNOWN-ERROR whose :real-error is
123
 ;; that my-error instance. See also https://github.com/usocket/usocket/issues/97
124
 #|
125
 (ql:quickload "usocket")
126
 
127
 (define-condition my-error (error) ())
128
 
129
 (handler-case
130
     (usocket:with-client-socket (socket stream "google.com" 443
131
                                         :element-type '(unsigned-byte 8))
132
       ;; some my code
133
       ;; ...
134
       (error 'my-error ))
135
   (my-error (c)
136
     ;; handle my error
137
              ))
138
 |#
139
 (define-condition unknown-error (socket-error)
140
   ((real-error :initarg :real-error
141
                :accessor usocket-real-error
142
                :initform nil)
143
    (errno      :initarg :errno
144
                :reader usocket-errno
145
                :initform 0))
146
   (:report (lambda (c stream)
147
              (typecase c
148
                (simple-condition
149
                 (format stream
150
                         (simple-condition-format-control (usocket-real-error c))
151
                         (simple-condition-format-arguments (usocket-real-error c))))
152
                (otherwise
153
                 (format stream "The condition ~A occurred with errno: ~D."
154
                         (usocket-real-error c)
155
                         (usocket-errno c))))))
156
   (:documentation "Error raised when there's no other - more applicable -
157
 error available."))
158
 
159
 (define-usocket-condition-classes
160
   (ns-try-again-condition) ; obsoleted
161
   (socket-condition))
162
 
163
 (define-condition ns-unknown-condition (ns-condition)
164
   ((real-condition :initarg :real-condition
165
                    :accessor ns-real-condition
166
                    :initform nil))
167
   (:documentation "Condition raised when there's no other - more applicable -
168
 condition available."))
169
 
170
 (define-usocket-condition-classes
171
   ;; the no-data error code in the Unix 98 api
172
   ;; isn't really an error: there's just no data to return.
173
   ;; with lisp, we just return NIL (indicating no data) instead of
174
   ;; raising an exception...
175
   (ns-host-not-found-error
176
    ns-no-recovery-error
177
    ns-try-again-error)
178
   (ns-error))
179
 
180
 (define-condition ns-unknown-error (ns-error)
181
   ((real-error :initarg :real-error
182
                :accessor ns-real-error
183
                :initform nil))
184
   (:report (lambda (c stream)
185
              (typecase c
186
                (simple-condition
187
                 (format stream
188
                         (simple-condition-format-control (usocket-real-error c))
189
                         (simple-condition-format-arguments (usocket-real-error c))))
190
                (otherwise
191
                 (format stream "The condition ~A occurred." (usocket-real-error c))))))
192
   (:documentation "Error raised when there's no other - more applicable -
193
 error available."))
194
 
195
 (defmacro with-mapped-conditions ((&optional socket host-or-ip) &body body)
196
   "Run `body', handling implementation-specific conditions by re-raising them as usocket conditions.
197
 
198
 When `socket' or `host-or-ip' are specified, their values will be passed as arguments to the corresponding usocket conditions."
199
   `(handler-bind ((condition
200
                    #'(lambda (c) (handle-condition c ,socket ,host-or-ip))))
201
      ,@body))
202
 
203
 (defparameter +unix-errno-condition-map+
204
   `(((11) . ns-try-again-error)     ;; EAGAIN
205
     ((35) . ns-try-again-error)     ;; EDEADLCK
206
     ((4) . interrupted-condition))) ;; EINTR
207
 
208
 (defparameter +unix-errno-error-map+
209
   ;;### the first column is for non-(linux or srv4) systems
210
   ;; the second for linux
211
   ;; the third for srv4
212
   ;;###FIXME: How do I determine on which Unix we're running
213
   ;;          (at least in clisp and sbcl; I know about cmucl...)
214
   ;; The table below works under the assumption we'll *only* see
215
   ;; socket associated errors...
216
   `(((48 98) . address-in-use-error)
217
     ((49 99) . address-not-available-error)
218
     ((9) . bad-file-descriptor-error)
219
     ((61 111) . connection-refused-error)
220
     ((54 104) . connection-reset-error)
221
     ((53 103) . connection-aborted-error)
222
     ((22) . invalid-argument-error)
223
     ((55 105) . no-buffers-error)
224
     ((12) . out-of-memory-error)
225
     ((45 95) . operation-not-supported-error)
226
     ((1 13) . operation-not-permitted-error)
227
     ((43 92) . protocol-not-supported-error)
228
     ((44 93) . socket-type-not-supported-error)
229
     ((51 101) . network-unreachable-error)
230
     ((50 100) . network-down-error)
231
     ((52 102) . network-reset-error)
232
     ((58 108) . already-shutdown-error)
233
     ((60 110) . timeout-error)
234
     ((64 112) . host-down-error)
235
     ((65 113) . host-unreachable-error)))
236
 
237
 (defun map-errno-condition (errno)
238
   (cdr (assoc errno +unix-errno-error-map+ :test #'member)))
239
 
240
 (defun map-errno-error (errno)
241
   (cdr (assoc errno +unix-errno-error-map+ :test #'member)))
242
 
243
 (defparameter +unix-ns-error-map+
244
   `((1 . ns-host-not-found-error)
245
     (2 . ns-try-again-error)
246
     (3 . ns-no-recovery-error)))
247
 
248
 (defmacro unsupported (feature context &key minimum)
249
   `(cerror "Ignore it and continue" 'unsupported
250
            :feature ,feature
251
            :context ,context
252
            :minimum ,minimum))
253
 
254
 (defmacro unimplemented (feature context)
255
   `(signal 'unimplemented :feature ,feature :context ,context))
256
 
257
 ;;; People may want to ignore all unsupported warnings, here it is.
258
 (defmacro ignore-unsupported-warnings (&body body)
259
   `(handler-bind ((unsupported
260
                    #'(lambda (c)
261
                        (declare (ignore c)) (continue))))
262
      (progn ,@body)))