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 * - * 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, ) 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);