*/

#include "tlsInt.h"
#include "tclOpts.h"
#include "tlsUuid.h"
#include <stdio.h>
#include <stdlib.h>
#include <openssl/ssl.h>
#include <openssl/crypto.h>
#include <openssl/opensslconf.h>
#include <openssl/rsa.h>
#include <openssl/safestack.h>

/* Min OpenSSL version */
#if OPENSSL_VERSION_NUMBER < 0x10101000L
#error "Only OpenSSL v1.1.1 or later is supported"
#endif


/*
 * Forward declarations
 */

#define F2N(key, dsp) \
	(((key) == NULL) ? (char *) NULL : \
		Tcl_TranslateFileName(interp, (key), (dsp)))

static SSL_CTX *CTX_Init(State *statePtr, int isServer, int proto, char *key,
		char *certfile, unsigned char *key_asn1, unsigned char *cert_asn1,
		int key_asn1_len, int cert_asn1_len, char *CApath, char *CAfile,
		Tcl_Size key_asn1_len, Tcl_Size cert_asn1_len, char *CApath, char *CAfile,
		char *ciphers, char *ciphersuites, int level, char *DHparams);

static int	TlsLibInit(int uninitialize);

#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 TLS_PROTO_TLS1_3	0x20
#define ENABLED(flag, mask)	(((flag) & (mask)) == (mask))

#define SSLKEYLOGFILE		"SSLKEYLOGFILE"

/*
 * Thread-Safe TLS Code
 */

#ifdef TCL_THREADS
#define OPENSSL_THREAD_DEFINES
#include <openssl/opensslconf.h>

#ifdef OPENSSL_THREADS
#include <openssl/crypto.h>
#include <openssl/ssl.h>

/*
 * Threaded operation requires locking callbacks
 * Based from /crypto/cryptlib.c of OpenSSL and NSOpenSSL.
 */

static Tcl_Mutex *locks = NULL;
static int locksCount = 0;
static Tcl_Mutex init_mx;
#endif /* OPENSSL_THREADS */
#endif /* TCL_THREADS */


/********************/
/* Callbacks        */
/********************/

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

 *-------------------------------------------------------------------
 */
static void
InfoCallback(const SSL *ssl, int where, int ret) {
    State *statePtr = (State*)SSL_get_app_data((SSL *)ssl);
    Tcl_Interp *interp	= statePtr->interp;
    Tcl_Obj *cmdPtr;
    char *major; char *minor;
    const char *major, *minor;

    dprintf("Called");

    if (statePtr->callback == (Tcl_Obj*)NULL)
    if (statePtr->callback == (Tcl_Obj*)NULL) {
	return;
    }

    if (where & SSL_CB_HANDSHAKE_START) {
	major = "handshake";
	minor = "start";
    } else if (where & SSL_CB_HANDSHAKE_DONE) {
	major = "handshake";
	minor = "done";

    char *ver, *type;
    BIO *bio;
    char buffer[15000];
    buffer[0] = 0;

    dprintf("Called");

    if (statePtr->callback == (Tcl_Obj*)NULL)
    if (statePtr->callback == (Tcl_Obj*)NULL) {
	return;
    }

    switch(version) {
#if OPENSSL_VERSION_NUMBER < 0x10100000L && !defined(NO_SSL2) && !defined(OPENSSL_NO_SSL2)
    case SSL2_VERSION:
	ver = "SSLv2";
	break;
#endif

	SSL_trace(write_p, version, content_type, buf, len, ssl, (void *)bio);
	n = BIO_read(bio, buffer, BIO_pending(bio) < 15000 ? BIO_pending(bio) : 14999);
	n = (n<0) ? 0 : n;
	buffer[n] = 0;
	(void)BIO_flush(bio);
	BIO_free(bio);
   }

    dprintf("Message direction=%d, ver=%s, type=%s, message=%s", write_p, ver, type, &buffer[0]);

    /* Create command to eval with fn, chan, direction, version, type, and message args */
    cmdPtr = Tcl_DuplicateObj(statePtr->callback);
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("message", -1));
    Tcl_ListObjAppendElement(interp, cmdPtr,
	    Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1));
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(write_p ? "Sent" : "Received", -1));

 * 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) {
Tls_Error(State *statePtr, const char *msg) {
    Tcl_Interp *interp	= statePtr->interp;
    Tcl_Obj *cmdPtr, *listPtr;
    unsigned long err;
    statePtr->err = msg;

    dprintf("Called");
    dprintf("Called with message %s", msg);

    if (statePtr->callback == (Tcl_Obj*)NULL)
    if (statePtr->callback == (Tcl_Obj*)NULL) {
	return;
    }

    /* Create command to eval with fn, chan, and message args */
    cmdPtr = Tcl_DuplicateObj(statePtr->callback);
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("error", -1));
    Tcl_ListObjAppendElement(interp, cmdPtr,
	    Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1));
    if (msg != NULL) {

		"\": not a TLS channel", (char *) NULL);
	    Tcl_SetErrorCode(interp, "TLS", "IMPORT", "CHANNEL", "INVALID", (char *) NULL);
	    Tls_Free((tls_free_type *) statePtr);
	    return TCL_ERROR;
	}
	ctx = ((State *)Tcl_GetChannelInstanceData(chan))->ctx;
    } else {
	if ((ctx = CTX_Init(statePtr, server, proto, keyfile, certfile, key, cert, (int) key_len,
	    (int) cert_len, CApath, CAfile, ciphers, ciphersuites, level, DHparams)) == NULL) {
	if ((ctx = CTX_Init(statePtr, server, proto, keyfile, certfile, key, cert, key_len,
	    cert_len, CApath, CAfile, ciphers, ciphersuites, level, DHparams)) == NULL) {
	    Tls_Free((tls_free_type *) 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_DStringInit(&upperChannelTranslation);
    Tcl_DStringInit(&upperChannelBlocking);
    Tcl_DStringInit(&upperChannelEOFChar);
    Tcl_DStringInit(&upperChannelEncoding);
    Tcl_GetChannelOption(interp, chan, "-eofchar", &upperChannelEOFChar);
    Tcl_GetChannelOption(interp, chan, "-encoding", &upperChannelEncoding);
    Tcl_GetChannelOption(interp, chan, "-translation", &upperChannelTranslation);
    Tcl_GetChannelOption(interp, chan, "-blocking", &upperChannelBlocking);
    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((tls_free_type *) statePtr);
	Tcl_DStringFree(&upperChannelTranslation);
	Tcl_DStringFree(&upperChannelEncoding);
	Tcl_DStringFree(&upperChannelEOFChar);
	Tcl_DStringFree(&upperChannelBlocking);
	return TCL_ERROR;
    }

    Tcl_SetChannelOption(interp, statePtr->self, "-translation", Tcl_DStringValue(&upperChannelTranslation));
    Tcl_SetChannelOption(interp, statePtr->self, "-encoding", Tcl_DStringValue(&upperChannelEncoding));
    Tcl_SetChannelOption(interp, statePtr->self, "-eofchar", Tcl_DStringValue(&upperChannelEOFChar));
    Tcl_SetChannelOption(interp, statePtr->self, "-blocking", Tcl_DStringValue(&upperChannelBlocking));

 * Side effects:
 *	May modify the behavior of an IO channel.
 *
 *-------------------------------------------------------------------
 */
static int
UnimportObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    Tcl_Channel chan;		/* The channel to set a mode on. */
    Tcl_Channel chan, child;	/* The stacked and underlying channels */
    Tcl_DString upperChannelTranslation, upperChannelBlocking, upperChannelEncoding, upperChannelEOFChar;
    int res = TCL_OK;
    (void) clientData;

    dprintf("Called");

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "channel");
	return TCL_ERROR;
    }

    /* Validate channel name */
    chan = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), NULL);
    if (chan == (Tcl_Channel) NULL) {
	return TCL_ERROR;
    }

    /* Make sure to operate on the topmost channel */
    chan = Tcl_GetTopChannel(chan);
    child = Tcl_GetStackedChannel(chan);

    if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {
    /* Verify is a stacked channel */
    if (child == NULL) {
	Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan),
		"\": not a TLS channel", (char *) NULL);
		"\": not a stacked channel", (char *) NULL);
	    Tcl_SetErrorCode(interp, "TLS", "UNIMPORT", "CHANNEL", "INVALID", (char *) NULL);
	return TCL_ERROR;
    }

    /* Flush any pending data */
    if (Tcl_Flush(chan) != TCL_OK) {
	return TCL_ERROR;
    }

    Tcl_DStringInit(&upperChannelTranslation);
    Tcl_DStringInit(&upperChannelBlocking);
    Tcl_DStringInit(&upperChannelEOFChar);
    Tcl_DStringInit(&upperChannelEncoding);

    /* Get current config - EOL translation, encoding and buffering options are shared between all channels in the stack */
    Tcl_GetChannelOption(interp, chan, "-blocking", &upperChannelBlocking);
    Tcl_GetChannelOption(interp, chan, "-encoding", &upperChannelEncoding);
    Tcl_GetChannelOption(interp, chan, "-eofchar", &upperChannelEOFChar);
    Tcl_GetChannelOption(interp, chan, "-translation", &upperChannelTranslation);

    /* Unstack the channel and restore underlying channel config */
    if (Tcl_UnstackChannel(interp, chan) == TCL_ERROR) {
	return TCL_ERROR;
    if (Tcl_UnstackChannel(interp, chan) == TCL_OK) {
	Tcl_SetChannelOption(interp, child, "-encoding", Tcl_DStringValue(&upperChannelEncoding));
	Tcl_SetChannelOption(interp, child, "-eofchar", Tcl_DStringValue(&upperChannelEOFChar));
	Tcl_SetChannelOption(interp, child, "-translation", Tcl_DStringValue(&upperChannelTranslation));
	Tcl_SetChannelOption(interp, child, "-blocking", Tcl_DStringValue(&upperChannelBlocking));
    } else {
	res = TCL_ERROR;
    }

    /* Clean-up */
    Tcl_DStringFree(&upperChannelTranslation);
    Tcl_DStringFree(&upperChannelEncoding);
    Tcl_DStringFree(&upperChannelEOFChar);
    Tcl_DStringFree(&upperChannelBlocking);
    return TCL_OK;
    return res;
}

/*
 *-------------------------------------------------------------------
 *
 * 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(State *statePtr, int isServer, int proto, char *keyfile, char *certfile,
    unsigned char *key, unsigned char *cert, int key_len, int cert_len, char *CApath,
    unsigned char *key, unsigned char *cert, Tcl_Size key_len, Tcl_Size cert_len, char *CApath,
    char *CAfile, char *ciphers, char *ciphersuites, int level, char *DHparams) {
    Tcl_Interp *interp = statePtr->interp;
    SSL_CTX *ctx = NULL;
    Tcl_DString ds;
    int off = 0, abort = 0;
    int load_private_key;
    const SSL_METHOD *method;

	    SSL_CTX_free(ctx);
	    return NULL;
	}
	Tcl_DStringFree(&ds);

    } else if (cert != NULL) {
	load_private_key = 1;
	if (SSL_CTX_use_certificate_ASN1(ctx, cert_len, cert) <= 0) {
	if (SSL_CTX_use_certificate_ASN1(ctx, (int) cert_len, cert) <= 0) {
	    Tcl_AppendResult(interp, "unable to set certificate: ",
		GET_ERR_REASON(), (char *) NULL);
	    SSL_CTX_free(ctx);
	    return NULL;
	}
    } else {
	certfile = (char*)X509_get_default_cert_file();

		    GET_ERR_REASON(), (char *) NULL);
		SSL_CTX_free(ctx);
		return NULL;
	    }
	    Tcl_DStringFree(&ds);

	} else if (key != NULL) {
	    if (SSL_CTX_use_PrivateKey_ASN1(EVP_PKEY_RSA, ctx, key,key_len) <= 0) {
	    if (SSL_CTX_use_PrivateKey_ASN1(EVP_PKEY_RSA, ctx, key, (int) key_len) <= 0) {
		/* flush the passphrase which might be left in the result */
		Tcl_SetResult(interp, NULL, TCL_STATIC);
		Tcl_AppendResult(interp, "unable to set public key: ", GET_ERR_REASON(), (char *) NULL);
		SSL_CTX_free(ctx);
		return NULL;
	    }
	}

	res = SSL_get_peer_signature_nid(statePtr->ssl, &nid);
    } else {
	res = SSL_get_signature_nid(statePtr->ssl, &nid);
    }
    if (!res) {nid = 0;}
    LAPPEND_STR(interp, objPtr, "signatureHashAlgorithm", OBJ_nid2ln(nid), -1);

    /* Added in OpenSSL 1.1.1a */
#if OPENSSL_VERSION_NUMBER > 0x10101000L
    if (objc == 2) {
	res = SSL_get_peer_signature_type_nid(statePtr->ssl, &nid);
    } else {
	res = SSL_get_signature_type_nid(statePtr->ssl, &nid);
    }
    if (!res) {nid = 0;}
    LAPPEND_STR(interp, objPtr, "signatureType", OBJ_nid2ln(nid), -1);
#endif

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

 * Side effects:
 *	Frees all the state
 *
 *-------------------------------------------------------------------
 */
void Tls_Clean(State *statePtr) {
    dprintf("Called");

    if (statePtr->ssl) {
	/* Send close_notify message */
	dprintf("SSL_shutdown(%p)", statePtr->ssl);
	SSL_shutdown(statePtr->ssl);
    }

    /*
     * we're assuming here that we're single-threaded
     */
    if (statePtr->timer != (Tcl_TimerToken) NULL) {
	Tcl_DeleteTimerHandler(statePtr->timer);
	statePtr->timer = NULL;
    }

    if (statePtr->protos) {
	ckfree(statePtr->protos);
	statePtr->protos = NULL;
    }
    if (statePtr->bio) {
	/* This will call SSL_shutdown. Bug 1414045 */
    /* Remove callbacks */
	dprintf("BIO_free_all(%p)", statePtr->bio);
	BIO_free_all(statePtr->bio);
	statePtr->bio = NULL;
    }
    if (statePtr->ssl) {
	dprintf("SSL_free(%p)", 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;
    }
    if (statePtr->vcmd) {
	Tcl_DecrRefCount(statePtr->vcmd);
	statePtr->vcmd = NULL;
    }

    if (statePtr->protos) {
	ckfree(statePtr->protos);
	statePtr->protos = NULL;
    }

    if (statePtr->bio) {
	/* This will call SSL_shutdown. Bug 1414045 */
	dprintf("BIO_free_all(%p)", statePtr->bio);
	BIO_free_all(statePtr->bio);
	statePtr->bio = NULL;
    }

    if (statePtr->ssl) {
	dprintf("SSL_free(%p)", statePtr->ssl);
	SSL_free(statePtr->ssl);
	statePtr->ssl = NULL;
    }

    if (statePtr->ctx) {
	SSL_CTX_free(statePtr->ctx);
	statePtr->ctx = NULL;
    }

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

			    ".static"
#endif
		), NULL);
    }
    return TCL_OK;
}

/*
 *------------------------------------------------------*
 *
 * TlsLibShutdown --
 *
 *	Shutdown SSL library once per application
 *
 * Results:
 *	A standard TCL result
 *
 * Side effects:
 *	Shutdown SSL library
 *
 *------------------------------------------------------*
 */
static int TlsLibShutdown(ClientData clientData) {
    BIO_cleanup();
    return TCL_OK;
}

/*
 *------------------------------------------------------*
 *
 *	TlsLibInit --
 *
 *	Initializes SSL library once per application
 *
 * Results:
 *	A standard Tcl result
 *
 * Side effects:
 *	Initializes SSL library
 *
 *------------------------------------------------------*
 */
static int TlsLibInit() {
    static int initialized = 0;

    dprintf("Called");

    if (!initialized) {
	/* Initialize BOTH libcrypto and libssl. */
	if (!OPENSSL_init_ssl(OPENSSL_INIT_LOAD_SSL_STRINGS | OPENSSL_INIT_LOAD_CRYPTO_STRINGS
	    | OPENSSL_INIT_ADD_ALL_CIPHERS | OPENSSL_INIT_ADD_ALL_DIGESTS
	    | OPENSSL_INIT_LOAD_CONFIG | OPENSSL_INIT_ASYNC, NULL)) {
	    return TCL_ERROR;
	}

	/* Create BIO handlers */
	BIO_new_tcl(NULL, 0);
	
	/* Create exit handler */
	Tcl_CreateExitHandler(TlsLibShutdown, NULL);
	initialized = 1;
    }
    return TCL_OK;
}

/* Init script */
static const char tlsTclInitScript[] = {
#include "tls.tcl.h"
};

/*
 *-------------------------------------------------------------------
 *
 * Tls_Init --
 *
 *	This is a package initialization procedure, which is called
 *	by Tcl when this package is to be added to an interpreter.
 *	by TCL when this package is to be added to an interpreter.
 *
 * Results:  Ssl configured and loaded
 * Results:
 *	Initializes structures and creates commands.
 *
 * Side effects:
 *	 create the ssl command, initialize ssl context
 *	 Create the commands
 *
 *-------------------------------------------------------------------
 */

#if TCL_MAJOR_VERSION > 8
#define MIN_VERSION "9.0"
#else
#define MIN_VERSION "8.5"
#endif

static const char tlsTclInitScript[] = {
#include "tls.tcl.h"
	0x00
    };

DLLEXPORT int Tls_Init(Tcl_Interp *interp) {

    dprintf("Called");

#ifdef USE_TCL_STUBS
    if (Tcl_InitStubs(interp, MIN_VERSION, 0) == NULL) {
	return TCL_ERROR;
    }
#endif
    if (Tcl_PkgRequire(interp, "Tcl", MIN_VERSION, 0) == NULL) {
	return TCL_ERROR;
    }

    if (TlsLibInit(0) != TCL_OK) {
    if (TlsLibInit() != TCL_OK) {
	Tcl_AppendResult(interp, "could not initialize SSL library", (char *) NULL);
	return TCL_ERROR;
    }

    Tcl_CreateObjCommand(interp, "::tls::ciphers", CiphersObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "::tls::connection", ConnectionInfoObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "::tls::handshake", HandshakeObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "::tls::import", ImportObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "::tls::unimport", UnimportObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "::tls::unstack", UnimportObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "::tls::status", StatusObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "::tls::version", VersionObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "::tls::misc", MiscObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "::tls::protocols", ProtocolsObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);

    BuildInfoCommand(interp);

    if (interp && Tcl_Eval(interp, tlsTclInitScript) != TCL_OK) {
	return TCL_ERROR;
    }

    return Tcl_PkgProvide(interp, PACKAGE_NAME, PACKAGE_VERSION);
}

/*
 *------------------------------------------------------*
 *-------------------------------------------------------------------
 *
 *	Tls_SafeInit --
 *
 *	------------------------------------------------*
 *	Standard procedure required by 'load'.
 *	This is a package initialization procedure for safe interps.
 *	Initializes this extension for a safe interpreter.
 *	------------------------------------------------*
 *
 *	Side effects:
 *		As of 'Tls_Init'
 * Results:
 *	Same as of 'Tls_Init'
 *
 * Side effects:
 *	Result:
 *	Same as of 'Tls_Init'
 *		A standard Tcl error code.
 *
 *------------------------------------------------------*
 *-------------------------------------------------------------------
 */
DLLEXPORT int Tls_SafeInit(Tcl_Interp *interp) {
    dprintf("Called");
    return Tls_Init(interp);
}

/*
 *------------------------------------------------------*
 *
 *	TlsLibInit --
 *
 *	------------------------------------------------*
 *	Initializes SSL library once per application
 *	------------------------------------------------*
 *
 *	Side effects:
 *		initializes SSL library
 *
 *	Result:
 *		none
 *
 *------------------------------------------------------*
 */
static int TlsLibInit(int uninitialize) {
    static int initialized = 0;
    int status = TCL_OK;
#if defined(OPENSSL_THREADS) && defined(TCL_THREADS)
    size_t num_locks;
#endif

    if (uninitialize) {
	if (!initialized) {
	    dprintf("Asked to uninitialize, but we are not initialized");

	    return TCL_OK;
	}

	dprintf("Asked to uninitialize");

#if defined(OPENSSL_THREADS) && defined(TCL_THREADS)
	Tcl_MutexLock(&init_mx);

	if (locks) {
	    free(locks);
	    locks = NULL;
	    locksCount = 0;
	}
#endif
	initialized = 0;

#if defined(OPENSSL_THREADS) && defined(TCL_THREADS)
	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)
    num_locks = 1;
    locksCount = (int) num_locks;
    locks = malloc(sizeof(*locks) * num_locks);
    memset(locks, 0, sizeof(*locks) * num_locks);
#endif

    /* Initialize BOTH libcrypto and libssl. */
    OPENSSL_init_ssl(OPENSSL_INIT_LOAD_SSL_STRINGS | OPENSSL_INIT_LOAD_CRYPTO_STRINGS
	| OPENSSL_INIT_ADD_ALL_CIPHERS | OPENSSL_INIT_ADD_ALL_DIGESTS, NULL);

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

#if defined(OPENSSL_THREADS) && defined(TCL_THREADS)
	Tcl_MutexUnlock(&init_mx);
#endif

    return status;
}