/site/cl+ssl-2008-11-04/conditions.lisp

  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))))