Permalink
Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
218 lines (197 sloc) 9.62 KB
;;; Copyright (C) 2001, 2003 Eric Marsden
;;; Copyright (C) 2005 David Lichteblau
;;; "the conditions and ENSURE-SSL-FUNCALL are by Jochen Schmidt."
;;;
;;; See LICENSE for details.
(in-package :cl+ssl)
(eval-when (:compile-toplevel :load-toplevel :execute)
(defconstant +ssl-error-none+ 0)
(defconstant +ssl-error-ssl+ 1)
(defconstant +ssl-error-want-read+ 2)
(defconstant +ssl-error-want-write+ 3)
(defconstant +ssl-error-want-x509-lookup+ 4)
(defconstant +ssl-error-syscall+ 5)
(defconstant +ssl-error-zero-return+ 6)
(defconstant +ssl-error-want-connect+ 7))
;;; Condition hierarchy
;;;
(defun write-queued-errors (condition stream)
(let ((queue (ssl-error-queue condition)))
(when queue
(write-sequence queue stream))))
(define-condition ssl-error (error)
((queue :initform nil :initarg :queue :reader ssl-error-queue)))
(define-condition ssl-error/handle (ssl-error)
((ret :initarg :ret
:reader ssl-error-ret)
(handle :initarg :handle
:reader ssl-error-handle))
(:report (lambda (condition stream)
(format stream "Unspecified error ~A on handle ~A"
(ssl-error-ret condition)
(ssl-error-handle condition))
(write-sequence (ssl-error-queue condition) stream))))
(define-condition ssl-error-initialize (ssl-error)
((reason :initarg :reason
:reader ssl-error-reason))
(:report (lambda (condition stream)
(format stream "SSL initialization error: ~A"
(ssl-error-reason condition))
(write-queued-errors condition stream))))
(define-condition ssl-error-want-something (ssl-error/handle)
())
;;;SSL_ERROR_NONE
(define-condition ssl-error-none (ssl-error/handle)
()
(:documentation
"The TLS/SSL I/O operation completed. This result code is returned if and
only if ret > 0.")
(:report (lambda (condition stream)
(format stream "The TLS/SSL operation on handle ~A completed. (return code: ~A)"
(ssl-error-handle condition)
(ssl-error-ret condition))
(write-queued-errors condition stream))))
;; SSL_ERROR_ZERO_RETURN
(define-condition ssl-error-zero-return (ssl-error/handle)
()
(:documentation
"The TLS/SSL connection has been closed. If the protocol version is SSL 3.0
or TLS 1.0, this result code is returned only if a closure alert has
occurred in the protocol, i.e. if the connection has been closed cleanly.
Note that in this case SSL_ERROR_ZERO_RETURN
does not necessarily indicate that the underlying transport has been
closed.")
(:report (lambda (condition stream)
(format stream "The TLS/SSL connection on handle ~A has been closed. (return code: ~A)"
(ssl-error-handle condition)
(ssl-error-ret condition))
(write-queued-errors condition stream))))
;; SSL_ERROR_WANT_READ
(define-condition ssl-error-want-read (ssl-error-want-something)
()
(:documentation
"The operation did not complete; the same TLS/SSL I/O function should be
called again later. If, by then, the underlying BIO has data available for
reading (if the result code is SSL_ERROR_WANT_READ) or allows writing data
(SSL_ERROR_WANT_WRITE), then some TLS/SSL protocol progress will take place,
i.e. at least part of an TLS/SSL record will be read or written. Note that
the retry may again lead to a SSL_ERROR_WANT_READ or SSL_ERROR_WANT_WRITE
condition. There is no fixed upper limit for the number of iterations that
may be necessary until progress becomes visible at application protocol
level.")
(:report (lambda (condition stream)
(format stream "The TLS/SSL operation on handle ~A did not complete: It wants a READ. (return code: ~A)"
(ssl-error-handle condition)
(ssl-error-ret condition))
(write-queued-errors condition stream))))
;; SSL_ERROR_WANT_WRITE
(define-condition ssl-error-want-write (ssl-error-want-something)
()
(:documentation
"The operation did not complete; the same TLS/SSL I/O function should be
called again later. If, by then, the underlying BIO has data available for
reading (if the result code is SSL_ERROR_WANT_READ) or allows writing data
(SSL_ERROR_WANT_WRITE), then some TLS/SSL protocol progress will take place,
i.e. at least part of an TLS/SSL record will be read or written. Note that
the retry may again lead to a SSL_ERROR_WANT_READ or SSL_ERROR_WANT_WRITE
condition. There is no fixed upper limit for the number of iterations that
may be necessary until progress becomes visible at application protocol
level.")
(:report (lambda (condition stream)
(format stream "The TLS/SSL operation on handle ~A did not complete: It wants a WRITE. (return code: ~A)"
(ssl-error-handle condition)
(ssl-error-ret condition))
(write-queued-errors condition stream))))
;; SSL_ERROR_WANT_CONNECT
(define-condition ssl-error-want-connect (ssl-error-want-something)
()
(:documentation
"The operation did not complete; the same TLS/SSL I/O function should be
called again later. The underlying BIO was not connected yet to the peer
and the call would block in connect()/accept(). The SSL
function should be called again when the connection is established. These
messages can only appear with a BIO_s_connect() or
BIO_s_accept() BIO, respectively. In order to find out, when
the connection has been successfully established, on many platforms
select() or poll() for writing on the socket file
descriptor can be used.")
(:report (lambda (condition stream)
(format stream "The TLS/SSL operation on handle ~A did not complete: It wants a connect first. (return code: ~A)"
(ssl-error-handle condition)
(ssl-error-ret condition))
(write-queued-errors condition stream))))
;; SSL_ERROR_WANT_X509_LOOKUP
(define-condition ssl-error-want-x509-lookup (ssl-error-want-something)
()
(:documentation
"The operation did not complete because an application callback set by
SSL_CTX_set_client_cert_cb() has asked to be called again. The
TLS/SSL I/O function should be called again later. Details depend on the
application.")
(:report (lambda (condition stream)
(format stream "The TLS/SSL operation on handle ~A did not complete: An application callback wants to be called again. (return code: ~A)"
(ssl-error-handle condition)
(ssl-error-ret condition))
(write-queued-errors condition stream))))
;; SSL_ERROR_SYSCALL
(define-condition ssl-error-syscall (ssl-error/handle)
((syscall :initarg :syscall))
(:documentation
"Some I/O error occurred. The OpenSSL error queue may contain more
information on the error. If the error queue is empty (i.e. ERR_get_error() returns 0),
ret can be used to find out more about the error: If ret == 0, an EOF was observed that
violates the protocol. If ret == -1, the underlying BIO reported an I/O error (for socket
I/O on Unix systems, consult errno for details).")
(:report (lambda (condition stream)
(if (zerop (err-get-error))
(case (ssl-error-ret condition)
(0 (format stream "An I/O error occurred: An unexpected EOF was observed on handle ~A. (return code: ~A)"
(ssl-error-handle condition)
(ssl-error-ret condition)))
(-1 (format stream "An I/O error occurred in the underlying BIO. (return code: ~A)"
(ssl-error-ret condition)))
(otherwise (format stream "An I/O error occurred: undocumented reason. (return code: ~A)"
(ssl-error-ret condition))))
(format stream "An UNKNOWN I/O error occurred in the underlying BIO. (return code: ~A)"
(ssl-error-ret condition)))
(write-queued-errors condition stream))))
;; SSL_ERROR_SSL
(define-condition ssl-error-ssl (ssl-error/handle)
()
(:documentation
"A failure in the SSL library occurred, usually a protocol error. The
OpenSSL error queue contains more information on the error.")
(:report (lambda (condition stream)
(format stream
"A failure in the SSL library occurred on handle ~A. (Return code: ~A)"
(ssl-error-handle condition)
(ssl-error-ret condition))
(write-queued-errors condition stream))))
(defun write-ssl-error-queue (stream)
(format stream "SSL error queue: ~%")
(loop
for error-code = (err-get-error)
until (zerop error-code)
do (format stream "~a~%" (err-error-string error-code (cffi:null-pointer)))))
(defun ssl-signal-error (handle syscall error-code original-error)
(let ((queue (with-output-to-string (s) (write-ssl-error-queue s))))
(if (and (eql error-code #.+ssl-error-syscall+)
(not (zerop original-error)))
(error 'ssl-error-syscall
:handle handle
:ret error-code
:queue queue
:syscall syscall)
(error (case error-code
(#.+ssl-error-none+ 'ssl-error-none)
(#.+ssl-error-ssl+ 'ssl-error-ssl)
(#.+ssl-error-want-read+ 'ssl-error-want-read)
(#.+ssl-error-want-write+ 'ssl-error-want-write)
(#.+ssl-error-want-x509-lookup+ 'ssl-error-want-x509-lookup)
(#.+ssl-error-zero-return+ 'ssl-error-zero-return)
(#.+ssl-error-want-connect+ 'ssl-error-want-connect)
(#.+ssl-error-syscall+ 'ssl-error-zero-return)
(t 'ssl-error/handle))
:handle handle
:ret error-code
:queue queue))))