Coverage report: /home/ellis/comp/core/ffi/aws-lc/condition.lisp

KindCoveredAll%
expression059 0.0
branch02 0.0
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;; condition.lisp --- AWS-LC Conditions
2
 
3
 ;; 
4
 
5
 ;;; Code:
6
 (in-package :aws-lc)
7
 
8
 (define-alien-enum (err-r int)
9
   :sys-lib (err-lib :sys)
10
   :bn-lib (err-lib :bn)
11
   :rsa-lib (err-lib :rsa)
12
   :dh-lib (err-lib :dh)
13
   :evp-lib (err-lib :evp)
14
   :buf-lib (err-lib :buf)
15
   :obj-lib (err-lib :obj)
16
   :pem-lib (err-lib :pem)
17
   :dsa-lib (err-lib :dsa)
18
   :x509-lib (err-lib :x509)
19
   :asn1-lib (err-lib :asn1)
20
   :conf-lib (err-lib :conf)
21
   :crypto-lib (err-lib :crypto)
22
   :ec-lib (err-lib :ec)
23
   :ssl-lib (err-lib :ssl)
24
   :bio-lib (err-lib :bio)
25
   :pkcs7-lib (err-lib :pkcs7)
26
   :pkcs8-lib (err-lib :pkcs8)
27
   :x509v3-lib (err-lib :x509v3)
28
   :rand-lib (err-lib :rand)
29
   :dso-lib (err-lib :dso)
30
   :engine-lib (err-lib :engine)
31
   :ocsp-lib (err-lib :ocsp)
32
   :ui-lib (err-lib :ui)
33
   :comp-lib (err-lib :comp)
34
   :ecdsa-lib (err-lib :ecdsa)
35
   :ecdh-lib (err-lib :ecdh)
36
   ;; todo: where is this defined?
37
   ;;  :store-lib (err-lib :store)
38
   :fips-lib (err-lib :fips)
39
   :cms-lib (err-lib :cms)
40
   :ts-lib (err-lib :ts)
41
   :hmac-lib (err-lib :hmac)
42
   ;; TODO: where is this defined?
43
   ;; :jpake-lib (err-lib :jpake)
44
   :user-lib (err-lib :user)
45
   :digest-lib (err-lib :digest)
46
   :cipher-lib (err-lib :cipher)
47
   :hkdf-lib (err-lib :hkdf)
48
   :trust-token-lib (err-lib :trust-token)
49
   :fatal 64
50
   :malloc-failure (logior 1 64)
51
   :should-not-have-been-called (logior 2 64)
52
   :passed-null-parameter (logior 3 64)
53
   :internal-error (logior 4 64)
54
   :overflow (logior 5 64))
55
 
56
 (define-condition aws-lc-condition () ())
57
 
58
 (define-condition aws-lc-error (aws-lc-condition error) 
59
   ((queue :initform nil :initarg :queue :reader error-queue)))
60
 
61
 (define-condition aws-lc-error-call (aws-lc-error std:std-error)
62
   ()
63
   (:documentation
64
    "A failure in the SSL library occurred..")
65
   (:report (lambda (condition stream)
66
              (format stream "A failure in OpenSSL library occurred~@[: ~A~]. "
67
                      (std:error-message condition))
68
              (format-error-queue stream condition))))
69
 
70
 (defun read-aws-lc-error-queue ()
71
   (loop for error-code = (err-get-error)
72
         until (zerop error-code)
73
         collect error-code))
74
 
75
 (defun format-error-queue (stream-designator queue-designator)
76
   "STREAM-DESIGNATOR is the same as CL:FORMAT accepts: T, NIL, or a stream.
77
 QUEUE-DESIGNATOR is either a list of error codes (as returned
78
 by READ-SSL-ERROR-QUEUE) or an SSL-ERROR condition."
79
   (flet ((body (stream)
80
            (let ((queue (etypecase queue-designator
81
                           (aws-lc-error (error-queue queue-designator))
82
                           (list queue-designator))))
83
              (format stream "SSL error queue")
84
              (if queue
85
                  (progn
86
                    (format stream ":~%")
87
                    (loop for error-code in queue
88
                          do (format stream "~a~%" (err-error-string error-code nil))))
89
                  (format stream " is empty.")))))
90
     (case stream-designator
91
       ((t) (body *standard-output*))
92
       ((nil) (let ((s (make-string-output-stream :element-type 'character)))
93
                (unwind-protect
94
                     (body s)
95
                  (close s))
96
                (get-output-stream-string s)))
97
       (t (body stream-designator)))))