Index: tls.c ================================================================== --- tls.c +++ tls.c @@ -80,16 +80,10 @@ #ifndef OPENSSL_NO_DH #include "dh_params.h" #endif -/* - * Defined in Tls_Init to determine what kind of channels we are using - * (old-style 8.2.0-8.3.1 or new-style 8.3.2+). - */ -int channelTypeVersion = TLS_CHANNEL_VERSION_2; - /* * We lose the tcl password callback when we use the RSA BSAFE SSL-C 1.1.2 * libraries instead of the current OpenSSL libraries. */ @@ -628,16 +622,15 @@ chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), NULL); if (chan == (Tcl_Channel) NULL) { return TCL_ERROR; } - if (channelTypeVersion == TLS_CHANNEL_VERSION_2) { - /* - * Make sure to operate on the topmost channel - */ - chan = Tcl_GetTopChannel(chan); - } + + /* + * Make sure to operate on the topmost channel + */ + chan = Tcl_GetTopChannel(chan); if (Tcl_GetChannelType(chan) != Tls_ChannelType()) { Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan), "\": not a TLS channel", NULL); return TCL_ERROR; } @@ -751,16 +744,15 @@ chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), NULL); if (chan == (Tcl_Channel) NULL) { return TCL_ERROR; } - if (channelTypeVersion == TLS_CHANNEL_VERSION_2) { - /* - * Make sure to operate on the topmost channel - */ - chan = Tcl_GetTopChannel(chan); - } + + /* + * Make sure to operate on the topmost channel + */ + chan = Tcl_GetTopChannel(chan); for (idx = 2; idx < objc; idx++) { char *opt = Tcl_GetStringFromObj(objv[idx], NULL); if (opt[0] != '-') @@ -843,16 +835,15 @@ chan = Tcl_GetChannel(interp, model, &mode); if (chan == (Tcl_Channel) NULL) { Tls_Free((char *) statePtr); return TCL_ERROR; } - if (channelTypeVersion == TLS_CHANNEL_VERSION_2) { - /* - * Make sure to operate on the topmost channel - */ - chan = Tcl_GetTopChannel(chan); - } + + /* + * Make sure to operate on the topmost channel + */ + chan = Tcl_GetTopChannel(chan); if (Tcl_GetChannelType(chan) != Tls_ChannelType()) { Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan), "\": not a TLS channel", NULL); Tls_Free((char *) statePtr); return TCL_ERROR; @@ -873,22 +864,11 @@ * 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"); - if (channelTypeVersion == TLS_CHANNEL_VERSION_1) { - Tcl_SetChannelOption(interp, chan, "-buffering", "none"); - } - - if (channelTypeVersion == TLS_CHANNEL_VERSION_2) { - statePtr->self = Tcl_StackChannel(interp, Tls_ChannelType(), - (ClientData) statePtr, (TCL_READABLE | TCL_WRITABLE), chan); - } else { - statePtr->self = chan; - 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); if (statePtr->self == (Tcl_Channel) NULL) { /* * No use of Tcl_EventuallyFree because no possible Tcl_Preserve. */ Tls_Free((char *) statePtr); @@ -983,16 +963,14 @@ chan = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), NULL); if (chan == (Tcl_Channel) NULL) { return TCL_ERROR; } - if (channelTypeVersion == TLS_CHANNEL_VERSION_2) { - /* - * Make sure to operate on the topmost channel - */ - chan = Tcl_GetTopChannel(chan); - } + /* + * Make sure to operate on the topmost channel + */ + chan = Tcl_GetTopChannel(chan); if (Tcl_GetChannelType(chan) != Tls_ChannelType()) { Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan), "\": not a TLS channel", NULL); return TCL_ERROR; @@ -1304,16 +1282,14 @@ chan = Tcl_GetChannel(interp, channelName, &mode); if (chan == (Tcl_Channel) NULL) { return TCL_ERROR; } - if (channelTypeVersion == TLS_CHANNEL_VERSION_2) { - /* - * Make sure to operate on the topmost channel - */ - chan = Tcl_GetTopChannel(chan); - } + /* + * Make sure to operate on the topmost channel + */ + chan = Tcl_GetTopChannel(chan); if (Tcl_GetChannelType(chan) != Tls_ChannelType()) { Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan), "\": not a TLS channel", NULL); return TCL_ERROR; } @@ -1641,65 +1617,34 @@ }; int major, minor, patchlevel, release; /* - * The original 8.2.0 stacked channel implementation (and the patch - * that preceded it) had problems with scalability and robustness. - * These were address in 8.3.2 / 8.4a2, so we now require that as a - * minimum for TLS 1.4+. We only support 8.2+ now (8.3.2+ preferred). + * We only support Tcl 8.4 or newer */ if ( #ifdef USE_TCL_STUBS - Tcl_InitStubs(interp, "8.2", 0) + Tcl_InitStubs(interp, "8.4", 0) #else - Tcl_PkgRequire(interp, "Tcl", "8.2", 0) + Tcl_PkgRequire(interp, "Tcl", "8.4", 0) #endif == NULL) { return TCL_ERROR; } - /* - * Get the version so we can runtime switch on available functionality. - * TLS should really only be used in 8.3.2+, but the other works for - * some limited functionality, so an attempt at support is made. - */ - Tcl_GetVersion(&major, &minor, &patchlevel, &release); - if ((major > 8) || ((major == 8) && ((minor > 3) || ((minor == 3) && - (release == TCL_FINAL_RELEASE) && (patchlevel >= 2))))) { - /* 8.3.2+ */ - channelTypeVersion = TLS_CHANNEL_VERSION_2; - } else { - /* 8.2.0 - 8.3.1 */ - channelTypeVersion = TLS_CHANNEL_VERSION_1; - } - if (TlsLibInit() != TCL_OK) { Tcl_AppendResult(interp, "could not initialize SSL library", NULL); return TCL_ERROR; } - Tcl_CreateObjCommand(interp, "tls::ciphers", CiphersObjCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); - - Tcl_CreateObjCommand(interp, "tls::handshake", HandshakeObjCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); - - Tcl_CreateObjCommand(interp, "tls::import", ImportObjCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); - - Tcl_CreateObjCommand(interp, "tls::unimport", UnimportObjCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); - - Tcl_CreateObjCommand(interp, "tls::status", StatusObjCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); - - Tcl_CreateObjCommand(interp, "tls::version", VersionObjCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); - - Tcl_CreateObjCommand(interp, "tls::misc", MiscObjCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + Tcl_CreateObjCommand(interp, "tls::ciphers", CiphersObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + Tcl_CreateObjCommand(interp, "tls::handshake", HandshakeObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + Tcl_CreateObjCommand(interp, "tls::import", ImportObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + Tcl_CreateObjCommand(interp, "tls::unimport", UnimportObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + Tcl_CreateObjCommand(interp, "tls::status", StatusObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + Tcl_CreateObjCommand(interp, "tls::version", VersionObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + Tcl_CreateObjCommand(interp, "tls::misc", MiscObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); if (interp) { Tcl_Eval(interp, tlsTclInitScript); } Index: tlsBIO.c ================================================================== --- tlsBIO.c +++ tlsBIO.c @@ -69,15 +69,11 @@ chan = Tls_GetParent((State *) BIO_get_data(bio)); dprintf("BioWrite(%p, , %d) [%p]", (void *) bio, bufLen, (void *) chan); - if (channelTypeVersion == TLS_CHANNEL_VERSION_2) { - ret = Tcl_WriteRaw(chan, buf, bufLen); - } else { - ret = Tcl_Write(chan, buf, bufLen); - } + ret = Tcl_WriteRaw(chan, buf, bufLen); dprintf("[%p] BioWrite(%d) -> %d [%d.%d]", (void *) chan, bufLen, ret, Tcl_Eof(chan), Tcl_GetErrno()); BIO_clear_flags(bio, BIO_FLAGS_WRITE | BIO_FLAGS_SHOULD_RETRY); @@ -106,15 +102,11 @@ if (buf == NULL) { return 0; } - if (channelTypeVersion == TLS_CHANNEL_VERSION_2) { - ret = Tcl_ReadRaw(chan, buf, bufLen); - } else { - ret = Tcl_Read(chan, buf, bufLen); - } + 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()); @@ -127,11 +119,11 @@ ret = -1; } else { dprintf("Got 0 from Tcl_Read or Tcl_ReadRaw, and EOF is set"); } } else { - dprintf("Got non-zero from Tcl_Read or Tcl_ReadRaw == ret == %i", ret); + dprintf("Got non-zero from Tcl_Read or Tcl_ReadRaw; ret == %i", ret); } if (BIO_should_write(bio)) { BIO_set_retry_write(bio); } @@ -155,16 +147,20 @@ dprintf("BioCtrl(%p, 0x%x, 0x%x, %p)", (void *) bio, (unsigned int) cmd, (unsigned int) num, (void *) ptr); switch (cmd) { case BIO_CTRL_RESET: + dprintf("Got BIO_CTRL_RESET"); num = 0; case BIO_C_FILE_SEEK: + dprintf("Got BIO_C_FILE_SEEK"); case BIO_C_FILE_TELL: + dprintf("Got BIO_C_FILE_TELL"); ret = 0; break; case BIO_CTRL_INFO: + dprintf("Got BIO_CTRL_INFO"); ret = 1; break; case BIO_C_SET_FD: dprintf("Unsupported call: BIO_C_SET_FD"); ret = -1; @@ -172,38 +168,40 @@ case BIO_C_GET_FD: dprintf("Unsupported call: BIO_C_GET_FD"); ret = -1; break; case BIO_CTRL_GET_CLOSE: + dprintf("Got BIO_CTRL_CLOSE"); ret = BIO_get_shutdown(bio); break; case BIO_CTRL_SET_CLOSE: + dprintf("Got BIO_SET_CLOSE"); BIO_set_shutdown(bio, num); break; case BIO_CTRL_EOF: - dprintf("BIO_CTRL_EOF"); + dprintf("Got BIO_CTRL_EOF"); ret = Tcl_Eof(chan); break; case BIO_CTRL_PENDING: + dprintf("Got BIO_CTRL_PENDING"); ret = ((chan) ? 1 : 0); dprintf("BIO_CTRL_PENDING(%d)", (int) ret); break; case BIO_CTRL_WPENDING: + dprintf("Got BIO_CTRL_WPENDING"); ret = 0; break; case BIO_CTRL_DUP: + dprintf("Got BIO_CTRL_DUP"); break; case BIO_CTRL_FLUSH: - dprintf("BIO_CTRL_FLUSH"); - if (channelTypeVersion == TLS_CHANNEL_VERSION_2) { - ret = ((Tcl_WriteRaw(chan, "", 0) >= 0) ? 1 : -1); - } else { - ret = ((Tcl_Flush(chan) == TCL_OK) ? 1 : -1); - } + dprintf("Got BIO_CTRL_FLUSH"); + 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; break; } return(ret); Index: tlsIO.c ================================================================== --- tlsIO.c +++ tlsIO.c @@ -20,70 +20,27 @@ #include "tlsInt.h" /* * Forward declarations */ - -static int TlsBlockModeProc _ANSI_ARGS_((ClientData instanceData, - int mode)); -static int TlsCloseProc _ANSI_ARGS_ ((ClientData instanceData, - Tcl_Interp *interp)); -static int TlsInputProc _ANSI_ARGS_((ClientData instanceData, - char *buf, int bufSize, int *errorCodePtr)); -static int TlsOutputProc _ANSI_ARGS_((ClientData instanceData, - CONST char *buf, int toWrite, int *errorCodePtr)); -static int TlsGetOptionProc _ANSI_ARGS_ ((ClientData instanceData, - Tcl_Interp *interp, CONST84 char *optionName, - Tcl_DString *dsPtr)); -static void TlsWatchProc _ANSI_ARGS_((ClientData instanceData, int mask)); -static int TlsGetHandleProc _ANSI_ARGS_ ((ClientData instanceData, - int direction, ClientData *handlePtr)); -static int TlsNotifyProc _ANSI_ARGS_ ((ClientData instanceData, - int mask)); -static void TlsChannelHandler _ANSI_ARGS_ ((ClientData clientData, - int mask)); -static void TlsChannelHandlerTimer _ANSI_ARGS_ ((ClientData clientData)); - -/* - * This structure describes the channel type structure for TCP socket - * based IO. These are what the structures should look like, but we - * have to build them up at runtime to be correct depending on whether - * we are loaded into an 8.2.0-8.3.1 or 8.3.2+ Tcl interpreter. - */ -#ifdef TLS_STATIC_STRUCTURES_NOT_USED -static Tcl_ChannelType tlsChannelType2 = { - "tls", /* Type name. */ - TCL_CHANNEL_VERSION_2, /* A v2 channel (8.3.2+) */ - TlsCloseProc, /* Close proc. */ - TlsInputProc, /* Input proc. */ - TlsOutputProc, /* Output proc. */ - NULL, /* Seek proc. */ - NULL, /* Set option proc. */ - TlsGetOptionProc, /* Get option proc. */ - TlsWatchProc, /* Initialize notifier. */ - TlsGetHandleProc, /* Get file handle out of channel. */ - NULL, /* Close2Proc. */ - TlsBlockModeProc, /* Set blocking/nonblocking mode.*/ - NULL, /* FlushProc. */ - TlsNotifyProc, /* handlerProc. */ -}; - -static Tcl_ChannelType tlsChannelType1 = { - "tls", /* Type name. */ - TlsBlockModeProc, /* Set blocking/nonblocking mode.*/ - TlsCloseProc, /* Close proc. */ - TlsInputProc, /* Input proc. */ - TlsOutputProc, /* Output proc. */ - NULL, /* Seek proc. */ - NULL, /* Set option proc. */ - TlsGetOptionProc, /* Get option proc. */ - TlsWatchProc, /* Initialize notifier. */ - TlsGetHandleProc, /* Get file handle out of channel. */ -}; -#else -static Tcl_ChannelType *tlsChannelType = NULL; +static int TlsBlockModeProc _ANSI_ARGS_((ClientData instanceData, int mode)); +static int TlsCloseProc _ANSI_ARGS_((ClientData instanceData, Tcl_Interp *interp)); +static int TlsInputProc _ANSI_ARGS_((ClientData instanceData, char *buf, int bufSize, int *errorCodePtr)); +static int TlsOutputProc _ANSI_ARGS_((ClientData instanceData, CONST char *buf, int toWrite, int *errorCodePtr)); +static int TlsGetOptionProc _ANSI_ARGS_((ClientData instanceData, Tcl_Interp *interp, CONST84 char *optionName, Tcl_DString *dsPtr)); +static void TlsWatchProc _ANSI_ARGS_((ClientData instanceData, int mask)); +static int TlsGetHandleProc _ANSI_ARGS_((ClientData instanceData, int direction, ClientData *handlePtr)); +static int TlsNotifyProc _ANSI_ARGS_((ClientData instanceData, int mask)); +#if 0 +static void TlsChannelHandler _ANSI_ARGS_((ClientData clientData, int mask)); #endif +static void TlsChannelHandlerTimer _ANSI_ARGS_((ClientData clientData)); + +/* + * TLS Channel Type + */ +static Tcl_ChannelType *tlsChannelType = NULL; /* *------------------------------------------------------------------- * * Tls_ChannelType -- @@ -96,134 +53,69 @@ * Side effects: * None. * *------------------------------------------------------------------- */ -Tcl_ChannelType *Tls_ChannelType() -{ - /* - * Initialize the channel type if necessary - */ - if (tlsChannelType == NULL) { - /* - * Allocation of a new channeltype structure is not easy, because of - * the various verson of the core and subsequent changes to the - * structure. The main challenge is to allocate enough memory for - * odern versions even if this extyension is compiled against one - * of the older variant! - * - * (1) Versions before stubs (8.0.x) are simple, because they are - * supported only if the extension is compiled against exactly - * that version of the core. - * - * (2) With stubs we just determine the difference between the older - * and modern variant and overallocate accordingly if compiled - * against an older variant. - */ - - unsigned int size = sizeof(Tcl_ChannelType); /* Base size */ - - /* - * Size of a procedure pointer. We assume that all procedure - * pointers are of the same size, regardless of exact type - * (arguments and return values). - * - * 8.2. First version containing close2proc. Baseline. - * 8.3.2 Three additional vectors. Moved blockMode, new flush- and - * handlerProc's. - * - * => Compilation against earlier version has to overallocate three - * procedure pointers. - */ - -#ifdef EMULATE_CHANNEL_VERSION_2 - size += 3 * procPtrSize; -#endif - - tlsChannelType = (Tcl_ChannelType *) ckalloc(size); - memset((VOID *) tlsChannelType, 0, size); - - /* - * Common elements of the structure (no changes in location or name) - * close2Proc, seekProc, setOptionProc stay NULL. - */ - - tlsChannelType->typeName = "tls"; - tlsChannelType->closeProc = TlsCloseProc; - tlsChannelType->inputProc = TlsInputProc; - tlsChannelType->outputProc = TlsOutputProc; - tlsChannelType->getOptionProc = TlsGetOptionProc; - tlsChannelType->watchProc = TlsWatchProc; - tlsChannelType->getHandleProc = TlsGetHandleProc; - - /* - * blockModeProc is a twister. We have to make some runtime-choices, - * depending on the version we compiled against. - */ - -#ifdef EMULATE_CHANNEL_VERSION_2 - /* - * We are compiling against an 8.3.1- core. We have to create some - * definitions for the new elements as the compiler does not know them - * by name. - */ - - if (channelTypeVersion == TLS_CHANNEL_VERSION_1) { - /* - * The 'version' element of 8.3.2 is in the the place of the - * blockModeProc. For 8.2.0-8.3.1 we have to set our blockModeProc - * into this place. - */ - tlsChannelType->blockModeProc = TlsBlockModeProc; - } else /* channelTypeVersion == TLS_CHANNEL_VERSION_2 */ { - /* - * For the 8.3.2 core we present ourselves as a version 2 - * driver. This means a special value in version (ex - * blockModeProc), blockModeProc in a different place and of - * course usage of the handlerProc. The last two have to - * referenced with pointer magic because they aren't defined - * otherwise. - */ - - tlsChannelType->blockModeProc = - (Tcl_DriverBlockModeProc*) TLS_CHANNEL_VERSION_2; - (*((Tcl_DriverBlockModeProc**)(&(tlsChannelType->close2Proc)+1))) - = TlsBlockModeProc; - (*((TlsDriverHandlerProc**)(&(tlsChannelType->close2Proc)+3))) - = TlsNotifyProc; - } -#else - /* - * Compiled against 8.3.2+. Direct access to all elements possible. Use - * channelTypeVersion information to select the values to use. - */ - - if (channelTypeVersion == TLS_CHANNEL_VERSION_1) { - /* - * The 'version' element of 8.3.2 is in the the place of the - * blockModeProc. For the original patch in 8.1.x and the firstly - * included (8.2) we have to set our blockModeProc into this - * place. - */ - tlsChannelType->version = (Tcl_ChannelTypeVersion)TlsBlockModeProc; - } else /* channelTypeVersion == TLS_CHANNEL_VERSION_2 */ { - /* - * For the 8.3.2 core we present ourselves as a version 2 - * driver. This means a special value in version (ex - * blockModeProc), blockModeProc in a different place and of - * course usage of the handlerProc. - */ - - tlsChannelType->version = TCL_CHANNEL_VERSION_2; - tlsChannelType->blockModeProc = TlsBlockModeProc; - tlsChannelType->handlerProc = TlsNotifyProc; - } -#endif - } - return tlsChannelType; -} - +Tcl_ChannelType *Tls_ChannelType(void) { + unsigned int size; + + /* + * Initialize the channel type if necessary + */ + if (tlsChannelType == NULL) { + /* + * Allocation of a new channeltype structure is not easy, because of + * the various verson of the core and subsequent changes to the + * structure. The main challenge is to allocate enough memory for + * modern versions even if this extsension is compiled against one + * of the older variant! + * + * (1) Versions before stubs (8.0.x) are simple, because they are + * supported only if the extension is compiled against exactly + * that version of the core. + * + * (2) With stubs we just determine the difference between the older + * and modern variant and overallocate accordingly if compiled + * against an older variant. + */ + size = sizeof(Tcl_ChannelType); /* Base size */ + + tlsChannelType = (Tcl_ChannelType *) ckalloc(size); + memset((VOID *) tlsChannelType, 0, size); + + /* + * Common elements of the structure (no changes in location or name) + * close2Proc, seekProc, setOptionProc stay NULL. + */ + + tlsChannelType->typeName = "tls"; + tlsChannelType->closeProc = TlsCloseProc; + tlsChannelType->inputProc = TlsInputProc; + tlsChannelType->outputProc = TlsOutputProc; + tlsChannelType->getOptionProc = TlsGetOptionProc; + tlsChannelType->watchProc = TlsWatchProc; + tlsChannelType->getHandleProc = TlsGetHandleProc; + + /* + * Compiled against 8.3.2+. Direct access to all elements possible. Use + * channelTypeVersion information to select the values to use. + */ + + /* + * For the 8.3.2 core we present ourselves as a version 2 + * driver. This means a special value in version (ex + * blockModeProc), blockModeProc in a different place and of + * course usage of the handlerProc. + */ + tlsChannelType->version = TCL_CHANNEL_VERSION_2; + tlsChannelType->blockModeProc = TlsBlockModeProc; + tlsChannelType->handlerProc = TlsNotifyProc; + } + + return(tlsChannelType); +} + /* *------------------------------------------------------------------- * * TlsBlockModeProc -- * @@ -235,32 +127,22 @@ * Side effects: * Sets the device into blocking or nonblocking mode. * *------------------------------------------------------------------- */ - -static int -TlsBlockModeProc(ClientData instanceData, /* Socket state. */ - int mode) /* The mode to set. Can be one of - * TCL_MODE_BLOCKING or - * TCL_MODE_NONBLOCKING. */ -{ - State *statePtr = (State *) instanceData; - - if (mode == TCL_MODE_NONBLOCKING) { - statePtr->flags |= TLS_TCL_ASYNC; - } else { - statePtr->flags &= ~(TLS_TCL_ASYNC); - } - if (channelTypeVersion == TLS_CHANNEL_VERSION_2) { - return 0; - } else { - return Tcl_SetChannelOption(statePtr->interp, Tls_GetParent(statePtr), - "-blocking", (mode == TCL_MODE_NONBLOCKING) ? "0" : "1"); - } -} - +static int TlsBlockModeProc(ClientData instanceData, int mode) { + State *statePtr = (State *) instanceData; + + if (mode == TCL_MODE_NONBLOCKING) { + statePtr->flags |= TLS_TCL_ASYNC; + } else { + statePtr->flags &= ~(TLS_TCL_ASYNC); + } + + return(0); +} + /* *------------------------------------------------------------------- * * TlsCloseProc -- * @@ -284,25 +166,15 @@ { State *statePtr = (State *) instanceData; dprintf("TlsCloseProc(%p)", (void *) statePtr); - if (channelTypeVersion == TLS_CHANNEL_VERSION_1) { - /* - * Remove event handler to underlying channel, this could - * be because we are closing for real, or being "unstacked". - */ - - Tcl_DeleteChannelHandler(Tls_GetParent(statePtr), - TlsChannelHandler, (ClientData) statePtr); - } - Tls_Clean(statePtr); Tcl_EventuallyFree((ClientData)statePtr, Tls_Free); return TCL_OK; } - + /* *------------------------------------------------------------------- * * TlsInputProc -- * @@ -396,11 +268,11 @@ } input: dprintf("Input(%d) -> %d [%d]", bufSize, bytesRead, *errorCodePtr); return bytesRead; } - + /* *------------------------------------------------------------------- * * TlsOutputProc -- * @@ -509,11 +381,11 @@ } output: dprintf("Output(%d) -> %d", toWrite, written); return written; } - + /* *------------------------------------------------------------------- * * TlsGetOptionProc -- * @@ -540,50 +412,28 @@ Tcl_DString *dsPtr) /* Where to store the computed value * initialized by caller. */ { State *statePtr = (State *) instanceData; - if (channelTypeVersion == TLS_CHANNEL_VERSION_2) { - Tcl_Channel downChan = Tls_GetParent(statePtr); - Tcl_DriverGetOptionProc *getOptionProc; - - getOptionProc = Tcl_ChannelGetOptionProc(Tcl_GetChannelType(downChan)); - if (getOptionProc != NULL) { - return (*getOptionProc)(Tcl_GetChannelInstanceData(downChan), - interp, optionName, dsPtr); - } else if (optionName == (char*) NULL) { - /* - * Request is query for all options, this is ok. - */ - return TCL_OK; - } - /* - * Request for a specific option has to fail, we don't have any. - */ - return TCL_ERROR; - } else { -#if 0 - size_t len = 0; - - if (optionName != (char *) NULL) { - len = strlen(optionName); - } - if ((len == 0) || ((len > 1) && (optionName[1] == 'c') && - (strncmp(optionName, "-cipher", len) == 0))) { - if (len == 0) { - Tcl_DStringAppendElement(dsPtr, "-cipher"); - } - Tcl_DStringAppendElement(dsPtr, SSL_get_cipher(statePtr->ssl)); - if (len) { - return TCL_OK; - } - } -#endif - return TCL_OK; - } -} - + Tcl_Channel downChan = Tls_GetParent(statePtr); + Tcl_DriverGetOptionProc *getOptionProc; + + getOptionProc = Tcl_ChannelGetOptionProc(Tcl_GetChannelType(downChan)); + if (getOptionProc != NULL) { + return (*getOptionProc)(Tcl_GetChannelInstanceData(downChan), interp, optionName, dsPtr); + } else if (optionName == (char*) NULL) { + /* + * Request is query for all options, this is ok. + */ + return TCL_OK; + } + /* + * Request for a specific option has to fail, we don't have any. + */ + return TCL_ERROR; +} + /* *------------------------------------------------------------------- * * TlsWatchProc -- * @@ -603,21 +453,19 @@ TlsWatchProc(ClientData instanceData, /* The socket state. */ int mask) /* Events of interest; an OR-ed * combination of TCL_READABLE, * TCL_WRITABLE and TCL_EXCEPTION. */ { + Tcl_Channel downChan; State *statePtr = (State *) instanceData; 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 (channelTypeVersion == TLS_CHANNEL_VERSION_2) { - Tcl_Channel downChan; - statePtr->watchMask = mask; /* No channel handlers any more. We will be notified automatically * about events on the channel below via a call to our * 'TransformNotifyProc'. But we have to pass the interest down now. @@ -645,36 +493,12 @@ * data waiting, so generate a timer to flush that. */ statePtr->timer = Tcl_CreateTimerHandler(TLS_TCL_DELAY, TlsChannelHandlerTimer, (ClientData) statePtr); } - } else { - if (mask == statePtr->watchMask) - return; - - if (statePtr->watchMask) { - /* - * Remove event handler to underlying channel, this could - * be because we are closing for real, or being "unstacked". - */ - - Tcl_DeleteChannelHandler(Tls_GetParent(statePtr), - TlsChannelHandler, (ClientData) statePtr); - } - statePtr->watchMask = mask; - if (statePtr->watchMask) { - /* - * Setup active monitor for events on underlying Channel. - */ - - Tcl_CreateChannelHandler(Tls_GetParent(statePtr), - statePtr->watchMask, TlsChannelHandler, - (ClientData) statePtr); - } - } -} - +} + /* *------------------------------------------------------------------- * * TlsGetHandleProc -- * @@ -696,11 +520,11 @@ { State *statePtr = (State *) instanceData; return Tcl_GetChannelHandle(Tls_GetParent(statePtr), direction, handlePtr); } - + /* *------------------------------------------------------------------- * * TlsNotifyProc -- * @@ -749,21 +573,27 @@ if ((statePtr->flags & TLS_TCL_INIT) && !SSL_is_init_finished(statePtr->ssl)) { int errorCode = 0; dprintf("Calling Tls_WaitForConnect"); - if (Tls_WaitForConnect(statePtr, &errorCode) <= 0 && errorCode == EAGAIN) { - dprintf("Async flag could be set (didn't check) and errorCode == EAGAIN: Returning 0"); - return 0; + if (Tls_WaitForConnect(statePtr, &errorCode) <= 0) { + if (errorCode == EAGAIN) { + dprintf("Async flag could be set (didn't check) and errorCode == EAGAIN: Returning 0"); + + return 0; + } + + dprintf("Tls_WaitForConnect returned an error"); } } dprintf("Returning %i", mask); return mask; } - + +#if 0 /* *------------------------------------------------------* * * TlsChannelHandler -- * @@ -839,11 +669,12 @@ statePtr->timer = Tcl_CreateTimerHandler(TLS_TCL_DELAY, TlsChannelHandlerTimer, (ClientData) statePtr); } Tcl_Release( (ClientData)statePtr); } - +#endif + /* *------------------------------------------------------* * * TlsChannelHandlerTimer -- * @@ -876,11 +707,11 @@ if (BIO_pending(statePtr->bio)) { mask |= TCL_READABLE; } Tcl_NotifyChannel(statePtr->self, mask); } - + /* *------------------------------------------------------* * * Tls_WaitForConnect -- * @@ -890,15 +721,11 @@ * Result: * None. * *------------------------------------------------------* */ -int -Tls_WaitForConnect( statePtr, errorCodePtr) - State *statePtr; - int *errorCodePtr; /* Where to store error code. */ -{ +int Tls_WaitForConnect(State *statePtr, int *errorCodePtr) { int err; dprintf("WaitForConnect(%p)", (void *) statePtr); if (statePtr->flags & TLS_TCL_HANDSHAKE_FAILED) { @@ -983,52 +810,10 @@ dprintf("R0! "); return 1; } } -Tcl_Channel -Tls_GetParent( statePtr ) - State *statePtr; -{ - if (channelTypeVersion == TLS_CHANNEL_VERSION_2) { - return Tcl_GetStackedChannel(statePtr->self); - } else { - /* The reason for the existence of this procedure is - * the fact that stacking a transform over another - * transform will leave our internal pointer unchanged, - * and thus pointing to the new transform, and not the - * Channel structure containing the saved state of this - * transform. This is the price to pay for leaving - * Tcl_Channel references intact. The only other solution - * is an extension of Tcl_ChannelType with another driver - * procedure to notify a Channel about the (un)stacking. - * - * It walks the chain of Channel structures until it - * finds the one pointing having 'ctrl' as instanceData - * and then returns the superceding channel to that. (AK) - */ - - Tcl_Channel self = statePtr->self; - Tcl_Channel next; - - while ((ClientData) statePtr != Tcl_GetChannelInstanceData (self)) { - next = Tcl_GetStackedChannel (self); - if (next == (Tcl_Channel) NULL) { - /* 09/24/1999 Unstacking bug, - * found by Matt Newman . - * - * We were unable to find the channel structure for this - * transformation in the chain of stacked channel. This - * means that we are currently in the process of unstacking - * it *and* there were some bytes waiting which are now - * flushed. In this situation the pointer to the channel - * itself already refers to the parent channel we have to - * write the bytes into, so we return that. - */ - return statePtr->self; - } - self = next; - } - - return Tcl_GetStackedChannel (self); - } +Tcl_Channel Tls_GetParent(State *statePtr) { + dprintf("Requested to get parent of channel %p", statePtr->self); + + return(Tcl_GetStackedChannel(statePtr->self)); } Index: tlsInt.h ================================================================== --- tlsInt.h +++ tlsInt.h @@ -132,131 +132,27 @@ BIO *p_bio; /* Parent BIO (that is layered on Tcl_Channel) */ char *err; } State; -/* - * The following definitions have to be usable for 8.2.0-8.3.1 and 8.3.2+. - * The differences between these versions: - * - * 8.0-8.1: There is no support for these in TLS 1.4 (get 1.3). This - * was the version with the original patch. - * - * 8.2.0- Changed semantics for Tcl_StackChannel (Tcl_ReplaceChannel). - * 8.3.1: Check at runtime to switch the behaviour. The patch is part - * of the core from now on. - * - * 8.3.2+: Stacked channels rewritten for better behaviour in some - * situations (closing). Some new API's, semantic changes. - * - * The following magic was adapted from Trf 2.1 (Kupries). - */ - -#define TLS_CHANNEL_VERSION_1 0x1 -#define TLS_CHANNEL_VERSION_2 0x2 -extern int channelTypeVersion; - #ifdef USE_TCL_STUBS #ifndef Tcl_StackChannel -/* - * The core we are compiling against is not patched, so supply the - * necesssary definitions here by ourselves. The form chosen for - * the procedure macros (reservedXXX) will notify us if the core - * does not have these reserved locations anymore. - * - * !! Synchronize the procedure indices in their definitions with - * the patch to tcl.decls, as they have to be the same. - */ - -/* 281 */ -typedef Tcl_Channel (tls_StackChannel) _ANSI_ARGS_((Tcl_Interp* interp, - Tcl_ChannelType* typePtr, - ClientData instanceData, - int mask, - Tcl_Channel prevChan)); -/* 282 */ -typedef void (tls_UnstackChannel) _ANSI_ARGS_((Tcl_Interp* interp, - Tcl_Channel chan)); - -#define Tcl_StackChannel ((tls_StackChannel*) tclStubsPtr->reserved281) -#define Tcl_UnstackChannel ((tls_UnstackChannel*) tclStubsPtr->reserved282) - -#endif /* Tcl_StackChannel */ - -#ifndef Tcl_GetStackedChannel -/* - * Separate definition, available in 8.2, but not 8.1 and before ! - */ - -/* 283 */ -typedef Tcl_Channel (tls_GetStackedChannel) _ANSI_ARGS_((Tcl_Channel chan)); - -#define Tcl_GetStackedChannel ((tls_GetStackedChannel*) tclStubsPtr->reserved283) - +#error "Unable to compile on this version of Tcl" #endif /* Tcl_GetStackedChannel */ - - -#ifndef TCL_CHANNEL_VERSION_2 -/* - * Core is older than 8.3.2. Supply the missing definitions for - * the new API's in 8.3.2. - */ -#define EMULATE_CHANNEL_VERSION_2 - -typedef struct TlsChannelTypeVersion_* TlsChannelTypeVersion; -#define TCL_CHANNEL_VERSION_2 ((TlsChannelTypeVersion) 0x2) - -typedef int (TlsDriverHandlerProc) _ANSI_ARGS_((ClientData instanceData, - int interestMask)); -/* 394 */ -typedef int (tls_ReadRaw) _ANSI_ARGS_((Tcl_Channel chan, char *dst, - int bytesToRead)); -/* 395 */ -typedef int (tls_WriteRaw) _ANSI_ARGS_((Tcl_Channel chan, char *src, - int srcLen)); -/* 397 */ -typedef int (tls_GetTopChannel) _ANSI_ARGS_((Tcl_Channel chan)); - -/* - * Generating code for accessing these parts of the stub table when - * compiling against a core older than 8.3.2 is a hassle because even - * the 'reservedXXX' fields of the structure are not defined yet. So - * we have to write up some macros hiding some very hackish pointer - * arithmetics to get at these fields. We assume that pointer to - * functions are always of the same size. - */ - -#define STUB_BASE ((char*)(&(tclStubsPtr->tcl_UtfNcasecmp))) /* field 370 */ -#define procPtrSize (sizeof (Tcl_DriverBlockModeProc *)) -#define IDX(n) (((n)-370) * procPtrSize) -#define SLOT(n) (STUB_BASE + IDX(n)) - -#define Tcl_ReadRaw (*((tls_ReadRaw**) (SLOT(394)))) -#define Tcl_WriteRaw (*((tls_WriteRaw**) (SLOT(395)))) -#define Tcl_GetTopChannel (*((tls_GetTopChannel**)(SLOT(396)))) - -/* - * Required, easy emulation. - */ -#define Tcl_ChannelGetOptionProc(chanDriver) ((chanDriver)->getOptionProc) - -#endif /* TCL_CHANNEL_VERSION_2 */ - #endif /* USE_TCL_STUBS */ /* * Forward declarations */ Tcl_ChannelType *Tls_ChannelType _ANSI_ARGS_((void)); -Tcl_Channel Tls_GetParent _ANSI_ARGS_((State *statePtr)); - -Tcl_Obj* Tls_NewX509Obj _ANSI_ARGS_ (( Tcl_Interp *interp, X509 *cert)); -void Tls_Error _ANSI_ARGS_ ((State *statePtr, char *msg)); -void Tls_Free _ANSI_ARGS_ ((char *blockPtr)); -void Tls_Clean _ANSI_ARGS_ ((State *statePtr)); -int Tls_WaitForConnect _ANSI_ARGS_(( State *statePtr, - int *errorCodePtr)); - -BIO * BIO_new_tcl _ANSI_ARGS_((State* statePtr, int flags)); +Tcl_Channel Tls_GetParent _ANSI_ARGS_((State *statePtr)); + +Tcl_Obj *Tls_NewX509Obj _ANSI_ARGS_ (( Tcl_Interp *interp, X509 *cert)); +void Tls_Error _ANSI_ARGS_ ((State *statePtr, char *msg)); +void Tls_Free _ANSI_ARGS_ ((char *blockPtr)); +void Tls_Clean _ANSI_ARGS_ ((State *statePtr)); +int Tls_WaitForConnect _ANSI_ARGS_(( State *statePtr, int *errorCodePtr)); + +BIO *BIO_new_tcl _ANSI_ARGS_((State* statePtr, int flags)); #endif /* _TLSINT_H */