Index: configure.in ================================================================== --- configure.in +++ configure.in @@ -121,10 +121,22 @@ dnl Find "xxd" so we can build the tls.tcl.h file AC_CHECK_PROG([XXD], [xxd], [xxd], [__xxd__not__found]) dnl Find "pkg-config" since we need to use it AC_CHECK_TOOL([PKGCONFIG], [pkg-config], [false]) + +dnl Determine if we have been asked to use a fast path if possible +tcltls_ssl_fastpath='yes' +AC_ARG_ENABLE([ssl-fastpath], AS_HELP_STRING([--disable-ssl-fast-path], [disable using the underlying file descriptor for talking directly to the SSL library]), [ + if test "$enableval" = 'no'; then + tcltls_ssl_fastpath='no' + fi +]) + +if test "$tcltls_ssl_fastpath" = 'yes'; then + AC_DEFINE(TCLTLS_SSL_USE_FASTPATH, [1], [Define this to enable using the underlying file descriptor for talking directly to the SSL library]) +fi dnl Determine if we have been asked to statically link to the SSL library TCLEXT_TLS_STATIC_SSL='no' AC_ARG_ENABLE([static-ssl], AS_HELP_STRING([--enable-static-ssl], [enable statically linking to the specified SSL library]), [ if test "$enableval" = 'yes'; then 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 @@ -166,11 +166,11 @@ set remoteServerIP 127.0.0.1 set remoteFile [file join [pwd] remote.tcl] if {[catch {set remoteProcChan \ [open "|[list $::tcltest::tcltest $remoteFile \ -serverIsSilent -port $remoteServerPort \ - -address $remoteServerIP]" w+]} msg] == 0} { + -address $remoteServerIP] 2> /dev/null" w+]} msg] == 0} { after 1000 if {[catch {set commandSocket [tls::socket -cafile $caCert \ -certfile $clientCert -keyfile $clientKey \ $remoteServerIP $remoteServerPort]} msg] == 0} { fconfigure $commandSocket -translation crlf -buffering line @@ -320,11 +320,11 @@ after cancel $timer close $f puts $x } close $f - set f [open "|[list $::tcltest::tcltest script]" r] + set f [open "|[list $::tcltest::tcltest script] 2> /dev/null" r] gets $f x if {[catch {tls::socket -certfile $clientCert -cafile $caCert \ -keyfile $clientKey 127.0.0.1 8828} msg]} { set x $msg } else { @@ -362,11 +362,11 @@ vwait x after cancel $timer close $f } close $f - set f [open "|[list $::tcltest::tcltest script]" r] + set f [open "|[list $::tcltest::tcltest script] 2> /dev/null" r] gets $f x global port if {[catch {tls::socket -myport $port \ -certfile $clientCert -cafile $caCert \ -keyfile $clientKey 127.0.0.1 8829} sock]} { @@ -402,11 +402,11 @@ vwait x after cancel $timer close $f } close $f - set f [open "|[list $::tcltest::tcltest script]" r] + set f [open "|[list $::tcltest::tcltest script] 2> /dev/null" r] gets $f x if {[catch {tls::socket -myaddr 127.0.0.1 \ -certfile $clientCert -cafile $caCert \ -keyfile $clientKey 127.0.0.1 8830} sock]} { set x $sock @@ -440,11 +440,11 @@ vwait x after cancel $timer close $f } close $f - set f [open "|[list $::tcltest::tcltest script]" r] + set f [open "|[list $::tcltest::tcltest script] 2> /dev/null" r] gets $f x if {[catch {tls::socket -certfile $clientCert -cafile $caCert \ -keyfile $clientKey [info hostname] 8831} sock]} { set x $sock } else { @@ -477,11 +477,11 @@ vwait x after cancel $timer close $f } close $f - set f [open "|[list $::tcltest::tcltest script]" r] + set f [open "|[list $::tcltest::tcltest script] 2> /dev/null" r] gets $f x if {[catch {tls::socket -certfile $clientCert -cafile $caCert \ -keyfile $clientKey 127.0.0.1 8832} sock]} { set x $sock } else { @@ -533,11 +533,11 @@ after cancel $timer close $f puts done } close $f - set f [open "|[list $::tcltest::tcltest script]" r] + set f [open "|[list $::tcltest::tcltest script] 2> /dev/null" r] gets $f set s [tls::socket -certfile $clientCert -cafile $caCert \ -keyfile $clientKey 127.0.0.1 8834] fconfigure $s -buffering line -translation lf puts $s "hello abcdefghijklmnop" @@ -580,11 +580,11 @@ after cancel $timer close $f puts "done $i" } close $f - set f [open "|[list $::tcltest::tcltest script]" r] + set f [open "|[list $::tcltest::tcltest script] 2> /dev/null" r] gets $f set s [tls::socket -certfile $clientCert -cafile $caCert \ -keyfile $clientKey 127.0.0.1 8835] fconfigure $s -buffering line catch { @@ -705,11 +705,11 @@ after cancel $timer close $f puts $x } close $f - set f [open "|[list $::tcltest::tcltest script]" r] + set f [open "|[list $::tcltest::tcltest script] 2> /dev/null" r] gets $f x if {[catch {tls::socket 127.0.0.1 8828} msg]} { set x $msg } else { lappend x [gets $f] @@ -732,11 +732,11 @@ puts ready gets stdin close $f } close $f - set f [open "|[list $::tcltest::tcltest script]" r+] + set f [open "|[list $::tcltest::tcltest script] 2> /dev/null" r+] gets $f set x [list [catch {tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ -server accept 8828} msg] \ $msg] @@ -781,11 +781,11 @@ after cancel $t3 close $s puts $x } close $f - set f [open "|[list $::tcltest::tcltest script]" r+] + set f [open "|[list $::tcltest::tcltest script] 2> /dev/null" r+] set x [gets $f] set s1 [tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ 127.0.0.1 8828] fconfigure $s1 -buffering line @@ -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 @@ -832,15 +832,15 @@ close $s puts bye gets stdin } close $f - set p1 [open "|[list $::tcltest::tcltest script]" r+] + set p1 [open "|[list $::tcltest::tcltest script] 2> /dev/null" r+] fconfigure $p1 -buffering line - set p2 [open "|[list $::tcltest::tcltest script]" r+] + set p2 [open "|[list $::tcltest::tcltest script] 2> /dev/null" r+] fconfigure $p2 -buffering line - set p3 [open "|[list $::tcltest::tcltest script]" r+] + set p3 [open "|[list $::tcltest::tcltest script] 2> /dev/null" r+] fconfigure $p3 -buffering line proc accept {s a p} { fconfigure $s -buffering line fileevent $s readable [list echo $s] } @@ -930,11 +930,11 @@ package require tls gets stdin } puts $f [list tls::socket -cafile $caCert 127.0.0.1 8848] close $f - set f [open "|[list $::tcltest::tcltest script]" r+] + set f [open "|[list $::tcltest::tcltest script] 2> /dev/null" r+] proc bgerror args { global x set x $args } proc accept {s a p} {expr 10 / 0} @@ -968,11 +968,11 @@ set timer [after 10000 "set x timed_out"] vwait x after cancel $timer } close $f - set f [open "|[list $::tcltest::tcltest script]" r] + set f [open "|[list $::tcltest::tcltest script] 2> /dev/null" r] gets $f set s [tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ 127.0.0.1 8820] set p [fconfigure $s -peername] @@ -1001,11 +1001,11 @@ set timer [after 10000 "set x timed_out"] vwait x after cancel $timer } close $f - set f [open "|[list $::tcltest::tcltest script]" r] + set f [open "|[list $::tcltest::tcltest script] 2> /dev/null" r] gets $f set s [tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ 127.0.0.1 8821] set p [fconfigure $s -sockname] @@ -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 @@ -2053,10 +2053,15 @@ [info hostname] 8831] fconfigure $c -blocking 0 puts $c a ; flush $c after 5000 [list set ::done timeout] vwait ::done + switch -exact -- $::done { + "handshake failed: wrong ssl version" { + set ::done "handshake failed: wrong version number" + } + } set ::done } {handshake failed: wrong version number} # cleanup if {[string match sock* $commandSocket] == 1} { Index: tls.c ================================================================== --- tls.c +++ tls.c @@ -153,10 +153,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); @@ -339,10 +341,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); } @@ -406,10 +410,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); @@ -478,10 +484,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; } @@ -603,10 +611,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; } @@ -644,12 +654,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)); @@ -724,10 +734,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; } @@ -854,11 +866,14 @@ * 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"); + 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); + 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); @@ -898,11 +913,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); @@ -913,10 +928,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; } @@ -942,10 +958,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; } @@ -1002,10 +1020,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; } @@ -1252,10 +1272,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; @@ -1331,10 +1353,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; @@ -1361,10 +1385,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; } @@ -1520,10 +1546,12 @@ */ void Tls_Free( char *blockPtr ) { State *statePtr = (State *)blockPtr; + + dprintf("Called"); Tls_Clean(statePtr); ckfree(blockPtr); } @@ -1543,17 +1571,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; } @@ -1578,10 +1605,12 @@ } if (statePtr->password) { Tcl_DecrRefCount(statePtr->password); statePtr->password = NULL; } + + dprintf("Returning"); } /* *------------------------------------------------------------------- * @@ -1599,11 +1628,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 ( @@ -1654,10 +1686,11 @@ * *------------------------------------------------------* */ int Tls_SafeInit(Tcl_Interp *interp) { + dprintf("Called"); return(Tls_Init(interp)); } /* *------------------------------------------------------* @@ -1711,12 +1744,15 @@ return(TCL_OK); } if (initialized) { + dprintf("Called, but using cached value"); return(status); } + + dprintf("Called"); #if defined(OPENSSL_THREADS) && defined(TCL_THREADS) Tcl_MutexLock(&init_mx); #endif initialized = 1; @@ -1734,10 +1770,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,17 @@ 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; + void *parentChannelFdIn_p, *parentChannelFdOut_p; + 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 +58,83 @@ 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); + } + +#ifdef TCLTLS_SSL_USE_FASTPATH + /* + * 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, 0); + parentChannelType = Tcl_GetChannelType(parentChannel); + + validParentChannelFd = 0; + if (strcmp(parentChannelType->typeName, "tcp") == 0) { + tclGetChannelHandleRet = Tcl_GetChannelHandle(parentChannel, TCL_READABLE, (ClientData) &parentChannelFdIn_p); + if (tclGetChannelHandleRet == TCL_OK) { + tclGetChannelHandleRet = Tcl_GetChannelHandle(parentChannel, TCL_WRITABLE, (ClientData) &parentChannelFdOut_p); + if (tclGetChannelHandleRet == TCL_OK) { + parentChannelFdIn = PTR2INT(parentChannelFdIn_p); + parentChannelFdOut = PTR2INT(parentChannelFdOut_p); + if (parentChannelFdIn == parentChannelFdOut) { + parentChannelFd = parentChannelFdIn; + validParentChannelFd = 1; + } + } + } + } + + if (validParentChannelFd) { + dprintf("We found a shortcut, this channel is backed by a socket: %i", parentChannelFdIn); + bio = BIO_new_socket(parentChannelFd, flags); + statePtr->flags |= TLS_TCL_FASTPATH; + return(bio); + } + + dprintf("Falling back to Tcl I/O for this channel"); +#endif + bio = BIO_new(BioMethods); BIO_set_data(bio, statePtr); - BIO_set_init(bio, 1); 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)); + chan = Tls_GetParent((State *) BIO_get_data(bio), 0); - 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); @@ -94,42 +146,47 @@ static int BioRead(BIO *bio, char *buf, int bufLen) { Tcl_Channel chan; int ret = 0; int tclEofChan; - chan = Tls_GetParent((State *) BIO_get_data(bio)); + chan = Tls_GetParent((State *) BIO_get_data(bio), 0); - 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); } @@ -141,11 +198,11 @@ static long BioCtrl(BIO *bio, int cmd, long num, void *ptr) { Tcl_Channel chan; long ret = 1; - chan = Tls_GetParent((State *) BIO_get_data(bio)); + chan = Tls_GetParent((State *) BIO_get_data(bio), 0); dprintf("BioCtrl(%p, 0x%x, 0x%x, %p)", (void *) bio, (unsigned int) cmd, (unsigned int) num, (void *) ptr); switch (cmd) { case BIO_CTRL_RESET: @@ -198,11 +255,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; } /* *------------------------------------------------------------------- @@ -190,87 +193,85 @@ * Reads input from the input device of the channel. * *------------------------------------------------------------------- */ -static int -TlsInputProc(ClientData instanceData, /* Socket state. */ - char *buf, /* Where to store data read. */ - int bufSize, /* How much space is available - * in the buffer? */ - int *errorCodePtr) /* Where to store error code. */ -{ - State *statePtr = (State *) instanceData; - int bytesRead; /* How many bytes were read? */ - - *errorCodePtr = 0; - - dprintf("BIO_read(%d)", bufSize); - - if (statePtr->flags & TLS_TCL_CALLBACK) { - /* don't process any bytes while verify callback is running */ - dprintf("Callback is running, reading 0 bytes"); - - bytesRead = 0; - goto input; - } - - if (!SSL_is_init_finished(statePtr->ssl)) { - dprintf("Calling Tls_WaitForConnect"); - bytesRead = Tls_WaitForConnect(statePtr, errorCodePtr); - if (bytesRead <= 0) { - dprintf("Got an error (bytesRead = %i)", bytesRead); - - if (*errorCodePtr == ECONNRESET) { - dprintf("Got connection reset"); - /* Soft EOF */ - *errorCodePtr = 0; - bytesRead = 0; - } - goto input; - } - } - - if (statePtr->flags & TLS_TCL_INIT) { - statePtr->flags &= ~(TLS_TCL_INIT); - } - /* - * We need to clear the SSL error stack now because we sometimes reach - * this function with leftover errors in the stack. If BIO_read - * returns -1 and intends EAGAIN, there is a leftover error, it will be - * misconstrued as an error, not EAGAIN. - * - * Alternatively, we may want to handle the <0 return codes from - * BIO_read specially (as advised in the RSA docs). TLS's lower level BIO - * functions play with the retry flags though, and this seems to work - * correctly. Similar fix in TlsOutputProc. - hobbs - */ - ERR_clear_error(); - bytesRead = BIO_read(statePtr->bio, buf, bufSize); - dprintf("BIO_read -> %d", bytesRead); - - 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! "); - *errorCodePtr = EAGAIN; - } else { - *errorCodePtr = Tcl_GetErrno(); - if (*errorCodePtr == ECONNRESET) { - /* Soft EOF */ - *errorCodePtr = 0; - bytesRead = 0; - } - } - } - input: - dprintf("Input(%d) -> %d [%d]", bufSize, bytesRead, *errorCodePtr); - return bytesRead; +static int TlsInputProc(ClientData instanceData, char *buf, int bufSize, int *errorCodePtr) { + State *statePtr = (State *) instanceData; + int bytesRead; + int tlsConnect; + int err; + + *errorCodePtr = 0; + + dprintf("BIO_read(%d)", bufSize); + + if (statePtr->flags & TLS_TCL_CALLBACK) { + /* don't process any bytes while verify callback is running */ + dprintf("Callback is running, reading 0 bytes"); + + bytesRead = 0; + return(0); + } + + dprintf("Calling Tls_WaitForConnect"); + tlsConnect = Tls_WaitForConnect(statePtr, errorCodePtr); + if (tlsConnect < 0) { + dprintf("Got an error (bytesRead = %i)", bytesRead); + + if (*errorCodePtr == ECONNRESET) { + dprintf("Got connection reset"); + /* Soft EOF */ + *errorCodePtr = 0; + bytesRead = 0; + } + return(bytesRead); + } + + if (statePtr->flags & TLS_TCL_INIT) { + statePtr->flags &= ~(TLS_TCL_INIT); + } + + /* + * We need to clear the SSL error stack now because we sometimes reach + * this function with leftover errors in the stack. If BIO_read + * returns -1 and intends EAGAIN, there is a leftover error, it will be + * misconstrued as an error, not EAGAIN. + * + * Alternatively, we may want to handle the <0 return codes from + * BIO_read specially (as advised in the RSA docs). TLS's lower level BIO + * functions play with the retry flags though, and this seems to work + * correctly. Similar fix in TlsOutputProc. - hobbs + */ + ERR_clear_error(); + bytesRead = BIO_read(statePtr->bio, buf, bufSize); + dprintf("BIO_read -> %d", bytesRead); + + err = SSL_get_error(statePtr->ssl, bytesRead); + + if (BIO_should_retry(statePtr->bio)) { + dprintf("I/O failed, will retry based on EAGAIN"); + *errorCodePtr = EAGAIN; + } + + switch (err) { + case SSL_ERROR_NONE: + dprintBuffer(buf, bytesRead); + break; + case SSL_ERROR_SSL: + Tls_Error(statePtr, TCLTLS_SSL_ERROR(statePtr->ssl, bytesRead)); + *errorCodePtr = ECONNABORTED; + break; + case SSL_ERROR_SYSCALL: + dprintf("I/O error reading, treating it as EOF"); + *errorCodePtr = 0; + bytesRead = 0; + break; + } +input: + dprintf("Input(%d) -> %d [%d]", bufSize, bytesRead, *errorCodePtr); + return bytesRead; } /* *------------------------------------------------------------------- * @@ -287,48 +288,42 @@ * Writes output on the output device of the channel. * *------------------------------------------------------------------- */ -static int -TlsOutputProc(ClientData instanceData, /* Socket state. */ - CONST char *buf, /* The data buffer. */ - int toWrite, /* How many bytes to write? */ - int *errorCodePtr) /* Where to store error code. */ -{ - State *statePtr = (State *) instanceData; - int written, err; - - *errorCodePtr = 0; - - dprintf("BIO_write(%p, %d)", (void *) statePtr, toWrite); - - if (statePtr->flags & TLS_TCL_CALLBACK) { - /* don't process any bytes while verify callback is running */ - written = -1; - *errorCodePtr = EAGAIN; - goto output; - } - - if (!SSL_is_init_finished(statePtr->ssl)) { - dprintf("Calling Tls_WaitForConnect"); +static int TlsOutputProc(ClientData instanceData, CONST char *buf, int toWrite, int *errorCodePtr) { + State *statePtr = (State *) instanceData; + int written, err; + + *errorCodePtr = 0; + + dprintf("BIO_write(%p, %d)", (void *) statePtr, toWrite); + dprintBuffer(buf, toWrite); + + if (statePtr->flags & TLS_TCL_CALLBACK) { + dprintf("Don't process output while callbacks are running") + written = -1; + *errorCodePtr = EAGAIN; + return(-1); + } + + dprintf("Calling Tls_WaitForConnect"); written = Tls_WaitForConnect(statePtr, errorCodePtr); - if (written <= 0) { - dprintf("Tls_WaitForConnect returned %i (err = %i)", written, *errorCodePtr); - - goto output; - } - } - if (statePtr->flags & TLS_TCL_INIT) { - statePtr->flags &= ~(TLS_TCL_INIT); - } - if (toWrite == 0) { - dprintf("zero-write"); - BIO_flush(statePtr->bio); - written = 0; - goto output; - } else { + if (written < 0) { + dprintf("Tls_WaitForConnect returned %i (err = %i)", written, *errorCodePtr); + + return(-1); + } + + if (toWrite == 0) { + dprintf("zero-write"); + BIO_flush(statePtr->bio); + written = 0; + *errorCodePtr = 0; + return(0); + } + /* * We need to clear the SSL error stack now because we sometimes reach * this function with leftover errors in the stack. If BIO_write * returns -1 and intends EAGAIN, there is a leftover error, it will be * misconstrued as an error, not EAGAIN. @@ -338,52 +333,49 @@ * BIO functions play with the retry flags though, and this seems to * work correctly. Similar fix in TlsInputProc. - hobbs */ ERR_clear_error(); written = BIO_write(statePtr->bio, buf, toWrite); - dprintf("BIO_write(%p, %d) -> [%d]", - (void *) statePtr, toWrite, written); - } - if (written <= 0) { - switch ((err = SSL_get_error(statePtr->ssl, written))) { - case SSL_ERROR_NONE: - if (written < 0) { - written = 0; - } - break; - case SSL_ERROR_WANT_WRITE: - dprintf(" write W BLOCK"); - break; - case SSL_ERROR_WANT_READ: - dprintf(" write R BLOCK"); - break; - case SSL_ERROR_WANT_X509_LOOKUP: - dprintf(" write X BLOCK"); - break; - case SSL_ERROR_ZERO_RETURN: - dprintf(" closed"); - written = 0; - break; - case SSL_ERROR_SYSCALL: - *errorCodePtr = Tcl_GetErrno(); - dprintf(" [%d] syscall errr: %d", - written, *errorCodePtr); - written = -1; - break; - case SSL_ERROR_SSL: - Tls_Error(statePtr, TCLTLS_SSL_ERROR(statePtr->ssl, written)); - *errorCodePtr = ECONNABORTED; - written = -1; - break; - default: - dprintf(" unknown err: %d", err); - break; - } - } - output: - dprintf("Output(%d) -> %d", toWrite, written); - return written; + dprintf("BIO_write(%p, %d) -> [%d]", (void *) statePtr, toWrite, written); + + err = SSL_get_error(statePtr->ssl, written); + switch (err) { + case SSL_ERROR_NONE: + if (written < 0) { + written = 0; + } + break; + case SSL_ERROR_WANT_WRITE: + dprintf(" write W BLOCK"); + break; + case SSL_ERROR_WANT_READ: + dprintf(" write R BLOCK"); + break; + case SSL_ERROR_WANT_X509_LOOKUP: + dprintf(" write X BLOCK"); + break; + case SSL_ERROR_ZERO_RETURN: + dprintf(" closed"); + written = 0; + break; + case SSL_ERROR_SYSCALL: + *errorCodePtr = Tcl_GetErrno(); + dprintf(" [%d] syscall errr: %d", written, *errorCodePtr); + written = -1; + break; + case SSL_ERROR_SSL: + Tls_Error(statePtr, TCLTLS_SSL_ERROR(statePtr->ssl, written)); + *errorCodePtr = ECONNABORTED; + written = -1; + break; + default: + dprintf(" unknown err: %d", err); + break; + } +output: + dprintf("Output(%d) -> %d", toWrite, written); + return(written); } /* *------------------------------------------------------------------- * @@ -412,11 +404,11 @@ Tcl_DString *dsPtr) /* Where to store the computed value * initialized by caller. */ { State *statePtr = (State *) instanceData; - Tcl_Channel downChan = Tls_GetParent(statePtr); + Tcl_Channel downChan = Tls_GetParent(statePtr, TLS_TCL_FASTPATH); Tcl_DriverGetOptionProc *getOptionProc; getOptionProc = Tcl_ChannelGetOptionProc(Tcl_GetChannelType(downChan)); if (getOptionProc != NULL) { return (*getOptionProc)(Tcl_GetChannelInstanceData(downChan), interp, optionName, dsPtr); @@ -460,11 +452,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, TLS_TCL_FASTPATH); + + 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 +482,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); } } @@ -511,18 +524,14 @@ * Side effects: * None. * *------------------------------------------------------------------- */ -static int -TlsGetHandleProc(ClientData instanceData, /* The socket state. */ - int direction, /* Which Tcl_File to retrieve? */ - ClientData *handlePtr) /* Where to store the handle. */ -{ - State *statePtr = (State *) instanceData; - - return Tcl_GetChannelHandle(Tls_GetParent(statePtr), direction, handlePtr); +static int TlsGetHandleProc(ClientData instanceData, int direction, ClientData *handlePtr) { + State *statePtr = (State *) instanceData; + + return(Tcl_GetChannelHandle(Tls_GetParent(statePtr, TLS_TCL_FASTPATH), direction, handlePtr)); } /* *------------------------------------------------------------------- * @@ -538,59 +547,51 @@ * May process the incoming event by itself. * *------------------------------------------------------------------- */ -static int -TlsNotifyProc(instanceData, mask) - ClientData instanceData; /* The state of the notified transformation */ - int mask; /* The mask of occuring events */ -{ - State *statePtr = (State *) instanceData; - - /* - * An event occured in the underlying channel. This - * transformation doesn't process such events thus returns the - * incoming mask unchanged. - */ - - if (statePtr->timer != (Tcl_TimerToken) NULL) { - /* - * Delete an existing timer. It was not fired, yet we are - * here, so the channel below generated such an event and we - * don't have to. The renewal of the interest after the - * execution of channel handlers will eventually cause us to - * recreate the timer (in WatchProc). - */ - - Tcl_DeleteTimerHandler(statePtr->timer); - statePtr->timer = (Tcl_TimerToken) NULL; - } - - if (statePtr->flags & TLS_TCL_CALLBACK) { - dprintf("Returning 0 due to callback"); - return 0; - } - - 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) { - 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; +static int TlsNotifyProc(ClientData instanceData, int mask) { + State *statePtr = (State *) instanceData; + int errorCode; + + /* + * An event occured in the underlying channel. This + * transformation doesn't process such events thus returns the + * incoming mask unchanged. + */ + if (statePtr->timer != (Tcl_TimerToken) NULL) { + /* + * Delete an existing timer. It was not fired, yet we are + * here, so the channel below generated such an event and we + * don't have to. The renewal of the interest after the + * execution of channel handlers will eventually cause us to + * recreate the timer (in WatchProc). + */ + Tcl_DeleteTimerHandler(statePtr->timer); + statePtr->timer = (Tcl_TimerToken) NULL; + } + + if (statePtr->flags & TLS_TCL_CALLBACK) { + dprintf("Returning 0 due to callback"); + return 0; + } + + dprintf("Calling Tls_WaitForConnect"); + errorCode = 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 /* *------------------------------------------------------* @@ -690,26 +691,36 @@ * None. * *------------------------------------------------------* */ -static void -TlsChannelHandlerTimer (clientData) -ClientData clientData; /* Transformation to query */ -{ - State *statePtr = (State *) clientData; - int mask = 0; - - statePtr->timer = (Tcl_TimerToken) NULL; - - if (BIO_wpending(statePtr->bio)) { - mask |= TCL_WRITABLE; - } - if (BIO_pending(statePtr->bio)) { - mask |= TCL_READABLE; - } - Tcl_NotifyChannel(statePtr->self, mask); +static void TlsChannelHandlerTimer(ClientData clientData) { + State *statePtr = (State *) clientData; + int mask = 0; + + dprintf("Called"); + + statePtr->timer = (Tcl_TimerToken) NULL; + + if (BIO_wpending(statePtr->bio)) { + dprintf("[chan=%p] BIO writable", statePtr->self); + + mask |= TCL_WRITABLE; + } + + if (BIO_pending(statePtr->bio)) { + dprintf("[chan=%p] BIO readable", statePtr->self); + + mask |= TCL_READABLE; + } + + dprintf("Notifying ourselves"); + Tcl_NotifyChannel(statePtr->self, mask); + + dprintf("Returning"); + + return; } /* *------------------------------------------------------* * @@ -722,98 +733,160 @@ * None. * *------------------------------------------------------* */ int Tls_WaitForConnect(State *statePtr, int *errorCodePtr) { - int err; - - dprintf("WaitForConnect(%p)", (void *) statePtr); - - if (statePtr->flags & TLS_TCL_HANDSHAKE_FAILED) { - /* - * We choose ECONNRESET over ECONNABORTED here because some server - * side code, on the wiki for example, sets up a read handler that - * does a read and if eof closes the channel. There is no catch/try - * around the reads so exceptions will result in potentially many - * dangling channels hanging around that should have been closed. - * (Backgroun: ECONNABORTED maps to a Tcl exception and - * ECONNRESET maps to graceful EOF). - */ - *errorCodePtr = ECONNRESET; - return -1; - } - - for (;;) { - /* Not initialized yet! */ - if (statePtr->flags & TLS_TCL_SERVER) { - dprintf("Calling SSL_accept()"); - err = SSL_accept(statePtr->ssl); - } else { - dprintf("Calling SSL_connect()"); - err = SSL_connect(statePtr->ssl); - } - - /*SSL_write(statePtr->ssl, (char*)&err, 0); HACK!!! */ - if (err > 0) { - dprintf("That seems to have gone okay"); - BIO_flush(statePtr->bio); - } else { - int rc = SSL_get_error(statePtr->ssl, err); - - dprintf("Got error: %i (rc = %i)", err, rc); - - if (rc == SSL_ERROR_SSL) { - Tls_Error(statePtr, - (char *)ERR_reason_error_string(ERR_get_error())); - statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED; - *errorCodePtr = ECONNABORTED; - return -1; - } else if (BIO_should_retry(statePtr->bio)) { - if (statePtr->flags & TLS_TCL_ASYNC) { - dprintf("E! "); - *errorCodePtr = EAGAIN; - return -1; - } else { - continue; - } - } else if (err <= 0) { - if (SSL_in_init(statePtr->ssl)) { - dprintf("SSL_in_init() is true"); - } - - if (Tcl_Eof(statePtr->self)) { - dprintf("Error = 0 and EOF is set"); - - if (rc != SSL_ERROR_SYSCALL) { - dprintf("Error from some reason other than our BIO, returning 0"); - return 0; - } - } - dprintf("CR! "); - statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED; - *errorCodePtr = ECONNRESET; - return -1; - } - if (statePtr->flags & TLS_TCL_SERVER) { + unsigned long backingError; + int err, rc; + int bioShouldRetry; + + dprintf("WaitForConnect(%p)", (void *) statePtr); + dprintFlags(statePtr); + + if (!(statePtr->flags & TLS_TCL_INIT)) { + dprintf("Tls_WaitForConnect called on already initialized channel -- returning with immediate success"); + *errorCodePtr = 0; + return(0); + } + + if (statePtr->flags & TLS_TCL_HANDSHAKE_FAILED) { + /* + * We choose ECONNRESET over ECONNABORTED here because some server + * side code, on the wiki for example, sets up a read handler that + * does a read and if eof closes the channel. There is no catch/try + * around the reads so exceptions will result in potentially many + * dangling channels hanging around that should have been closed. + * (Backgroun: ECONNABORTED maps to a Tcl exception and + * ECONNRESET maps to graceful EOF). + */ + *errorCodePtr = ECONNRESET; + return(-1); + } + + for (;;) { + /* Not initialized yet! */ + if (statePtr->flags & TLS_TCL_SERVER) { + dprintf("Calling SSL_accept()"); + + err = SSL_accept(statePtr->ssl); + } else { + dprintf("Calling SSL_connect()"); + + err = SSL_connect(statePtr->ssl); + } + + if (err > 0) { + dprintf("That seems to have gone okay"); + + BIO_flush(statePtr->bio); + } + + rc = SSL_get_error(statePtr->ssl, err); + + dprintf("Got error: %i (rc = %i)", err, rc); + + 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; + } else if (BIO_should_retry(statePtr->bio)) { + bioShouldRetry = 1; + } + } else { + if (!SSL_is_init_finished(statePtr->ssl)) { + bioShouldRetry = 1; + } + } + + 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"); + break; + } + + + *errorCodePtr = EINVAL; + + switch (rc) { + case SSL_ERROR_NONE: + /* The connection is up, we are done here */ + dprintf("The connection is up"); + break; + case SSL_ERROR_ZERO_RETURN: + dprintf("SSL_ERROR_ZERO_RETURN: Connect returned an invalid value...") + return(-1); + case SSL_ERROR_SYSCALL: + backingError = ERR_get_error(); + dprintf("I/O error occured"); + + if (backingError == 0 && err == 0) { + dprintf("EOF reached") + } + + statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED; + *errorCodePtr = ECONNRESET; + return(-1); + case SSL_ERROR_SSL: + dprintf("Got permanent fatal SSL error, aborting immediately"); + Tls_Error(statePtr, (char *)ERR_reason_error_string(ERR_get_error())); + 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) { - Tls_Error(statePtr, - (char *)X509_verify_cert_error_string(err)); - statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED; - *errorCodePtr = ECONNABORTED; - return -1; - } - } - *errorCodePtr = Tcl_GetErrno(); - dprintf("ERR(%d, %d) ", rc, *errorCodePtr); - return -1; - } - dprintf("R0! "); - return 1; - } -} - -Tcl_Channel Tls_GetParent(State *statePtr) { - dprintf("Requested to get parent of channel %p", statePtr->self); + 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 + + dprintf("Removing the \"TLS_TCL_INIT\" flag since we have completed the handshake"); + statePtr->flags &= ~TLS_TCL_INIT; + + dprintf("Returning in success"); + *errorCodePtr = 0; + + return(0); +} + +Tcl_Channel Tls_GetParent(State *statePtr, int maskFlags) { + dprintf("Requested to get parent of channel %p", statePtr->self); + + if ((statePtr->flags & ~maskFlags) & TLS_TCL_FASTPATH) { + dprintf("Asked to get the parent channel while we are using FastPath -- returning NULL"); + return(NULL); + } return(Tcl_GetStackedChannel(statePtr->self)); } Index: tlsInt.h ================================================================== --- tlsInt.h +++ tlsInt.h @@ -19,10 +19,11 @@ #define _TLSINT_H #include "tls.h" #include #include +#include #ifdef __WIN32__ #define WIN32_LEAN_AND_MEAN #include #include /* OpenSSL needs this on Windows */ @@ -63,13 +64,49 @@ #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(...) { \ + char dprintfBuffer[8192], *dprintfBuffer_p; \ + dprintfBuffer_p = &dprintfBuffer[0]; \ + dprintfBuffer_p += sprintf(dprintfBuffer_p, "%s:%i:%s():", __FILE__, __LINE__, __func__); \ + dprintfBuffer_p += sprintf(dprintfBuffer_p, __VA_ARGS__); \ + fprintf(stderr, "%s\n", dprintfBuffer); \ + } +#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) { \ + char dprintfBuffer[8192], *dprintfBuffer_p; \ + dprintfBuffer_p = &dprintfBuffer[0]; \ + dprintfBuffer_p += sprintf(dprintfBuffer_p, "%s:%i:%s():%s->flags=0", __FILE__, __LINE__, __func__, #statePtr); \ + if (((statePtr)->flags & TLS_TCL_ASYNC) == TLS_TCL_ASYNC) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_ASYNC"); }; \ + if (((statePtr)->flags & TLS_TCL_SERVER) == TLS_TCL_SERVER) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_SERVER"); }; \ + if (((statePtr)->flags & TLS_TCL_INIT) == TLS_TCL_INIT) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_INIT"); }; \ + if (((statePtr)->flags & TLS_TCL_DEBUG) == TLS_TCL_DEBUG) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_DEBUG"); }; \ + if (((statePtr)->flags & TLS_TCL_CALLBACK) == TLS_TCL_CALLBACK) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_CALLBACK"); }; \ + if (((statePtr)->flags & TLS_TCL_HANDSHAKE_FAILED) == TLS_TCL_HANDSHAKE_FAILED) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_HANDSHAKE_FAILED"); }; \ + if (((statePtr)->flags & TLS_TCL_FASTPATH) == TLS_TCL_FASTPATH) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_FASTPATH"); }; \ + fprintf(stderr, "%s\n", dprintfBuffer); \ + } #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 @@ -86,11 +123,11 @@ #define TLS_TCL_CALLBACK (1<<4) /* In a callback, prevent update * looping problem. [Bug 1652380] */ #define TLS_TCL_HANDSHAKE_FAILED (1<<5) /* Set on handshake failures and once * set, all further I/O will result * in ECONNABORTED errors. */ - +#define TLS_TCL_FASTPATH (1<<6) /* The parent channel is being used directly by the SSL library */ #define TLS_TCL_DELAY (5) /* * This structure describes the per-instance state * of an ssl channel. @@ -126,16 +163,18 @@ /* * Forward declarations */ Tcl_ChannelType *Tls_ChannelType(void); -Tcl_Channel Tls_GetParent(State *statePtr); +Tcl_Channel Tls_GetParent(State *statePtr, int maskFlags); Tcl_Obj *Tls_NewX509Obj(Tcl_Interp *interp, X509 *cert); void Tls_Error(State *statePtr, char *msg); void Tls_Free(char *blockPtr); void Tls_Clean(State *statePtr); int Tls_WaitForConnect(State *statePtr, int *errorCodePtr); BIO *BIO_new_tcl(State* statePtr, int flags); + +#define PTR2INT(x) ((int) ((intptr_t) (x))) #endif /* _TLSINT_H */