Coverage report: /development/source/library/com/dydra/gitlab/dydra-cgi/ffi/lisp/dydra-ndk/error.lisp

KindCoveredAll%
expression0109 0.0
branch00nil
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 (in-package :dydra-ndk)
2
 
3
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4
 
5
 (defcvar ("errno" %errno :read-only t) :int)
6
 (declaim (inline %strerror))
7
 (defcfun ("strerror" %strerror) :string (errnum :int))
8
 
9
 (defcfun ("dydra_error_report" %report-query-error) :void (query-uuid-string :string) (error-condition-type :string) (flags :ulong) (error-string :string))
10
 
11
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12
 
13
 (define-condition error (cl:error) ())
14
 
15
 (define-condition initialization-error (error) ())
16
 
17
 (define-condition mismatched-version (initialization-error)
18
   ((expected :initarg :expected :reader mismatched-version-expected)
19
    (actual :initarg :actual :reader mismatched-version-actual))
20
   (:report (lambda (condition stream)
21
              (format stream "mismatched libspocq version: expected ~A, but loaded ~A"
22
                      (mismatched-version-expected condition)
23
                      (mismatched-version-actual condition)))))
24
 
25
 (define-condition incompatible-version (mismatched-version) ())
26
 
27
 (define-condition incompatible-abi-version (incompatible-version) ())
28
 
29
 (define-condition incompatible-abi-structure (incompatible-abi-version)
30
   ((type :initarg :type :reader incompatible-abi-structure-type))
31
   (:report (lambda (condition stream)
32
              (format stream "the ~A structure's CFFI size ~A differs from the libspocq size ~A"
33
                      (incompatible-abi-structure-type condition)
34
                      (mismatched-version-expected condition)
35
                      (mismatched-version-actual condition)))))
36
 
37
 (define-condition missing-feature (initialization-error)
38
   ((name :initarg :name :reader missing-feature-name))
39
   (:report (lambda (condition stream)
40
              (format stream "libspocq is missing the required feature ~A"
41
                      (missing-feature-name condition)))))
42
 
43
 (define-condition foreign-function-error (error)
44
   ((function :initarg :function :reader foreign-function-error-function)
45
    (code :initarg :code :reader foreign-function-error-code)
46
    (message :initarg :message :reader foreign-function-error-message))
47
   (:report (lambda (condition stream)
48
              (format stream "~A failed with error code ~A: ~A"
49
                      (foreign-function-error-function condition)
50
                      (foreign-function-error-code condition)
51
                      (foreign-function-error-message condition)))))
52
 
53
 (define-condition unpermitted-operation (foreign-function-error) ())     ;; EPERM   (1)
54
 (define-condition unknown-pathname (foreign-function-error) ())          ;; ENOENT  (2)
55
 (define-condition unknown-process (foreign-function-error) ())           ;; ESRCH   (3)
56
 (define-condition interrupted-system-call (foreign-function-error) ())   ;; EINTR   (4)
57
 (define-condition input-output-error (foreign-function-error) ())        ;; EIO     (5)
58
 (define-condition bad-file-descriptor (foreign-function-error) ())       ;; EBADF   (9)
59
 (define-condition temporarily-unavailable (foreign-function-error) ())   ;; EAGAIN  (11)
60
 (define-condition insufficient-memory (foreign-function-error) ())       ;; ENOMEM  (12)
61
 (define-condition disallowed-access (foreign-function-error) ())         ;; EACCES  (13)
62
 (define-condition bad-address (foreign-function-error) ())               ;; EFAULT  (14)
63
 (define-condition invalid-argument (foreign-function-error) ())          ;; EINVAL  (22)
64
 (define-condition insufficient-storage (foreign-function-error) ())      ;; ENOSPC  (28)
65
 (define-condition read-only-storage (foreign-function-error) ())         ;; EROFS   (30)
66
 (define-condition broken-pipe (foreign-function-error) ())               ;; EPIPE   (32)
67
 (define-condition invalid-term (foreign-function-error) ())              ;; EDOM    (33)
68
 (define-condition unrepresentable-result (foreign-function-error) ())    ;; ERANGE  (34)
69
 (define-condition detected-deadlock (foreign-function-error) ())         ;; EDEADLK (35)
70
 (define-condition unimplemented-function (foreign-function-error) ())    ;; ENOSYS  (38)
71
 (define-condition protocol-error (foreign-function-error) ())            ;; EPROTO  (71)
72
 (define-condition illegal-byte-sequence (foreign-function-error) ())     ;; EILSEQ  (84)
73
 (define-condition insufficient-buffer-space (foreign-function-error) ()) ;; ENOBUFS (105)
74
 (define-condition stale-file-handle (foreign-function-error) ())         ;; ESTALE  (116)
75
 (define-condition exceeded-quota (foreign-function-error) ())            ;; EDQUOT  (122)
76
 (define-condition expired-key (foreign-function-error) ())               ;; EKEYEXPIRED (127)
77
 (define-condition revoked-key (foreign-function-error) ())               ;; EKEYREVOKED (128)
78
 
79
 (defun mismatched-version (ffi-version lib-version)
80
   (cerror "Continue regardless." 'mismatched-version
81
           :expected lib-version :actual ffi-version))
82
 
83
 (defun incompatible-abi-structure (type ffi-size lib-size)
84
   (cerror "Continue regardless." 'incompatible-abi-structure
85
           :expected lib-size :actual ffi-size :type type))
86
 
87
 (defun missing-feature (feature-name)
88
   (cerror "Continue regardless." 'missing-feature :name feature-name))
89
 
90
 (defun foreign-function-error (errno function-name &optional message)
91
   (declare (type fixnum errno)
92
            (type string function-name))
93
   (cl:error (find-foreign-function-error-class errno)
94
             :function function-name
95
             :code errno
96
             :message (or message (%strerror errno))))
97
 
98
 (defun find-foreign-function-error-class (errno)
99
   (declare (type fixnum errno))
100
   (case errno
101
     ;; FIXME: this is all Linux-specific.
102
     (1   'unpermitted-operation)
103
     (2   'unknown-pathname)
104
     (3   'unknown-process)
105
     (4   'interrupted-system-call)
106
     (5   'input-output-error)
107
     (9   'bad-file-descriptor)
108
     (11  'temporarily-unavailable)
109
     (12  'insufficient-memory)
110
     (13  'disallowed-access)
111
     (14  'bad-address)
112
     (22  'invalid-argument)
113
     (28  'insufficient-storage)
114
     (30  'read-only-storage)
115
     (32  'broken-pipe)
116
     (33  'invalid-term)
117
     (34  'unrepresentable-result)
118
     (35  'detected-deadlock)
119
     (38  'unimplemented-function)
120
     (71  'protocol-error)
121
     (84  'illegal-byte-sequence)
122
     (105 'insufficient-buffer-space)
123
     (116 'stale-file-handle)
124
     (122 'exceeded-quota)
125
     (127 'expired-key)
126
     (128 'revoked-key)
127
     (t   'foreign-function-error)))
128
 
129
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
130
 
131
 (defun report-query-error (query-uuid-string error-condition-type &key string line column variable)
132
   "Used by SPOCQ engines to report error conditions back to the parent process."
133
   (declare (type string query-uuid-string)
134
            (type (or string null) string)
135
            (type (or fixnum null) line column)
136
            (type (or symbol null) variable)
137
            (ignore line column variable)) ;; TODO
138
   (%report-query-error query-uuid-string (write-to-string error-condition-type) 0
139
                        (or string (null-pointer)))
140
   (values))