update TEA 3.13

1 files changed, 0 insertions, 1833 deletions

diff --git a/tls/tls.c b/tls/tls.c
deleted file mode 100644
index dd95e93..0000000
--- a/tls/tls.c
+++ /dev/null
@@ -1,1833 +0,0 @@
-/*
- * Copyright (C) 1997-1999 Matt Newman <matt@novadigm.com>
- * some modifications:
- *	Copyright (C) 2000 Ajuba Solutions
- *	Copyright (C) 2002 ActiveState Corporation
- *	Copyright (C) 2004 Starfish Systems 
- *
- * $Header: /cvsroot/tls/tls/tls.c,v 1.37 2015/07/07 17:16:02 andreas_kupries Exp $
- *
- * TLS (aka SSL) Channel - can be layered on any bi-directional
- * Tcl_Channel (Note: Requires Trf Core Patch)
- *
- * This was built (almost) from scratch based upon observation of
- * OpenSSL 0.9.2B
- *
- * Addition credit is due for Andreas Kupries (a.kupries@westend.com), for
- * providing the Tcl_ReplaceChannel mechanism and working closely with me
- * to enhance it to support full fileevent semantics.
- *
- * Also work done by the follow people provided the impetus to do this "right":
- *	tclSSL (Colin McCormack, Shared Technology)
- *	SSLtcl (Peter Antman)
- *
- */
-
-#include "tlsInt.h"
-#include "tclOpts.h"
-#include <stdlib.h>
-
-/*
- * External functions
- */
-
-/*
- * Forward declarations
- */
-
-#define F2N( key, dsp) \
-	(((key) == NULL) ? (char *) NULL : \
-		Tcl_TranslateFileName(interp, (key), (dsp)))
-#define REASON()	ERR_reason_error_string(ERR_get_error())
-
-static void	InfoCallback _ANSI_ARGS_ ((CONST SSL *ssl, int where, int ret));
-
-static int	CiphersObjCmd _ANSI_ARGS_ ((ClientData clientData,
-			Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-
-static int	HandshakeObjCmd _ANSI_ARGS_ ((ClientData clientData,
-			Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-
-static int	ImportObjCmd _ANSI_ARGS_ ((ClientData clientData,
-			Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-
-static int	StatusObjCmd _ANSI_ARGS_ ((ClientData clientData,
-			Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-
-static int	VersionObjCmd _ANSI_ARGS_ ((ClientData clientData,
-			Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-
-static int	MiscObjCmd _ANSI_ARGS_ ((ClientData clientData,
-			Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-
-static int	UnimportObjCmd _ANSI_ARGS_ ((ClientData clientData,
-			Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-
-static SSL_CTX *CTX_Init _ANSI_ARGS_((State *statePtr, int proto, char *key,
-			char *cert, char *CAdir, char *CAfile, char *ciphers,
-			char *DHparams));
-
-static int	TlsLibInit _ANSI_ARGS_ (()) ;
-
-#define TLS_PROTO_SSL2		0x01
-#define TLS_PROTO_SSL3		0x02
-#define TLS_PROTO_TLS1		0x04
-#define TLS_PROTO_TLS1_1	0x08
-#define TLS_PROTO_TLS1_2	0x10
-#define ENABLED(flag, mask)	(((flag) & (mask)) == (mask))
-
-/*
- * Static data structures
- */
-
-#ifndef OPENSSL_NO_DH
-/* code derived from output of 'openssl dhparam -C 2048' */
-
-static unsigned char dh2048_p[]={
-	0xEC,0xFD,0x6F,0x66,0xD8,0xBC,0xB4,0xCB,0xD7,0xE7,0xB4,0xAE,
-	0xEC,0xC0,0x06,0x25,0x40,0x9F,0x3F,0xC4,0xAC,0x34,0x19,0x36,
-	0x8A,0xAB,0xA9,0xF6,0x45,0x36,0x87,0x1F,0x10,0x35,0x3F,0x90,
-	0x00,0xC6,0x7A,0xE8,0x51,0xF4,0x7F,0x50,0x0F,0xC2,0x82,0x91,
-	0xAD,0x60,0x1B,0x49,0xB1,0x0B,0x23,0xC3,0x37,0xAE,0x0D,0x2C,
-	0x49,0xC6,0xFB,0x60,0x9D,0x50,0x2F,0x8C,0x2F,0xDE,0xE6,0x5F,
-	0x53,0x8B,0x5F,0xF9,0x70,0x16,0xEE,0x51,0xD1,0xAB,0x02,0x48,
-	0x61,0xF1,0xA0,0xD7,0xBD,0x04,0x24,0xF0,0xE4,0xD1,0x0A,0x4C,
-	0x28,0xDC,0x22,0x78,0x7C,0xED,0x2A,0xFA,0xF4,0x57,0x7C,0xAE,
-	0xDF,0x52,0xC6,0xA2,0x11,0x28,0xC5,0x3B,0xB8,0x2F,0x95,0x3F,
-	0x1E,0x05,0x66,0xFE,0x7D,0x1A,0x73,0xA0,0x45,0xF8,0xBB,0x8C,
-	0x64,0xB9,0xA9,0x4D,0x23,0xBE,0x20,0x60,0xA2,0xF7,0xC7,0xD8,
-	0xD8,0x49,0x28,0x9A,0x81,0xAC,0xF9,0x7F,0x3C,0xFC,0xBE,0x25,
-	0x5B,0x1D,0xB6,0xAB,0x08,0x06,0x11,0x8D,0x94,0x69,0x3C,0x68,
-	0x98,0x5A,0x90,0xF8,0xEB,0x19,0xCA,0x9F,0x1C,0x50,0x96,0x53,
-	0xEF,0xEC,0x1B,0x93,0x4F,0x53,0xB7,0xD9,0x04,0x8E,0x48,0x99,
-	0x6E,0x24,0xFF,0x66,0xF5,0xB0,0xDF,0x00,0xBA,0x22,0xE2,0xB6,
-	0xE3,0x3A,0xC2,0x95,0xB1,0x14,0x68,0xFB,0xA5,0x37,0x22,0x78,
-	0x56,0x5C,0xA4,0x23,0x31,0x02,0x97,0x7D,0xA9,0x84,0x0B,0x12,
-	0x26,0x58,0x2F,0x86,0x10,0xAD,0xB0,0xAB,0xB9,0x7B,0x05,0x9A,
-	0xDE,0x11,0xF1,0xE7,0x34,0xC7,0x95,0x42,0x1C,0x4F,0xA9,0xA8,
-	0x92,0xDF,0x3F,0x7B,
-	};
-static unsigned char dh2048_g[]={
-	0x02,
-};
-
-
-static DH *get_dh2048()
-{
-    DH *dh=NULL;
-
-    if ((dh=DH_new()) == NULL) return(NULL);
-
-    dh->p=BN_bin2bn(dh2048_p,sizeof(dh2048_p),NULL);
-    dh->g=BN_bin2bn(dh2048_g,sizeof(dh2048_g),NULL);
-
-    if ((dh->p == NULL) || (dh->g == NULL))
-	return(NULL);
-    return(dh);
-}
-#endif
-
-/*
- * Defined in Tls_Init to determine what kind of channels we are using
- * (old-style 8.2.0-8.3.1 or new-style 8.3.2+).
- */
-int channelTypeVersion;
-
-/*
- * We lose the tcl password callback when we use the RSA BSAFE SSL-C 1.1.2
- * libraries instead of the current OpenSSL libraries.
- */
-
-#ifdef BSAFE
-#define PRE_OPENSSL_0_9_4 1
-#endif
-
-/*
- * Pre OpenSSL 0.9.4 Compat
- */
-
-#ifndef STACK_OF
-#define STACK_OF(x)			STACK
-#define sk_SSL_CIPHER_num(sk)		sk_num((sk))
-#define sk_SSL_CIPHER_value( sk, index)	(SSL_CIPHER*)sk_value((sk), (index))
-#endif
-
-/*
- * Thread-Safe TLS Code
- */
-
-#ifdef TCL_THREADS
-#define OPENSSL_THREAD_DEFINES
-#include <openssl/opensslconf.h>
-
-#ifdef OPENSSL_THREADS
-#include <openssl/crypto.h>
-
-/*
- * Threaded operation requires locking callbacks
- * Based from /crypto/cryptlib.c of OpenSSL and NSOpenSSL.
- */
-
-static Tcl_Mutex locks[CRYPTO_NUM_LOCKS];
-static Tcl_Mutex init_mx;
-static int initialized;
-
-static void          CryptoThreadLockCallback (int mode, int n, const char *file, int line);
-static unsigned long CryptoThreadIdCallback   (void);
-
-static void
-CryptoThreadLockCallback(int mode, int n, const char *file, int line)
-{
-    if (mode & CRYPTO_LOCK) {
-       Tcl_MutexLock(&locks[n]);
-    } else {
-       Tcl_MutexUnlock(&locks[n]);
-    }
-}
-
-static unsigned long
-CryptoThreadIdCallback(void)
-{
-    return (unsigned long) Tcl_GetCurrentThread();
-}
-#endif /* OPENSSL_THREADS */
-#endif /* TCL_THREADS */
-
-
-/*
- *-------------------------------------------------------------------
- *
- * InfoCallback --
- *
- *	monitors SSL connection process
- *
- * Results:
- *	None
- *
- * Side effects:
- *	Calls callback (if defined)
- *-------------------------------------------------------------------
- */
-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;
-
-    if (statePtr->callback == (Tcl_Obj*)NULL)
-	return;
-
-    cmdPtr = Tcl_DuplicateObj(statePtr->callback);
-
-#if 0
-    if (where & SSL_CB_ALERT) {
-	sev = SSL_alert_type_string_long(ret);
-	if (strcmp( sev, "fatal")==0) {	/* Map to error */
-	    Tls_Error(statePtr, SSL_ERROR(ssl, 0));
-	    return;
-	}
-    }
-#endif
-    if (where & SSL_CB_HANDSHAKE_START) {
-	major = "handshake";
-	minor = "start";
-    } else if (where & SSL_CB_HANDSHAKE_DONE) {
-	major = "handshake";
-	minor = "done";
-    } else {
-	if (where & SSL_CB_ALERT)		major = "alert";
-	else if (where & SSL_ST_CONNECT)	major = "connect";
-	else if (where & SSL_ST_ACCEPT)		major = "accept";
-	else					major = "unknown";
-
-	if (where & SSL_CB_READ)		minor = "read";
-	else if (where & SSL_CB_WRITE)		minor = "write";
-	else if (where & SSL_CB_LOOP)		minor = "loop";
-	else if (where & SSL_CB_EXIT)		minor = "exit";
-	else					minor = "unknown";
-    }
-
-    Tcl_ListObjAppendElement( statePtr->interp, cmdPtr, 
-	    Tcl_NewStringObj( "info", -1));
-
-    Tcl_ListObjAppendElement( statePtr->interp, cmdPtr, 
-	    Tcl_NewStringObj( Tcl_GetChannelName(statePtr->self), -1) );
-
-    Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
-	    Tcl_NewStringObj( major, -1) );
-
-    Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
-	    Tcl_NewStringObj( minor, -1) );
-
-    if (where & (SSL_CB_LOOP|SSL_CB_EXIT)) {
-	Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
-	    Tcl_NewStringObj( SSL_state_string_long(ssl), -1) );
-    } else if (where & SSL_CB_ALERT) {
-	CONST char *cp = (char *) SSL_alert_desc_string_long(ret);
-
-	Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
-	    Tcl_NewStringObj( cp, -1) );
-    } else {
-	Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
-	    Tcl_NewStringObj( SSL_state_string_long(ssl), -1) );
-    }
-    Tcl_Preserve( (ClientData) statePtr->interp);
-    Tcl_Preserve( (ClientData) statePtr);
-
-    Tcl_IncrRefCount( cmdPtr);
-    (void) Tcl_EvalObjEx(statePtr->interp, cmdPtr, TCL_EVAL_GLOBAL);
-    Tcl_DecrRefCount( cmdPtr);
-
-    Tcl_Release( (ClientData) statePtr);
-    Tcl_Release( (ClientData) statePtr->interp);
-
-}
-
-/*
- *-------------------------------------------------------------------
- *
- * VerifyCallback --
- *
- *	Monitors SSL certificate validation process.
- *	This is called whenever a certificate is inspected
- *	or decided invalid.
- *
- * Results:
- *	A callback bound to the socket may return one of:
- *	    0			- the certificate is deemed invalid
- *	    1			- the certificate is deemed valid
- *	    empty string	- no change to certificate validation
- *
- * Side effects:
- *	The err field of the currently operative State is set
- *	  to a string describing the SSL negotiation failure reason
- *-------------------------------------------------------------------
- */
-static int
-VerifyCallback(int ok, X509_STORE_CTX *ctx)
-{
-    Tcl_Obj *cmdPtr, *result;
-    char *errStr, *string;
-    int length;
-    SSL   *ssl		= (SSL*)X509_STORE_CTX_get_app_data(ctx);
-    X509  *cert		= X509_STORE_CTX_get_current_cert(ctx);
-    State *statePtr	= (State*)SSL_get_app_data(ssl);
-    int depth		= X509_STORE_CTX_get_error_depth(ctx);
-    int err		= X509_STORE_CTX_get_error(ctx);
-
-    dprintf(stderr, "Verify: %d\n", ok);
-
-    if (!ok) {
-	errStr = (char*)X509_verify_cert_error_string(err);
-    } else {
-	errStr = (char *)0;
-    }
-
-    if (statePtr->callback == (Tcl_Obj*)NULL) {
-	if (statePtr->vflags & SSL_VERIFY_FAIL_IF_NO_PEER_CERT) {
-	    return ok;
-	} else {
-	    return 1;
-	}
-    }
-    cmdPtr = Tcl_DuplicateObj(statePtr->callback);
-
-    Tcl_ListObjAppendElement( statePtr->interp, cmdPtr, 
-	    Tcl_NewStringObj( "verify", -1));
-
-    Tcl_ListObjAppendElement( statePtr->interp, cmdPtr, 
-	    Tcl_NewStringObj( Tcl_GetChannelName(statePtr->self), -1) );
-
-    Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
-	    Tcl_NewIntObj( depth) );
-
-    Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
-	    Tls_NewX509Obj( statePtr->interp, cert) );
-
-    Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
-	    Tcl_NewIntObj( ok) );
-
-    Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
-	    Tcl_NewStringObj( errStr ? errStr : "", -1) );
-
-    Tcl_Preserve( (ClientData) statePtr->interp);
-    Tcl_Preserve( (ClientData) statePtr);
-
-    statePtr->flags |= TLS_TCL_CALLBACK;
-
-    Tcl_IncrRefCount( cmdPtr);
-    if (Tcl_EvalObjEx(statePtr->interp, cmdPtr, TCL_EVAL_GLOBAL) != TCL_OK) {
-	/* It got an error - reject the certificate.		*/
-	Tcl_BackgroundError( statePtr->interp);
-	ok = 0;
-    } else {
-	result = Tcl_GetObjResult(statePtr->interp);
-	string = Tcl_GetStringFromObj(result, &length);
-	/* An empty result leaves verification unchanged.	*/
-	if (length > 0) {
-	    if (Tcl_GetIntFromObj(statePtr->interp, result, &ok) != TCL_OK) {
-		Tcl_BackgroundError(statePtr->interp);
-		ok = 0;
-	    }
-	}
-    }
-    Tcl_DecrRefCount( cmdPtr);
-
-    statePtr->flags &= ~(TLS_TCL_CALLBACK);
-
-    Tcl_Release( (ClientData) statePtr);
-    Tcl_Release( (ClientData) statePtr->interp);
-
-    return(ok);	/* By default, leave verification unchanged.	*/
-}
-
-/*
- *-------------------------------------------------------------------
- *
- * Tls_Error --
- *
- *	Calls callback with $fd and $msg - so the callback can decide
- *	what to do with errors.
- *
- * Side effects:
- *	The err field of the currently operative State is set
- *	  to a string describing the SSL negotiation failure reason
- *-------------------------------------------------------------------
- */
-void
-Tls_Error(State *statePtr, char *msg)
-{
-    Tcl_Obj *cmdPtr;
-
-    if (msg && *msg) {
-	Tcl_SetErrorCode(statePtr->interp, "SSL", msg, (char *)NULL);
-    } else {
-	msg = Tcl_GetStringFromObj(Tcl_GetObjResult(statePtr->interp), NULL);
-    }
-    statePtr->err = msg;
-
-    if (statePtr->callback == (Tcl_Obj*)NULL) {
-	char buf[BUFSIZ];
-	sprintf(buf, "SSL channel \"%s\": error: %s",
-	    Tcl_GetChannelName(statePtr->self), msg);
-	Tcl_SetResult( statePtr->interp, buf, TCL_VOLATILE);
-	Tcl_BackgroundError( statePtr->interp);
-	return;
-    }
-    cmdPtr = Tcl_DuplicateObj(statePtr->callback);
-
-    Tcl_ListObjAppendElement(statePtr->interp, cmdPtr, 
-	    Tcl_NewStringObj("error", -1));
-
-    Tcl_ListObjAppendElement(statePtr->interp, cmdPtr, 
-	    Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1));
-
-    Tcl_ListObjAppendElement(statePtr->interp, cmdPtr,
-	    Tcl_NewStringObj(msg, -1));
-
-    Tcl_Preserve((ClientData) statePtr->interp);
-    Tcl_Preserve((ClientData) statePtr);
-
-    Tcl_IncrRefCount(cmdPtr);
-    if (Tcl_EvalObjEx(statePtr->interp, cmdPtr, TCL_EVAL_GLOBAL) != TCL_OK) {
-	Tcl_BackgroundError(statePtr->interp);
-    }
-    Tcl_DecrRefCount(cmdPtr);
-
-    Tcl_Release((ClientData) statePtr);
-    Tcl_Release((ClientData) statePtr->interp);
-}
-
-/*
- *-------------------------------------------------------------------
- *
- * PasswordCallback -- 
- *
- *	Called when a password is needed to unpack RSA and PEM keys.
- *	Evals any bound password script and returns the result as
- *	the password string.
- *-------------------------------------------------------------------
- */
-#ifdef PRE_OPENSSL_0_9_4
-/*
- * 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;
-}
-#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;
-
-    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);
-	} else {
-	    return -1;
-	}
-    }
-
-    cmdPtr = Tcl_DuplicateObj(statePtr->password);
-
-    Tcl_Preserve((ClientData) statePtr->interp);
-    Tcl_Preserve((ClientData) statePtr);
-
-    Tcl_IncrRefCount(cmdPtr);
-    result = Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL);
-    if (result != TCL_OK) {
-	Tcl_BackgroundError(statePtr->interp);
-    }
-    Tcl_DecrRefCount(cmdPtr);
-
-    Tcl_Release((ClientData) statePtr);
-    Tcl_Release((ClientData) statePtr->interp);
-
-    if (result == TCL_OK) {
-	char *ret = (char *) Tcl_GetStringResult(interp);
-	strncpy(buf, ret, (size_t) size);
-	return (int)strlen(ret);
-    } else {
-	return -1;
-    }
-}
-#endif
-
-/*
- *-------------------------------------------------------------------
- *
- * CiphersObjCmd -- list available ciphers
- *
- *	This procedure is invoked to process the "tls::ciphers" command
- *	to list available ciphers, based upon protocol selected.
- *
- * Results:
- *	A standard Tcl result list.
- *
- * Side effects:
- *	constructs and destroys SSL context (CTX)
- *
- *-------------------------------------------------------------------
- */
-static int
-CiphersObjCmd(clientData, interp, objc, objv)
-    ClientData clientData;	/* Not used. */
-    Tcl_Interp *interp;
-    int objc;
-    Tcl_Obj	*CONST objv[];
-{
-    static CONST84 char *protocols[] = {
-	"ssl2",	"ssl3",	"tls1",	"tls1.1", "tls1.2", NULL
-    };
-    enum protocol {
-	TLS_SSL2, TLS_SSL3, TLS_TLS1, TLS_TLS1_1, TLS_TLS1_2, TLS_NONE
-    };
-    Tcl_Obj *objPtr;
-    SSL_CTX *ctx = NULL;
-    SSL *ssl = NULL;
-    STACK_OF(SSL_CIPHER) *sk;
-    char *cp, buf[BUFSIZ];
-    int index, verbose = 0;
-
-    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) {
-	return TCL_ERROR;
-    }
-    if (objc > 2 && Tcl_GetBooleanFromObj( interp, objv[2],
-	&verbose) != TCL_OK) {
-	return TCL_ERROR;
-    }
-    switch ((enum protocol)index) {
-    case TLS_SSL2:
-#if defined(NO_SSL2)
-		Tcl_AppendResult(interp, "protocol not supported", NULL);
-		return TCL_ERROR;
-#else
-		ctx = SSL_CTX_new(SSLv2_method()); break;
-#endif
-    case TLS_SSL3:
-#if defined(NO_SSL3)
-		Tcl_AppendResult(interp, "protocol not supported", NULL);
-		return TCL_ERROR;
-#else
-		ctx = SSL_CTX_new(SSLv3_method()); break;
-#endif
-    case TLS_TLS1:
-#if defined(NO_TLS1)
-		Tcl_AppendResult(interp, "protocol not supported", NULL);
-		return TCL_ERROR;
-#else
-		ctx = SSL_CTX_new(TLSv1_method()); break;
-#endif
-    case TLS_TLS1_1:
-#if defined(NO_TLS1_1)
-		Tcl_AppendResult(interp, "protocol not supported", NULL);
-		return TCL_ERROR;
-#else
-		ctx = SSL_CTX_new(TLSv1_1_method()); break;
-#endif
-    case TLS_TLS1_2:
-#if defined(NO_TLS1_2)
-		Tcl_AppendResult(interp, "protocol not supported", NULL);
-		return TCL_ERROR;
-#else
-		ctx = SSL_CTX_new(TLSv1_2_method()); break;
-#endif
-    default:
-		break;
-    }
-    if (ctx == NULL) {
-	Tcl_AppendResult(interp, REASON(), (char *) NULL);
-	return TCL_ERROR;
-    }
-    ssl = SSL_new(ctx);
-    if (ssl == NULL) {
-	Tcl_AppendResult(interp, REASON(), (char *) NULL);
-	SSL_CTX_free(ctx);
-	return TCL_ERROR;
-    }
-    objPtr = Tcl_NewListObj( 0, NULL);
-
-    if (!verbose) {
-	for (index = 0; ; index++) {
-	    cp = (char*)SSL_get_cipher_list( ssl, index);
-	    if (cp == NULL) break;
-	    Tcl_ListObjAppendElement( interp, objPtr,
-		Tcl_NewStringObj( cp, -1) );
-	}
-    } else {
-	sk = SSL_get_ciphers(ssl);
-
-	for (index = 0; index < sk_SSL_CIPHER_num(sk); index++) {
-	    register size_t i;
-	    SSL_CIPHER_description( sk_SSL_CIPHER_value( sk, index),
-				    buf, sizeof(buf));
-	    for (i = strlen(buf) - 1; i ; i--) {
-		if (buf[i] == ' ' || buf[i] == '\n' ||
-		    buf[i] == '\r' || buf[i] == '\t') {
-		    buf[i] = '\0';
-		} else {
-		    break;
-		}
-	    }
-	    Tcl_ListObjAppendElement( interp, objPtr,
-		Tcl_NewStringObj( buf, -1) );
-	}
-    }
-    SSL_free(ssl);
-    SSL_CTX_free(ctx);
-
-    Tcl_SetObjResult( interp, objPtr);
-    return TCL_OK;
-}
-
-/*
- *-------------------------------------------------------------------
- *
- * HandshakeObjCmd --
- *
- *	This command is used to verify whether the handshake is complete
- *	or not.
- *
- * Results:
- *	A standard Tcl result. 1 means handshake complete, 0 means pending.
- *
- * Side effects:
- *	May force SSL negotiation to take place.
- *
- *-------------------------------------------------------------------
- */
-
-static int
-HandshakeObjCmd(clientData, interp, objc, objv)
-    ClientData clientData;	/* Not used. */
-    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;
-
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "channel");
-	return TCL_ERROR;
-    }
-
-    chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), NULL);
-    if (chan == (Tcl_Channel) NULL) {
-	return TCL_ERROR;
-    }
-    if (channelTypeVersion == TLS_CHANNEL_VERSION_2) {
-	/*
-	 * Make sure to operate on the topmost channel
-	 */
-	chan = Tcl_GetTopChannel(chan);
-    }
-    if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {
-	Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan),
-		"\": not a TLS channel", NULL);
-	return TCL_ERROR;
-    }
-    statePtr = (State *)Tcl_GetChannelInstanceData(chan);
-
-    if (!SSL_is_init_finished(statePtr->ssl)) {
-	int err;
-	ret = Tls_WaitForConnect(statePtr, &err);
-	if ((statePtr->flags & TLS_TCL_ASYNC) && err == EAGAIN) {
-	    ret = 0;
-	}
-	if (ret < 0) {
-	    CONST char *errStr = statePtr->err;
-	    Tcl_ResetResult(interp);
-	    Tcl_SetErrno(err);
-
-	    if (!errStr || *errStr == 0) {
-		errStr = Tcl_PosixError(interp);
-	    }
-
-	    Tcl_AppendResult(interp, "handshake failed: ", errStr,
-		    (char *) NULL);
-	    return TCL_ERROR;
-	}
-    }
-
-    Tcl_SetObjResult(interp, Tcl_NewIntObj(ret));
-    return TCL_OK;
-}
-
-/*
- *-------------------------------------------------------------------
- *
- * ImportObjCmd --
- *
- *	This procedure is invoked to process the "ssl" command
- *
- *	The ssl command pushes SSL over a (newly connected) tcp socket
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	May modify the behavior of an IO channel.
- *
- *-------------------------------------------------------------------
- */
-
-static int
-ImportObjCmd(clientData, interp, objc, objv)
-    ClientData clientData;	/* Not used. */
-    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 */
-    SSL_CTX *ctx	= NULL;
-    Tcl_Obj *script	= NULL;
-    Tcl_Obj *password	= NULL;
-    int idx, len;
-    int flags		= TLS_TCL_INIT;
-    int server		= 0;	/* is connection incoming or outgoing? */
-    char *key		= NULL;
-    char *cert		= NULL;
-    char *ciphers	= NULL;
-    char *CAfile	= NULL;
-    char *CAdir		= NULL;
-    char *DHparams	= NULL;
-    char *model		= NULL;
-#ifndef OPENSSL_NO_TLSEXT
-    char *servername	= NULL;	/* hostname for Server Name Indication */
-#endif
-#if defined(NO_SSL2)
-    int ssl2 = 0;
-#else
-    int ssl2 = 1;
-#endif
-#if defined(NO_SSL3)
-    int ssl3 = 0;
-#else
-    int ssl3 = 1;
-#endif
-    int tls1 = 1;
-    int tls1_1 = 1;
-    int tls1_2 = 1;
-    int proto = 0;
-    int verify = 0, require = 0, request = 1;
-
-    if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "channel ?options?");
-	return TCL_ERROR;
-    }
-
-    chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), NULL);
-    if (chan == (Tcl_Channel) NULL) {
-	return TCL_ERROR;
-    }
-    if (channelTypeVersion == TLS_CHANNEL_VERSION_2) {
-	/*
-	 * Make sure to operate on the topmost channel
-	 */
-	chan = Tcl_GetTopChannel(chan);
-    }
-
-    for (idx = 2; idx < objc; idx++) {
-	char *opt = Tcl_GetStringFromObj(objv[idx], NULL);
-
-	if (opt[0] != '-')
-	    break;
-
-	OPTSTR( "-cadir", CAdir);
-	OPTSTR( "-cafile", CAfile);
-	OPTSTR( "-certfile", cert);
-	OPTSTR( "-cipher", ciphers);
-	OPTOBJ( "-command", script);
-	OPTSTR( "-dhparams", DHparams);
-	OPTSTR( "-keyfile", key);
-	OPTSTR( "-model", model);
-	OPTOBJ( "-password", password);
-	OPTBOOL( "-require", require);
-	OPTBOOL( "-request", request);
-	OPTBOOL( "-server", server);
-#ifndef OPENSSL_NO_TLSEXT
-        OPTSTR( "-servername", servername);
-#endif
-
-	OPTBOOL( "-ssl2", ssl2);
-	OPTBOOL( "-ssl3", ssl3);
-	OPTBOOL( "-tls1", tls1);
-	OPTBOOL( "-tls1.1", tls1_1);
-	OPTBOOL( "-tls1.2", tls1_2);
-
-	OPTBAD( "option", "-cadir, -cafile, -certfile, -cipher, -command, -dhparams, -keyfile, -model, -password, -require, -request, -server, -servername, -ssl2, -ssl3, -tls1, -tls1.1 or -tls1.2");
-
-	return TCL_ERROR;
-    }
-    if (request)	    verify |= SSL_VERIFY_CLIENT_ONCE | SSL_VERIFY_PEER;
-    if (request && require) verify |= SSL_VERIFY_FAIL_IF_NO_PEER_CERT;
-    if (verify == 0)	verify = SSL_VERIFY_NONE;
-
-    proto |= (ssl2 ? TLS_PROTO_SSL2 : 0);
-    proto |= (ssl3 ? TLS_PROTO_SSL3 : 0);
-    proto |= (tls1 ? TLS_PROTO_TLS1 : 0);
-    proto |= (tls1_1 ? TLS_PROTO_TLS1_1 : 0);
-    proto |= (tls1_2 ? TLS_PROTO_TLS1_2 : 0);
-
-    /* reset to NULL if blank string provided */
-    if (cert && !*cert)		cert	 = NULL;
-    if (key && !*key)		key	 = NULL;
-    if (ciphers && !*ciphers)	ciphers	 = NULL;
-    if (CAfile && !*CAfile)	CAfile	 = NULL;
-    if (CAdir && !*CAdir)	CAdir	 = NULL;
-    if (DHparams && !*DHparams)	DHparams = NULL;
-
-    /* new SSL state */
-    statePtr		= (State *) ckalloc((unsigned) sizeof(State));
-    memset(statePtr, 0, sizeof(State));
-
-    statePtr->flags	= flags;
-    statePtr->interp	= interp;
-    statePtr->vflags	= verify;
-    statePtr->err	= "";
-
-    /* allocate script */
-    if (script) {
-	(void) Tcl_GetStringFromObj(script, &len);
-	if (len) {
-	    statePtr->callback = script;
-	    Tcl_IncrRefCount(statePtr->callback);
-	}
-    }
-
-    /* allocate password */
-    if (password) {
-	(void) Tcl_GetStringFromObj(password, &len);
-	if (len) {
-	    statePtr->password = password;
-	    Tcl_IncrRefCount(statePtr->password);
-	}
-    }
-
-    if (model != NULL) {
-	int mode;
-	/* Get the "model" context */
-	chan = Tcl_GetChannel(interp, model, &mode);
-	if (chan == (Tcl_Channel) NULL) {
-	    Tls_Free((char *) statePtr);
-	    return TCL_ERROR;
-	}
-	if (channelTypeVersion == TLS_CHANNEL_VERSION_2) {
-	    /*
-	     * Make sure to operate on the topmost channel
-	     */
-	    chan = Tcl_GetTopChannel(chan);
-	}
-	if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {
-	    Tcl_AppendResult(interp, "bad channel \"",
-		    Tcl_GetChannelName(chan), "\": not a TLS channel", NULL);
-	    Tls_Free((char *) statePtr);
-	    return TCL_ERROR;
-	}
-	ctx = ((State *)Tcl_GetChannelInstanceData(chan))->ctx;
-    } else {
-	if ((ctx = CTX_Init(statePtr, proto, key, cert, CAdir, CAfile, ciphers,
-		DHparams)) == (SSL_CTX*)0) {
-	    Tls_Free((char *) statePtr);
-	    return TCL_ERROR;
-	}
-    }
-
-    statePtr->ctx = ctx;
-
-    /*
-     * 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");
-    if (channelTypeVersion == TLS_CHANNEL_VERSION_1) {
-	Tcl_SetChannelOption(interp, chan, "-buffering", "none");
-    }
-
-    if (channelTypeVersion == TLS_CHANNEL_VERSION_2) {
-	statePtr->self = Tcl_StackChannel(interp, Tls_ChannelType(),
-		(ClientData) statePtr, (TCL_READABLE | TCL_WRITABLE), chan);
-    } else {
-	statePtr->self = chan;
-	Tcl_StackChannel(interp, Tls_ChannelType(),
-		(ClientData) statePtr, (TCL_READABLE | TCL_WRITABLE), chan);
-    }
-    if (statePtr->self == (Tcl_Channel) NULL) {
-	/*
-	 * No use of Tcl_EventuallyFree because no possible Tcl_Preserve.
-	 */
-	Tls_Free((char *) statePtr);
-	return TCL_ERROR;
-    }
-
-    /*
-     * SSL Initialization
-     */
-
-    statePtr->ssl = SSL_new(statePtr->ctx);
-    if (!statePtr->ssl) {
-	/* SSL library error */
-	Tcl_AppendResult(interp, "couldn't construct ssl session: ", REASON(),
-		(char *) NULL);
-	Tls_Free((char *) statePtr);
-	return TCL_ERROR;
-    }
-
-#ifndef OPENSSL_NO_TLSEXT
-    if (servername) {
-        if (!SSL_set_tlsext_host_name(statePtr->ssl, servername) && require) {
-            Tcl_AppendResult(interp, "setting TLS host name extension failed",
-                (char *) NULL);
-            Tls_Free((char *) statePtr);
-            return TCL_ERROR;
-        }
-    }
-#endif
-
-    /*
-     * SSL Callbacks
-     */
-
-    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->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
-     */
-    Tcl_SetResult(interp, (char *) Tcl_GetChannelName(statePtr->self),
-	    TCL_VOLATILE);
-    return TCL_OK;
-}
-
-/*
- *-------------------------------------------------------------------
- *
- * UnimportObjCmd --
- *
- *	This procedure is invoked to remove the topmost channel filter.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	May modify the behavior of an IO channel.
- *
- *-------------------------------------------------------------------
- */
-
-static int
-UnimportObjCmd(clientData, interp, objc, objv)
-    ClientData clientData;	/* Not used. */
-    Tcl_Interp *interp;
-    int objc;
-    Tcl_Obj *CONST objv[];
-{
-    Tcl_Channel chan;		/* The channel to set a mode on. */
-
-    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) {
-	return TCL_ERROR;
-    }
-
-    if (channelTypeVersion == TLS_CHANNEL_VERSION_2) {
-	/*
-	 * Make sure to operate on the topmost channel
-	 */
-	chan = Tcl_GetTopChannel(chan);
-    }
-
-    if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {
-	Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan),
-		"\": not a TLS channel", NULL);
-	return TCL_ERROR;
-    }
-
-    if (Tcl_UnstackChannel(interp, chan) == TCL_ERROR) {
-	return TCL_ERROR;
-    }
-
-    return TCL_OK;
-}
-
-/*
- *-------------------------------------------------------------------
- *
- * CTX_Init -- construct a SSL_CTX instance
- *
- * Results:
- *	A valid SSL_CTX instance or NULL.
- *
- * Side effects:
- *	constructs SSL context (CTX)
- *
- *-------------------------------------------------------------------
- */
-
-static SSL_CTX *
-CTX_Init(statePtr, proto, key, cert, CAdir, CAfile, ciphers, DHparams)
-    State *statePtr;
-    int proto;
-    char *key;
-    char *cert;
-    char *CAdir;
-    char *CAfile;
-    char *ciphers;
-    char *DHparams;
-{
-    Tcl_Interp *interp = statePtr->interp;
-    SSL_CTX *ctx = NULL;
-    Tcl_DString ds;
-    Tcl_DString ds1;
-    int off = 0;
-    const SSL_METHOD *method;
-
-    if (!proto) {
-	Tcl_AppendResult(interp, "no valid protocol selected", NULL);
-	return (SSL_CTX *)0;
-    }
-
-    /* create SSL context */
-#if defined(NO_SSL2)
-    if (ENABLED(proto, TLS_PROTO_SSL2)) {
-	Tcl_AppendResult(interp, "protocol not supported", NULL);
-	return (SSL_CTX *)0;
-    }
-#endif
-#if defined(NO_SSL3)
-    if (ENABLED(proto, TLS_PROTO_SSL3)) {
-	Tcl_AppendResult(interp, "protocol not supported", NULL);
-	return (SSL_CTX *)0;
-    }
-#endif
-#if defined(NO_TLS1)
-    if (ENABLED(proto, TLS_PROTO_TLS1)) {
-	Tcl_AppendResult(interp, "protocol not supported", NULL);
-	return (SSL_CTX *)0;
-    }
-#endif
-#if defined(NO_TLS1_1)
-    if (ENABLED(proto, TLS_PROTO_TLS1_1)) {
-	Tcl_AppendResult(interp, "protocol not supported", NULL);
-	return (SSL_CTX *)0;
-    }
-#endif
-#if defined(NO_TLS1_2)
-    if (ENABLED(proto, TLS_PROTO_TLS1_2)) {
-	Tcl_AppendResult(interp, "protocol not supported", NULL);
-	return (SSL_CTX *)0;
-    }
-#endif
-
-    switch (proto) {
-#if !defined(NO_SSL2)
-    case TLS_PROTO_SSL2:
-	method = SSLv2_method ();
-	break;
-#endif
-#if !defined(NO_SSL3)
-    case TLS_PROTO_SSL3:
-	method = SSLv3_method ();
-	break;
-#endif
-#if !defined(NO_TLS1)
-    case TLS_PROTO_TLS1:
-	method = TLSv1_method ();
-	break;
-#endif
-#if !defined(NO_TLS1_1)
-    case TLS_PROTO_TLS1_1:
-	method = TLSv1_1_method ();
-	break;
-#endif
-#if !defined(NO_TLS1_2)
-    case TLS_PROTO_TLS1_2:
-	method = TLSv1_2_method ();
-	break;
-#endif
-    default:
-        method = SSLv23_method ();
-#if !defined(NO_SSL2)
-	off |= (ENABLED(proto, TLS_PROTO_SSL2)   ? 0 : SSL_OP_NO_SSLv2);
-#endif
-#if !defined(NO_SSL3)
-	off |= (ENABLED(proto, TLS_PROTO_SSL3)   ? 0 : SSL_OP_NO_SSLv3);
-#endif
-#if !defined(NO_TLS1)
-	off |= (ENABLED(proto, TLS_PROTO_TLS1)   ? 0 : SSL_OP_NO_TLSv1);
-#endif
-#if !defined(NO_TLS1_1)
-	off |= (ENABLED(proto, TLS_PROTO_TLS1_1) ? 0 : SSL_OP_NO_TLSv1_1);
-#endif
-#if !defined(NO_TLS1_2)
-	off |= (ENABLED(proto, TLS_PROTO_TLS1_2) ? 0 : SSL_OP_NO_TLSv1_2);
-#endif
-	break;
-    }
-    
-    ctx = SSL_CTX_new (method);
-    
-    SSL_CTX_set_app_data( ctx, (VOID*)interp);	/* remember the interpreter */
-    SSL_CTX_set_options( ctx, SSL_OP_ALL);	/* all SSL bug workarounds */
-    SSL_CTX_set_options( ctx, off);	/* all SSL bug workarounds */
-    SSL_CTX_sess_set_cache_size( ctx, 128);
-
-    if (ciphers != NULL)
-	SSL_CTX_set_cipher_list(ctx, ciphers);
-
-    /* set some callbacks */
-    SSL_CTX_set_default_passwd_cb(ctx, PasswordCallback);
-
-#ifndef BSAFE
-    SSL_CTX_set_default_passwd_cb_userdata(ctx, (void *)statePtr);
-#endif
-
-    /* read a Diffie-Hellman parameters file, or use the built-in one */
-#ifdef OPENSSL_NO_DH
-    if (DHparams != NULL) {
-	Tcl_AppendResult(interp,
-	    "DH parameter support not available", (char *) NULL);
-	SSL_CTX_free(ctx);
-	return (SSL_CTX *)0;
-    }
-#else
-    {
-	DH* dh;
-	if (DHparams != NULL) {
-	    BIO *bio;
-	    Tcl_DStringInit(&ds);
-	    bio = BIO_new_file(F2N(DHparams, &ds), "r");
-	    if (!bio) {
-		Tcl_DStringFree(&ds);
-		Tcl_AppendResult(interp,
-		    "Could not find DH parameters file", (char *) NULL);
-		SSL_CTX_free(ctx);
-		return (SSL_CTX *)0;
-	    }
-	    
-	    dh = PEM_read_bio_DHparams(bio, NULL, NULL, NULL);
-	    BIO_free(bio);
-	    Tcl_DStringFree(&ds);
-	    if (!dh) {
-		Tcl_AppendResult(interp,
-		    "Could not read DH parameters from file", (char *) NULL);
-		SSL_CTX_free(ctx);
-		return (SSL_CTX *)0;
-	    }
-	} else {
-	    dh = get_dh2048();
-	}
-	SSL_CTX_set_tmp_dh(ctx, dh);
-	DH_free(dh);
-    }
-#endif
-
-    /* set our certificate */
-    if (cert != NULL) {
-	Tcl_DStringInit(&ds);
-
-	if (SSL_CTX_use_certificate_file(ctx, F2N( cert, &ds),
-					SSL_FILETYPE_PEM) <= 0) {
-	    Tcl_DStringFree(&ds);
-	    Tcl_AppendResult(interp,
-			     "unable to set certificate file ", cert, ": ",
-			     REASON(), (char *) NULL);
-	    SSL_CTX_free(ctx);
-	    return (SSL_CTX *)0;
-	}
-
-	/* get the private key associated with this certificate */
-	if (key == NULL) key=cert;
-
-	if (SSL_CTX_use_PrivateKey_file(ctx, F2N( key, &ds),
-					SSL_FILETYPE_PEM) <= 0) {
-	    Tcl_DStringFree(&ds);
-	    /* flush the passphrase which might be left in the result */
-	    Tcl_SetResult(interp, NULL, TCL_STATIC);
-	    Tcl_AppendResult(interp,
-			     "unable to set public key file ", key, " ",
-			     REASON(), (char *) NULL);
-	    SSL_CTX_free(ctx);
-	    return (SSL_CTX *)0;
-	}
-	Tcl_DStringFree(&ds);
-	/* Now we know that a key and cert have been set against
-	 * the SSL context */
-	if (!SSL_CTX_check_private_key(ctx)) {
-	    Tcl_AppendResult(interp,
-			     "private key does not match the certificate public key",
-			     (char *) NULL);
-	    SSL_CTX_free(ctx);
-	    return (SSL_CTX *)0;
-	}
-    } else {
-	cert = (char*)X509_get_default_cert_file();
-
-	if (SSL_CTX_use_certificate_file(ctx, cert,
-					SSL_FILETYPE_PEM) <= 0) {
-#if 0
-	    Tcl_DStringFree(&ds);
-	    Tcl_AppendResult(interp,
-			     "unable to use default certificate file ", cert, ": ",
-			     REASON(), (char *) NULL);
-	    SSL_CTX_free(ctx);
-	    return (SSL_CTX *)0;
-#endif
-	}
-    }
-	
-    Tcl_DStringInit(&ds);
-    Tcl_DStringInit(&ds1);
-    if (!SSL_CTX_load_verify_locations(ctx, F2N(CAfile, &ds), F2N(CAdir, &ds1)) ||
-	!SSL_CTX_set_default_verify_paths(ctx)) {
-#if 0
-	Tcl_DStringFree(&ds);
-	Tcl_DStringFree(&ds1);
-	/* Don't currently care if this fails */
-	Tcl_AppendResult(interp, "SSL default verify paths: ",
-		REASON(), (char *) NULL);
-	SSL_CTX_free(ctx);
-	return (SSL_CTX *)0;
-#endif
-    }
-
-    /* https://sourceforge.net/p/tls/bugs/57/ */
-    if ( CAfile != NULL ) {
-        STACK_OF(X509_NAME) *certNames = SSL_load_client_CA_file( F2N(CAfile, &ds) );
-	if ( certNames != NULL ) { 
-	    SSL_CTX_set_client_CA_list(ctx, certNames );
-	}
-    }
-
-    Tcl_DStringFree(&ds);
-    Tcl_DStringFree(&ds1);
-    return ctx;
-}
-
-/*
- *-------------------------------------------------------------------
- *
- * StatusObjCmd -- return certificate for connected peer.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	None.
- *
- *-------------------------------------------------------------------
- */
-static int
-StatusObjCmd(clientData, interp, objc, objv)
-    ClientData clientData;	/* Not used. */
-    Tcl_Interp *interp;
-    int objc;
-    Tcl_Obj	*CONST objv[];
-{
-    State *statePtr;
-    X509 *peer;
-    Tcl_Obj *objPtr;
-    Tcl_Channel chan;
-    char *channelName, *ciphers;
-    int mode;
-
-    switch (objc) {
-	case 2:
-	    channelName = Tcl_GetStringFromObj(objv[1], NULL);
-	    break;
-
-	case 3:
-	    if (!strcmp (Tcl_GetString (objv[1]), "-local")) {
-		channelName = Tcl_GetStringFromObj(objv[2], NULL);
-		break;
-	    }
-	    /* else fall... */
-	default:
-	    Tcl_WrongNumArgs(interp, 1, objv, "?-local? channel");
-	    return TCL_ERROR;
-    }
-
-    chan = Tcl_GetChannel(interp, channelName, &mode);
-    if (chan == (Tcl_Channel) NULL) {
-	return TCL_ERROR;
-    }
-    if (channelTypeVersion == TLS_CHANNEL_VERSION_2) {
-	/*
-	 * Make sure to operate on the topmost channel
-	 */
-	chan = Tcl_GetTopChannel(chan);
-    }
-    if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {
-	Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan),
-		"\": not a TLS channel", NULL);
-	return TCL_ERROR;
-    }
-    statePtr = (State *) Tcl_GetChannelInstanceData(chan);
-    if (objc == 2) {
-	peer = SSL_get_peer_certificate(statePtr->ssl);
-    } else {
-	peer = SSL_get_certificate(statePtr->ssl);
-    }
-    if (peer) {
-	objPtr = Tls_NewX509Obj(interp, peer);
-	if (objc == 2) { X509_free(peer); }
-    } else {
-	objPtr = Tcl_NewListObj(0, NULL);
-    }
-
-    Tcl_ListObjAppendElement (interp, objPtr,
-	    Tcl_NewStringObj ("sbits", -1));
-    Tcl_ListObjAppendElement (interp, objPtr,
-	    Tcl_NewIntObj (SSL_get_cipher_bits (statePtr->ssl, NULL)));
-
-    ciphers = (char*)SSL_get_cipher(statePtr->ssl);
-    if (ciphers != NULL && strcmp(ciphers, "(NONE)")!=0) {
-	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;
-}
-
-/*
- *-------------------------------------------------------------------
- *
- * VersionObjCmd -- return version string from OpenSSL.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	None.
- *
- *-------------------------------------------------------------------
- */
-static int
-VersionObjCmd(clientData, interp, objc, objv)
-    ClientData clientData;	/* Not used. */
-    Tcl_Interp *interp;
-    int objc;
-    Tcl_Obj	*CONST objv[];
-{
-    Tcl_Obj *objPtr;
-
-    objPtr = Tcl_NewStringObj(OPENSSL_VERSION_TEXT, -1);
-
-    Tcl_SetObjResult(interp, objPtr);
-    return TCL_OK;
-}
-
-/*
- *-------------------------------------------------------------------
- *
- * MiscObjCmd -- misc commands
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	None.
- *
- *-------------------------------------------------------------------
- */
-static int
-MiscObjCmd(clientData, interp, objc, objv)
-    ClientData clientData;	/* Not used. */
-    Tcl_Interp *interp;
-    int objc;
-    Tcl_Obj	*CONST objv[];
-{
-    static CONST84 char *commands [] = { "req", NULL };
-    enum command { C_REQ, C_DUMMY };
-    int cmd;
-
-    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) {
-	return TCL_ERROR;
-    }
-
-    switch ((enum command) cmd) {
-	case C_REQ: {
-	    EVP_PKEY *pkey=NULL;
-	    X509 *cert=NULL;
-	    X509_NAME *name=NULL;
-	    Tcl_Obj **listv;
-	    int listc,i;
-
-	    BIO *out=NULL;
-
-	    char *k_C="",*k_ST="",*k_L="",*k_O="",*k_OU="",*k_CN="",*k_Email="";
-	    char *keyout,*pemout,*str;
-	    int keysize,serial=0,days=365;
-	    
-	    if ((objc<5) || (objc>6)) {
-		Tcl_WrongNumArgs(interp, 2, objv, "keysize keyfile certfile ?info?");
-		return TCL_ERROR;
-	    }
-
-	    if (Tcl_GetIntFromObj(interp, objv[2], &keysize) != TCL_OK) {
-		return TCL_ERROR;
-	    }
-	    keyout=Tcl_GetString(objv[3]);
-	    pemout=Tcl_GetString(objv[4]);
-
-	    if (objc>=6) {
-		if (Tcl_ListObjGetElements(interp, objv[5],
-			&listc, &listv) != TCL_OK) {
-		    return TCL_ERROR;
-		}
-
-		if ((listc%2) != 0) {
-		    Tcl_SetResult(interp,"Information list must have even number of arguments",NULL);
-		    return TCL_ERROR;
-		}
-		for (i=0; i<listc; i+=2) {
-		    str=Tcl_GetString(listv[i]);
-		    if (strcmp(str,"days")==0) {
-			if (Tcl_GetIntFromObj(interp,listv[i+1],&days)!=TCL_OK)
-			    return TCL_ERROR;
-		    } else if (strcmp(str,"serial")==0) {
-			if (Tcl_GetIntFromObj(interp,listv[i+1],&serial)!=TCL_OK)
-			    return TCL_ERROR;
-		    } else if (strcmp(str,"serial")==0) {
-			if (Tcl_GetIntFromObj(interp,listv[i+1],&serial)!=TCL_OK)
-			    return TCL_ERROR;
-		    } else if (strcmp(str,"C")==0) {
-			k_C=Tcl_GetString(listv[i+1]);
-		    } else if (strcmp(str,"ST")==0) {
-			k_ST=Tcl_GetString(listv[i+1]);
-		    } else if (strcmp(str,"L")==0) {
-			k_L=Tcl_GetString(listv[i+1]);
-		    } else if (strcmp(str,"O")==0) {
-			k_O=Tcl_GetString(listv[i+1]);
-		    } else if (strcmp(str,"OU")==0) {
-			k_OU=Tcl_GetString(listv[i+1]);
-		    } else if (strcmp(str,"CN")==0) {
-			k_CN=Tcl_GetString(listv[i+1]);
-		    } else if (strcmp(str,"Email")==0) {
-			k_Email=Tcl_GetString(listv[i+1]);
-		    } else {
-			Tcl_SetResult(interp,"Unknown parameter",NULL);
-			return TCL_ERROR;
-		    }
-		}
-	    }
-	    if ((pkey = EVP_PKEY_new()) != NULL) {
-		if (!EVP_PKEY_assign_RSA(pkey,
-			RSA_generate_key(keysize, 0x10001, NULL, NULL))) {
-		    Tcl_SetResult(interp,"Error generating private key",NULL);
-		    EVP_PKEY_free(pkey);
-		    return TCL_ERROR;
-		}
-		out=BIO_new(BIO_s_file());
-		BIO_write_filename(out,keyout);
-		PEM_write_bio_PrivateKey(out,pkey,NULL,NULL,0,NULL,NULL);
-		BIO_free_all(out);
-
-		if ((cert=X509_new())==NULL) {
-		    Tcl_SetResult(interp,"Error generating certificate request",NULL);
-		    EVP_PKEY_free(pkey);
-		    return(TCL_ERROR);
-		}
-
-		X509_set_version(cert,2);
-		ASN1_INTEGER_set(X509_get_serialNumber(cert),serial);
-		X509_gmtime_adj(X509_get_notBefore(cert),0);
-		X509_gmtime_adj(X509_get_notAfter(cert),(long)60*60*24*days);
-		X509_set_pubkey(cert,pkey);
-		
-		name=X509_get_subject_name(cert);
-
-		X509_NAME_add_entry_by_txt(name,"C", MBSTRING_ASC, k_C, -1, -1, 0);
-		X509_NAME_add_entry_by_txt(name,"ST", MBSTRING_ASC, k_ST, -1, -1, 0);
-		X509_NAME_add_entry_by_txt(name,"L", MBSTRING_ASC, k_L, -1, -1, 0);
-		X509_NAME_add_entry_by_txt(name,"O", MBSTRING_ASC, k_O, -1, -1, 0);
-		X509_NAME_add_entry_by_txt(name,"OU", MBSTRING_ASC, k_OU, -1, -1, 0);
-		X509_NAME_add_entry_by_txt(name,"CN", MBSTRING_ASC, k_CN, -1, -1, 0);
-		X509_NAME_add_entry_by_txt(name,"Email", MBSTRING_ASC, k_Email, -1, -1, 0);
-
-		X509_set_subject_name(cert,name);
-
-		if (!X509_sign(cert,pkey,EVP_md5())) {
-		    X509_free(cert);
-		    EVP_PKEY_free(pkey);
-		    Tcl_SetResult(interp,"Error signing certificate",NULL);
-		    return TCL_ERROR;
-		}
-
-		out=BIO_new(BIO_s_file());
-		BIO_write_filename(out,pemout);
-
-		PEM_write_bio_X509(out,cert);
-		BIO_free_all(out);
-
-		X509_free(cert);
-		EVP_PKEY_free(pkey);
-	    } else {
-		Tcl_SetResult(interp,"Error generating private key",NULL);
-		return TCL_ERROR;
-	    }
-	}
-	break;
-    default:
-	break;
-    }
-    return TCL_OK;
-}
-
-/*
- *-------------------------------------------------------------------
- *
- * Tls_Free --
- *
- *	This procedure cleans up when a SSL socket based channel
- *	is closed and its reference count falls below 1
- *
- * Results:
- *	none
- *
- * Side effects:
- *	Frees all the state
- *
- *-------------------------------------------------------------------
- */
-void
-Tls_Free( char *blockPtr )
-{
-    State *statePtr = (State *)blockPtr;
-
-    Tls_Clean(statePtr);
-    ckfree(blockPtr);
-}
-
-/*
- *-------------------------------------------------------------------
- *
- * Tls_Clean --
- *
- *	This procedure cleans up when a SSL socket based channel
- *	is closed and its reference count falls below 1.  This should
- *	be called synchronously by the CloseProc, not in the
- *	EventuallyFree callback.
- *
- * Results:
- *	none
- *
- * Side effects:
- *	Frees all the state
- *
- *-------------------------------------------------------------------
- */
-void
-Tls_Clean(State *statePtr)
-{
-    /*
-     * 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 */
-	dprintf(stderr, "BIO_free_all(%p)\n", statePtr->bio);
-	BIO_free_all(statePtr->bio);
-	statePtr->bio = NULL;
-    }
-    if (statePtr->ssl) {
-	dprintf(stderr, "SSL_free(%p)\n", statePtr->ssl);
-	SSL_free(statePtr->ssl);
-	statePtr->ssl = NULL;
-    }
-    if (statePtr->ctx) {
-	SSL_CTX_free(statePtr->ctx);
-	statePtr->ctx = NULL;
-    }
-    if (statePtr->callback) {
-	Tcl_DecrRefCount(statePtr->callback);
-	statePtr->callback = NULL;
-    }
-    if (statePtr->password) {
-	Tcl_DecrRefCount(statePtr->password);
-	statePtr->password = NULL;
-    }
-}
-
-/*
- *-------------------------------------------------------------------
- *
- * Tls_Init --
- *
- *	This is a package initialization procedure, which is called
- *	by Tcl when this package is to be added to an interpreter.
- *
- * Results:  Ssl configured and loaded
- *
- * Side effects:
- *	 create the ssl command, initialise ssl context
- *
- *-------------------------------------------------------------------
- */
-
-int
-Tls_Init(Tcl_Interp *interp)		/* Interpreter in which the package is
-					 * to be made available. */
-{
-    int major, minor, patchlevel, release;
-
-    /*
-     * The original 8.2.0 stacked channel implementation (and the patch
-     * that preceded it) had problems with scalability and robustness.
-     * These were address in 8.3.2 / 8.4a2, so we now require that as a
-     * minimum for TLS 1.4+.  We only support 8.2+ now (8.3.2+ preferred).
-     */
-    if (
-#ifdef USE_TCL_STUBS
-	Tcl_InitStubs(interp, "8.2", 0)
-#else
-	Tcl_PkgRequire(interp, "Tcl", "8.2", 0)
-#endif
-	== NULL) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * Get the version so we can runtime switch on available functionality.
-     * TLS should really only be used in 8.3.2+, but the other works for
-     * some limited functionality, so an attempt at support is made.
-     */
-    Tcl_GetVersion(&major, &minor, &patchlevel, &release);
-    if ((major > 8) || ((major == 8) && ((minor > 3) || ((minor == 3) &&
-	    (release == TCL_FINAL_RELEASE) && (patchlevel >= 2))))) {
-	/* 8.3.2+ */
-	channelTypeVersion = TLS_CHANNEL_VERSION_2;
-    } else {
-	/* 8.2.0 - 8.3.1 */
-	channelTypeVersion = TLS_CHANNEL_VERSION_1;
-    }
-
-    if (TlsLibInit() != TCL_OK) {
-	Tcl_AppendResult(interp, "could not initialize SSL library", NULL);
-	return TCL_ERROR;
-    }
-
-    Tcl_CreateObjCommand(interp, "tls::ciphers", CiphersObjCmd,
-	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
-
-    Tcl_CreateObjCommand(interp, "tls::handshake", HandshakeObjCmd,
-	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
-
-    Tcl_CreateObjCommand(interp, "tls::import", ImportObjCmd,
-	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
-
-    Tcl_CreateObjCommand(interp, "tls::unimport", UnimportObjCmd,
-	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
-
-    Tcl_CreateObjCommand(interp, "tls::status", StatusObjCmd,
-	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
-
-    Tcl_CreateObjCommand(interp, "tls::version", VersionObjCmd,
-	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
-
-    Tcl_CreateObjCommand(interp, "tls::misc", MiscObjCmd,
-	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
-
-    return Tcl_PkgProvide(interp, PACKAGE_NAME, PACKAGE_VERSION);
-}
-
-/*
- *------------------------------------------------------*
- *
- *	Tls_SafeInit --
- *
- *	------------------------------------------------*
- *	Standard procedure required by 'load'. 
- *	Initializes this extension for a safe interpreter.
- *	------------------------------------------------*
- *
- *	Sideeffects:
- *		As of 'Tls_Init'
- *
- *	Result:
- *		A standard Tcl error code.
- *
- *------------------------------------------------------*
- */
-
-int
-Tls_SafeInit (Tcl_Interp* interp)
-{
-    return Tls_Init (interp);
-}
-
-
-/*
- *------------------------------------------------------*
- *
- *	TlsLibInit --
- *
- *	------------------------------------------------*
- *	Initializes SSL library once per application
- *	------------------------------------------------*
- *
- *	Side effects:
- *		initilizes SSL library
- *
- *	Result:
- *		none
- *
- *------------------------------------------------------*
- */
-static int
-TlsLibInit ()
-{
-    int i;
-    char rnd_seed[16] = "GrzSlplKqUdnnzP!";	/* 16 bytes */
-#if defined(OPENSSL_THREADS) && defined(TCL_THREADS)
-    size_t num_locks;
-#endif
-    int status=TCL_OK;
-
-    if (!initialized) {
-	Tcl_MutexLock(&init_mx);
-	if (!initialized) {
-	    initialized = 1;
-
-	    if (CRYPTO_set_mem_functions((void *(*)(size_t))Tcl_Alloc,
-					 (void *(*)(void *, size_t))Tcl_Realloc,
-					 (void(*)(void *))Tcl_Free) == 0) {
-	       /* Not using Tcl's mem functions ... not critical */
-	    }
-
-#if defined(OPENSSL_THREADS) && defined(TCL_THREADS)
-	    /* should we consider allocating mutexes? */
-	    num_locks = CRYPTO_num_locks();
-	    if (num_locks > CRYPTO_NUM_LOCKS) {
-		status=TCL_ERROR;
-		goto done;
-	    }
-
-	    CRYPTO_set_locking_callback(CryptoThreadLockCallback);
-	    CRYPTO_set_id_callback(CryptoThreadIdCallback);
-#endif
-
-	    if (SSL_library_init() != 1) {
-	    	status=TCL_ERROR;
-		goto done;
-	    }
-	    SSL_load_error_strings();
-	    ERR_load_crypto_strings();
-
-	    /*
-	     * Seed the random number generator in the SSL library,
-	     * using the do/while construct because of the bug note in the
-	     * OpenSSL FAQ at http://www.openssl.org/support/faq.html#USER1
-	     *
-	     * The crux of the problem is that Solaris 7 does not have a 
-	     * /dev/random or /dev/urandom device so it cannot gather enough
-	     * entropy from the RAND_seed() when TLS initializes and refuses
-	     * to go further. Earlier versions of OpenSSL carried on regardless.
-	     */
-	    srand((unsigned int) time((time_t *) NULL));
-	    do {
-		for (i = 0; i < 16; i++) {
-		    rnd_seed[i] = 1 + (char) (255.0 * rand()/(RAND_MAX+1.0));
-		}
-		RAND_seed(rnd_seed, sizeof(rnd_seed));
-	    } while (RAND_status() != 1);
-	}
-    	done:
-
-	Tcl_MutexUnlock(&init_mx);
-    }
-    return status;
-}