Index: generic/tls.c
==================================================================
--- generic/tls.c
+++ generic/tls.c
@@ -112,25 +112,30 @@
*-------------------------------------------------------------------
*/
static int
EvalCallback(Tcl_Interp *interp, State *statePtr, Tcl_Obj *cmdPtr) {
int code, ok = 0;
+
+ dprintf("Called");
Tcl_Preserve((ClientData) interp);
Tcl_Preserve((ClientData) statePtr);
/* Eval callback with success for ok or return value 1, fail for error or return value 0 */
Tcl_ResetResult(interp);
code = Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL);
+ dprintf("EvalCallback: %d", code);
if (code == TCL_OK) {
/* Check result for return value */
Tcl_Obj *result = Tcl_GetObjResult(interp);
if (result == NULL || Tcl_GetIntFromObj(interp, result, &ok) != TCL_OK) {
ok = 1;
}
+ dprintf("Result: %d", ok);
} else {
/* Error - reject the certificate */
+ dprintf("Tcl_BackgroundError");
#if (TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION < 6)
Tcl_BackgroundError(interp);
#else
Tcl_BackgroundException(interp, code);
#endif
@@ -364,28 +369,32 @@
*-------------------------------------------------------------------
*/
static int
VerifyCallback(int ok, X509_STORE_CTX *ctx) {
Tcl_Obj *cmdPtr;
- SSL *ssl = (SSL*)X509_STORE_CTX_get_ex_data(ctx, SSL_get_ex_data_X509_STORE_CTX_idx());
+ SSL *ssl = (SSL*)X509_STORE_CTX_get_ex_data(ctx, SSL_get_ex_data_X509_STORE_CTX_idx());
X509 *cert = X509_STORE_CTX_get_current_cert(ctx);
State *statePtr = (State*)SSL_get_app_data(ssl);
Tcl_Interp *interp = statePtr->interp;
int depth = X509_STORE_CTX_get_error_depth(ctx);
int err = X509_STORE_CTX_get_error(ctx);
- dprintf("Verify: %d", ok);
+ dprintf("Called");
+ dprintf("VerifyCallback: %d", ok);
if (statePtr->vcmd == (Tcl_Obj*)NULL) {
+ /* Use ok value if verification is required */
if (statePtr->vflags & SSL_VERIFY_FAIL_IF_NO_PEER_CERT) {
return ok;
} else {
return 1;
}
} else if (cert == NULL || ssl == NULL) {
return 0;
}
+
+ dprintf("VerifyCallback: eval callback");
/* Create command to eval */
cmdPtr = Tcl_DuplicateObj(statePtr->vcmd);
Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("verify", -1));
Tcl_ListObjAppendElement(interp, cmdPtr,
@@ -401,10 +410,12 @@
/* Eval callback command */
Tcl_IncrRefCount(cmdPtr);
ok = EvalCallback(interp, statePtr, cmdPtr);
Tcl_DecrRefCount(cmdPtr);
+
+ dprintf("VerifyCallback: command result = %d", ok);
/* statePtr->flags &= ~(TLS_TCL_CALLBACK); */
return(ok); /* By default, leave verification unchanged. */
}
@@ -975,23 +986,19 @@
if (ret < 0 && ((statePtr->flags & TLS_TCL_ASYNC) && (err == EAGAIN))) {
dprintf("Async set and err = EAGAIN");
ret = 0;
} else if (ret < 0) {
- long result;
errStr = statePtr->err;
Tcl_ResetResult(interp);
Tcl_SetErrno(err);
if (!errStr || (*errStr == 0)) {
errStr = Tcl_PosixError(interp);
}
Tcl_AppendResult(interp, "handshake failed: ", errStr, (char *) NULL);
- if ((result = SSL_get_verify_result(statePtr->ssl)) != X509_V_OK) {
- Tcl_AppendResult(interp, " due to: ", X509_verify_cert_error_string(result), (char *) NULL);
- }
Tcl_SetErrorCode(interp, "TLS", "HANDSHAKE", "FAILED", (char *) NULL);
dprintf("Returning TCL_ERROR with handshake failed: %s", errStr);
return(TCL_ERROR);
} else {
if (err != 0) {
@@ -1304,11 +1311,12 @@
Tcl_GetChannelOption(interp, chan, "-translation", &upperChannelTranslation);
Tcl_GetChannelOption(interp, chan, "-blocking", &upperChannelBlocking);
Tcl_SetChannelOption(interp, chan, "-translation", "binary");
Tcl_SetChannelOption(interp, chan, "-blocking", "true");
dprintf("Consuming Tcl channel %s", Tcl_GetChannelName(chan));
- statePtr->self = Tcl_StackChannel(interp, Tls_ChannelType(), (ClientData) statePtr, (TCL_READABLE | TCL_WRITABLE), chan);
+ statePtr->self = Tcl_StackChannel(interp, Tls_ChannelType(), (ClientData) statePtr,
+ (TCL_READABLE | TCL_WRITABLE), chan);
dprintf("Created channel named %s", Tcl_GetChannelName(statePtr->self));
if (statePtr->self == (Tcl_Channel) NULL) {
/*
* No use of Tcl_EventuallyFree because no possible Tcl_Preserve.
*/
@@ -1325,11 +1333,11 @@
* SSL Initialization
*/
statePtr->ssl = SSL_new(statePtr->ctx);
if (!statePtr->ssl) {
/* SSL library error */
- Tcl_AppendResult(interp, "couldn't construct ssl session: ", REASON(), (char *) NULL);
+ Tcl_AppendResult(interp, "couldn't construct ssl session: ", GET_ERR_REASON(), (char *) NULL);
Tcl_SetErrorCode(interp, "TLS", "IMPORT", "INIT", "FAILED", (char *) NULL);
Tls_Free((char *) statePtr);
return TCL_ERROR;
}
@@ -1336,20 +1344,20 @@
/* Set host server name */
if (servername) {
/* Sets the server name indication (SNI) in ClientHello extension */
/* Per RFC 6066, hostname is a ASCII encoded string, though RFC 4366 says UTF-8. */
if (!SSL_set_tlsext_host_name(statePtr->ssl, servername) && require) {
- Tcl_AppendResult(interp, "setting TLS host name extension failed", (char *) NULL);
+ Tcl_AppendResult(interp, "Set SNI extension failed: ", GET_ERR_REASON(), (char *) NULL);
Tcl_SetErrorCode(interp, "TLS", "IMPORT", "SNI", "FAILED", (char *) NULL);
Tls_Free((char *) statePtr);
return TCL_ERROR;
}
/* Set hostname for peer certificate hostname verification in clients.
Don't use SSL_set1_host since it has limitations. */
if (!SSL_add1_host(statePtr->ssl, servername)) {
- Tcl_AppendResult(interp, "setting DNS host name failed", (char *) NULL);
+ Tcl_AppendResult(interp, "Set DNS hostname failed: ", GET_ERR_REASON(), (char *) NULL);
Tcl_SetErrorCode(interp, "TLS", "IMPORT", "HOSTNAME", "FAILED", (char *) NULL);
Tls_Free((char *) statePtr);
return TCL_ERROR;
}
}
@@ -1356,11 +1364,11 @@
/* Resume session id */
if (session_id && sess_len <= SSL_MAX_SID_CTX_LENGTH) {
/* SSL_set_session() */
if (!SSL_SESSION_set1_id_context(SSL_get_session(statePtr->ssl), session_id, (unsigned int) sess_len)) {
- Tcl_AppendResult(interp, "Resume session id ", session_id, " failed", (char *) NULL);
+ Tcl_AppendResult(interp, "Resume session failed: ", GET_ERR_REASON(), (char *) NULL);
Tcl_SetErrorCode(interp, "TLS", "IMPORT", "SESSION", "FAILED", (char *) NULL);
Tls_Free((char *) statePtr);
return TCL_ERROR;
}
}
@@ -1382,11 +1390,11 @@
/* Determine the memory required for the protocol-list */
for (i = 0; i < cnt; i++) {
Tcl_GetStringFromObj(list[i], &len);
if (len > 255) {
- Tcl_AppendResult(interp, "ALPN protocol name too long", (char *) NULL);
+ Tcl_AppendResult(interp, "ALPN protocol names too long", (char *) NULL);
Tcl_SetErrorCode(interp, "TLS", "IMPORT", "ALPN", "FAILED", (char *) NULL);
Tls_Free((char *) statePtr);
return TCL_ERROR;
}
protos_len += 1 + (int) len;
@@ -1403,11 +1411,11 @@
}
/* SSL_set_alpn_protos makes a copy of the protocol-list */
/* Note: This functions reverses the return value convention */
if (SSL_set_alpn_protos(statePtr->ssl, protos, protos_len)) {
- Tcl_AppendResult(interp, "failed to set ALPN protocols", (char *) NULL);
+ Tcl_AppendResult(interp, "Set ALPN protocols failed: ", GET_ERR_REASON(), (char *) NULL);
Tcl_SetErrorCode(interp, "TLS", "IMPORT", "ALPN", "FAILED", (char *) NULL);
Tls_Free((char *) statePtr);
ckfree(protos);
return TCL_ERROR;
}
@@ -1770,11 +1778,11 @@
DH_free(dh);
} else {
/* Use well known DH parameters that have built-in support in OpenSSL */
if (!SSL_CTX_set_dh_auto(ctx, 1)) {
- Tcl_AppendResult(interp, "Could not enable set DH auto: ", REASON(), (char *) NULL);
+ Tcl_AppendResult(interp, "Could not enable set DH auto: ", GET_ERR_REASON(), (char *) NULL);
SSL_CTX_free(ctx);
return NULL;
}
}
}
@@ -1788,20 +1796,20 @@
Tcl_DStringInit(&ds);
if (SSL_CTX_use_certificate_file(ctx, F2N(certfile, &ds), SSL_FILETYPE_PEM) <= 0) {
Tcl_DStringFree(&ds);
Tcl_AppendResult(interp, "unable to set certificate file ", certfile, ": ",
- REASON(), (char *) NULL);
+ GET_ERR_REASON(), (char *) NULL);
SSL_CTX_free(ctx);
return NULL;
}
} else if (cert != NULL) {
load_private_key = 1;
if (SSL_CTX_use_certificate_ASN1(ctx, cert_len, cert) <= 0) {
Tcl_DStringFree(&ds);
Tcl_AppendResult(interp, "unable to set certificate: ",
- REASON(), (char *) NULL);
+ GET_ERR_REASON(), (char *) NULL);
SSL_CTX_free(ctx);
return NULL;
}
} else {
certfile = (char*)X509_get_default_cert_file();
@@ -1808,11 +1816,11 @@
if (SSL_CTX_use_certificate_file(ctx, certfile, SSL_FILETYPE_PEM) <= 0) {
#if 0
Tcl_DStringFree(&ds);
Tcl_AppendResult(interp, "unable to use default certificate file ", certfile, ": ",
- REASON(), (char *) NULL);
+ GET_ERR_REASON(), (char *) NULL);
SSL_CTX_free(ctx);
return NULL;
#endif
}
}
@@ -1832,11 +1840,11 @@
if (SSL_CTX_use_PrivateKey_file(ctx, F2N(keyfile, &ds), SSL_FILETYPE_PEM) <= 0) {
Tcl_DStringFree(&ds);
/* flush the passphrase which might be left in the result */
Tcl_SetResult(interp, NULL, TCL_STATIC);
Tcl_AppendResult(interp, "unable to set public key file ", keyfile, " ",
- REASON(), (char *) NULL);
+ GET_ERR_REASON(), (char *) NULL);
SSL_CTX_free(ctx);
return NULL;
}
Tcl_DStringFree(&ds);
@@ -1843,11 +1851,11 @@
} else if (key != NULL) {
if (SSL_CTX_use_PrivateKey_ASN1(EVP_PKEY_RSA, ctx, key,key_len) <= 0) {
Tcl_DStringFree(&ds);
/* flush the passphrase which might be left in the result */
Tcl_SetResult(interp, NULL, TCL_STATIC);
- Tcl_AppendResult(interp, "unable to set public key: ", REASON(), (char *) NULL);
+ Tcl_AppendResult(interp, "unable to set public key: ", GET_ERR_REASON(), (char *) NULL);
SSL_CTX_free(ctx);
return NULL;
}
}
/* Now we know that a key and cert have been set against
@@ -1873,11 +1881,11 @@
!SSL_CTX_set_default_verify_paths(ctx)) {
#if 0
Tcl_DStringFree(&ds);
Tcl_DStringFree(&ds1);
/* Don't currently care if this fails */
- Tcl_AppendResult(interp, "SSL default verify paths: ", REASON(), (char *) NULL);
+ Tcl_AppendResult(interp, "SSL default verify paths: ", GET_ERR_REASON(), (char *) NULL);
SSL_CTX_free(ctx);
return NULL;
#endif
}
Index: generic/tlsBIO.c
==================================================================
--- generic/tlsBIO.c
+++ generic/tlsBIO.c
@@ -1,13 +1,14 @@
/*
* Copyright (C) 1997-2000 Matt Newman <matt@novadigm.com>
*
- * Provides BIO layer to interface openssl to Tcl.
+ * Provides BIO layer to interface OpenSSL to TCL.
*/
#include "tlsInt.h"
+/* Called by SSL_write() */
static int BioWrite(BIO *bio, const char *buf, int bufLen) {
Tcl_Channel chan;
Tcl_Size ret;
int tclEofChan, tclErrno;
@@ -19,11 +20,11 @@
tclEofChan = Tcl_Eof(chan);
tclErrno = Tcl_GetErrno();
dprintf("[chan=%p] BioWrite(%d) -> %" TCL_SIZE_MODIFIER "d [tclEof=%d; tclErrno=%d]",
- (void *) chan, bufLen, ret, tclEofChan, Tcl_GetErrno());
+ (void *) chan, bufLen, ret, tclEofChan, tclErrno);
BIO_clear_flags(bio, BIO_FLAGS_WRITE | BIO_FLAGS_SHOULD_RETRY);
if (tclEofChan && ret <= 0) {
dprintf("Got EOF while reading, returning a Connection Reset error which maps to Soft EOF");
@@ -43,11 +44,11 @@
} else {
dprintf("It's an unexpected error: %s/%i", Tcl_ErrnoMsg(tclErrno), tclErrno);
}
} else {
- dprintf("Successfully wrote some data");
+ dprintf("Successfully wrote %" TCL_SIZE_MODIFIER "d bytes of data", ret);
}
if (ret != -1 || (ret == -1 && tclErrno == EAGAIN)) {
if (BIO_should_read(bio)) {
dprintf("Setting should retry read flag");
@@ -56,10 +57,11 @@
}
}
return((int) ret);
}
+/* Called by SSL_read()*/
static int BioRead(BIO *bio, char *buf, int bufLen) {
Tcl_Channel chan;
Tcl_Size ret = 0;
int tclEofChan, tclErrno;
@@ -99,11 +101,11 @@
} else {
dprintf("It's an unexpected error: %s/%i", Tcl_ErrnoMsg(tclErrno), tclErrno);
}
} else {
- dprintf("Successfully read some data");
+ dprintf("Successfully read %" TCL_SIZE_MODIFIER "d bytes of data", ret);
}
if (ret != -1 || (ret == -1 && tclErrno == EAGAIN)) {
if (BIO_should_write(bio)) {
dprintf("Setting should retry write flag");
@@ -119,11 +121,11 @@
}
static int BioPuts(BIO *bio, const char *str) {
dprintf("BioPuts(%p, <string:%p>) called", bio, str);
- return BioWrite(bio, str, (int) strlen(str));
+ return(BioWrite(bio, str, (int) strlen(str)));
}
static long BioCtrl(BIO *bio, int cmd, long num, void *ptr) {
Tcl_Channel chan;
long ret = 1;
Index: generic/tlsDigest.c
==================================================================
--- generic/tlsDigest.c
+++ generic/tlsDigest.c
@@ -209,11 +209,11 @@
res = CMAC_Init(statePtr->cctx, key, (int) key_len, cipher, NULL);
break;
}
if (!res) {
- Tcl_AppendResult(interp, "Initialize failed: ", REASON(), (char *) NULL);
+ Tcl_AppendResult(interp, "Initialize failed: ", GET_ERR_REASON(), (char *) NULL);
return TCL_ERROR;
}
return TCL_OK;
}
@@ -249,11 +249,11 @@
res = CMAC_Update(statePtr->cctx, buf, (size_t) read);
break;
}
if (!res && do_result) {
- Tcl_AppendResult(statePtr->interp, "Update failed: ", REASON(), (char *) NULL);
+ Tcl_AppendResult(statePtr->interp, "Update failed: ", GET_ERR_REASON(), (char *) NULL);
return TCL_ERROR;
}
return TCL_OK;
}
@@ -302,11 +302,11 @@
break;
}
if (!res) {
if (resultObj == NULL) {
- Tcl_AppendResult(interp, "Finalize failed: ", REASON(), (char *) NULL);
+ Tcl_AppendResult(interp, "Finalize failed: ", GET_ERR_REASON(), (char *) NULL);
}
return TCL_ERROR;
}
/* Return message digest as either a binary or hex string */
@@ -457,11 +457,11 @@
/* Update hash function */
if (read > 0) {
/* Have data */
if (DigestUpdate(statePtr, buf, read, 0) != TCL_OK) {
- Tcl_SetChannelError(statePtr->self, Tcl_ObjPrintf("Update failed: %s", REASON()));
+ Tcl_SetChannelError(statePtr->self, Tcl_ObjPrintf("Update failed: %s", GET_ERR_REASON()));
*errorCodePtr = EINVAL;
return 0;
}
/* This is correct */
read = -1;
@@ -478,11 +478,11 @@
unsigned char *data = Tcl_GetByteArrayFromObj(resultObj, &read);
memcpy(buf, data, (int) read);
Tcl_DecrRefCount(resultObj);
} else {
- Tcl_SetChannelError(statePtr->self, Tcl_ObjPrintf("Finalize failed: %s", REASON()));
+ Tcl_SetChannelError(statePtr->self, Tcl_ObjPrintf("Finalize failed: %s", GET_ERR_REASON()));
*errorCodePtr = EINVAL;
read = 0;
}
statePtr->flags |= CHAN_EOF;
}
@@ -515,11 +515,11 @@
return 0;
}
/* Update hash function */
if (DigestUpdate(statePtr, buf, (Tcl_Size) toWrite, 0) != TCL_OK) {
- Tcl_SetChannelError(statePtr->self, Tcl_ObjPrintf("Update failed: %s", REASON()));
+ Tcl_SetChannelError(statePtr->self, Tcl_ObjPrintf("Update failed: %s", GET_ERR_REASON()));
*errorCodePtr = EINVAL;
return 0;
}
return toWrite;
}
Index: generic/tlsEncrypt.c
==================================================================
--- generic/tlsEncrypt.c
+++ generic/tlsEncrypt.c
@@ -186,11 +186,11 @@
} else {
res = EVP_DecryptInit_ex(*ctx, cipher, NULL, key, iv);
}
if(!res) {
- Tcl_AppendResult(interp, "Initialize failed: ", REASON(), (char *) NULL);
+ Tcl_AppendResult(interp, "Initialize failed: ", GET_ERR_REASON(), (char *) NULL);
return TCL_ERROR;
}
/* Erase buffers */
memset(key, 0, EVP_MAX_KEY_LENGTH);
@@ -227,11 +227,11 @@
}
if (res) {
return TCL_OK;
} else {
- Tcl_AppendResult(interp, "Update failed: ", REASON(), (char *) NULL);
+ Tcl_AppendResult(interp, "Update failed: ", GET_ERR_REASON(), (char *) NULL);
return TCL_ERROR;
}
}
/*
@@ -264,11 +264,11 @@
}
if (res) {
return TCL_OK;
} else {
- Tcl_AppendResult(interp, "Finalize failed: ", REASON(), (char *) NULL);
+ Tcl_AppendResult(interp, "Finalize failed: ", GET_ERR_REASON(), (char *) NULL);
return TCL_ERROR;
}
}
/*******************************************************************/
@@ -408,11 +408,11 @@
} else {
*errorCodePtr = EAGAIN;
read = -1;
}
} else {
- Tcl_SetChannelError(statePtr->self, Tcl_ObjPrintf("Update failed: %s", REASON()));
+ Tcl_SetChannelError(statePtr->self, Tcl_ObjPrintf("Update failed: %s", GET_ERR_REASON()));
*errorCodePtr = EINVAL;
read = 0;
}
} else if (read < 0) {
@@ -422,11 +422,11 @@
} else if (!(statePtr->flags & CHAN_EOF)) {
/* EOF - Finalize function and put any remaining data in buf */
if (EncryptFinalize(statePtr->interp, statePtr->type, statePtr->ctx, buf, &out_len) == TCL_OK) {
read = (Tcl_Size) out_len;
} else {
- Tcl_SetChannelError(statePtr->self, Tcl_ObjPrintf("Finalize failed: %s", REASON()));
+ Tcl_SetChannelError(statePtr->self, Tcl_ObjPrintf("Finalize failed: %s", GET_ERR_REASON()));
*errorCodePtr = EINVAL;
read = 0;
}
statePtr->flags |= CHAN_EOF;
@@ -476,11 +476,11 @@
*errorCodePtr = EAGAIN;
write = -1;
}
} else {
- Tcl_SetChannelError(statePtr->self, Tcl_ObjPrintf("Update failed: %s", REASON()));
+ Tcl_SetChannelError(statePtr->self, Tcl_ObjPrintf("Update failed: %s", GET_ERR_REASON()));
*errorCodePtr = EINVAL;
write = 0;
}
Tcl_Free(out_buf);
return write;
Index: generic/tlsIO.c
==================================================================
--- generic/tlsIO.c
+++ generic/tlsIO.c
@@ -133,14 +133,17 @@
*errorCodePtr = ECONNABORTED;
} else {
dprintf("Asked to wait for a TLS handshake that has already failed. Returning soft error");
*errorCodePtr = ECONNRESET;
}
+ Tls_Error(statePtr, "Wait for failed handshake");
return(-1);
}
for (;;) {
+ ERR_clear_error();
+
/* Not initialized yet! Also calls SSL_do_handshake. */
if (statePtr->flags & TLS_TCL_SERVER) {
dprintf("Calling SSL_accept()");
err = SSL_accept(statePtr->ssl);
@@ -148,22 +151,25 @@
dprintf("Calling SSL_connect()");
err = SSL_connect(statePtr->ssl);
}
if (err > 0) {
- dprintf("That seems to have gone okay");
-
+ dprintf("Accept or connect was successful");
err = BIO_flush(statePtr->bio);
if (err <= 0) {
dprintf("Flushing the lower layers failed, this will probably terminate this session");
}
+ } else {
+ dprintf("Accept or connect failed");
}
rc = SSL_get_error(statePtr->ssl, err);
-
- dprintf("Got error: %i (rc = %i)", err, rc);
- dprintf("Got error: %s", REASON());
+ backingError = ERR_get_error();
+ if (rc != SSL_ERROR_NONE) {
+ dprintf("Got error: %i (rc = %i)", err, rc);
+ dprintf("Got error: %s", GET_ERR_REASON());
+ }
bioShouldRetry = 0;
if (err <= 0) {
if (rc == SSL_ERROR_WANT_CONNECT || rc == SSL_ERROR_WANT_ACCEPT || rc == SSL_ERROR_WANT_READ || rc == SSL_ERROR_WANT_WRITE) {
bioShouldRetry = 1;
@@ -181,16 +187,14 @@
if (bioShouldRetry) {
dprintf("The I/O did not complete -- but we should try it again");
if (statePtr->flags & TLS_TCL_ASYNC) {
dprintf("Returning EAGAIN so that it can be retried later");
-
*errorCodePtr = EAGAIN;
return(-1);
} else {
dprintf("Doing so now");
-
continue;
}
}
dprintf("We have either completely established the session or completely failed it -- there is no more need to ever retry it though");
@@ -197,73 +201,79 @@
break;
}
switch (rc) {
case SSL_ERROR_NONE:
- /* The connection is up, we are done here */
- dprintf("The connection is up");
+ /* The TLS/SSL I/O operation completed */
+ dprintf("The connection is good");
*errorCodePtr = 0;
break;
+
case SSL_ERROR_ZERO_RETURN:
+ /* The TLS/SSL peer has closed the connection for writing by sending the close_notify alert */
dprintf("SSL_ERROR_ZERO_RETURN: Connect returned an invalid value...");
*errorCodePtr = EINVAL;
+ Tls_Error(statePtr, "Peer has closed the connection for writing by sending the close_notify alert");
return(-1);
+
case SSL_ERROR_SYSCALL:
- backingError = ERR_get_error();
-
+ /* Some non-recoverable, fatal I/O error occurred */
+ dprintf("SSL_ERROR_SYSCALL");
if (backingError == 0 && err == 0) {
dprintf("EOF reached")
*errorCodePtr = ECONNRESET;
+ Tls_Error(statePtr, "(unexpected) EOF reached");
+
} else if (backingError == 0 && err == -1) {
dprintf("I/O error occurred (errno = %lu)", (unsigned long) Tcl_GetErrno());
*errorCodePtr = Tcl_GetErrno();
if (*errorCodePtr == ECONNRESET) {
*errorCodePtr = ECONNABORTED;
}
+ Tls_Error(statePtr, Tcl_ErrnoMsg(Tcl_GetErrno()));
+
} else {
dprintf("I/O error occurred (backingError = %lu)", backingError);
*errorCodePtr = backingError;
if (*errorCodePtr == ECONNRESET) {
*errorCodePtr = ECONNABORTED;
}
+ Tls_Error(statePtr, ERR_reason_error_string(backingError));
}
statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED;
return(-1);
case SSL_ERROR_SSL:
- dprintf("Got permanent fatal SSL error, aborting immediately");
- Tls_Error(statePtr, (char *)REASON());
- statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED;
- *errorCodePtr = ECONNABORTED;
- return(-1);
-
- case SSL_ERROR_WANT_CONNECT:
- case SSL_ERROR_WANT_ACCEPT:
- case SSL_ERROR_WANT_X509_LOOKUP:
- default:
- dprintf("We got a confusing reply: %i", rc);
- *errorCodePtr = Tcl_GetErrno();
- dprintf("ERR(%d, %d) ", rc, *errorCodePtr);
- return(-1);
- }
-
-#if 0
- if (statePtr->flags & TLS_TCL_SERVER) {
- dprintf("This is an TLS server, checking the certificate for the peer");
-
- err = SSL_get_verify_result(statePtr->ssl);
- if (err != X509_V_OK) {
- dprintf("Invalid certificate, returning in failure");
-
- Tls_Error(statePtr, (char *)X509_verify_cert_error_string(err));
- statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED;
- *errorCodePtr = ECONNABORTED;
- return(-1);
- }
- }
-#endif
+ /* A non-recoverable, fatal error in the SSL library occurred, usually a protocol error */
+ dprintf("SSL_ERROR_SSL: Got permanent fatal SSL error, aborting immediately");
+ if (backingError != 0) {
+ Tls_Error(statePtr, ERR_reason_error_string(backingError));
+ }
+ if (SSL_get_verify_result(statePtr->ssl) != X509_V_OK) {
+ Tls_Error(statePtr, X509_verify_cert_error_string(SSL_get_verify_result(statePtr->ssl)));
+ }
+ statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED;
+ *errorCodePtr = ECONNABORTED;
+ return(-1);
+
+ case SSL_ERROR_WANT_READ:
+ case SSL_ERROR_WANT_WRITE:
+ case SSL_ERROR_WANT_X509_LOOKUP:
+ case SSL_ERROR_WANT_CONNECT:
+ case SSL_ERROR_WANT_ACCEPT:
+ case SSL_ERROR_WANT_ASYNC:
+ case SSL_ERROR_WANT_ASYNC_JOB:
+ case SSL_ERROR_WANT_CLIENT_HELLO_CB:
+ default:
+ /* The operation did not complete and should be retried later. */
+ dprintf("Operation did not complete, call function again later: %i", rc);
+ *errorCodePtr = EAGAIN;
+ dprintf("ERR(%d, %d) ", rc, *errorCodePtr);
+ Tls_Error(statePtr, "Operation did not complete, call function again later");
+ return(-1);
+ }
dprintf("Removing the \"TLS_TCL_INIT\" flag since we have completed the handshake");
statePtr->flags &= ~TLS_TCL_INIT;
dprintf("Returning in success");
@@ -335,10 +345,11 @@
ERR_clear_error();
bytesRead = BIO_read(statePtr->bio, buf, bufSize);
dprintf("BIO_read -> %d", bytesRead);
err = SSL_get_error(statePtr->ssl, bytesRead);
+ backingError = ERR_get_error();
#if 0
if (bytesRead <= 0) {
if (BIO_should_retry(statePtr->bio)) {
dprintf("I/O failed, will retry based on EAGAIN");
@@ -351,45 +362,64 @@
case SSL_ERROR_NONE:
dprintBuffer(buf, bytesRead);
break;
case SSL_ERROR_SSL:
- dprintf("SSL negotiation error, indicating that the connection has been aborted");
-
- Tls_Error(statePtr, TCLTLS_SSL_ERROR(statePtr->ssl, bytesRead));
+ /* A non-recoverable, fatal error in the SSL library occurred, usually a protocol error */
+ dprintf("SSL error, indicating that the connection has been aborted");
+ if (backingError != 0) {
+ Tls_Error(statePtr, ERR_reason_error_string(backingError));
+ }
*errorCodePtr = ECONNABORTED;
bytesRead = -1;
+
+#if OPENSSL_VERSION_NUMBER >= 0x30000000L
+ /* Unexpected EOF from the peer for OpenSSL 3.0+ */
+ if (ERR_GET_REASON(backingError) == SSL_R_UNEXPECTED_EOF_WHILE_READING) {
+ dprintf("(Unexpected) EOF reached")
+ *errorCodePtr = 0;
+ bytesRead = 0;
+ Tls_Error(statePtr, "EOF reached");
+ }
+#endif
break;
case SSL_ERROR_SYSCALL:
- backingError = ERR_get_error();
-
+ /* Some non-recoverable, fatal I/O error occurred */
if (backingError == 0 && bytesRead == 0) {
- dprintf("EOF reached")
+ /* Unexpected EOF from the peer for OpenSSL 1.1 */
+ dprintf("(Unexpected) EOF reached")
*errorCodePtr = 0;
bytesRead = 0;
+ Tls_Error(statePtr, "EOF reached");
+
} else if (backingError == 0 && bytesRead == -1) {
dprintf("I/O error occurred (errno = %lu)", (unsigned long) Tcl_GetErrno());
*errorCodePtr = Tcl_GetErrno();
bytesRead = -1;
+ Tls_Error(statePtr, Tcl_ErrnoMsg(Tcl_GetErrno()));
+
} else {
dprintf("I/O error occurred (backingError = %lu)", backingError);
*errorCodePtr = backingError;
bytesRead = -1;
+ Tls_Error(statePtr, ERR_reason_error_string(backingError));
}
break;
case SSL_ERROR_ZERO_RETURN:
dprintf("Got SSL_ERROR_ZERO_RETURN, this means an EOF has been reached");
bytesRead = 0;
*errorCodePtr = 0;
+ Tls_Error(statePtr, "Peer has closed the connection for writing by sending the close_notify alert");
break;
case SSL_ERROR_WANT_READ:
dprintf("Got SSL_ERROR_WANT_READ, mapping this to EAGAIN");
bytesRead = -1;
*errorCodePtr = EAGAIN;
+ Tls_Error(statePtr, "SSL_ERROR_WANT_READ");
break;
default:
dprintf("Unknown error (err = %i), mapping to EOF", err);
*errorCodePtr = 0;
@@ -486,10 +516,12 @@
ERR_clear_error();
written = BIO_write(statePtr->bio, buf, toWrite);
dprintf("BIO_write(%p, %d) -> [%d]", (void *) statePtr, toWrite, written);
err = SSL_get_error(statePtr->ssl, written);
+ backingError = ERR_get_error();
+
switch (err) {
case SSL_ERROR_NONE:
if (written < 0) {
written = 0;
}
@@ -497,52 +529,64 @@
case SSL_ERROR_WANT_WRITE:
dprintf("Got SSL_ERROR_WANT_WRITE, mapping it to EAGAIN");
*errorCodePtr = EAGAIN;
written = -1;
+ Tls_Error(statePtr, "SSL_ERROR_WANT_WRITE");
break;
case SSL_ERROR_WANT_READ:
dprintf(" write R BLOCK");
+ Tls_Error(statePtr, "SSL_ERROR_WANT_READ");
break;
case SSL_ERROR_WANT_X509_LOOKUP:
dprintf(" write X BLOCK");
+ Tls_Error(statePtr, "SSL_ERROR_WANT_X509_LOOKUP");
break;
case SSL_ERROR_ZERO_RETURN:
dprintf(" closed");
written = 0;
*errorCodePtr = 0;
+ Tls_Error(statePtr, "Peer has closed the connection for writing by sending the close_notify alert");
break;
case SSL_ERROR_SYSCALL:
- backingError = ERR_get_error();
-
+ /* Some non-recoverable, fatal I/O error occurred */
if (backingError == 0 && written == 0) {
dprintf("EOF reached")
*errorCodePtr = 0;
written = 0;
+ Tls_Error(statePtr, "EOF reached");
+
} else if (backingError == 0 && written == -1) {
dprintf("I/O error occurred (errno = %lu)", (unsigned long) Tcl_GetErrno());
*errorCodePtr = Tcl_GetErrno();
written = -1;
+ Tls_Error(statePtr, Tcl_ErrnoMsg(Tcl_GetErrno()));
+
} else {
dprintf("I/O error occurred (backingError = %lu)", backingError);
*errorCodePtr = backingError;
written = -1;
+ Tls_Error(statePtr, ERR_reason_error_string(backingError));
}
break;
case SSL_ERROR_SSL:
- Tls_Error(statePtr, TCLTLS_SSL_ERROR(statePtr->ssl, written));
+ /* A non-recoverable, fatal error in the SSL library occurred, usually a protocol error */
+ dprintf("SSL error, indicating that the connection has been aborted");
+ if (backingError != 0) {
+ Tls_Error(statePtr, ERR_reason_error_string(backingError));
+ }
*errorCodePtr = ECONNABORTED;
written = -1;
break;
default:
- dprintf(" unknown err: %d", err);
+ dprintf("unknown error: %d", err);
break;
}
if (*errorCodePtr < 0) {
Tls_Error(statePtr, strerror(*errorCodePtr));
Index: generic/tlsInfo.c
==================================================================
--- generic/tlsInfo.c
+++ generic/tlsInfo.c
@@ -348,11 +348,11 @@
break;
}
/* Create context */
if ((ctx = SSL_CTX_new(TLS_server_method())) == NULL) {
- Tcl_AppendResult(interp, REASON(), (char *) NULL);
+ Tcl_AppendResult(interp, GET_ERR_REASON(), (char *) NULL);
return TCL_ERROR;
}
/* Set protocol versions */
if (SSL_CTX_set_min_proto_version(ctx, min_version) == 0 ||
@@ -361,11 +361,11 @@
return TCL_ERROR;
}
/* Create SSL context */
if ((ssl = SSL_new(ctx)) == NULL) {
- Tcl_AppendResult(interp, REASON(), (char *) NULL);
+ Tcl_AppendResult(interp, GET_ERR_REASON(), (char *) NULL);
SSL_CTX_free(ctx);
return TCL_ERROR;
}
/* Use list and order as would be sent in a ClientHello or all available ciphers */
Index: generic/tlsInt.h
==================================================================
--- generic/tlsInt.h
+++ generic/tlsInt.h
@@ -106,12 +106,11 @@
#define dprintf(...) if (0) { fprintf(stderr, __VA_ARGS__); }
#define dprintBuffer(bufferName, bufferLength) /**/
#define dprintFlags(statePtr) /**/
#endif
-#define TCLTLS_SSL_ERROR(ssl,err) ((char*)ERR_reason_error_string((unsigned long)SSL_get_error((ssl),(err))))
-#define REASON() ERR_reason_error_string(ERR_get_error())
+#define GET_ERR_REASON() ERR_reason_error_string(ERR_get_error())
/* Common list append macros */
#define LAPPEND_BARRAY(interp, obj, text, value, size) {\
if (text != NULL) Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(text, -1)); \
Tcl_ListObjAppendElement(interp, obj, Tcl_NewByteArrayObj(value, size)); \
Index: generic/tlsKDF.c
==================================================================
--- generic/tlsKDF.c
+++ generic/tlsKDF.c
@@ -129,11 +129,11 @@
dk_len = iklen+ivlen;
}
/* Derive key */
if (!PKCS5_PBKDF2_HMAC(pass, (int) pass_len, salt, (int) salt_len, iter, md, dk_len, tmpkeyiv)) {
- Tcl_AppendResult(interp, "Key derivation failed: ", REASON(), (char *) NULL);
+ Tcl_AppendResult(interp, "Key derivation failed: ", GET_ERR_REASON(), (char *) NULL);
return TCL_ERROR;
}
/* Set result to key and iv */
if (cipher == NULL) {
@@ -248,29 +248,29 @@
Tcl_AppendResult(interp, "Memory allocation error", (char *) NULL);
goto error;
}
if (EVP_PKEY_derive_init(pctx) < 1) {
- Tcl_AppendResult(interp, "Initialize failed: ", REASON(), (char *) NULL);
+ Tcl_AppendResult(interp, "Initialize failed: ", GET_ERR_REASON(), (char *) NULL);
goto error;
}
/* Set config parameters */
if (EVP_PKEY_CTX_set_hkdf_md(pctx, md) < 1) {
- Tcl_AppendResult(interp, "Set digest failed: ", REASON(), (char *) NULL);
+ Tcl_AppendResult(interp, "Set digest failed: ", GET_ERR_REASON(), (char *) NULL);
goto error;
}
if (EVP_PKEY_CTX_set1_hkdf_key(pctx, key, (int) key_len) < 1) {
- Tcl_AppendResult(interp, "Set key failed: ", REASON(), (char *) NULL);
+ Tcl_AppendResult(interp, "Set key failed: ", GET_ERR_REASON(), (char *) NULL);
goto error;
}
if (salt != NULL && EVP_PKEY_CTX_set1_hkdf_salt(pctx, salt, (int) salt_len) < 1) {
- Tcl_AppendResult(interp, "Set salt failed: ", REASON(), (char *) NULL);
+ Tcl_AppendResult(interp, "Set salt failed: ", GET_ERR_REASON(), (char *) NULL);
goto error;
}
if (info != NULL && EVP_PKEY_CTX_add1_hkdf_info(pctx, info, (int) info_len) < 1) {
- Tcl_AppendResult(interp, "Set info failed: ", REASON(), (char *) NULL);
+ Tcl_AppendResult(interp, "Set info failed: ", GET_ERR_REASON(), (char *) NULL);
goto error;
}
/* Get buffer */
resultObj = Tcl_NewObj();
@@ -286,11 +286,11 @@
Tcl_SetByteArrayLength(resultObj, (Tcl_Size) out_len);
Tcl_SetObjResult(interp, resultObj);
res = TCL_OK;
goto done;
} else {
- Tcl_AppendResult(interp, "Key derivation failed: ", REASON(), (char *) NULL);
+ Tcl_AppendResult(interp, "Key derivation failed: ", GET_ERR_REASON(), (char *) NULL);
Tcl_DecrRefCount(resultObj);
}
error:
res = TCL_ERROR;
@@ -396,37 +396,37 @@
Tcl_AppendResult(interp, "Memory allocation error", (char *) NULL);
goto error;
}
if (EVP_PKEY_derive_init(pctx) < 1) {
- Tcl_AppendResult(interp, "Initialize failed: ", REASON(), (char *) NULL);
+ Tcl_AppendResult(interp, "Initialize failed: ", GET_ERR_REASON(), (char *) NULL);
goto error;
}
/* Set config parameters */
if (EVP_PKEY_CTX_set1_pbe_pass(pctx, pass, (int) pass_len) < 1) {
- Tcl_AppendResult(interp, "Set key failed: ", REASON(), (char *) NULL);
+ Tcl_AppendResult(interp, "Set key failed: ", GET_ERR_REASON(), (char *) NULL);
goto error;
}
if (EVP_PKEY_CTX_set1_scrypt_salt(pctx, salt, (int) salt_len) < 1) {
- Tcl_AppendResult(interp, "Set salt failed: ", REASON(), (char *) NULL);
+ Tcl_AppendResult(interp, "Set salt failed: ", GET_ERR_REASON(), (char *) NULL);
goto error;
}
if (N != 0 && EVP_PKEY_CTX_set_scrypt_N(pctx, N) < 1) {
- Tcl_AppendResult(interp, "Set cost parameter (N) failed: ", REASON(), (char *) NULL);
+ Tcl_AppendResult(interp, "Set cost parameter (N) failed: ", GET_ERR_REASON(), (char *) NULL);
goto error;
}
if (r != 0 && EVP_PKEY_CTX_set_scrypt_r(pctx, r) < 1) {
- Tcl_AppendResult(interp, "Set lock size parameter (r) failed: ", REASON(), (char *) NULL);
+ Tcl_AppendResult(interp, "Set lock size parameter (r) failed: ", GET_ERR_REASON(), (char *) NULL);
goto error;
}
if (p != 0 && EVP_PKEY_CTX_set_scrypt_p(pctx, p) < 1) {
- Tcl_AppendResult(interp, "Set Parallelization parameter (p) failed: ", REASON(), (char *) NULL);
+ Tcl_AppendResult(interp, "Set Parallelization parameter (p) failed: ", GET_ERR_REASON(), (char *) NULL);
goto error;
}
if (maxmem != 0 && EVP_PKEY_CTX_set_scrypt_maxmem_bytes(pctx, maxmem) < 1) {
- Tcl_AppendResult(interp, "Set max memory failed: ", REASON(), (char *) NULL);
+ Tcl_AppendResult(interp, "Set max memory failed: ", GET_ERR_REASON(), (char *) NULL);
goto error;
}
/* Get buffer */
resultObj = Tcl_NewObj();
@@ -442,11 +442,11 @@
Tcl_SetByteArrayLength(resultObj, (Tcl_Size) out_len);
Tcl_SetObjResult(interp, resultObj);
goto done;
} else {
- Tcl_AppendResult(interp, "Key derivation failed: ", REASON(), (char *) NULL);
+ Tcl_AppendResult(interp, "Key derivation failed: ", GET_ERR_REASON(), (char *) NULL);
Tcl_DecrRefCount(resultObj);
}
error:
res = TCL_ERROR;
Index: generic/tlsRand.c
==================================================================
--- generic/tlsRand.c
+++ generic/tlsRand.c
@@ -84,11 +84,11 @@
res = RAND_bytes(out_buf, out_len);
} else {
res = RAND_priv_bytes(out_buf, out_len);
}
if (!res) {
- Tcl_AppendResult(interp, "Generate failed: ", REASON(), (char *) NULL);
+ Tcl_AppendResult(interp, "Generate failed: ", GET_ERR_REASON(), (char *) NULL);
Tcl_DecrRefCount(resultObj);
return TCL_ERROR;
}
Tcl_SetObjResult(interp, resultObj);