Index: tests/all.tcl ================================================================== --- tests/all.tcl +++ tests/all.tcl @@ -16,10 +16,11 @@ namespace import ::tcltest::* } set ::tcltest::testSingleFile false set ::tcltest::testsDirectory [file dir [info script]] +::tcltest::configure -verbose start # We should ensure that the testsDirectory is absolute. # This was introduced in Tcl 8.3+'s tcltest, so we need a catch. catch {::tcltest::normalizePath ::tcltest::testsDirectory} Index: tests/tlsIO.test ================================================================== --- tests/tlsIO.test +++ tests/tlsIO.test @@ -796,15 +796,15 @@ set s3 [tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ 127.0.0.1 8828] fconfigure $s3 -buffering line for {set i 0} {$i < 100} {incr i} { - puts $s1 hello,s1 + puts $s1 hello,tlsIO-3.2,s1 gets $s1 - puts $s2 hello,s2 + puts $s2 hello,tlsIO-3.2,s2 gets $s2 - puts $s3 hello,s3 + puts $s3 hello,tlsIO-3.2,s3 gets $s3 } close $s1 close $s2 close $s3 @@ -1451,15 +1451,15 @@ set s3 [tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ $remoteServerIP 8836] fconfigure $s3 -buffering line for {set i 0} {$i < 100} {incr i} { - puts $s1 hello,s1 + puts $s1 hello,tlsIO-11.7,s1 gets $s1 - puts $s2 hello,s2 + puts $s2 hello,tlsIO-11.7,s2 gets $s2 - puts $s3 hello,s3 + puts $s3 hello,tlsIO-11.7,s3 gets $s3 } close $s1 close $s2 close $s3 Index: tls.c ================================================================== --- tls.c +++ tls.c @@ -163,10 +163,12 @@ InfoCallback(CONST SSL *ssl, int where, int ret) { State *statePtr = (State*)SSL_get_app_data((SSL *)ssl); Tcl_Obj *cmdPtr; char *major; char *minor; + + dprintf("Called"); if (statePtr->callback == (Tcl_Obj*)NULL) return; cmdPtr = Tcl_DuplicateObj(statePtr->callback); @@ -349,10 +351,12 @@ void Tls_Error(State *statePtr, char *msg) { Tcl_Obj *cmdPtr; + dprintf("Called"); + if (msg && *msg) { Tcl_SetErrorCode(statePtr->interp, "SSL", msg, (char *)NULL); } else { msg = Tcl_GetStringFromObj(Tcl_GetObjResult(statePtr->interp), NULL); } @@ -416,10 +420,12 @@ { State *statePtr = (State *) udata; Tcl_Interp *interp = statePtr->interp; Tcl_Obj *cmdPtr; int result; + + dprintf("Called"); if (statePtr->password == NULL) { if (Tcl_EvalEx(interp, "tls::password", -1, TCL_EVAL_GLOBAL) == TCL_OK) { char *ret = (char *) Tcl_GetStringResult(interp); @@ -488,10 +494,12 @@ SSL_CTX *ctx = NULL; SSL *ssl = NULL; STACK_OF(SSL_CIPHER) *sk; char *cp, buf[BUFSIZ]; int index, verbose = 0; + + dprintf("Called"); if (objc < 2 || objc > 3) { Tcl_WrongNumArgs(interp, 1, objv, "protocol ?verbose?"); return TCL_ERROR; } @@ -613,10 +621,12 @@ { Tcl_Channel chan; /* The channel to set a mode on. */ State *statePtr; /* client state for ssl socket */ int ret = 1; + dprintf("Called"); + if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "channel"); return TCL_ERROR; } @@ -654,12 +664,12 @@ if (!errStr || *errStr == 0) { errStr = Tcl_PosixError(interp); } - Tcl_AppendResult(interp, "handshake failed: ", errStr, - (char *) NULL); + Tcl_AppendResult(interp, "handshake failed: ", errStr, (char *) NULL); + dprintf("Returning TCL_ERROR with handshake failed: %s", errStr); return TCL_ERROR; } } Tcl_SetObjResult(interp, Tcl_NewIntObj(ret)); @@ -734,10 +744,12 @@ #else int tls1_2 = 1; #endif int proto = 0; int verify = 0, require = 0, request = 1; + + dprintf("Called"); if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "channel ?options?"); return TCL_ERROR; } @@ -864,11 +876,13 @@ * encryption not to get goofed up). * We only want to adjust the buffering in pre-v2 channels, where * each channel in the stack maintained its own buffers. */ Tcl_SetChannelOption(interp, chan, "-translation", "binary"); + dprintf("Consuming Tcl channel %s", Tcl_GetChannelName(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. */ Tls_Free((char *) statePtr); @@ -908,11 +922,11 @@ SSL_set_verify(statePtr->ssl, verify, VerifyCallback); SSL_CTX_set_info_callback(statePtr->ctx, InfoCallback); /* Create Tcl_Channel BIO Handler */ - statePtr->p_bio = BIO_new_tcl(statePtr, BIO_CLOSE); + statePtr->p_bio = BIO_new_tcl(statePtr, BIO_NOCLOSE); statePtr->bio = BIO_new(BIO_f_ssl()); if (server) { statePtr->flags |= TLS_TCL_SERVER; SSL_set_accept_state(statePtr->ssl); @@ -923,10 +937,11 @@ BIO_set_ssl(statePtr->bio, statePtr->ssl, BIO_NOCLOSE); /* * End of SSL Init */ + dprintf("Returning %s", Tcl_GetChannelName(statePtr->self)); Tcl_SetResult(interp, (char *) Tcl_GetChannelName(statePtr->self), TCL_VOLATILE); return TCL_OK; } @@ -952,10 +967,12 @@ Tcl_Interp *interp; int objc; Tcl_Obj *CONST objv[]; { Tcl_Channel chan; /* The channel to set a mode on. */ + + dprintf("Called"); if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "channel"); return TCL_ERROR; } @@ -1012,10 +1029,12 @@ SSL_CTX *ctx = NULL; Tcl_DString ds; Tcl_DString ds1; int off = 0; const SSL_METHOD *method; + + dprintf("Called"); if (!proto) { Tcl_AppendResult(interp, "no valid protocol selected", NULL); return (SSL_CTX *)0; } @@ -1262,10 +1281,12 @@ Tcl_Obj *objPtr; Tcl_Channel chan; char *channelName, *ciphers; int mode; + dprintf("Called"); + switch (objc) { case 2: channelName = Tcl_GetStringFromObj(objv[1], NULL); break; @@ -1341,10 +1362,12 @@ Tcl_Interp *interp; int objc; Tcl_Obj *CONST objv[]; { Tcl_Obj *objPtr; + + dprintf("Called"); objPtr = Tcl_NewStringObj(OPENSSL_VERSION_TEXT, -1); Tcl_SetObjResult(interp, objPtr); return TCL_OK; @@ -1371,10 +1394,12 @@ Tcl_Obj *CONST objv[]; { static CONST84 char *commands [] = { "req", NULL }; enum command { C_REQ, C_DUMMY }; int cmd; + + dprintf("Called"); if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?args?"); return TCL_ERROR; } @@ -1530,10 +1555,12 @@ */ void Tls_Free( char *blockPtr ) { State *statePtr = (State *)blockPtr; + + dprintf("Called"); Tls_Clean(statePtr); ckfree(blockPtr); } @@ -1553,17 +1580,16 @@ * Side effects: * Frees all the state * *------------------------------------------------------------------- */ -void -Tls_Clean(State *statePtr) -{ +void Tls_Clean(State *statePtr) { + dprintf("Called"); + /* * we're assuming here that we're single-threaded */ - if (statePtr->timer != (Tcl_TimerToken) NULL) { Tcl_DeleteTimerHandler(statePtr->timer); statePtr->timer = NULL; } @@ -1588,10 +1614,12 @@ } if (statePtr->password) { Tcl_DecrRefCount(statePtr->password); statePtr->password = NULL; } + + dprintf("Returning"); } /* *------------------------------------------------------------------- * @@ -1609,11 +1637,14 @@ */ int Tls_Init(Tcl_Interp *interp) { const char tlsTclInitScript[] = { #include "tls.tcl.h" + , 0x00 }; + + dprintf("Called"); /* * We only support Tcl 8.4 or newer */ if ( @@ -1664,10 +1695,11 @@ * *------------------------------------------------------* */ int Tls_SafeInit(Tcl_Interp *interp) { + dprintf("Called"); return(Tls_Init(interp)); } /* *------------------------------------------------------* @@ -1689,12 +1721,15 @@ static int TlsLibInit(void) { static int initialized = 0; int status = TCL_OK; if (initialized) { + dprintf("Called, but using cached value"); return(status); } + + dprintf("Called"); initialized = 1; #if defined(OPENSSL_THREADS) && defined(TCL_THREADS) size_t num_locks; @@ -1719,10 +1754,12 @@ goto done; } SSL_load_error_strings(); ERR_load_crypto_strings(); + + BIO_new_tcl(NULL, 0); #if 0 /* * XXX:TODO: Remove this code and replace it with a check * for enough entropy and do not try to create our own Index: tlsBIO.c ================================================================== --- tlsBIO.c +++ tlsBIO.c @@ -38,11 +38,16 @@ static int BioNew _ANSI_ARGS_((BIO *h)); static int BioFree _ANSI_ARGS_((BIO *h)); BIO *BIO_new_tcl(State *statePtr, int flags) { BIO *bio; + Tcl_Channel parentChannel; + const Tcl_ChannelType *parentChannelType; static BIO_METHOD *BioMethods = NULL; + int parentChannelFdIn, parentChannelFdOut, parentChannelFd; + int validParentChannelFd; + int tclGetChannelHandleRet; dprintf("BIO_new_tcl() called"); if (BioMethods == NULL) { BioMethods = BIO_meth_new(BIO_TYPE_TCL, "tcl"); @@ -52,37 +57,80 @@ BIO_meth_set_ctrl(BioMethods, BioCtrl); BIO_meth_set_create(BioMethods, BioNew); BIO_meth_set_destroy(BioMethods, BioFree); } - bio = BIO_new(BioMethods); + if (statePtr == NULL) { + dprintf("Asked to setup a NULL state, just creating the initial configuration"); + + return(NULL); + } + + /* + * If the channel can be mapped back to a file descriptor, just use the file descriptor + * with the SSL library since it will likely be optimized for this. + */ + parentChannel = Tls_GetParent(statePtr); + parentChannelType = Tcl_GetChannelType(parentChannel); + + /* If we do not get the channel name here, we segfault later :-( */ + dprintf("Channel Name is valid: %s", Tcl_GetChannelName(statePtr->self)); + dprintf("Parent Channel Name is valid: %s", Tcl_GetChannelName(parentChannel)); + + validParentChannelFd = 0; + if (strcmp(parentChannelType->typeName, "tcp") == 0) { + tclGetChannelHandleRet = Tcl_GetChannelHandle(parentChannel, TCL_READABLE, (ClientData) &parentChannelFdIn); + if (tclGetChannelHandleRet == TCL_OK) { + tclGetChannelHandleRet = Tcl_GetChannelHandle(parentChannel, TCL_WRITABLE, (ClientData) &parentChannelFdOut); + if (tclGetChannelHandleRet == TCL_OK) { + if (parentChannelFdIn == parentChannelFdOut) { + parentChannelFd = parentChannelFdIn; + validParentChannelFd = 1; + } + } + } + } - BIO_set_data(bio, statePtr); - BIO_set_init(bio, 1); - BIO_set_shutdown(bio, flags); + if (validParentChannelFd) { + dprintf("We found a shortcut, this channel is backed by a file descriptor: %i", parentChannelFdIn); + bio = BIO_new_socket(parentChannelFd, flags); + } else { + dprintf("Falling back to Tcl I/O for this channel"); + bio = BIO_new(BioMethods); + BIO_set_data(bio, statePtr); + BIO_set_shutdown(bio, flags); + BIO_set_init(bio, 1); + } return(bio); } static int BioWrite(BIO *bio, CONST char *buf, int bufLen) { Tcl_Channel chan; int ret; + int tclEofChan; chan = Tls_GetParent((State *) BIO_get_data(bio)); - dprintf("BioWrite(%p, , %d) [%p]", (void *) bio, bufLen, (void *) chan); + dprintf("[chan=%p] BioWrite(%p, , %d)", (void *)chan, (void *) bio, bufLen); ret = Tcl_WriteRaw(chan, buf, bufLen); - dprintf("[%p] BioWrite(%d) -> %d [%d.%d]", (void *) chan, bufLen, ret, Tcl_Eof(chan), Tcl_GetErrno()); + tclEofChan = Tcl_Eof(chan); + + dprintf("[chan=%p] BioWrite(%d) -> %d [tclEof=%d; tclErrno=%d]", (void *) chan, bufLen, ret, tclEofChan, Tcl_GetErrno()); BIO_clear_flags(bio, BIO_FLAGS_WRITE | BIO_FLAGS_SHOULD_RETRY); if (ret == 0) { - if (!Tcl_Eof(chan)) { - BIO_set_retry_write(bio); + if (tclEofChan) { + dprintf("Unable to write bytes and EOF is set, returning in failure"); + Tcl_SetErrno(ECONNRESET); ret = -1; + } else { + dprintf("Unable to write bytes but we do not have EOF set... will retry"); + BIO_set_retry_write(bio); } } if (BIO_should_read(bio)) { BIO_set_retry_read(bio); @@ -96,40 +144,45 @@ int ret = 0; int tclEofChan; chan = Tls_GetParent((State *) BIO_get_data(bio)); - dprintf("BioRead(%p, , %d) [%p]", (void *) bio, bufLen, (void *) chan); + dprintf("[chan=%p] BioRead(%p, , %d)", (void *) chan, (void *) bio, bufLen); if (buf == NULL) { return 0; } ret = Tcl_ReadRaw(chan, buf, bufLen); tclEofChan = Tcl_Eof(chan); - dprintf("[%p] BioRead(%d) -> %d [tclEof=%d; tclErrno=%d]", (void *) chan, bufLen, ret, tclEofChan, Tcl_GetErrno()); + dprintf("[chan=%p] BioRead(%d) -> %d [tclEof=%d; tclErrno=%d]", (void *) chan, bufLen, ret, tclEofChan, Tcl_GetErrno()); BIO_clear_flags(bio, BIO_FLAGS_READ | BIO_FLAGS_SHOULD_RETRY); + + if (BIO_should_write(bio)) { + dprintf("Setting should retry write flag"); + + BIO_set_retry_write(bio); + } if (ret == 0) { - if (!tclEofChan) { - dprintf("Got 0 from Tcl_Read or Tcl_ReadRaw, and EOF is not set -- ret == -1 now"); - BIO_set_retry_read(bio); + if (tclEofChan) { + dprintf("Got 0 from Tcl_Read or Tcl_ReadRaw, and EOF is set; ret = -1"); + Tcl_SetErrno(ECONNRESET); ret = -1; } else { - dprintf("Got 0 from Tcl_Read or Tcl_ReadRaw, and EOF is set"); + dprintf("Got 0 from Tcl_Read or Tcl_ReadRaw, and EOF is not set; ret = 0"); + dprintf("Setting retry read flag"); + BIO_set_retry_read(bio); + ret = 0; } } else { dprintf("Got non-zero from Tcl_Read or Tcl_ReadRaw; ret == %i", ret); } - if (BIO_should_write(bio)) { - BIO_set_retry_write(bio); - } - dprintf("BioRead(%p, , %d) [%p] returning %i", (void *) bio, bufLen, (void *) chan, ret); return(ret); } @@ -198,11 +251,11 @@ ret = ((Tcl_WriteRaw(chan, "", 0) >= 0) ? 1 : -1); dprintf("BIO_CTRL_FLUSH returning value %li", ret); break; default: dprintf("Got unknown control command (%i)", cmd); - ret = 0; + ret = -2; break; } return(ret); } Index: tlsIO.c ================================================================== --- tlsIO.c +++ tlsIO.c @@ -168,10 +168,13 @@ dprintf("TlsCloseProc(%p)", (void *) statePtr); Tls_Clean(statePtr); Tcl_EventuallyFree((ClientData)statePtr, Tls_Free); + + dprintf("Returning TCL_OK"); + return TCL_OK; } /* *------------------------------------------------------------------- @@ -245,27 +248,30 @@ * correctly. Similar fix in TlsOutputProc. - hobbs */ ERR_clear_error(); bytesRead = BIO_read(statePtr->bio, buf, bufSize); dprintf("BIO_read -> %d", bytesRead); + dprintBuffer(buf, bytesRead); - if (bytesRead < 0) { + if (bytesRead <= 0) { int err = SSL_get_error(statePtr->ssl, bytesRead); if (err == SSL_ERROR_SSL) { Tls_Error(statePtr, TCLTLS_SSL_ERROR(statePtr->ssl, bytesRead)); *errorCodePtr = ECONNABORTED; } else if (BIO_should_retry(statePtr->bio)) { - dprintf("RE! "); + dprintf("retry based on EAGAIN"); *errorCodePtr = EAGAIN; } else { *errorCodePtr = Tcl_GetErrno(); if (*errorCodePtr == ECONNRESET) { /* Soft EOF */ *errorCodePtr = 0; bytesRead = 0; - } + } else { + dprintf("Got an unexpected error: %i", *errorCodePtr); + } } } input: dprintf("Input(%d) -> %d [%d]", bufSize, bytesRead, *errorCodePtr); return bytesRead; @@ -299,10 +305,11 @@ int written, err; *errorCodePtr = 0; dprintf("BIO_write(%p, %d)", (void *) statePtr, toWrite); + dprintBuffer(buf, toWrite); if (statePtr->flags & TLS_TCL_CALLBACK) { /* don't process any bytes while verify callback is running */ written = -1; *errorCodePtr = EAGAIN; @@ -460,11 +467,29 @@ dprintf("TlsWatchProc(0x%x)", mask); /* Pretend to be dead as long as the verify callback is running. * Otherwise that callback could be invoked recursively. */ - if (statePtr->flags & TLS_TCL_CALLBACK) { return; } + if (statePtr->flags & TLS_TCL_CALLBACK) { + dprintf("Callback is on-going, doing nothing"); + return; + } + + dprintFlags(statePtr); + + downChan = Tls_GetParent(statePtr); + + if (statePtr->flags & TLS_TCL_HANDSHAKE_FAILED) { + dprintf("Asked to watch a socket with a failed handshake -- nothing can happen here"); + + dprintf("Unregistering interest in the lower channel"); + (Tcl_GetChannelType(downChan))->watchProc(Tcl_GetChannelInstanceData(downChan), 0); + + statePtr->watchMask = 0; + + return; + } statePtr->watchMask = mask; /* No channel handlers any more. We will be notified automatically * about events on the channel below via a call to our @@ -472,28 +497,31 @@ * We are allowed to add additional 'interest' to the mask if we want * to. But this transformation has no such interest. It just passes * the request down, unchanged. */ - downChan = Tls_GetParent(statePtr); + dprintf("Registering our interest in the lower channel (chan=%p)", (void *) downChan); (Tcl_GetChannelType(downChan)) ->watchProc(Tcl_GetChannelInstanceData(downChan), mask); /* * Management of the internal timer. */ if (statePtr->timer != (Tcl_TimerToken) NULL) { + dprintf("A timer was found, deleting it"); Tcl_DeleteTimerHandler(statePtr->timer); statePtr->timer = (Tcl_TimerToken) NULL; } + if ((mask & TCL_READABLE) && Tcl_InputBuffered(statePtr->self) > 0) { /* * There is interest in readable events and we actually have * data waiting, so generate a timer to flush that. */ + dprintf("Creating a new timer since data appears to be waiting"); statePtr->timer = Tcl_CreateTimerHandler(TLS_TCL_DELAY, TlsChannelHandlerTimer, (ClientData) statePtr); } } Index: tlsInt.h ================================================================== --- tlsInt.h +++ tlsInt.h @@ -63,13 +63,40 @@ #ifndef ECONNRESET #define ECONNRESET 131 /* Connection reset by peer */ #endif #ifdef TCLEXT_TCLTLS_DEBUG -#define dprintf(...) { fprintf(stderr, "%s:%i:", __func__, __LINE__); fprintf(stderr, __VA_ARGS__); fprintf(stderr, "\n"); } +#include +#define dprintf(...) { fprintf(stderr, "%s:%i:%s():", __FILE__, __LINE__, __func__); fprintf(stderr, __VA_ARGS__); fprintf(stderr, "\n"); } +#define dprintBuffer(bufferName, bufferLength) { \ + int dprintBufferIdx; \ + unsigned char dprintBufferChar; \ + fprintf(stderr, "%s:%i:%s():%s[%llu]={", __FILE__, __LINE__, __func__, #bufferName, (unsigned long long) bufferLength); \ + for (dprintBufferIdx = 0; dprintBufferIdx < bufferLength; dprintBufferIdx++) { \ + dprintBufferChar = bufferName[dprintBufferIdx]; \ + if (isalpha(dprintBufferChar) || isdigit(dprintBufferChar)) { \ + fprintf(stderr, "'%c' ", dprintBufferChar); \ + } else { \ + fprintf(stderr, "%02x ", (unsigned int) dprintBufferChar); \ + }; \ + }; \ + fprintf(stderr, "}\n"); \ + } +#define dprintFlags(statePtr) { \ + fprintf(stderr, "%s:%i:%s():%s->flags=0", __FILE__, __LINE__, __func__, #statePtr); \ + if (((statePtr)->flags & TLS_TCL_ASYNC) == TLS_TCL_ASYNC) { fprintf(stderr,"|TLS_TCL_ASYNC"); }; \ + if (((statePtr)->flags & TLS_TCL_SERVER) == TLS_TCL_SERVER) { fprintf(stderr,"|TLS_TCL_SERVER"); }; \ + if (((statePtr)->flags & TLS_TCL_INIT) == TLS_TCL_INIT) { fprintf(stderr,"|TLS_TCL_INIT"); }; \ + if (((statePtr)->flags & TLS_TCL_DEBUG) == TLS_TCL_DEBUG) { fprintf(stderr,"|TLS_TCL_DEBUG"); }; \ + if (((statePtr)->flags & TLS_TCL_CALLBACK) == TLS_TCL_CALLBACK) { fprintf(stderr,"|TLS_TCL_CALLBACK"); }; \ + if (((statePtr)->flags & TLS_TCL_HANDSHAKE_FAILED) == TLS_TCL_HANDSHAKE_FAILED) { fprintf(stderr,"|TLS_TCL_HANDSHAKE_FAILED"); }; \ + fprintf(stderr, "\n"); \ + } #else #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)))) /* * OpenSSL BIO Routines