3rdparties/software/cl+ssl-20200427-git/src/conditions.lisp (14468 bytes)
1 ;;;; -*- Mode: LISP; Syntax: COMMON-LISP; indent-tabs-mode: nil; coding: utf-8; show-trailing-whitespace: t -*- 2 ;;; 3 ;;; Copyright (C) 2001, 2003 Eric Marsden 4 ;;; Copyright (C) 2005 David Lichteblau 5 ;;; "the conditions and ENSURE-SSL-FUNCALL are by Jochen Schmidt." 6 ;;; 7 ;;; See LICENSE for details. 8 9 #+xcvb (module (:depends-on ("package"))) 10 11 (in-package :cl+ssl) 12 13 (eval-when (:compile-toplevel :load-toplevel :execute) 14 (defconstant +ssl-error-none+ 0) 15 (defconstant +ssl-error-ssl+ 1) 16 (defconstant +ssl-error-want-read+ 2) 17 (defconstant +ssl-error-want-write+ 3) 18 (defconstant +ssl-error-want-x509-lookup+ 4) 19 (defconstant +ssl-error-syscall+ 5) 20 (defconstant +ssl-error-zero-return+ 6) 21 (defconstant +ssl-error-want-connect+ 7)) 22 23 24 ;;; Condition hierarchy 25 ;;; 26 27 (defun read-ssl-error-queue () 28 (loop 29 :for error-code = (err-get-error) 30 :until (zerop error-code) 31 :collect error-code)) 32 33 (defun format-ssl-error-queue (stream-designator queue-designator) 34 "STREAM-DESIGNATOR is the same as CL:FORMAT accepts: T, NIL, or a stream. 35 QUEUE-DESIGNATOR is either a list of error codes (as returned 36 by READ-SSL-ERROR-QUEUE) or an SSL-ERROR condition." 37 (flet ((body (stream) 38 (let ((queue (etypecase queue-designator 39 (ssl-error (ssl-error-queue queue-designator)) 40 (list queue-designator)))) 41 (format stream "SSL error queue") 42 (if queue 43 (progn 44 (format stream ":~%") 45 (loop 46 :for error-code :in queue 47 :do (format stream "~a~%" (err-error-string error-code (cffi:null-pointer))))) 48 (format stream " is empty."))))) 49 (case stream-designator 50 ((t) (body *standard-output*)) 51 ((nil) (let ((s (make-string-output-stream :element-type 'character))) 52 (unwind-protect 53 (body s) 54 (close s)) 55 (get-output-stream-string s))) 56 (otherwise (body stream-designator))))) 57 58 (define-condition cl+ssl-error (error) 59 ()) 60 61 (define-condition ssl-error (cl+ssl-error) 62 ( 63 ;; Stores list of error codes 64 ;; (as returned by the READ-SSL-ERROR-QUEUE function) 65 (queue :initform nil :initarg :queue :reader ssl-error-queue))) 66 67 (define-condition ssl-error/handle (ssl-error) 68 ((ret :initarg :ret 69 :reader ssl-error-ret) 70 (handle :initarg :handle 71 :reader ssl-error-handle)) 72 (:report (lambda (condition stream) 73 (format stream "Unspecified error ~A on handle ~A~%" 74 (ssl-error-ret condition) 75 (ssl-error-handle condition)) 76 (format-ssl-error-queue stream condition)))) 77 78 (define-condition ssl-error-initialize (ssl-error) 79 ((reason :initarg :reason 80 :reader ssl-error-reason)) 81 (:report (lambda (condition stream) 82 (format stream "SSL initialization error: ~A~%" 83 (ssl-error-reason condition)) 84 (format-ssl-error-queue stream condition)))) 85 86 87 (define-condition ssl-error-want-something (ssl-error/handle) 88 ()) 89 90 ;;;SSL_ERROR_NONE 91 (define-condition ssl-error-none (ssl-error/handle) 92 () 93 (:documentation 94 "The TLS/SSL I/O operation completed. This result code is returned if and 95 only if ret > 0.") 96 (:report (lambda (condition stream) 97 (format stream "The TLS/SSL operation on handle ~A completed (return code: ~A).~%" 98 (ssl-error-handle condition) 99 (ssl-error-ret condition)) 100 (format-ssl-error-queue stream condition)))) 101 102 ;; SSL_ERROR_ZERO_RETURN 103 (define-condition ssl-error-zero-return (ssl-error/handle) 104 () 105 (:documentation 106 "The TLS/SSL connection has been closed. If the protocol version is SSL 3.0 107 or TLS 1.0, this result code is returned only if a closure alert has 108 occurred in the protocol, i.e. if the connection has been closed cleanly. 109 Note that in this case SSL_ERROR_ZERO_RETURN 110 does not necessarily indicate that the underlying transport has been 111 closed.") 112 (:report (lambda (condition stream) 113 (format stream "The TLS/SSL connection on handle ~A has been closed (return code: ~A).~%" 114 (ssl-error-handle condition) 115 (ssl-error-ret condition)) 116 (format-ssl-error-queue stream condition)))) 117 118 ;; SSL_ERROR_WANT_READ 119 (define-condition ssl-error-want-read (ssl-error-want-something) 120 () 121 (:documentation 122 "The operation did not complete; the same TLS/SSL I/O function should be 123 called again later. If, by then, the underlying BIO has data available for 124 reading (if the result code is SSL_ERROR_WANT_READ) or allows writing data 125 (SSL_ERROR_WANT_WRITE), then some TLS/SSL protocol progress will take place, 126 i.e. at least part of an TLS/SSL record will be read or written. Note that 127 the retry may again lead to a SSL_ERROR_WANT_READ or SSL_ERROR_WANT_WRITE 128 condition. There is no fixed upper limit for the number of iterations that 129 may be necessary until progress becomes visible at application protocol 130 level.") 131 (:report (lambda (condition stream) 132 (format stream "The TLS/SSL operation on handle ~A did not complete: It wants a READ (return code: ~A).~%" 133 (ssl-error-handle condition) 134 (ssl-error-ret condition)) 135 (format-ssl-error-queue stream condition)))) 136 137 ;; SSL_ERROR_WANT_WRITE 138 (define-condition ssl-error-want-write (ssl-error-want-something) 139 () 140 (:documentation 141 "The operation did not complete; the same TLS/SSL I/O function should be 142 called again later. If, by then, the underlying BIO has data available for 143 reading (if the result code is SSL_ERROR_WANT_READ) or allows writing data 144 (SSL_ERROR_WANT_WRITE), then some TLS/SSL protocol progress will take place, 145 i.e. at least part of an TLS/SSL record will be read or written. Note that 146 the retry may again lead to a SSL_ERROR_WANT_READ or SSL_ERROR_WANT_WRITE 147 condition. There is no fixed upper limit for the number of iterations that 148 may be necessary until progress becomes visible at application protocol 149 level.") 150 (:report (lambda (condition stream) 151 (format stream "The TLS/SSL operation on handle ~A did not complete: It wants a WRITE (return code: ~A).~%" 152 (ssl-error-handle condition) 153 (ssl-error-ret condition)) 154 (format-ssl-error-queue stream condition)))) 155 156 ;; SSL_ERROR_WANT_CONNECT 157 (define-condition ssl-error-want-connect (ssl-error-want-something) 158 () 159 (:documentation 160 "The operation did not complete; the same TLS/SSL I/O function should be 161 called again later. The underlying BIO was not connected yet to the peer 162 and the call would block in connect()/accept(). The SSL 163 function should be called again when the connection is established. These 164 messages can only appear with a BIO_s_connect() or 165 BIO_s_accept() BIO, respectively. In order to find out, when 166 the connection has been successfully established, on many platforms 167 select() or poll() for writing on the socket file 168 descriptor can be used.") 169 (:report (lambda (condition stream) 170 (format stream "The TLS/SSL operation on handle ~A did not complete: It wants a connect first (return code: ~A).~%" 171 (ssl-error-handle condition) 172 (ssl-error-ret condition)) 173 (format-ssl-error-queue stream condition)))) 174 175 ;; SSL_ERROR_WANT_X509_LOOKUP 176 (define-condition ssl-error-want-x509-lookup (ssl-error-want-something) 177 () 178 (:documentation 179 "The operation did not complete because an application callback set by 180 SSL_CTX_set_client_cert_cb() has asked to be called again. The 181 TLS/SSL I/O function should be called again later. Details depend on the 182 application.") 183 (:report (lambda (condition stream) 184 (format stream "The TLS/SSL operation on handle ~A did not complete: An application callback wants to be called again (return code: ~A).~%" 185 (ssl-error-handle condition) 186 (ssl-error-ret condition)) 187 (format-ssl-error-queue stream condition)))) 188 189 ;; SSL_ERROR_SYSCALL 190 (define-condition ssl-error-syscall (ssl-error/handle) 191 ((syscall :initarg :syscall)) 192 (:documentation 193 "Some I/O error occurred. The OpenSSL error queue may contain more 194 information on the error. If the error queue is empty (i.e. ERR_get_error() returns 0), 195 ret can be used to find out more about the error: If ret == 0, an EOF was observed that 196 violates the protocol. If ret == -1, the underlying BIO reported an I/O error (for socket 197 I/O on Unix systems, consult errno for details).") 198 (:report (lambda (condition stream) 199 (if (zerop (length (ssl-error-queue condition))) 200 (case (ssl-error-ret condition) 201 (0 (format stream "An I/O error occurred: An unexpected EOF was observed on handle ~A (return code: ~A).~%" 202 (ssl-error-handle condition) 203 (ssl-error-ret condition))) 204 (-1 (format stream "An I/O error occurred in the underlying BIO (return code: ~A).~%" 205 (ssl-error-ret condition))) 206 (otherwise (format stream "An I/O error occurred: undocumented reason (return code: ~A).~%" 207 (ssl-error-ret condition)))) 208 (format stream "An UNKNOWN I/O error occurred in the underlying BIO (return code: ~A).~%" 209 (ssl-error-ret condition))) 210 (format-ssl-error-queue stream condition)))) 211 212 ;; SSL_ERROR_SSL 213 (define-condition ssl-error-ssl (ssl-error/handle) 214 () 215 (:documentation 216 "A failure in the SSL library occurred, usually a protocol error. The 217 OpenSSL error queue contains more information on the error.") 218 (:report (lambda (condition stream) 219 (format stream 220 "A failure in the SSL library occurred on handle ~A (return code: ~A).~%" 221 (ssl-error-handle condition) 222 (ssl-error-ret condition)) 223 (format-ssl-error-queue stream condition)))) 224 225 (defun ssl-signal-error (handle syscall error-code original-error) 226 (let ((queue (read-ssl-error-queue))) 227 (if (and (eql error-code #.+ssl-error-syscall+) 228 (not (zerop original-error))) 229 (error 'ssl-error-syscall 230 :handle handle 231 :ret error-code 232 :queue queue 233 :syscall syscall) 234 (error (case error-code 235 (#.+ssl-error-none+ 'ssl-error-none) 236 (#.+ssl-error-ssl+ 'ssl-error-ssl) 237 (#.+ssl-error-want-read+ 'ssl-error-want-read) 238 (#.+ssl-error-want-write+ 'ssl-error-want-write) 239 (#.+ssl-error-want-x509-lookup+ 'ssl-error-want-x509-lookup) 240 (#.+ssl-error-zero-return+ 'ssl-error-zero-return) 241 (#.+ssl-error-want-connect+ 'ssl-error-want-connect) 242 (#.+ssl-error-syscall+ 'ssl-error-zero-return) ; this is intentional here. we got an EOF from the syscall (ret is 0) 243 (t 'ssl-error/handle)) 244 :handle handle 245 :ret error-code 246 :queue queue)))) 247 248 (defparameter *ssl-verify-error-alist* 249 '((0 :X509_V_OK) 250 (2 :X509_V_ERR_UNABLE_TO_GET_ISSUER_CERT) 251 (3 :X509_V_ERR_UNABLE_TO_GET_CRL) 252 (4 :X509_V_ERR_UNABLE_TO_DECRYPT_CERT_SIGNATURE) 253 (5 :X509_V_ERR_UNABLE_TO_DECRYPT_CRL_SIGNATURE) 254 (6 :X509_V_ERR_UNABLE_TO_DECODE_ISSUER_PUBLIC_KEY) 255 (7 :X509_V_ERR_CERT_SIGNATURE_FAILURE) 256 (8 :X509_V_ERR_CRL_SIGNATURE_FAILURE) 257 (9 :X509_V_ERR_CERT_NOT_YET_VALID) 258 (10 :X509_V_ERR_CERT_HAS_EXPIRED) 259 (11 :X509_V_ERR_CRL_NOT_YET_VALID) 260 (12 :X509_V_ERR_CRL_HAS_EXPIRED) 261 (13 :X509_V_ERR_ERROR_IN_CERT_NOT_BEFORE_FIELD) 262 (14 :X509_V_ERR_ERROR_IN_CERT_NOT_AFTER_FIELD) 263 (15 :X509_V_ERR_ERROR_IN_CRL_LAST_UPDATE_FIELD) 264 (16 :X509_V_ERR_ERROR_IN_CRL_NEXT_UPDATE_FIELD) 265 (17 :X509_V_ERR_OUT_OF_MEM) 266 (18 :X509_V_ERR_DEPTH_ZERO_SELF_SIGNED_CERT) 267 (19 :X509_V_ERR_SELF_SIGNED_CERT_IN_CHAIN) 268 (20 :X509_V_ERR_UNABLE_TO_GET_ISSUER_CERT_LOCALLY) 269 (21 :X509_V_ERR_UNABLE_TO_VERIFY_LEAF_SIGNATURE) 270 (22 :X509_V_ERR_CERT_CHAIN_TOO_LONG) 271 (23 :X509_V_ERR_CERT_REVOKED) 272 (24 :X509_V_ERR_INVALID_CA) 273 (25 :X509_V_ERR_PATH_LENGTH_EXCEEDED) 274 (26 :X509_V_ERR_INVALID_PURPOSE) 275 (27 :X509_V_ERR_CERT_UNTRUSTED) 276 (28 :X509_V_ERR_CERT_REJECTED) 277 (29 :X509_V_ERR_SUBJECT_ISSUER_MISMATCH) 278 (30 :X509_V_ERR_AKID_SKID_MISMATCH) 279 (31 :X509_V_ERR_AKID_ISSUER_SERIAL_MISMATCH) 280 (32 :X509_V_ERR_KEYUSAGE_NO_CERTSIGN) 281 (50 :X509_V_ERR_APPLICATION_VERIFICATION))) 282 283 (defun ssl-verify-error-keyword (code) 284 (cadr (assoc code *ssl-verify-error-alist*))) 285 286 (defun ssl-verify-error-code (keyword) 287 (caar (member keyword *ssl-verify-error-alist* :key #'cadr))) 288 289 (define-condition ssl-error-verify (ssl-error) 290 ((stream :initarg :stream 291 :reader ssl-error-stream 292 :documentation "The SSL stream whose peer certificate didn't verify.") 293 (error-code :initarg :error-code 294 :reader ssl-error-code 295 :documentation "The peer certificate verification error code.")) 296 (:report (lambda (condition stream) 297 (let ((code (ssl-error-code condition))) 298 (format stream "SSL verify error: ~d~@[ ~a~]" 299 code (ssl-verify-error-keyword code))))) 300 (:documentation "This condition is signalled on SSL connection when a peer certificate doesn't verify.")) 301 302 (define-condition ssl-error-call (cl+ssl::ssl-error) 303 ((message :initarg :message)) 304 (:documentation 305 "A failure in the SSL library occurred..") 306 (:report (lambda (condition stream) 307 (format stream "A failure in OpenSSL library occurred~@[: ~A~].~%" (slot-value condition 'message)) (cl+ssl::format-ssl-error-queue stream (cl+ssl::ssl-error-queue condition))))) 308 309 (define-condition asn1-error (cl+ssl-error) 310 () 311 (:documentation "Asn1 syntax error")) 312 313 (define-condition invalid-asn1-string (cl+ssl-error) 314 ((type :initarg :type :initform nil)) 315 (:documentation "ASN.1 string parsing/validation error") 316 (:report (lambda (condition stream) 317 (format stream "ASN.1 syntax error: invalid asn1 string (expected type ~a)" (slot-value condition 'type))))) ;; TODO: when moved to grovel use enum symbol here 318 319 (define-condition server-certificate-missing (cl+ssl-error simple-error) 320 () 321 (:documentation "SSL server didn't present a certificate"))