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
@@ -132,11 +144,14 @@
fi
])
dnl Enable compiler warnings
AX_CHECK_COMPILE_FLAG([-Wall], [CFLAGS="$CFLAGS -Wall"])
-AX_CHECK_COMPILE_FLAG([-W], [CFLAGS="$CFLAGS -W"])
+AX_CHECK_COMPILE_FLAG([-W], [
+ CFLAGS="$CFLAGS -W"
+ AX_CHECK_COMPILE_FLAG([-Wno-self-assign], [CFLAGS="$CFLAGS -Wno-self-assign"])
+])
dnl Enable hardening
AX_CHECK_COMPILE_FLAG([-fstack-protector-all], [CFLAGS="$CFLAGS -fstack-protector-all"])
AX_CHECK_COMPILE_FLAG([-fno-strict-overflow], [CFLAGS="$CFLAGS -fno-strict-overflow"])
AC_DEFINE([_FORTIFY_SOURCE], [2], [Enable fortification])
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
@@ -116,22 +116,41 @@
* Threaded operation requires locking callbacks
* Based from /crypto/cryptlib.c of OpenSSL and NSOpenSSL.
*/
static Tcl_Mutex *locks = NULL;
+static int locksCount = 0;
static Tcl_Mutex init_mx;
void CryptoThreadLockCallback(int mode, int n, const char *file, int line) {
+
if (mode & CRYPTO_LOCK) {
+ /* This debugging is turned off by default -- it's too noisy. */
+ /* dprintf("Called to lock (n=%i of %i)", n, locksCount); */
Tcl_MutexLock(&locks[n]);
} else {
+ /* dprintf("Called to unlock (n=%i of %i)", n, locksCount); */
Tcl_MutexUnlock(&locks[n]);
}
+
+ dprintf("Returning");
+
+ return;
+ file = file;
+ line = line;
}
unsigned long CryptoThreadIdCallback(void) {
- return (unsigned long) Tcl_GetCurrentThread();
+ unsigned long ret;
+
+ dprintf("Called");
+
+ ret = (unsigned long) Tcl_GetCurrentThread();
+
+ dprintf("Returning %lu", ret);
+
+ return(ret);
}
#endif /* OPENSSL_THREADS */
#endif /* TCL_THREADS */
@@ -153,10 +172,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 +360,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);
}
@@ -397,19 +420,24 @@
*/
static int
PasswordCallback(char *buf, int size, int verify)
{
return -1;
+ buf = buf;
+ size = size;
+ verify = verify;
}
#else
static int
PasswordCallback(char *buf, int size, int verify, void *udata)
{
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);
@@ -440,10 +468,11 @@
strncpy(buf, ret, (size_t) size);
return (int)strlen(ret);
} else {
return -1;
}
+ verify = verify;
}
#endif
/*
*-------------------------------------------------------------------
@@ -478,10 +507,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;
}
@@ -573,10 +604,11 @@
SSL_free(ssl);
SSL_CTX_free(ctx);
Tcl_SetObjResult( interp, objPtr);
return TCL_OK;
+ clientData = clientData;
}
/*
*-------------------------------------------------------------------
*
@@ -602,10 +634,12 @@
Tcl_Obj *CONST objv[];
{
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,18 +678,19 @@
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));
return TCL_OK;
+ clientData = clientData;
}
/*
*-------------------------------------------------------------------
*
@@ -724,10 +759,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 +891,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 +938,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,13 +953,15 @@
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;
+ clientData = clientData;
}
/*
*-------------------------------------------------------------------
*
@@ -943,10 +985,12 @@
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;
}
@@ -969,10 +1013,11 @@
if (Tcl_UnstackChannel(interp, chan) == TCL_ERROR) {
return TCL_ERROR;
}
return TCL_OK;
+ clientData = clientData;
}
/*
*-------------------------------------------------------------------
*
@@ -1002,10 +1047,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 +1299,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;
@@ -1308,10 +1357,11 @@
Tcl_ListObjAppendElement(interp, objPtr,
Tcl_NewStringObj(SSL_get_cipher(statePtr->ssl), -1));
}
Tcl_SetObjResult( interp, objPtr);
return TCL_OK;
+ clientData = clientData;
}
/*
*-------------------------------------------------------------------
*
@@ -1331,15 +1381,20 @@
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;
+ clientData = clientData;
+ objc = objc;
+ objv = objv;
}
/*
*-------------------------------------------------------------------
*
@@ -1361,10 +1416,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;
}
@@ -1498,10 +1555,11 @@
break;
default:
break;
}
return TCL_OK;
+ clientData = clientData;
}
/*
*-------------------------------------------------------------------
*
@@ -1520,10 +1578,12 @@
*/
void
Tls_Free( char *blockPtr )
{
State *statePtr = (State *)blockPtr;
+
+ dprintf("Called");
Tls_Clean(statePtr);
ckfree(blockPtr);
}
@@ -1543,17 +1603,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 +1637,12 @@
}
if (statePtr->password) {
Tcl_DecrRefCount(statePtr->password);
statePtr->password = NULL;
}
+
+ dprintf("Returning");
}
/*
*-------------------------------------------------------------------
*
@@ -1599,11 +1660,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 +1718,11 @@
*
*------------------------------------------------------*
*/
int Tls_SafeInit(Tcl_Interp *interp) {
+ dprintf("Called");
return(Tls_Init(interp));
}
/*
*------------------------------------------------------*
@@ -1699,10 +1764,11 @@
CRYPTO_set_id_callback(NULL);
if (locks) {
free(locks);
locks = NULL;
+ locksCount = 0;
}
#endif
initialized = 0;
#if defined(OPENSSL_THREADS) && defined(TCL_THREADS)
@@ -1711,21 +1777,26 @@
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;
#if defined(OPENSSL_THREADS) && defined(TCL_THREADS)
num_locks = CRYPTO_num_locks();
+ locksCount = num_locks;
locks = malloc(sizeof(*locks) * num_locks);
+ memset(locks, 0, sizeof(*locks) * num_locks);
CRYPTO_set_locking_callback(CryptoThreadLockCallback);
CRYPTO_set_id_callback(CryptoThreadIdCallback);
#endif
@@ -1734,10 +1805,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
@@ -39,10 +39,18 @@
static int BioFree _ANSI_ARGS_((BIO *h));
BIO *BIO_new_tcl(State *statePtr, int flags) {
BIO *bio;
static BIO_METHOD *BioMethods = NULL;
+#ifdef TCLTLS_SSL_USE_FASTPATH
+ Tcl_Channel parentChannel;
+ const Tcl_ChannelType *parentChannelType;
+ void *parentChannelFdIn_p, *parentChannelFdOut_p;
+ int parentChannelFdIn, parentChannelFdOut, parentChannelFd;
+ int validParentChannelFd;
+ int tclGetChannelHandleRet;
+#endif
dprintf("BIO_new_tcl() called");
if (BioMethods == NULL) {
BioMethods = BIO_meth_new(BIO_TYPE_TCL, "tcl");
@@ -52,82 +60,161 @@
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, tclErrno;
- chan = Tls_GetParent((State *) BIO_get_data(bio));
+ chan = Tls_GetParent((State *) BIO_get_data(bio), 0);
- dprintf("BioWrite(%p, <buf>, %d) [%p]", (void *) bio, bufLen, (void *) chan);
+ dprintf("[chan=%p] BioWrite(%p, <buf>, %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);
+ tclErrno = Tcl_GetErrno();
+
+ 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 && ret <= 0) {
+ dprintf("Got %i from Tcl_WriteRaw, and EOF is set; ret = -1", ret);
+ Tcl_SetErrno(ECONNRESET);
+ ret = -1;
+ } else if (ret == 0) {
+ dprintf("Got 0 from Tcl_WriteRaw, and EOF is not set; ret = 0");
+ dprintf("Setting retry read flag");
+ BIO_set_retry_read(bio);
+ } else if (ret < 0) {
+ dprintf("We got some kind of I/O error");
+
+ if (tclErrno == EAGAIN) {
+ dprintf("It's EAGAIN");
+ ret = 0;
+ } else {
+ dprintf("It's an unepxected error: %s/%i", Tcl_ErrnoMsg(tclErrno), tclErrno);
+ Tcl_SetErrno(ECONNRESET);
ret = -1;
}
+ } else {
+ dprintf("Successfully wrote some data");
}
- if (BIO_should_read(bio)) {
- BIO_set_retry_read(bio);
+ if (ret != -1) {
+ if (BIO_should_read(bio)) {
+ dprintf("Setting should retry read flag");
+
+ BIO_set_retry_read(bio);
+ }
}
return(ret);
}
static int BioRead(BIO *bio, char *buf, int bufLen) {
Tcl_Channel chan;
int ret = 0;
- int tclEofChan;
+ int tclEofChan, tclErrno;
- chan = Tls_GetParent((State *) BIO_get_data(bio));
+ chan = Tls_GetParent((State *) BIO_get_data(bio), 0);
- dprintf("BioRead(%p, <buf>, %d) [%p]", (void *) bio, bufLen, (void *) chan);
+ dprintf("[chan=%p] BioRead(%p, <buf>, %d)", (void *) chan, (void *) bio, bufLen);
if (buf == NULL) {
return 0;
}
ret = Tcl_ReadRaw(chan, buf, bufLen);
tclEofChan = Tcl_Eof(chan);
+ tclErrno = Tcl_GetErrno();
- 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, tclErrno);
BIO_clear_flags(bio, BIO_FLAGS_READ | BIO_FLAGS_SHOULD_RETRY);
- 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);
- ret = -1;
+ if (tclEofChan && ret <= 0) {
+ dprintf("Got %i from Tcl_Read or Tcl_ReadRaw, and EOF is set; ret = -1", ret);
+ Tcl_SetErrno(ECONNRESET);
+ ret = -1;
+ } else if (ret == 0) {
+ 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);
+ } else if (ret < 0) {
+ dprintf("We got some kind of I/O error");
+
+ if (tclErrno == EAGAIN) {
+ dprintf("It's EAGAIN");
+ ret = 0;
} else {
- dprintf("Got 0 from Tcl_Read or Tcl_ReadRaw, and EOF is set");
+ dprintf("It's an unepxected error: %s/%i", Tcl_ErrnoMsg(tclErrno), tclErrno);
+ Tcl_SetErrno(ECONNRESET);
+ ret = -1;
}
} else {
- dprintf("Got non-zero from Tcl_Read or Tcl_ReadRaw; ret == %i", ret);
+ dprintf("Successfully read some data");
}
- if (BIO_should_write(bio)) {
- BIO_set_retry_write(bio);
+ if (ret != -1) {
+ if (BIO_should_write(bio)) {
+ dprintf("Setting should retry write flag");
+
+ BIO_set_retry_write(bio);
+ }
}
dprintf("BioRead(%p, <buf>, %d) [%p] returning %i", (void *) bio, bufLen, (void *) chan, ret);
return(ret);
@@ -141,11 +228,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 +285,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
@@ -158,21 +158,24 @@
* Side effects:
* Closes the socket of the channel.
*
*-------------------------------------------------------------------
*/
-static int
-TlsCloseProc(ClientData instanceData, /* The socket to close. */
- Tcl_Interp *interp) /* For error reporting - unused. */
-{
- State *statePtr = (State *) instanceData;
-
- dprintf("TlsCloseProc(%p)", (void *) statePtr);
-
- Tls_Clean(statePtr);
- Tcl_EventuallyFree((ClientData)statePtr, Tls_Free);
- return TCL_OK;
+static int TlsCloseProc(ClientData instanceData, Tcl_Interp *interp) {
+ State *statePtr = (State *) instanceData;
+
+ dprintf("TlsCloseProc(%p)", (void *) statePtr);
+
+ Tls_Clean(statePtr);
+ Tcl_EventuallyFree((ClientData)statePtr, Tls_Free);
+
+ dprintf("Returning TCL_OK");
+
+ return(TCL_OK);
+
+ /* Interp is unused. */
+ interp = interp;
}
/*
*-------------------------------------------------------------------
*
@@ -190,87 +193,84 @@
* 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");
+ 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(0);
+ }
+
+ 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;
+ }
+
+ dprintf("Input(%d) -> %d [%d]", bufSize, bytesRead, *errorCodePtr);
+ return(bytesRead);
}
/*
*-------------------------------------------------------------------
*
@@ -287,48 +287,51 @@
* 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");
+ err = BIO_flush(statePtr->bio);
+
+ if (err <= 0) {
+ dprintf("Flushing failed");
+
+ *errorCodePtr = EIO;
+ written = 0;
+ return(-1);
+ }
+
+ 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 +341,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;
+ }
+
+ dprintf("Output(%d) -> %d", toWrite, written);
+ return(written);
}
/*
*-------------------------------------------------------------------
*
@@ -412,11 +412,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 +460,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 +490,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 +532,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 +555,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 +699,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 +741,166 @@
* 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");
+
+ err = BIO_flush(statePtr->bio);
+
+ if (err <= 0) {
+ dprintf("Flushing the lower layers failed, this will probably terminate this session");
+ }
+ }
+
+ 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 (rc == SSL_ERROR_SYSCALL && Tcl_GetErrno() == EAGAIN) {
+ 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 <errno.h>
#include <string.h>
+#include <stdint.h>
#ifdef __WIN32__
#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#include <wincrypt.h> /* 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 <ctype.h>
+#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 */
Index: tlsX509.c
==================================================================
--- tlsX509.c
+++ tlsX509.c
@@ -119,29 +119,29 @@
X509_NAME_print_ex(bio, X509_get_subject_name(cert), 0, flags);
n = BIO_read(bio, subject, min(BIO_pending(bio), BUFSIZ - 1));
n = max(n, 0);
subject[n] = 0;
- BIO_flush(bio);
+ (void)BIO_flush(bio);
X509_NAME_print_ex(bio, X509_get_issuer_name(cert), 0, flags);
n = BIO_read(bio, issuer, min(BIO_pending(bio), BUFSIZ - 1));
n = max(n, 0);
issuer[n] = 0;
- BIO_flush(bio);
+ (void)BIO_flush(bio);
i2a_ASN1_INTEGER(bio, X509_get_serialNumber(cert));
n = BIO_read(bio, serial, min(BIO_pending(bio), BUFSIZ - 1));
n = max(n, 0);
serial[n] = 0;
- BIO_flush(bio);
+ (void)BIO_flush(bio);
if (PEM_write_bio_X509(bio, cert)) {
n = BIO_read(bio, certStr, min(BIO_pending(bio), BUFSIZ - 1));
n = max(n, 0);
certStr[n] = 0;
- BIO_flush(bio);
+ (void)BIO_flush(bio);
}
BIO_free(bio);
}