/*
 * Copyright (C) 1997-1999 Matt Newman <[email protected]>
 * some modifications:
 *	Copyright (C) 2000 Ajuba Solutions
 *	Copyright (C) 2002 ActiveState Corporation
 *	Copyright (C) 2004 Starfish Systems
 *	Copyright (C) 2023 Brian O'Hagan
 *
 * 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
 *

 */

#include "tlsInt.h"
#include "tclOpts.h"
#include <stdio.h>
#include <stdlib.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

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

 * Static data structures
 */

#ifndef OPENSSL_NO_DH
#include "dh_params.h"
#endif




















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

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

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













static int
PasswordCallback(char *buf, int size, int verify, void *udata) {
    State *statePtr	= (State *) udata;
    Tcl_Interp *interp	= statePtr->interp;
    Tcl_Obj *cmdPtr;
    int code;

	    return (int)strlen(ret);
	}
    }
    Tcl_Release((ClientData) interp);
    return -1;
	verify = verify;
}


/*
 *-------------------------------------------------------------------
 *
 * 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 const char *protocols[] = {
	"ssl2", "ssl3", "tls1", "tls1.1", "tls1.2", "tls1.3", NULL
};
enum protocol {
    TLS_SSL2, TLS_SSL3, TLS_TLS1, TLS_TLS1_1, TLS_TLS1_2, TLS_TLS1_3, TLS_NONE
};

static int
CiphersObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    Tcl_Obj *objPtr = NULL;
    SSL_CTX *ctx = NULL;
    SSL *ssl = NULL;
    STACK_OF(SSL_CIPHER) *sk;
    char *cp, buf[BUFSIZ];
    int index, verbose = 0, use_supported = 0;

    dprintf("Called");

    if ((objc < 2) || (objc > 4)) {
	Tcl_WrongNumArgs(interp, 1, objv, "protocol ?verbose? ?supported?");
	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;
    }
    if ((objc > 3) && Tcl_GetBooleanFromObj(interp, objv[3], &use_supported) != TCL_OK) {
	return TCL_ERROR;
    }

    switch ((enum protocol)index) {
	case TLS_SSL2:
#if OPENSSL_VERSION_NUMBER >= 0x10100000L || defined(NO_SSL2) || defined(OPENSSL_NO_SSL2)
	    Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL);
	    return TCL_ERROR;
#else
	    ctx = SSL_CTX_new(SSLv2_method()); break;
#endif
	case TLS_SSL3:
#if defined(NO_SSL3) || defined(OPENSSL_NO_SSL3) || defined(OPENSSL_NO_SSL3_METHOD)
	    Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL);
	    return TCL_ERROR;
#else
	    ctx = SSL_CTX_new(SSLv3_method()); break;
#endif
	case TLS_TLS1:
#if defined(NO_TLS1) || defined(OPENSSL_NO_TLS1) || defined(OPENSSL_NO_TLS1_METHOD)
	    Tcl_AppendResult(interp, protocols[index], ": 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) || defined(OPENSSL_NO_TLS1_1) || defined(OPENSSL_NO_TLS1_1_METHOD)
	    Tcl_AppendResult(interp, protocols[index], ": 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) || defined(OPENSSL_NO_TLS1_2) || defined(OPENSSL_NO_TLS1_2_METHOD)
	    Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL);
	    return TCL_ERROR;
#else
	    ctx = SSL_CTX_new(TLSv1_2_method()); break;
#endif
	case TLS_TLS1_3:
#if defined(NO_TLS1_3) || defined(OPENSSL_NO_TLS1_3)

	default:
	    break;
    }
    if (ctx == NULL) {
	Tcl_AppendResult(interp, REASON(), NULL);
	return TCL_ERROR;
    }

    ssl = SSL_new(ctx);
    if (ssl == NULL) {
	Tcl_AppendResult(interp, REASON(), NULL);
	SSL_CTX_free(ctx);
	return TCL_ERROR;
    }

    /* Use list and order as would be sent in a ClientHello or all available ciphers */
    if (use_supported) {
	sk = SSL_get1_supported_ciphers(ssl);
    } else {
	sk = SSL_get_ciphers(ssl);
    }

    if (sk != NULL) {
	if (!verbose) {
	    objPtr = Tcl_NewListObj(0, NULL);
	    for (int i = 0; i < sk_SSL_CIPHER_num(sk); i++) {
		const SSL_CIPHER *c = sk_SSL_CIPHER_value(sk, i);
		if (c == NULL) continue;

		/* cipher name or (NONE) */
		cp = SSL_CIPHER_get_name(c);
		if (cp == NULL) break;
		Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(cp, -1));
	    }

	} else {
	    objPtr = Tcl_NewStringObj("",0);
	    for (int i = 0; i < sk_SSL_CIPHER_num(sk); i++) {
		const SSL_CIPHER *c = sk_SSL_CIPHER_value(sk, i);
		if (c == NULL) continue;



		/* textual description of the cipher */
		if (SSL_CIPHER_description(c, buf, sizeof(buf)) != NULL) {
		    Tcl_AppendToObj(objPtr, buf, (int) strlen(buf));


		} else {

		    Tcl_AppendToObj(objPtr, "UNKNOWN\n", 8);
		}
	    }

	}
	if (use_supported) {
	    sk_SSL_CIPHER_free(sk);
	}
    }
    SSL_free(ssl);
    SSL_CTX_free(ctx);

    Tcl_SetObjResult(interp, objPtr);
    return TCL_OK;
	clientData = clientData;
}

/*
 *-------------------------------------------------------------------
 *
 * ProtocolsObjCmd -- list available protocols
 *
 *	This procedure is invoked to process the "tls::protocols" command
 *	to list available protocols.
 *
 * Results:
 *	A standard Tcl result list.
 *
 * Side effects:
 *	none
 *
 *-------------------------------------------------------------------
 */
static int
ProtocolsObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    Tcl_Obj *objPtr;

    dprintf("Called");

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

    objPtr = Tcl_NewListObj(0, NULL);

#if OPENSSL_VERSION_NUMBER < 0x10100000L && !defined(NO_SSL2) && !defined(OPENSSL_NO_SSL2)
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(protocols[TLS_SSL2], -1));
#endif
#if !defined(NO_SSL3) && !defined(OPENSSL_NO_SSL3)
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(protocols[TLS_SSL3], -1));
#endif
#if !defined(NO_TLS1) && !defined(OPENSSL_NO_TLS1)
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(protocols[TLS_TLS1], -1));
#endif
#if !defined(NO_TLS1_1) && !defined(OPENSSL_NO_TLS1_1)
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(protocols[TLS_TLS1_1], -1));
#endif
#if !defined(NO_TLS1_2) && !defined(OPENSSL_NO_TLS1_2)
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(protocols[TLS_TLS1_2], -1));
#endif
#if !defined(NO_TLS1_3) && !defined(OPENSSL_NO_TLS1_3)
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(protocols[TLS_TLS1_3], -1));
#endif

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

    char *keyfile	        = NULL;
    char *certfile	        = NULL;
    unsigned char *key  	= NULL;
    int key_len                 = 0;
    unsigned char *cert         = NULL;
    int cert_len                = 0;
    char *ciphers	        = NULL;
    char *ciphersuites	        = NULL;
    char *CAfile	        = NULL;
    char *CAdir		        = NULL;
    char *DHparams	        = NULL;
    char *model		        = NULL;

    char *servername	        = NULL;	/* hostname for Server Name Indication */
    Tcl_Obj *alpn		= NULL;

    int ssl2 = 0, ssl3 = 0;
    int tls1 = 1, tls1_1 = 1, tls1_2 = 1, tls1_3 = 1;
    int proto = 0, level = -1;
    int verify = 0, require = 0, request = 1;

    dprintf("Called");

#if OPENSSL_VERSION_NUMBER < 0x10100000L && !defined(OPENSSL_NO_SSL2) && !defined(NO_SSL2) && defined(NO_SSL3) && defined(NO_TLS1) && defined(NO_TLS1_1) && defined(NO_TLS1_2) && defined(NO_TLS1_3)
    ssl2 = 1;
#endif
#if !defined(OPENSSL_NO_SSL3) && !defined(NO_SSL3) && defined(NO_SSL2) && defined(NO_TLS1) && defined(NO_TLS1_1) && defined(NO_TLS1_2) && defined(NO_TLS1_3)
    ssl3 = 1;
#endif
#if defined(NO_TLS1) || defined(OPENSSL_NO_TLS1)
    tls1 = 0;
#endif
#if defined(NO_TLS1_1) || defined(OPENSSL_NO_TLS1_1)
    tls1_1 = 0;

	if (opt[0] != '-')
	    break;

	OPTSTR("-cadir", CAdir);
	OPTSTR("-cafile", CAfile);
	OPTSTR("-certfile", certfile);
	OPTSTR("-cipher", ciphers);
	OPTSTR("-ciphers", ciphers);
	OPTSTR("-ciphersuites", ciphersuites);
	OPTOBJ("-command", script);
	OPTSTR("-dhparams", DHparams);
	OPTSTR("-keyfile", keyfile);
	OPTSTR("-model", model);
	OPTOBJ("-password", password);
	OPTBOOL("-require", require);
	OPTBOOL("-request", request);
	OPTINT("-securitylevel", level);
	OPTBOOL("-server", server);

	OPTSTR("-servername", servername);
	OPTOBJ("-alpn", alpn);


	OPTBOOL("-ssl2", ssl2);
	OPTBOOL("-ssl3", ssl3);
	OPTBOOL("-tls1", tls1);
	OPTBOOL("-tls1.1", tls1_1);
	OPTBOOL("-tls1.2", tls1_2);
	OPTBOOL("-tls1.3", tls1_3);
	OPTBYTE("-cert", cert, cert_len);
	OPTBYTE("-key", key, key_len);

	OPTBAD("option", "-alpn, -cadir, -cafile, -cert, -certfile, -cipher, -ciphersuites, -command, -dhparams, -key, -keyfile, -model, -password, -require, -request, -securitylevel, -server, -servername, -ssl2, -ssl3, -tls1, -tls1.1, -tls1.2, or -tls1.3");

	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);
    proto |= (tls1_3 ? TLS_PROTO_TLS1_3 : 0);

    /* reset to NULL if blank string provided */
    if (cert && !*cert)		        cert	        = NULL;
    if (key && !*key)		        key	        = NULL;
    if (certfile && !*certfile)         certfile	= NULL;
    if (keyfile && !*keyfile)		keyfile	        = NULL;
    if (ciphers && !*ciphers)	        ciphers	        = NULL;
    if (ciphersuites && !*ciphersuites) ciphersuites    = 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));

		"\": not a TLS channel", NULL);
	    Tls_Free((char *) statePtr);
	    return TCL_ERROR;
	}
	ctx = ((State *)Tcl_GetChannelInstanceData(chan))->ctx;
    } else {
	if ((ctx = CTX_Init(statePtr, server, proto, keyfile, certfile, key, cert,
	    key_len, cert_len, CAdir, CAfile, ciphers, ciphersuites, level, DHparams)) == (SSL_CTX*)0) {
	    Tls_Free((char *) statePtr);
	    return TCL_ERROR;
	}
    }

    statePtr->ctx = 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;
    }


    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;
        }
    }
    if (alpn) {
	/* Convert a Tcl list into a protocol-list in wire-format */
	unsigned char *protos, *p;
	unsigned int protos_len = 0;
	int i, len, cnt;
	Tcl_Obj **list;
	if (Tcl_ListObjGetElements(interp, alpn, &cnt, &list) != TCL_OK) {
	    Tls_Free((char *) statePtr);
	    return TCL_ERROR;
	}
	/* Determine the memory required for the protocol-list */
	for (i = 0; i < cnt; i++) {
	    Tcl_GetStringFromObj(list[i], &len);
	    if (len > 255) {
		Tcl_AppendResult(interp, "alpn protocol name too long", (char *) NULL);
		Tls_Free((char *) statePtr);
		return TCL_ERROR;
	    }
	    protos_len += 1 + len;
	}
	/* Build the complete protocol-list */
	protos = ckalloc(protos_len);
	/* protocol-lists consist of 8-bit length-prefixed, byte strings */
	for (i = 0, p = protos; i < cnt; i++) {
	    char *str = Tcl_GetStringFromObj(list[i], &len);
	    *p++ = len;
	    memcpy(p, str, len);
	    p += len;
	}
	/* Note: This functions reverses the return value convention */
	if (SSL_set_alpn_protos(statePtr->ssl, protos, protos_len)) {
	    Tcl_AppendResult(interp, "failed to set alpn protocols", (char *) NULL);
	    Tls_Free((char *) statePtr);
	    ckfree(protos);
	    return TCL_ERROR;
	}
	/* SSL_set_alpn_protos makes a copy of the protocol-list */
	ckfree(protos);
    }


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

 *	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 *CAdir,
    char *CAfile, char *ciphers, char *ciphersuites, int level, char *DHparams) {
    Tcl_Interp *interp = statePtr->interp;
    SSL_CTX *ctx = NULL;
    Tcl_DString ds;
    Tcl_DString ds1;
    int off = 0;
    int load_private_key;
    const SSL_METHOD *method;

    dprintf("Called");

    if (!proto) {
	Tcl_AppendResult(interp, "no valid protocol selected", NULL);
	return (SSL_CTX *)0;
    }

    /* create SSL context */
#if OPENSSL_VERSION_NUMBER >= 0x10100000L || defined(NO_SSL2) || defined(OPENSSL_NO_SSL2)
    if (ENABLED(proto, TLS_PROTO_SSL2)) {
	Tcl_AppendResult(interp, "SSL2 protocol not supported", NULL);
	return (SSL_CTX *)0;
    }
#endif
#if defined(NO_SSL3) || defined(OPENSSL_NO_SSL3)
    if (ENABLED(proto, TLS_PROTO_SSL3)) {

    if (ENABLED(proto, TLS_PROTO_TLS1_3)) {
	Tcl_AppendResult(interp, "TLS 1.3 protocol not supported", NULL);
	return (SSL_CTX *)0;
    }
#endif

    switch (proto) {
#if OPENSSL_VERSION_NUMBER < 0x10100000L && !defined(NO_SSL2) && !defined(OPENSSL_NO_SSL2)
    case TLS_PROTO_SSL2:
	method = SSLv2_method();
	break;
#endif
#if !defined(NO_SSL3) && !defined(OPENSSL_NO_SSL3) && !defined(OPENSSL_NO_SSL3_METHOD)
    case TLS_PROTO_SSL3:
	method = SSLv3_method();
	break;
#endif
#if !defined(NO_TLS1) && !defined(OPENSSL_NO_TLS1) && !defined(OPENSSL_NO_TLS1_METHOD)
    case TLS_PROTO_TLS1:
	method = TLSv1_method();
	break;
#endif
#if !defined(NO_TLS1_1) && !defined(OPENSSL_NO_TLS1_1) && !defined(OPENSSL_NO_TLS1_1_METHOD)
    case TLS_PROTO_TLS1_1:
	method = TLSv1_1_method();
	break;
#endif
#if !defined(NO_TLS1_2) && !defined(OPENSSL_NO_TLS1_2) && !defined(OPENSSL_NO_TLS1_2_METHOD)
    case TLS_PROTO_TLS1_2:
	method = TLSv1_2_method();
	break;
#endif
#if !defined(NO_TLS1_3) && !defined(OPENSSL_NO_TLS1_3)
    case TLS_PROTO_TLS1_3:
	/*
	 * The version range is constrained below,
	 * after the context is created.  Use the
	 * generic method here.
	 */
	method = TLS_method();
	break;
#endif
    default:

	/* Negotiate highest available SSL/TLS version */
	method = TLS_method();



#if OPENSSL_VERSION_NUMBER < 0x10100000L && !defined(NO_SSL2) && !defined(OPENSSL_NO_SSL2)
	off |= (ENABLED(proto, TLS_PROTO_SSL2)   ? 0 : SSL_OP_NO_SSLv2);
#endif
#if !defined(NO_SSL3) && !defined(OPENSSL_NO_SSL3)
	off |= (ENABLED(proto, TLS_PROTO_SSL3)   ? 0 : SSL_OP_NO_SSLv3);
#endif
#if !defined(NO_TLS1) && !defined(OPENSSL_NO_TLS1)

    SSL_CTX_set_options(ctx, SSL_OP_ALL);	/* all SSL bug workarounds */
    SSL_CTX_set_options(ctx, off);		/* disable protocol versions */
#if OPENSSL_VERSION_NUMBER < 0x10101000L
    SSL_CTX_set_mode(ctx, SSL_MODE_AUTO_RETRY);	/* handle new handshakes in background */
#endif
    SSL_CTX_sess_set_cache_size(ctx, 128);

    /* Set user defined ciphers, cipher suites, and security level */
    if (((ciphers != NULL) && !SSL_CTX_set_cipher_list(ctx, ciphers)) || \
	((ciphersuites != NULL) && !SSL_CTX_set_ciphersuites(ctx, ciphersuites))) {
	    Tcl_AppendResult(interp, "Set ciphers failed", (char *) NULL);
	    SSL_CTX_free(ctx);
	    return (SSL_CTX *)0;
    }

    /* Set security level */
    if (level > -1 && level < 6) {
	/* SSL_set_security_level */
	SSL_CTX_set_security_level(ctx, level);
    }

    /* set some callbacks */
    SSL_CTX_set_default_passwd_cb(ctx, PasswordCallback);


    SSL_CTX_set_default_passwd_cb_userdata(ctx, (void *)statePtr);


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

StatusObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    State *statePtr;
    X509 *peer;
    Tcl_Obj *objPtr;
    Tcl_Channel chan;
    char *channelName, *ciphers;
    int mode;

    const unsigned char *proto;
    unsigned int len;


    dprintf("Called");

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

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


    /* Report the selected protocol as a result of the negotiation */
    SSL_get0_alpn_selected(statePtr->ssl, &proto, &len);
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("alpn", -1));
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj((char *)proto, (int)len));
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("version", -1));
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_get_version(statePtr->ssl), -1));

    Tcl_SetObjResult(interp, objPtr);
    return TCL_OK;
	clientData = clientData;
}

/*
 *-------------------------------------------------------------------
 *
 * ConnectionInfoObjCmd -- return connection info from OpenSSL.
 *
 * Results:
 *	A list of connection info
  *
 *-------------------------------------------------------------------
 */

static int ConnectionInfoObjCmd(ClientData clientData, 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 */
    Tcl_Obj *objPtr;
    const SSL *ssl;
    const SSL_CIPHER *cipher;
    const unsigned char *proto;
    unsigned int len;
#if defined(HAVE_SSL_COMPRESSION)
    const COMP_METHOD *comp;
#endif

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

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

    objPtr = Tcl_NewListObj(0, NULL);

    /* Get connection state */
    statePtr = (State *)Tcl_GetChannelInstanceData(chan);
    ssl = statePtr->ssl;
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("state", -1));
    if (SSL_is_init_finished(ssl)) {
	Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("established", -1));
    } else if (SSL_in_init(ssl)) {
	Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("handshake", -1));
    } else {
	Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("initializing", -1));
    }

    /* Get server name */
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("servername", -1));
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_get_servername(ssl, TLSEXT_NAMETYPE_host_name), -1));

    /* Get protocol */
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("protocol", -1));
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_get_version(ssl), -1));

    /* Get security level */
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("securitylevel", -1));
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewIntObj(SSL_get_security_level(ssl)));

    /* Get cipher */
    cipher = SSL_get_current_cipher(ssl);
    if (cipher != NULL) {
	char buf[BUFSIZ] = {0};
	int bits, alg_bits;

	Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("cipher", -1));
	Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_CIPHER_get_name(cipher), -1));
	Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("standard_name", -1));
	Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_CIPHER_standard_name(cipher), -1));

	bits = SSL_CIPHER_get_bits(cipher, &alg_bits);
	Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("bits", -1));
	Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewIntObj(bits));
	Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("secret_bits", -1));
	Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewIntObj(alg_bits));
	/* alg_bits is actual key secret bits. If use bits and secret (algorithm) bits differ,
           the rest of the bits are fixed, i.e. for limited export ciphers (bits < 56) */
	Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("min_version", -1));
	Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_CIPHER_get_version(cipher), -1));

	if (SSL_CIPHER_description(cipher, buf, sizeof(buf)) != NULL) {
	    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("description", -1));
	    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(buf, -1));
	}
    }

    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("renegotiation", -1));
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(
	SSL_get_secure_renegotiation_support(ssl) ? "allowed" : "disallowed", -1));

    /* Report the selected protocol as a result of the negotiation */
    SSL_get0_alpn_selected(ssl, &proto, &len);
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("alpn", -1));
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj((char *)proto, (int)len));

    /* Session info */
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("session_reused", -1));
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewIntObj(SSL_session_reused(ssl)));

#if defined(HAVE_SSL_COMPRESSION)
    /* Compression info */
    comp = SSL_get_current_compression(ssl);
    if (comp != NULL) {
	expansion = SSL_get_current_expansion(ssl);
	Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("compression", -1));
	Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_COMP_get_name(comp), -1));
	Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("expansion", -1));
	Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_COMP_get_name(expansion), -1));
    }
#endif

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

	    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 OPENSSL_VERSION_NUMBER < 0x30000000L


	    BIGNUM *bne = NULL;
	    RSA *rsa = NULL;
#else
	    EVP_PKEY_CTX *ctx = NULL;
#endif

	    if ((objc<5) || (objc>6)) {

		    } else {
			Tcl_SetResult(interp,"Unknown parameter",NULL);
			return TCL_ERROR;
		    }
		}
	    }

#if OPENSSL_VERSION_NUMBER < 0x30000000L






	    bne = BN_new();
	    rsa = RSA_new();
	    pkey = EVP_PKEY_new();
	    if (bne == NULL || rsa == NULL || pkey == NULL || !BN_set_word(bne,RSA_F4) ||
		!RSA_generate_key_ex(rsa, keysize, bne, NULL) || !EVP_PKEY_assign_RSA(pkey, rsa)) {
		EVP_PKEY_free(pkey);
		/* RSA_free(rsa); freed by EVP_PKEY_free */

		    /* PEM_write_bio_RSAPrivateKey(out, rsa, 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);
#if OPENSSL_VERSION_NUMBER < 0x30000000L
		    BN_free(bne);
#endif
		    return(TCL_ERROR);
		}

		X509_set_version(cert,2);
		ASN1_INTEGER_set(X509_get_serialNumber(cert),serial);




		X509_gmtime_adj(X509_getm_notBefore(cert),0);
		X509_gmtime_adj(X509_getm_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, (const unsigned char *) k_C, -1, -1, 0);
		X509_NAME_add_entry_by_txt(name,"ST", MBSTRING_ASC, (const unsigned char *) k_ST, -1, -1, 0);
		X509_NAME_add_entry_by_txt(name,"L", MBSTRING_ASC, (const unsigned char *) k_L, -1, -1, 0);
		X509_NAME_add_entry_by_txt(name,"O", MBSTRING_ASC, (const unsigned char *) k_O, -1, -1, 0);
		X509_NAME_add_entry_by_txt(name,"OU", MBSTRING_ASC, (const unsigned char *) k_OU, -1, -1, 0);
		X509_NAME_add_entry_by_txt(name,"CN", MBSTRING_ASC, (const unsigned char *) k_CN, -1, -1, 0);
		X509_NAME_add_entry_by_txt(name,"Email", MBSTRING_ASC, (const unsigned char *) k_Email, -1, -1, 0);

		X509_set_subject_name(cert,name);

		if (!X509_sign(cert,pkey,EVP_sha256())) {
		    X509_free(cert);
		    EVP_PKEY_free(pkey);
#if OPENSSL_VERSION_NUMBER < 0x30000000L
		    BN_free(bne);
#endif
		    Tcl_SetResult(interp,"Error signing certificate",NULL);
		    return TCL_ERROR;
		}

		if (isStr) {

		    BIO_write_filename(out,pemout);
		    PEM_write_bio_X509(out,cert);
		    BIO_free_all(out);
		}

		X509_free(cert);
		EVP_PKEY_free(pkey);
#if OPENSSL_VERSION_NUMBER < 0x30000000L
		BN_free(bne);
#endif
	    }
	}
	break;
    default:
	break;

    if (TlsLibInit(0) != 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::connection", ConnectionInfoObjCmd, (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);
    Tcl_CreateObjCommand(interp, "tls::protocols", ProtocolsObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);

    if (interp) {
	Tcl_Eval(interp, tlsTclInitScript);
    }

    return(Tcl_PkgProvide(interp, "tls", PACKAGE_VERSION));
}

        }

        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_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

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