/site/cl+ssl-2008-11-04/conditions.lisp
Lisp | 217 lines | 182 code | 20 blank | 15 comment | 13 complexity | 0fc094aa0960c52f6be2fc0c85ff5595 MD5 | raw file
1;;; Copyright (C) 2001, 2003 Eric Marsden 2;;; Copyright (C) 2005 David Lichteblau 3;;; "the conditions and ENSURE-SSL-FUNCALL are by Jochen Schmidt." 4;;; 5;;; See LICENSE for details. 6 7(in-package :cl+ssl) 8 9(eval-when (:compile-toplevel :load-toplevel :execute) 10 (defconstant +ssl-error-none+ 0) 11 (defconstant +ssl-error-ssl+ 1) 12 (defconstant +ssl-error-want-read+ 2) 13 (defconstant +ssl-error-want-write+ 3) 14 (defconstant +ssl-error-want-x509-lookup+ 4) 15 (defconstant +ssl-error-syscall+ 5) 16 (defconstant +ssl-error-zero-return+ 6) 17 (defconstant +ssl-error-want-connect+ 7)) 18 19 20;;; Condition hierarchy 21;;; 22 23(defun write-queued-errors (condition stream) 24 (let ((queue (ssl-error-queue condition))) 25 (when queue 26 (write-sequence queue stream)))) 27 28(define-condition ssl-error (error) 29 ((queue :initform nil :initarg :queue :reader ssl-error-queue))) 30 31(define-condition ssl-error/handle (ssl-error) 32 ((ret :initarg :ret 33 :reader ssl-error-ret) 34 (handle :initarg :handle 35 :reader ssl-error-handle)) 36 (:report (lambda (condition stream) 37 (format stream "Unspecified error ~A on handle ~A" 38 (ssl-error-ret condition) 39 (ssl-error-handle condition)) 40 (write-sequence (ssl-error-queue condition) stream)))) 41 42(define-condition ssl-error-initialize (ssl-error) 43 ((reason :initarg :reason 44 :reader ssl-error-reason)) 45 (:report (lambda (condition stream) 46 (format stream "SSL initialization error: ~A" 47 (ssl-error-reason condition)) 48 (write-queued-errors condition stream)))) 49 50 51(define-condition ssl-error-want-something (ssl-error/handle) 52 ()) 53 54;;;SSL_ERROR_NONE 55(define-condition ssl-error-none (ssl-error/handle) 56 () 57 (:documentation 58 "The TLS/SSL I/O operation completed. This result code is returned if and 59 only if ret > 0.") 60 (:report (lambda (condition stream) 61 (format stream "The TLS/SSL operation on handle ~A completed. (return code: ~A)" 62 (ssl-error-handle condition) 63 (ssl-error-ret condition)) 64 (write-queued-errors condition stream)))) 65 66;; SSL_ERROR_ZERO_RETURN 67(define-condition ssl-error-zero-return (ssl-error/handle) 68 () 69 (:documentation 70 "The TLS/SSL connection has been closed. If the protocol version is SSL 3.0 71 or TLS 1.0, this result code is returned only if a closure alert has 72 occurred in the protocol, i.e. if the connection has been closed cleanly. 73 Note that in this case SSL_ERROR_ZERO_RETURN 74 does not necessarily indicate that the underlying transport has been 75 closed.") 76 (:report (lambda (condition stream) 77 (format stream "The TLS/SSL connection on handle ~A has been closed. (return code: ~A)" 78 (ssl-error-handle condition) 79 (ssl-error-ret condition)) 80 (write-queued-errors condition stream)))) 81 82;; SSL_ERROR_WANT_READ 83(define-condition ssl-error-want-read (ssl-error-want-something) 84 () 85 (:documentation 86 "The operation did not complete; the same TLS/SSL I/O function should be 87 called again later. If, by then, the underlying BIO has data available for 88 reading (if the result code is SSL_ERROR_WANT_READ) or allows writing data 89 (SSL_ERROR_WANT_WRITE), then some TLS/SSL protocol progress will take place, 90 i.e. at least part of an TLS/SSL record will be read or written. Note that 91 the retry may again lead to a SSL_ERROR_WANT_READ or SSL_ERROR_WANT_WRITE 92 condition. There is no fixed upper limit for the number of iterations that 93 may be necessary until progress becomes visible at application protocol 94 level.") 95 (:report (lambda (condition stream) 96 (format stream "The TLS/SSL operation on handle ~A did not complete: It wants a READ. (return code: ~A)" 97 (ssl-error-handle condition) 98 (ssl-error-ret condition)) 99 (write-queued-errors condition stream)))) 100 101;; SSL_ERROR_WANT_WRITE 102(define-condition ssl-error-want-write (ssl-error-want-something) 103 () 104 (:documentation 105 "The operation did not complete; the same TLS/SSL I/O function should be 106 called again later. If, by then, the underlying BIO has data available for 107 reading (if the result code is SSL_ERROR_WANT_READ) or allows writing data 108 (SSL_ERROR_WANT_WRITE), then some TLS/SSL protocol progress will take place, 109 i.e. at least part of an TLS/SSL record will be read or written. Note that 110 the retry may again lead to a SSL_ERROR_WANT_READ or SSL_ERROR_WANT_WRITE 111 condition. There is no fixed upper limit for the number of iterations that 112 may be necessary until progress becomes visible at application protocol 113 level.") 114 (:report (lambda (condition stream) 115 (format stream "The TLS/SSL operation on handle ~A did not complete: It wants a WRITE. (return code: ~A)" 116 (ssl-error-handle condition) 117 (ssl-error-ret condition)) 118 (write-queued-errors condition stream)))) 119 120;; SSL_ERROR_WANT_CONNECT 121(define-condition ssl-error-want-connect (ssl-error-want-something) 122 () 123 (:documentation 124 "The operation did not complete; the same TLS/SSL I/O function should be 125 called again later. The underlying BIO was not connected yet to the peer 126 and the call would block in connect()/accept(). The SSL 127 function should be called again when the connection is established. These 128 messages can only appear with a BIO_s_connect() or 129 BIO_s_accept() BIO, respectively. In order to find out, when 130 the connection has been successfully established, on many platforms 131 select() or poll() for writing on the socket file 132 descriptor can be used.") 133 (:report (lambda (condition stream) 134 (format stream "The TLS/SSL operation on handle ~A did not complete: It wants a connect first. (return code: ~A)" 135 (ssl-error-handle condition) 136 (ssl-error-ret condition)) 137 (write-queued-errors condition stream)))) 138 139;; SSL_ERROR_WANT_X509_LOOKUP 140(define-condition ssl-error-want-x509-lookup (ssl-error-want-something) 141 () 142 (:documentation 143 "The operation did not complete because an application callback set by 144 SSL_CTX_set_client_cert_cb() has asked to be called again. The 145 TLS/SSL I/O function should be called again later. Details depend on the 146 application.") 147 (:report (lambda (condition stream) 148 (format stream "The TLS/SSL operation on handle ~A did not complete: An application callback wants to be called again. (return code: ~A)" 149 (ssl-error-handle condition) 150 (ssl-error-ret condition)) 151 (write-queued-errors condition stream)))) 152 153;; SSL_ERROR_SYSCALL 154(define-condition ssl-error-syscall (ssl-error/handle) 155 ((syscall :initarg :syscall)) 156 (:documentation 157 "Some I/O error occurred. The OpenSSL error queue may contain more 158 information on the error. If the error queue is empty (i.e. ERR_get_error() returns 0), 159 ret can be used to find out more about the error: If ret == 0, an EOF was observed that 160 violates the protocol. If ret == -1, the underlying BIO reported an I/O error (for socket 161 I/O on Unix systems, consult errno for details).") 162 (:report (lambda (condition stream) 163 (if (zerop (err-get-error)) 164 (case (ssl-error-ret condition) 165 (0 (format stream "An I/O error occurred: An unexpected EOF was observed on handle ~A. (return code: ~A)" 166 (ssl-error-handle condition) 167 (ssl-error-ret condition))) 168 (-1 (format stream "An I/O error occurred in the underlying BIO. (return code: ~A)" 169 (ssl-error-ret condition))) 170 (otherwise (format stream "An I/O error occurred: undocumented reason. (return code: ~A)" 171 (ssl-error-ret condition)))) 172 (format stream "An UNKNOWN I/O error occurred in the underlying BIO. (return code: ~A)" 173 (ssl-error-ret condition))) 174 (write-queued-errors condition stream)))) 175 176;; SSL_ERROR_SSL 177(define-condition ssl-error-ssl (ssl-error/handle) 178 () 179 (:documentation 180 "A failure in the SSL library occurred, usually a protocol error. The 181 OpenSSL error queue contains more information on the error.") 182 (:report (lambda (condition stream) 183 (format stream 184 "A failure in the SSL library occurred on handle ~A. (Return code: ~A)" 185 (ssl-error-handle condition) 186 (ssl-error-ret condition)) 187 (write-queued-errors condition stream)))) 188 189(defun write-ssl-error-queue (stream) 190 (format stream "SSL error queue: ~%") 191 (loop 192 for error-code = (err-get-error) 193 until (zerop error-code) 194 do (format stream "~a~%" (err-error-string error-code (cffi:null-pointer))))) 195 196(defun ssl-signal-error (handle syscall error-code original-error) 197 (let ((queue (with-output-to-string (s) (write-ssl-error-queue s)))) 198 (if (and (eql error-code #.+ssl-error-syscall+) 199 (not (zerop original-error))) 200 (error 'ssl-error-syscall 201 :handle handle 202 :ret error-code 203 :queue queue 204 :syscall syscall) 205 (error (case error-code 206 (#.+ssl-error-none+ 'ssl-error-none) 207 (#.+ssl-error-ssl+ 'ssl-error-ssl) 208 (#.+ssl-error-want-read+ 'ssl-error-want-read) 209 (#.+ssl-error-want-write+ 'ssl-error-want-write) 210 (#.+ssl-error-want-x509-lookup+ 'ssl-error-want-x509-lookup) 211 (#.+ssl-error-zero-return+ 'ssl-error-zero-return) 212 (#.+ssl-error-want-connect+ 'ssl-error-want-connect) 213 (#.+ssl-error-syscall+ 'ssl-error-zero-return) 214 (t 'ssl-error/handle)) 215 :handle handle 216 :ret error-code 217 :queue queue))))