fi

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
		TCLEXT_TLS_STATIC_SSL='yes'
	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])

dnl XXX:TODO: Automatically determine the SSL library to use

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    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}

puts stdout "Tests running in interp:  [info nameofexecutable]"
puts stdout "Tests running in working dir:  $::tcltest::testsDirectory"

	    set doTestsWithRemoteServer 0
	} else {
	    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
		} else {
		    set noRemoteTestReason $msg

	puts ready
	vwait x
	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 {
        lappend x [gets $f]
        close $msg

	}
	puts ready
	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]} {
        set x $sock
	catch {close [tls::socket 127.0.0.1 8829]}

	}
	puts ready
	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
    } else {
        puts $sock hello

	}
	puts ready
	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 {
        puts $sock hello
	flush $sock

	}
	puts ready
	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 {
        puts $sock hello
	flush $sock

	puts ready
	vwait x
	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"
    after 1000
    set x [gets $s]

	set timer [after 20000 "set x done"]
	vwait x
	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 {
	for {set x 0} {$x < 50} {incr x} {
	    puts $s "hello abcdefghijklmnop"

	puts ready
	vwait x
	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]
        close $msg
    }

    puts $f "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 8828 \]"
    puts $f {
	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]
    puts $f bye
    close $f

	after cancel $t2
	vwait x
	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
    set s2 [tls::socket \
	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
	    127.0.0.1 8828]
    fconfigure $s2 -buffering line
    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
    lappend x [gets $f]
    close $f

	    gets $s
	}
	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]
    }
    proc echo {s} {
	global x

    puts $f [list set auto_path $auto_path]
    puts $f {
    	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}
    set s [tls::socket -server accept \
	    -certfile $serverCert -cafile $caCert -keyfile $serverKey 8848]

	}
	puts ready
	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]
    close $s
    close $f

	}
	puts ready
	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]
    close $s
    close $f

	    $remoteServerIP 8836]
    fconfigure $s2 -buffering line
    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
    sendCommand {close $socket10_9_test_server}
    set i

               -cafile $caCert \
               -request 0 -require 0 -ssl2 0 -ssl3 0 -tls1 1 -tls1.1 0 -tls1.2 0 \
               [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} {
   puts $commandSocket exit
   flush $commandSocket
}
catch {close $commandSocket}
catch {close $remoteProcChan}
::tcltest::cleanupTests
flush stdout
return

void CryptoThreadLockCallback(int mode, int n, const char *file, int line) {
	if (mode & CRYPTO_LOCK) {
		Tcl_MutexLock(&locks[n]);
	} else {
		Tcl_MutexUnlock(&locks[n]);
	}
	return;
	file = file;
	line = line;
}

unsigned long CryptoThreadIdCallback(void) {
	return (unsigned long) Tcl_GetCurrentThread();
}
#endif /* OPENSSL_THREADS */
#endif /* TCL_THREADS */

 */
static void
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);

#if 0

 *-------------------------------------------------------------------
 */
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);
    }
    statePtr->err = msg;

 * No way to handle user-data therefore no way without a global
 * variable to access the Tcl interpreter.
*/
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);
	    strncpy(buf, ret, (size_t) size);
	    return (int)strlen(ret);

    if (result == TCL_OK) {
	char *ret = (char *) Tcl_GetStringResult(interp);
	strncpy(buf, ret, (size_t) size);
	return (int)strlen(ret);
    } else {
	return -1;
    }
    	verify = verify;
}
#endif

/*
 *-------------------------------------------------------------------
 *
 * CiphersObjCmd -- list available ciphers

    };
    Tcl_Obj *objPtr;
    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;
    }
    if (Tcl_GetIndexFromObj( interp, objv[1], protocols, "protocol", 0,
	&index) != TCL_OK) {

	}
    }
    SSL_free(ssl);
    SSL_CTX_free(ctx);

    Tcl_SetObjResult( interp, objPtr);
    return TCL_OK;
    	clientData = clientData;
}

/*
 *-------------------------------------------------------------------
 *
 * HandshakeObjCmd --
 *

    Tcl_Interp *interp;
    int objc;
    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;
    }

    chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), NULL);

	    Tcl_ResetResult(interp);
	    Tcl_SetErrno(err);

	    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;
}

/*
 *-------------------------------------------------------------------
 *
 * ImportObjCmd --
 *

#if defined(NO_TLS1_2)
    int tls1_2 = 0;
#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;
    }

    chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), NULL);

    /*
     * We need to make sure that the channel works in binary (for the
     * 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);
	return TCL_ERROR;
    }

    SSL_set_app_data(statePtr->ssl, (VOID *)statePtr);	/* point back to us */

    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);
    } else {
	SSL_set_connect_state(statePtr->ssl);
    }
    SSL_set_bio(statePtr->ssl, statePtr->p_bio, statePtr->p_bio);
    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;
}

/*
 *-------------------------------------------------------------------
 *
 * UnimportObjCmd --
 *

    ClientData clientData;	/* Not used. */
    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;
    }

    chan = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), NULL);
    if (chan == (Tcl_Channel) NULL) {

    }

    if (Tcl_UnstackChannel(interp, chan) == TCL_ERROR) {
	return TCL_ERROR;
    }

    return TCL_OK;
    	clientData = clientData;
}

/*
 *-------------------------------------------------------------------
 *
 * CTX_Init -- construct a SSL_CTX instance
 *

{
    Tcl_Interp *interp = statePtr->interp;
    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;
    }

    /* create SSL context */

    State *statePtr;
    X509 *peer;
    Tcl_Obj *objPtr;
    Tcl_Channel chan;
    char *channelName, *ciphers;
    int mode;

    dprintf("Called");

    switch (objc) {
	case 2:
	    channelName = Tcl_GetStringFromObj(objv[1], NULL);
	    break;

	case 3:
	    if (!strcmp (Tcl_GetString (objv[1]), "-local")) {

	Tcl_ListObjAppendElement(interp, objPtr,
		Tcl_NewStringObj("cipher", -1));
	Tcl_ListObjAppendElement(interp, objPtr,
		Tcl_NewStringObj(SSL_get_cipher(statePtr->ssl), -1));
    }
    Tcl_SetObjResult( interp, objPtr);
    return TCL_OK;
    	clientData = clientData;
}

/*
 *-------------------------------------------------------------------
 *
 * VersionObjCmd -- return version string from OpenSSL.
 *

VersionObjCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Not used. */
    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;
}

/*
 *-------------------------------------------------------------------
 *
 * MiscObjCmd -- misc commands
 *

    Tcl_Interp *interp;
    int objc;
    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;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], commands,
	    "command", 0,&cmd) != TCL_OK) {

	    }
	}
	break;
    default:
	break;
    }
    return TCL_OK;
    	clientData = clientData;
}

/*
 *-------------------------------------------------------------------
 *
 * Tls_Free --
 *

 *
 *-------------------------------------------------------------------
 */
void
Tls_Free( char *blockPtr )
{
    State *statePtr = (State *)blockPtr;

    dprintf("Called");

    Tls_Clean(statePtr);
    ckfree(blockPtr);
}

/*
 *-------------------------------------------------------------------

 *	none
 *
 * 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;
    }

    if (statePtr->bio) {
	/* This will call SSL_shutdown. Bug 1414045 */

	Tcl_DecrRefCount(statePtr->callback);
	statePtr->callback = NULL;
    }
    if (statePtr->password) {
	Tcl_DecrRefCount(statePtr->password);
	statePtr->password = NULL;
    }

    dprintf("Returning");
}

/*
 *-------------------------------------------------------------------
 *
 * Tls_Init --
 *

 *
 *-------------------------------------------------------------------
 */

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 (
#ifdef USE_TCL_STUBS
	    Tcl_InitStubs(interp, "8.4", 0)

 *	Result:
 *		A standard Tcl error code.
 *
 *------------------------------------------------------*
 */

int Tls_SafeInit(Tcl_Interp *interp) {
	dprintf("Called");
	return(Tls_Init(interp));
}

/*
 *------------------------------------------------------*
 *
 *	TlsLibInit --

		Tcl_MutexUnlock(&init_mx);
#endif

		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)

	if (SSL_library_init() != 1) {
		status = TCL_ERROR;
		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
	 * terrible entropy
	 */

static int BioPuts  _ANSI_ARGS_((BIO *h, CONST char *str));
static long BioCtrl _ANSI_ARGS_((BIO *h, int cmd, long arg1, void *ptr));
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");
		BIO_meth_set_write(BioMethods, BioWrite);
		BIO_meth_set_read(BioMethods, BioRead);
		BIO_meth_set_puts(BioMethods, BioPuts);
		BIO_meth_set_ctrl(BioMethods, BioCtrl);
		BIO_meth_set_create(BioMethods, BioNew);
		BIO_meth_set_destroy(BioMethods, BioFree);
	}

	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(BioMethods);

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

	tclEofChan = Tcl_Eof(chan);
	dprintf("[%p] BioWrite(%d) -> %d [%d.%d]", (void *) chan, bufLen, ret, Tcl_Eof(chan), 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) {
			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);
	}

	return(ret);
}

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

	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");
		if (tclEofChan) {
			dprintf("Got 0 from Tcl_Read or Tcl_ReadRaw, and EOF is set; ret = -1");
			BIO_set_retry_read(bio);
			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, <buf>, %d) [%p] returning %i", (void *) bio, bufLen, (void *) chan, ret);

	return(ret);
}

static int BioPuts(BIO *bio, CONST char *str) {
	dprintf("BioPuts(%p, <string:%p>) called", bio, str);

	return BioWrite(bio, str, (int) strlen(str));
}

static long BioCtrl(BIO *bio, int cmd, long num, void *ptr) {
	Tcl_Channel chan;
	long ret = 1;

	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:
			dprintf("Got BIO_CTRL_RESET");
			num = 0;

		case BIO_CTRL_FLUSH:
			dprintf("Got BIO_CTRL_FLUSH");
			ret = ((Tcl_WriteRaw(chan, "", 0) >= 0) ? 1 : -1);
			dprintf("BIO_CTRL_FLUSH returning value %li", ret);
			break;
		default:
			dprintf("Got unknown control command (%i)", cmd);
			ret = 0;
			ret = -2;
			break;
	}

	return(ret);
}

static int BioNew(BIO *bio) {

 *	0 if successful, the value of Tcl_GetErrno() if failed.
 *
 * Side effects:
 *	Closes the socket of the channel.
 *
 *-------------------------------------------------------------------
 */
static int
TlsCloseProc(ClientData instanceData,	/* The socket to close. */
static int TlsCloseProc(ClientData instanceData, Tcl_Interp *interp) {
             Tcl_Interp *interp)	/* For error reporting - unused. */
{
    State *statePtr = (State *) instanceData;
	State *statePtr = (State *) instanceData;

    dprintf("TlsCloseProc(%p)", (void *) statePtr);
	dprintf("TlsCloseProc(%p)", (void *) statePtr);

    Tls_Clean(statePtr);
    Tcl_EventuallyFree((ClientData)statePtr, Tls_Free);
    return TCL_OK;
	Tls_Clean(statePtr);
	Tcl_EventuallyFree((ClientData)statePtr, Tls_Free);

	dprintf("Returning TCL_OK");

	return(TCL_OK);

	/* Interp is unused. */
	interp = interp;
}

/*
 *-------------------------------------------------------------------
 *
 * TlsInputProc --
 *

 *
 * Side effects:
 *	Reads input from the input device of the channel.
 *
 *-------------------------------------------------------------------
 */

static int
TlsInputProc(ClientData instanceData,	/* Socket state. */
static int TlsInputProc(ClientData instanceData, char *buf, int bufSize, int *errorCodePtr) {
	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? */
	State *statePtr = (State *) instanceData;
	int bytesRead;
	int tlsConnect;
	int err;

    *errorCodePtr = 0;
	*errorCodePtr = 0;

    dprintf("BIO_read(%d)", bufSize);
	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");

	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);
       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);
	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;
	    }
		if (*errorCodePtr == ECONNRESET) {
			dprintf("Got connection reset");
			/* Soft EOF */
			*errorCodePtr = 0;
			bytesRead = 0;
		}
	    goto input;
	}
    }

		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);
	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);
	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) {
	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");
		/* Soft EOF */
		*errorCodePtr = 0;
		bytesRead = 0;
	    }
	}
			*errorCodePtr = 0;
			bytesRead = 0;
			break;
	}

    }
    input:
    dprintf("Input(%d) -> %d [%d]", bufSize, bytesRead, *errorCodePtr);
    return bytesRead;
	dprintf("Input(%d) -> %d [%d]", bufSize, bytesRead, *errorCodePtr);
	return(bytesRead);
}

/*
 *-------------------------------------------------------------------
 *
 * TlsOutputProc --
 *
 *	This procedure is invoked by the generic IO level
 *       to write output to a SSL socket based channel.
 *
 * Results:
 *	The number of bytes written is returned. An output argument is
 *	set to a POSIX error code if an error occurred, or zero.
 *
 * Side effects:
 *	Writes output on the output device of the channel.
 *
 *-------------------------------------------------------------------
 */

static int
TlsOutputProc(ClientData instanceData,	/* Socket state. */
static int TlsOutputProc(ClientData instanceData, CONST char *buf, int toWrite, int *errorCodePtr) {
              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;
	State *statePtr = (State *) instanceData;
	int written, err;

    *errorCodePtr = 0;
	*errorCodePtr = 0;

    dprintf("BIO_write(%p, %d)", (void *) statePtr, toWrite);
	dprintf("BIO_write(%p, %d)", (void *) statePtr, toWrite);
	dprintBuffer(buf, toWrite);

    if (statePtr->flags & TLS_TCL_CALLBACK) {
       /* don't process any bytes while verify callback is running */
       written = -1;
       *errorCodePtr = EAGAIN;
	if (statePtr->flags & TLS_TCL_CALLBACK) {
		dprintf("Don't process output while callbacks are running")
		written = -1;
		*errorCodePtr = EAGAIN;
       goto output;
    }
		return(-1);
	}

    if (!SSL_is_init_finished(statePtr->ssl)) {
        dprintf("Calling Tls_WaitForConnect");
	dprintf("Calling Tls_WaitForConnect");
	written = Tls_WaitForConnect(statePtr, errorCodePtr);
	if (written <= 0) {
            dprintf("Tls_WaitForConnect returned %i (err = %i)", written, *errorCodePtr);
	if (written < 0) {
		dprintf("Tls_WaitForConnect returned %i (err = %i)", written, *errorCodePtr);

	    goto output;
		return(-1);
	}
    }

    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 (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.
	 *
	 * Alternatively, we may want to handle the <0 return codes from
	 * BIO_write 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 TlsInputProc. - hobbs
	 */
	ERR_clear_error();
	written = BIO_write(statePtr->bio, buf, toWrite);
	dprintf("BIO_write(%p, %d) -> [%d]",
	dprintf("BIO_write(%p, %d) -> [%d]", (void *) statePtr, toWrite, written);
		(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",
	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, *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;
			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("Output(%d) -> %d", toWrite, written);
	return(written);
}

/*
 *-------------------------------------------------------------------
 *
 * TlsGetOptionProc --
 *

					 * NULL to get all options and
					 * their values. */
	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);
    } else if (optionName == (char*) NULL) {
        /*

    Tcl_Channel     downChan;
    State *statePtr = (State *) instanceData;

    dprintf("TlsWatchProc(0x%x)", mask);

    /* Pretend to be dead as long as the verify callback is running. 
     * Otherwise that callback could be invoked recursively. */
    if (statePtr->flags & TLS_TCL_CALLBACK) { return; }
    if (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
	 * 'TransformNotifyProc'. But we have to pass the interest down now.
	 * 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);
	}
}

/*
 *-------------------------------------------------------------------

 *	The appropriate Tcl_File or NULL if not present. 
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
static int
TlsGetHandleProc(ClientData instanceData,	/* The socket state. */
static int TlsGetHandleProc(ClientData instanceData, int direction, ClientData *handlePtr) {
                 int direction,		/* Which Tcl_File to retrieve? */
                 ClientData *handlePtr)	/* Where to store the handle.  */
{
    State *statePtr = (State *) instanceData;
	State *statePtr = (State *) instanceData;

    return Tcl_GetChannelHandle(Tls_GetParent(statePtr), direction, handlePtr);
	return(Tcl_GetChannelHandle(Tls_GetParent(statePtr, TLS_TCL_FASTPATH), direction, handlePtr));
}

/*
 *-------------------------------------------------------------------
 *
 * TlsNotifyProc --
 *
 *	Handler called by Tcl to inform us of activity
 *	on the underlying channel.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	May process the incoming event by itself.
 *
 *-------------------------------------------------------------------
 */

static int
static int TlsNotifyProc(ClientData instanceData, int mask) {
TlsNotifyProc(instanceData, mask)
    ClientData	   instanceData; /* The state of the notified transformation */
    int		   mask;       /* The mask of occuring events */
{
    State *statePtr = (State *) instanceData;
	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.
     */
	/*
	 * 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).
	 */
	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;
    }
		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_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");
	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;
            }
			return 0;
		}

            dprintf("Tls_WaitForConnect returned an error");
		dprintf("Tls_WaitForConnect returned an error");
	}
    }


    dprintf("Returning %i", mask);
	dprintf("Returning %i", mask);

    return mask;
	return(mask);
}

#if 0
/*
 *------------------------------------------------------*
 *
 *      TlsChannelHandler --

 *
 *	Result:
 *		None.
 *
 *------------------------------------------------------*
 */

static void
TlsChannelHandlerTimer (clientData)
static void TlsChannelHandlerTimer(ClientData clientData) {
ClientData clientData; /* Transformation to query */
{
    State *statePtr = (State *) clientData;
    int mask = 0;
	State *statePtr = (State *) clientData;
	int mask = 0;

	dprintf("Called");

    statePtr->timer = (Tcl_TimerToken) NULL;
	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);
	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;
}

/*
 *------------------------------------------------------*
 *
 *	Tls_WaitForConnect --
 *
 *	Sideeffects:
 *		Issues SSL_accept or SSL_connect
 *
 *	Result:
 *		None.
 *
 *------------------------------------------------------*
 */
int Tls_WaitForConnect(State *statePtr, int *errorCodePtr) {
	unsigned long backingError;
    int err;
	int err, rc;
	int bioShouldRetry;

    dprintf("WaitForConnect(%p)", (void *) statePtr);
	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;
    }
	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);
	}
	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);
		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);
		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;
	    if (rc == SSL_ERROR_SSL) {
		Tls_Error(statePtr,
			} else if (rc == SSL_ERROR_SYSCALL && Tcl_GetErrno() == EAGAIN) {
				bioShouldRetry = 1;
			}
		} else {
			(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_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;
			}
		}

                if (SSL_in_init(statePtr->ssl)) {
                    dprintf("SSL_in_init() is true");
                }
		dprintf("We have either completely established the session or completely failed it -- there is no more need to ever retry it though");
		break;
	}

                if (Tcl_Eof(statePtr->self)) {
                    dprintf("Error = 0 and EOF is set");

	*errorCodePtr = EINVAL;

	switch (rc) {
                    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) {
		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) {
			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;

			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);
	}
#endif

	dprintf("Removing the \"TLS_TCL_INIT\" flag since we have completed the handshake");
	    return -1;
	}
	dprintf("R0! ");
	statePtr->flags &= ~TLS_TCL_INIT;

	dprintf("Returning in success");
	return 1;
    }
	*errorCodePtr = 0;

	return(0);
}

Tcl_Channel Tls_GetParent(State *statePtr) {
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));
}

 */
#ifndef _TLSINT_H
#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 */
#endif

#define ECONNABORTED	130	/* Software caused connection abort */
#endif
#ifndef ECONNRESET
#define ECONNRESET	131	/* Connection reset by peer */
#endif

#ifdef TCLEXT_TCLTLS_DEBUG
#include <ctype.h>
#define dprintf(...) { fprintf(stderr, "%s:%i:", __func__, __LINE__); fprintf(stderr, __VA_ARGS__); fprintf(stderr, "\n"); }
#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
 */
#define BIO_TYPE_TCL	(19|0x0400)

/*
 * Defines for State.flags
 */
#define TLS_TCL_ASYNC	(1<<0)	/* non-blocking mode */
#define TLS_TCL_SERVER	(1<<1)	/* Server-Side */
#define TLS_TCL_INIT	(1<<2)	/* Initializing connection */
#define TLS_TCL_DEBUG	(1<<3)	/* Show debug tracing */
#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.
 *
 * The SSL processing context is maintained here, in the ClientData

#endif /* Tcl_GetStackedChannel */
#endif /* USE_TCL_STUBS */

/*
 * 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 */

	flags = XN_FLAG_RFC2253 | ASN1_STRFLGS_UTF8_CONVERT;
	flags &= ~ASN1_STRFLGS_ESC_MSB;

	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);
    }

    strcpy( notBefore, ASN1_UTCTIME_tostr( X509_get_notBefore(cert) ));
    strcpy( notAfter, ASN1_UTCTIME_tostr( X509_get_notAfter(cert) ));