Coverage report: /home/ellis/.stash/lisp/cl-plus-ssl/src/conditions.lisp

Kind	Covered	All	%
expression	3	322	0.9
branch	0	18	0.0

Key

Not instrumented

Conditionalized out

Executed

Not executed

Both branches taken

One branch taken

Neither branch taken

1

 ;;;; -*- Mode: LISP; Syntax: COMMON-LISP; indent-tabs-mode: nil; coding: utf-8; show-trailing-whitespace: t -*-

2

;;;

3

4

5

;;; "the conditions and ENSURE-SSL-FUNCALL are by Jochen Schmidt."

6

;;; Copyright (C) contributors as per cl+ssl git history

7

;;;

8

;;; See LICENSE for details.

9

10

(in-package :cl+ssl)

11

12

(eval-when (:compile-toplevel :load-toplevel :execute)

13

(defconstant +ssl-error-none+ 0)

14

(defconstant +ssl-error-ssl+ 1)

15

(defconstant +ssl-error-want-read+ 2)

16

(defconstant +ssl-error-want-write+ 3)

17

(defconstant +ssl-error-want-x509-lookup+ 4)

18

(defconstant +ssl-error-syscall+ 5)

19

(defconstant +ssl-error-zero-return+ 6)

20

(defconstant +ssl-error-want-connect+ 7))

21

22

23

;;; Condition hierarchy

24

;;;

25

26

(defun read-ssl-error-queue ()

27

(loop

28

:for error-code = (err-get-error)

29

:until (zerop error-code)

30

:collect error-code))

31

32

(defun format-ssl-error-queue (stream-designator queue-designator)

33

"STREAM-DESIGNATOR is the same as CL:FORMAT accepts: T, NIL, or a stream.

34

QUEUE-DESIGNATOR is either a list of error codes (as returned

35

by READ-SSL-ERROR-QUEUE) or an SSL-ERROR condition."

36

(flet ((body (stream)

37

38

;; If printed-queue is present, just use it

39

(when (and (typep queue-designator 'ssl-error)

40

(printed-queue queue-designator))

41

(format stream "ERR_print_errors(): ~A"

42

(printed-queue queue-designator))

43

(return-from body))

44

45

(let ((queue (etypecase queue-designator

46

(ssl-error (ssl-error-queue queue-designator))

47

(list queue-designator))))

48

(format stream "SSL error queue")

49

(if queue

50

(progn

51

(format stream ":~%")

52

(loop

53

:for error-code :in queue

54

                       :do (format stream "~a~%" (err-error-string error-code (cffi:null-pointer)))))

55

(format stream " is empty.")))))

56

(case stream-designator

57

((t) (body *standard-output*))

58

((nil) (let ((s (make-string-output-stream :element-type 'character)))

59

(unwind-protect

60

(body s)

61

(close s))

62

(get-output-stream-string s)))

63

(otherwise (body stream-designator)))))

64

65

(define-condition cl+ssl-error (error)

66

())

67

68

(define-condition ssl-error (cl+ssl-error)

69

(

70

;; Stores list of error codes

71

;; (as returned by the READ-SSL-ERROR-QUEUE function)

72

(queue :initform nil :initarg :queue :reader ssl-error-queue)

73

74

;; The queue formatted using ERR_print_errors.

75

;; If this value is present, ignore the QUEUE field (which will

76

;; be empty, most likely, because ERR_print_errors cleans the queue).

77

;;

78

;; That's the preferred way, becuase it includes more info

79

;; than the printing we implemented in Lisp. In particualr, in includes

80

;; the optional string added by ERR_add_error_data, which

81

;; we use to provide error details of unexpected lisp errors

82

;; in Lisp BIO. Consider migrating all the code to PRINTED-QUEUE,

83

;; for example, when working on

84

;; https://github.com/cl-plus-ssl/cl-plus-ssl/issues/75.

85

(printed-queue :initform nil

86

:initarg :printed-queue

87

:reader printed-queue)))

88

89

(define-condition ssl-error/handle (ssl-error)

90

(;; Misnamed, better to be called CODE :READER SSL-ERROR-CODE

91

;; becuase OpenSSL docs use the term RET for return

92

;; values of IO calls like SSL_Read, etc, while

93

;; here we store explanation of such failures

94

;; as returned by SSL_get_error called

95

;; after the failure.

96

;; Unfortunately, SSL-ERROR-CODE is already used

97

;; by SSL-ERROR-VERIFY condition class below

98

;; for return values of SSL_get_verify_result,

99

;; and that's already exported from cl+ssl package.

100

;; Using the same generic function for two different

101

;; types of error codes is not the best approach.

102

;; Keeping it as is for now.

103

;; Or maybe the intention was for SSL-SIGNAL-ERROR

104

;; to really pass RET here (the IO call return value)?

105

;; Unlikely, RET is not very useful.

106

(ret :initarg :ret

107

:reader ssl-error-ret

108

:documentation "The error code returned by SSL_get_error. " )

109

(handle :initarg :handle

110

:reader ssl-error-handle))

111

(:documentation "Base condition for lisp wrappers of SSL_get_error return values.")

112

(:report (lambda (condition stream)

113

(format stream "Unspecified error ~A on handle ~A. "

114

(ssl-error-ret condition)

115

(ssl-error-handle condition))

116

(format-ssl-error-queue stream condition))))

117

118

(define-condition ssl-error-initialize (ssl-error)

119

((reason :initarg :reason

120

:reader ssl-error-reason))

121

(:report (lambda (condition stream)

122

(format stream "SSL initialization error: ~A. "

123

(ssl-error-reason condition))

124

(format-ssl-error-queue stream condition))))

125

126

127

(define-condition ssl-error-want-something (ssl-error/handle)

128

())

129

130

;;;SSL_ERROR_NONE

131

(define-condition ssl-error-none (ssl-error/handle)

132

()

133

(:documentation

134

"The TLS/SSL I/O operation completed. This result code is returned if and

135

only if ret > 0.")

136

(:report (lambda (condition stream)

137

              (format stream "The TLS/SSL operation on handle ~A completed (SSL_get_error: ~A). "

138

(ssl-error-handle condition)

139

(ssl-error-ret condition))

140

(format-ssl-error-queue stream condition))))

141

142

;; SSL_ERROR_ZERO_RETURN

143

(define-condition ssl-error-zero-return (ssl-error/handle)

144

()

145

(:documentation

146

"The TLS/SSL connection has been closed. If the protocol version is SSL 3.0

147

or TLS 1.0, this result code is returned only if a closure alert has

148

occurred in the protocol, i.e. if the connection has been closed cleanly.

149

Note that in this case SSL_ERROR_ZERO_RETURN

150

does not necessarily indicate that the underlying transport has been

151

closed.")

152

(:report (lambda (condition stream)

153

              (format stream "The TLS/SSL connection on handle ~A has been closed (SSL_get_error: ~A). "

154

(ssl-error-handle condition)

155

(ssl-error-ret condition))

156

(format-ssl-error-queue stream condition))))

157

158

;; SSL_ERROR_WANT_READ

159

(define-condition ssl-error-want-read (ssl-error-want-something)

160

()

161

(:documentation

162

"The operation did not complete; the same TLS/SSL I/O function should be

163

called again later. If, by then, the underlying BIO has data available for

164

reading (if the result code is SSL_ERROR_WANT_READ) or allows writing data

165

(SSL_ERROR_WANT_WRITE), then some TLS/SSL protocol progress will take place,

166

i.e. at least part of an TLS/SSL record will be read or written. Note that

167

the retry may again lead to a SSL_ERROR_WANT_READ or SSL_ERROR_WANT_WRITE

168

condition. There is no fixed upper limit for the number of iterations that

169

may be necessary until progress becomes visible at application protocol

170

level.")

171

(:report (lambda (condition stream)

172

              (format stream "The TLS/SSL operation on handle ~A did not complete: It wants a READ (SSL_get_error: ~A). "

173

(ssl-error-handle condition)

174

(ssl-error-ret condition))

175

(format-ssl-error-queue stream condition))))

176

177

;; SSL_ERROR_WANT_WRITE

178

(define-condition ssl-error-want-write (ssl-error-want-something)

179

()

180

(:documentation

181

"The operation did not complete; the same TLS/SSL I/O function should be

182

called again later. If, by then, the underlying BIO has data available for

183

reading (if the result code is SSL_ERROR_WANT_READ) or allows writing data

184

(SSL_ERROR_WANT_WRITE), then some TLS/SSL protocol progress will take place,

185

i.e. at least part of an TLS/SSL record will be read or written. Note that

186

the retry may again lead to a SSL_ERROR_WANT_READ or SSL_ERROR_WANT_WRITE

187

condition. There is no fixed upper limit for the number of iterations that

188

may be necessary until progress becomes visible at application protocol

189

level.")

190

(:report (lambda (condition stream)

191

              (format stream "The TLS/SSL operation on handle ~A did not complete: It wants a WRITE (SSL_get_error: ~A). "

192

(ssl-error-handle condition)

193

(ssl-error-ret condition))

194

(format-ssl-error-queue stream condition))))

195

196

;; SSL_ERROR_WANT_CONNECT

197

(define-condition ssl-error-want-connect (ssl-error-want-something)

198

()

199

(:documentation

200

"The operation did not complete; the same TLS/SSL I/O function should be

201

called again later. The underlying BIO was not connected yet to the peer

202

and the call would block in connect()/accept(). The SSL

203

function should be called again when the connection is established. These

204

messages can only appear with a BIO_s_connect() or

205

BIO_s_accept() BIO, respectively. In order to find out, when

206

the connection has been successfully established, on many platforms

207

select() or poll() for writing on the socket file

208

descriptor can be used.")

209

(:report (lambda (condition stream)

210

              (format stream "The TLS/SSL operation on handle ~A did not complete: It wants a connect first (SSL_get_error: ~A). "

211

(ssl-error-handle condition)

212

(ssl-error-ret condition))

213

(format-ssl-error-queue stream condition))))

214

215

;; SSL_ERROR_WANT_X509_LOOKUP

216

(define-condition ssl-error-want-x509-lookup (ssl-error-want-something)

217

()

218

(:documentation

219

"The operation did not complete because an application callback set by

220

SSL_CTX_set_client_cert_cb() has asked to be called again. The

221

TLS/SSL I/O function should be called again later. Details depend on the

222

application.")

223

(:report (lambda (condition stream)

224

              (format stream "The TLS/SSL operation on handle ~A did not complete: An application callback wants to be called again (SSL_get_error: ~A). "

225

(ssl-error-handle condition)

226

(ssl-error-ret condition))

227

(format-ssl-error-queue stream condition))))

228

229

;; SSL_ERROR_SYSCALL

230

(define-condition ssl-error-syscall (ssl-error/handle)

231

((syscall :initarg :syscall))

232

(:documentation

233

"Some I/O error occurred. The OpenSSL error queue may contain more

234

information on the error. If the error queue is empty (i.e. ERR_get_error() returns 0),

235

ret can be used to find out more about the error: If ret == 0, an EOF was observed that

236

violates the protocol. If ret == -1, the underlying BIO reported an I/O error (for socket

237

I/O on Unix systems, consult errno for details).")

238

(:report (lambda (condition stream)

239

(if (zerop (length (ssl-error-queue condition)))

240

(case (ssl-error-ret condition)

241

                    (0 (format stream "An I/O error occurred: An unexpected EOF was observed on handle ~A (SSL_get_error: ~A). "

242

(ssl-error-handle condition)

243

(ssl-error-ret condition)))

244

                    (-1 (format stream "An I/O error occurred in the underlying BIO (SSL_get_error: ~A). "

245

(ssl-error-ret condition)))

246

                    (otherwise (format stream "An I/O error occurred: undocumented reason (SSL_get_error: ~A). "

247

(ssl-error-ret condition))))

248

                  (format stream "An UNKNOWN I/O error occurred in the underlying BIO (SSL_get_error: ~A). "

249

(ssl-error-ret condition)))

250

(format-ssl-error-queue stream condition))))

251

252

;; SSL_ERROR_SSL

253

(define-condition ssl-error-ssl (ssl-error/handle)

254

((;; When SSL_Connect or SSL_Accept fail due to

255

;; the SSL_VERIFY_PEER flag and bad peer certificate,

256

;; the error queue simply says "certificate verify failed"

257

;; and the user needs to call SSL_get_verify_result

258

;; to find our the exact verification error (expired cert,

259

;; can't get issuer cert locally, etc).

260

;;

261

;; To facilitate debugging and logging, we

262

;; automaticall store the SSL_get_verify_result

263

;; in this slot and use it in the printed

264

;; representation of the condition.

265

;;

266

;; Ideally, we should only collect the verification

267

;; error if the error queue includes reason code

268

;; SSL_R_CERTIFICATE_VERIFY_FAILED for library

269

;; code ERR_LIB_SSL, but this would require

270

;; us to implement the logic of OpenSSL macros

271

;; ERR_raise, ERR_PACK, taking OpenSSL version into

272

;; account - those macros produce different number

273

;; for that reason code in different OpenSSL versions.

274

;; Here are snippets of printed error queues, starting

275

;; with error code:

276

;; openssl-0.9.8zh

277

;; 14090086:SSL routines:SSL3_GET_SERVER_CERTIFICATE:certificate verify failed:s3_clnt.c:973:

278

;; openssl-1.1.1p

279

     ;;     1416F086:SSL routines:tls_process_server_certificate:certificate verify failed:ssl/statem/statem_clnt.c:1919:

280

;; openssl-3.0.4

281

     ;;     0A000086:SSL routines:tls_post_process_server_certificate:certificate verify failed:ssl/statem/statem_clnt.c:1887:

282

;; Therefore we simply collect the verification

283

;; error if it is present at the time of SSL_Connect

284

;; or SSL_Accept failure - see how the

285

;; collecting-verify-error macro is used.

286

;; This approach, however, will not collect verification

287

;; error if it happens not on the initial handshake,

288

;; but during session renegotiation.

289

verify-error :type (or null string)

290

:initform nil

291

:accessor ssl-error-ssl-verify-error))

292

(:documentation

293

"A failure in the SSL library occurred, usually a protocol error. The

294

OpenSSL error queue contains more information on the error.")

295

(:report (lambda (condition stream)

296

(format stream

297

                      "A failure in the SSL library occurred on handle ~A (SSL_get_error: ~A). "

298

(ssl-error-handle condition)

299

(ssl-error-ret condition))

300

(format-ssl-error-queue stream condition)

301

(when (ssl-error-ssl-verify-error condition)

302

(format stream

303

"~A"

304

(ssl-error-ssl-verify-error condition))))))

305

306

(defun collect-verify-error (ssl-error-ssl-condition handle)

307

(let ((code (ssl-get-verify-result handle)))

308

(unless (eql code +x509-v-ok+)

309

(setf (ssl-error-ssl-verify-error ssl-error-ssl-condition)

310

(format nil "SSL_get_verify_result: ~d~@[ ~a~]"

311

code (ssl-verify-error-keyword code))))))

312

313

(defun collecting-verify-error-impl (handle body-fn)

314

(handler-bind ((ssl-error-ssl (lambda (c)

315

(collect-verify-error c handle))))

316

(funcall body-fn)))

317

318

(defmacro collecting-verify-error ((handle) &body body)

319

`(collecting-verify-error-impl ,handle (lambda () ,@body)))

320

321

(defun err-print-errors-to-string ()

322

(with-bio-output-to-string (bio)

323

(err-print-errors bio)))

324

325

(defun ssl-signal-error (handle syscall error-code ret)

326

"RET is return value of the failed SYSCALL (like SSL_read, SSL_connect,

327

SSL_shutdown, etc - most of them designate failure by returning

328

RET <= 0, althought SSL_shutdow fails with RET < 0.

329

330

ERROR-CODE is return value of SSL_get_error - an explanation of the failure.

331

"

332

(let ((printed-queue (err-print-errors-to-string))

333

;; FixMe: the error queue is emptied by (err-print-errors-to-string)

334

;; above so the QUEUE becomes an empty list.

335

(queue (read-ssl-error-queue)))

336

;; BAD: The IF below is responsible to represent the "Unexpected EOF"

337

;; situation, which is when the remote peer closes

338

;; TCP connection without sending TLS close_notify alert,

339

;; as a situation of normal close_notify alert received.

340

;;

341

;; OpenSSL before version 3.0 signals the Unexpected EOF

342

;; as error-code = SSL_ERROR_SYSCALL and ret = 0.

343

;; Normal termination is signalled by error-code = SSL_ERROR_ZERO_RETURN.

344

;;

345

;; As you see below, the IF turns the former into the latter.

346

;;

347

;; We should not suppress the Unexpected EOF error, because

348

;; some protocols on top of TLS may be attacked with TLS truncation

349

;; attack. For example HTTP 0.9, where response size is not specified

350

;; by the server but instead end of message is indicated by server closing

351

;; the connection.

352

;;

353

;; In such protocols a malicious middle-man can insert an unencrypted

354

;; TCP FIN packet, thus giving the client a partial response. OpenSSL treats

355

;; this as an Unexpected EOF error, but cl+ssl turns it into

356

;; the ssl-error-zero-return condition, which is then internally

357

;; converted simply to an end of ssl-stream. Thus the user will treat

358

;; the truncated response as authoritative and complete.

359

;;

360

;; Since OpenSSL 3.0 the suppression does not happen

361

;; and cl+ssl user receives an error condition, because

362

;; the Unexpected EOF is reported as error-code = SSL_ERROR_SSL.

363

;;

364

;; The only reason we currently keep this not fixed for older OpenSSL

365

;; is potential backwards compatibility problems with existing

366

;; Common Lisp libraries and applications and the fact

367

;; that protocols where message sizes are usually

368

;; explicitly indicated (like HTTP 1.1 where Content-Length or

369

;; chunked encoding are used) truncation can be detected

370

;; without relying to TLS and thus some servers close TCP

371

;; connections without sending TLS close_notify alert.

372

;; Some libraries or applications may be relying onto

373

;; silent end of stream after full message is received

374

;; according to the size indicated by the protocol.

375

;;

376

;; See one example of this, discussion and links in

377

;; https://github.com/cl-plus-ssl/cl-plus-ssl/issues/166

378

(if (and (eql error-code #.+ssl-error-syscall+)

379

(not (zerop ret)))

380

(error 'ssl-error-syscall

381

:handle handle

382

:ret error-code

383

:printed-queue printed-queue

384

:queue queue

385

:syscall syscall)

386

(error (case error-code

387

(#.+ssl-error-none+ 'ssl-error-none)

388

(#.+ssl-error-ssl+ 'ssl-error-ssl)

389

(#.+ssl-error-want-read+ 'ssl-error-want-read)

390

(#.+ssl-error-want-write+ 'ssl-error-want-write)

391

(#.+ssl-error-want-x509-lookup+ 'ssl-error-want-x509-lookup)

392

(#.+ssl-error-zero-return+ 'ssl-error-zero-return)

393

(#.+ssl-error-want-connect+ 'ssl-error-want-connect)

394

                  (#.+ssl-error-syscall+ 'ssl-error-zero-return) ; this is intentional here. we got an EOF from the syscall (ret is 0)

395

(t 'ssl-error/handle))

396

:handle handle

397

:ret error-code

398

:printed-queue printed-queue

399

:queue queue))))

400

401

(defparameter *ssl-verify-error-alist*

402

'((0 :X509_V_OK)

403

(2 :X509_V_ERR_UNABLE_TO_GET_ISSUER_CERT)

404

(3 :X509_V_ERR_UNABLE_TO_GET_CRL)

405

(4 :X509_V_ERR_UNABLE_TO_DECRYPT_CERT_SIGNATURE)

406

(5 :X509_V_ERR_UNABLE_TO_DECRYPT_CRL_SIGNATURE)

407

(6 :X509_V_ERR_UNABLE_TO_DECODE_ISSUER_PUBLIC_KEY)

408

(7 :X509_V_ERR_CERT_SIGNATURE_FAILURE)

409

(8 :X509_V_ERR_CRL_SIGNATURE_FAILURE)

410

(9 :X509_V_ERR_CERT_NOT_YET_VALID)

411

(10 :X509_V_ERR_CERT_HAS_EXPIRED)

412

(11 :X509_V_ERR_CRL_NOT_YET_VALID)

413

(12 :X509_V_ERR_CRL_HAS_EXPIRED)

414

(13 :X509_V_ERR_ERROR_IN_CERT_NOT_BEFORE_FIELD)

415

(14 :X509_V_ERR_ERROR_IN_CERT_NOT_AFTER_FIELD)

416

(15 :X509_V_ERR_ERROR_IN_CRL_LAST_UPDATE_FIELD)

417

(16 :X509_V_ERR_ERROR_IN_CRL_NEXT_UPDATE_FIELD)

418

(17 :X509_V_ERR_OUT_OF_MEM)

419

(18 :X509_V_ERR_DEPTH_ZERO_SELF_SIGNED_CERT)

420

(19 :X509_V_ERR_SELF_SIGNED_CERT_IN_CHAIN)

421

(20 :X509_V_ERR_UNABLE_TO_GET_ISSUER_CERT_LOCALLY)

422

(21 :X509_V_ERR_UNABLE_TO_VERIFY_LEAF_SIGNATURE)

423

(22 :X509_V_ERR_CERT_CHAIN_TOO_LONG)

424

(23 :X509_V_ERR_CERT_REVOKED)

425

(24 :X509_V_ERR_INVALID_CA)

426

(25 :X509_V_ERR_PATH_LENGTH_EXCEEDED)

427

(26 :X509_V_ERR_INVALID_PURPOSE)

428

(27 :X509_V_ERR_CERT_UNTRUSTED)

429

(28 :X509_V_ERR_CERT_REJECTED)

430

(29 :X509_V_ERR_SUBJECT_ISSUER_MISMATCH)

431

(30 :X509_V_ERR_AKID_SKID_MISMATCH)

432

(31 :X509_V_ERR_AKID_ISSUER_SERIAL_MISMATCH)

433

(32 :X509_V_ERR_KEYUSAGE_NO_CERTSIGN)

434

(50 :X509_V_ERR_APPLICATION_VERIFICATION)))

435

436

(defun ssl-verify-error-keyword (code)

437

(cadr (assoc code *ssl-verify-error-alist*)))

438

439

(defun ssl-verify-error-code (keyword)

440

(caar (member keyword *ssl-verify-error-alist* :key #'cadr)))

441

442

(define-condition ssl-error-verify (ssl-error)

443

((stream :initarg :stream

444

:reader ssl-error-stream

445

:documentation "The SSL stream whose peer certificate didn't verify.")

446

(error-code :initarg :error-code

447

:reader ssl-error-code

448

:documentation "The peer certificate verification error code

449

(as returned by functions like SSL_get_verify_result or X509_STORE_CTX_get_error)."))

450

(:report (lambda (condition stream)

451

(let ((code (ssl-error-code condition)))

452

(format stream "SSL verify error: ~d~@[ ~a~]"

453

code (ssl-verify-error-keyword code)))))

454

   (:documentation "This condition is signalled on SSL connection when a peer certificate doesn't verify."))

455

456

(define-condition ssl-error-call (ssl-error)

457

((message :initarg :message))

458

(:documentation

459

"A failure in the SSL library occurred..")

460

(:report (lambda (condition stream)

461

(format stream "A failure in OpenSSL library occurred~@[: ~A~]. "

462

(slot-value condition 'message))

463

(format-ssl-error-queue stream condition))))

464

465

(define-condition asn1-error (cl+ssl-error)

466

()

467

(:documentation "Asn1 syntax error"))

468

469

(define-condition invalid-asn1-string (cl+ssl-error)

470

((type :initarg :type :initform nil))

471

(:documentation "ASN.1 string parsing/validation error")

472

(:report (lambda (condition stream)

473

              (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

474

475

(define-condition server-certificate-missing (cl+ssl-error simple-error)

476

()

477

(:documentation "SSL server didn't present a certificate"))