*/

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

 *-------------------------------------------------------------------
 */
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;
    char *major, *minor;

    dprintf("Called");

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

    if (where & SSL_CB_HANDSHAKE_START) {

static void
MessageCallback(int write_p, int version, int content_type, const void *buf, size_t len, SSL *ssl, void *arg) {
    State *statePtr = (State*)arg;
    Tcl_Interp *interp	= statePtr->interp;
    Tcl_Obj *cmdPtr;
    char *ver, *type;
    BIO *bio;
    char buffer[15000];
    char buffer[30000];
    buffer[0] = 0;

    dprintf("Called");

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

 *	  to a string describing the SSL negotiation failure reason
 *
 *-------------------------------------------------------------------
 */
static int
VerifyCallback(int ok, X509_STORE_CTX *ctx) {
    Tcl_Obj *cmdPtr;
    SSL   *ssl		= (SSL*)X509_STORE_CTX_get_ex_data(ctx, SSL_get_ex_data_X509_STORE_CTX_idx());
    SSL   *ssl = (SSL*)X509_STORE_CTX_get_ex_data(ctx, SSL_get_ex_data_X509_STORE_CTX_idx());
    X509  *cert		= X509_STORE_CTX_get_current_cert(ctx);
    State *statePtr	= (State*)SSL_get_app_data(ssl);
    Tcl_Interp *interp	= statePtr->interp;
    int depth		= X509_STORE_CTX_get_error_depth(ctx);
    int err		= X509_STORE_CTX_get_error(ctx);

    dprintf("Called");

/********************/
/* Commands         */
/********************/

/*
 *-------------------------------------------------------------------
 *
 * 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 buf[BUFSIZ];
    int index, verbose = 0, use_supported = 0;
    const SSL_METHOD *method;
    (void) clientData;

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

    ERR_clear_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", (char *) NULL);
	    return TCL_ERROR;
#else
	    method = 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", (char *) NULL);
	    return TCL_ERROR;
#else
	    method = 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", (char *) NULL);
	    return TCL_ERROR;
#else
	    method = 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", (char *) NULL);
	    return TCL_ERROR;
#else
	    method = 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", (char *) NULL);
	    return TCL_ERROR;
#else
	    method = TLSv1_2_method(); break;
#endif
	case TLS_TLS1_3:
#if defined(NO_TLS1_3) || defined(OPENSSL_NO_TLS1_3)
	    Tcl_AppendResult(interp, protocols[index], ": protocol not supported", (char *) NULL);
	    return TCL_ERROR;
#else
	    method = TLS_method();
	    SSL_CTX_set_min_proto_version(ctx, TLS1_3_VERSION);
	    SSL_CTX_set_max_proto_version(ctx, TLS1_3_VERSION);
	    break;
#endif
	default:
	    method = TLS_method();
	    break;
    }

    ctx = SSL_CTX_new(method);
    if (ctx == NULL) {
	Tcl_AppendResult(interp, GET_ERR_REASON(), (char *) NULL);
	return TCL_ERROR;
    }

    ssl = SSL_new(ctx);
    if (ssl == NULL) {
	Tcl_AppendResult(interp, GET_ERR_REASON(), (char *) 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) {
	    const char *cp;
	    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((char *) 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, (Tcl_Size) 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;
}

/*
 *-------------------------------------------------------------------
 *
 * 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;
    (void) clientData;

    dprintf("Called");

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

    ERR_clear_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) && !defined(OPENSSL_NO_SSL3_METHOD)
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(protocols[TLS_SSL3], -1));
#endif
#if !defined(NO_TLS1) && !defined(OPENSSL_NO_TLS1) && !defined(OPENSSL_NO_TLS1_METHOD)
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(protocols[TLS_TLS1], -1));
#endif
#if !defined(NO_TLS1_1) && !defined(OPENSSL_NO_TLS1_1) && !defined(OPENSSL_NO_TLS1_1_METHOD)
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(protocols[TLS_TLS1_1], -1));
#endif
#if !defined(NO_TLS1_2) && !defined(OPENSSL_NO_TLS1_2) && !defined(OPENSSL_NO_TLS1_2_METHOD)
    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;
}

/*
 *-------------------------------------------------------------------
 *
 * 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.

    }

    dprintf("Returning TCL_OK with data \"%i\"", ret);
    Tcl_SetObjResult(interp, Tcl_NewIntObj(ret));
    return TCL_OK;
}

static const char *command_opts [] = {
    "-alpn", "-cadir", "-cafile", "-cert", "-certfile", "-cipher", "-ciphers", "-ciphersuites",
    "-command", "-dhparams", "-key", "-keyfile", "-model", "-password", "-post_handshake",
    "-request", "-require", "-security_level", "-server", "-servername", "-session_id", "-ssl2",
    "-ssl3", "-tls1", "-tls1.1", "-tls1.2", "-tls1.3", "-validatecommand", "-vcmd", NULL};

enum _command_opts {
    _opt_alpn, _opt_cadir, _opt_cafile, _opt_cert, _opt_certfile, _opt_cipher, _opt_ciphers,
    _opt_ciphersuite, _opt_cmd, _opt_dhparams, _opt_key, _opt_keyfile, _opt_model, _opt_password,
    _opt_handshake, _opt_request, _opt_require, _opt_security_level, _opt_server, _opt_servername,
    _opt_session_id, _opt_ssl2, _opt_ssl3, _opt_tls1, _opt_tls11, _opt_tls12, _opt_tls13,
    _opt_validate, _opt_vcmd
};

/*
 *-------------------------------------------------------------------
 *
 * ImportObjCmd --
 *
 *	This procedure is invoked to process the "ssl" command
 *

 *-------------------------------------------------------------------
 */
static int
ImportObjCmd(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 */
    SSL_CTX *ctx		= NULL;
    Tcl_Obj *script		= NULL;
    Tcl_Obj *password		= NULL;
    Tcl_Obj *cmdObj		= NULL;
    Tcl_Obj *passwdObj		= NULL;
    Tcl_Obj *vcmd		= NULL;
    Tcl_DString upperChannelTranslation, upperChannelBlocking, upperChannelEncoding, upperChannelEOFChar;
    int idx;
    Tcl_Size len;
    Tcl_Size fn, len;
    int flags			= TLS_TCL_INIT;
    int server			= 0;	/* is connection incoming or outgoing? */
    char *keyfile		= NULL;
    char *certfile		= NULL;
    unsigned char *key		= NULL;
    Tcl_Size key_len		= 0;
    unsigned char *cert		= NULL;
    Tcl_Size cert_len		= 0;
    char *ciphers		= NULL;
    char *ciphersuites		= NULL;
    char *CAfile		= NULL;
    char *CApath		= NULL;
    char *DHparams		= NULL;
    char *model			= NULL;
    char *servername		= NULL;	/* hostname for Server Name Indication */
    char *session_id		= NULL;
    Tcl_Obj *alpn		= NULL;
    const unsigned char *session_id = NULL;
    Tcl_Size sess_len		= 0;
    Tcl_Obj *alpnObj		= 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, post_handshake = 0;
    (void) clientData;

    dprintf("Called");

	return TCL_ERROR;
    }

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

    for (idx = 2; idx < objc; idx++) {
	if (Tcl_GetIndexFromObj(interp, objv[idx], command_opts, "option", 0, &fn) != TCL_OK) {
	    return TCL_ERROR;
	}
	char *opt = Tcl_GetString(objv[idx]);

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

	/* Validate arg has value */
	if (++idx >= objc) {
	    Tcl_AppendResult(interp, "No value for option \"", command_opts[fn], "\"", (char *) NULL);
	    return TCL_ERROR;
	}

	switch(fn) {
	case _opt_alpn:
	    alpnObj = objv[idx];
	    break;
	case _opt_cadir:
	    GET_OPT_STRING(objv[idx], CApath, NULL);
	    break;
	case _opt_cafile:
	    GET_OPT_STRING(objv[idx], CAfile, NULL);
	    break;
	case _opt_cert:
	    GET_OPT_BYTE_ARRAY(objv[idx], cert, &cert_len);
	    break;
	case _opt_certfile:
	    GET_OPT_STRING(objv[idx], certfile, NULL);
	    break;
	case _opt_cipher:
	case _opt_ciphers:
	    GET_OPT_STRING(objv[idx], ciphers, NULL);
	    break;
	case _opt_ciphersuite:
	    GET_OPT_STRING(objv[idx], ciphersuites, NULL);
	    break;
	case _opt_cmd:
	    cmdObj = objv[idx];
	    break;
	case _opt_dhparams:
	    GET_OPT_STRING(objv[idx], DHparams, NULL);
	    break;
	case _opt_key:
	    GET_OPT_BYTE_ARRAY(objv[idx], key, &key_len);
	    break;
	case _opt_keyfile:
	    GET_OPT_STRING(objv[idx], keyfile, NULL);
	    break;
	case _opt_model:
	    GET_OPT_STRING(objv[idx], model, NULL);
	    break;
	case _opt_password:
	    passwdObj = objv[idx];
	    break;
	case _opt_handshake:
	    GET_OPT_BOOL(objv[idx], &post_handshake);
	    break;
	case _opt_request:
	    GET_OPT_BOOL(objv[idx], &request);
	    break;
	case _opt_require:
	    GET_OPT_BOOL(objv[idx], &require);
	    break;
	case _opt_security_level:
	    GET_OPT_INT(objv[idx], &level);
	    break;
	case _opt_server:
	    GET_OPT_BOOL(objv[idx], &server);
	    break;
	case _opt_servername:
	    GET_OPT_STRING(objv[idx], servername, NULL);
	    break;
	case _opt_session_id:
	    GET_OPT_BYTE_ARRAY(objv[idx], session_id, &sess_len);
	    break;
	case _opt_ssl2:
	    GET_OPT_INT(objv[idx], &ssl2);
	    break;
	case _opt_ssl3:
	    GET_OPT_INT(objv[idx], &ssl3);
	    break;
	case _opt_tls1:
	    GET_OPT_INT(objv[idx], &tls1);
	    break;
	case _opt_tls11:
	    GET_OPT_INT(objv[idx], &tls1_1);
	    break;
	case _opt_tls12:
	    GET_OPT_INT(objv[idx], &tls1_2);
	    break;
	case _opt_tls13:
	    GET_OPT_INT(objv[idx], &tls1_3);
	    break;
	case _opt_validate:
	case _opt_vcmd:
	    vcmd = objv[idx];
	    break;

	}
	OPTOBJ("-alpn", alpn);
	OPTSTR("-cadir", CApath);
	OPTSTR("-cafile", CAfile);
	OPTBYTE("-cert", cert, cert_len);
	OPTSTR("-certfile", certfile);
	OPTSTR("-cipher", ciphers);
	OPTSTR("-ciphers", ciphers);
	OPTSTR("-ciphersuites", ciphersuites);
	OPTOBJ("-command", script);
	OPTSTR("-dhparams", DHparams);
	OPTBYTE("-key", key, key_len);
	OPTSTR("-keyfile", keyfile);
	OPTSTR("-model", model);
	OPTOBJ("-password", password);
	OPTBOOL("-post_handshake", post_handshake);
	OPTBOOL("-request", request);
	OPTBOOL("-require", require);
	OPTINT("-security_level", level);
	OPTBOOL("-server", server);
	OPTSTR("-servername", servername);
	OPTSTR("-session_id", session_id);
	OPTBOOL("-ssl2", ssl2);
	OPTBOOL("-ssl3", ssl3);
	OPTBOOL("-tls1", tls1);
	OPTBOOL("-tls1.1", tls1_1);
	OPTBOOL("-tls1.2", tls1_2);
	OPTBOOL("-tls1.3", tls1_3);
	OPTOBJ("-validatecommand", vcmd);
	OPTOBJ("-vcmd", vcmd);

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

	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 (request && post_handshake)	verify |= SSL_VERIFY_POST_HANDSHAKE;
    if (verify == 0)		verify = SSL_VERIFY_NONE;

    proto |= (ssl2 ? TLS_PROTO_SSL2 : 0);
    proto |= (ssl3 ? TLS_PROTO_SSL3 : 0);

    statePtr->flags	= flags;
    statePtr->interp	= interp;
    statePtr->vflags	= verify;
    statePtr->err	= "";

    /* allocate script */
    if (script) {
	(void) Tcl_GetStringFromObj(script, &len);
    if (cmdObj != NULL) {
	(void) Tcl_GetStringFromObj(cmdObj, &len);
	if (len) {
	    statePtr->callback = script;
	    statePtr->callback = cmdObj;
	    Tcl_IncrRefCount(statePtr->callback);
	}
    }

    /* allocate password */
    if (password) {
	(void) Tcl_GetStringFromObj(password, &len);
    if (passwdObj != NULL) {
	(void) Tcl_GetStringFromObj(passwdObj, &len);
	if (len) {
	    statePtr->password = password;
	    statePtr->password = passwdObj;
	    Tcl_IncrRefCount(statePtr->password);
	}
    }

    /* allocate validate command */
    if (vcmd) {
	(void) Tcl_GetStringFromObj(vcmd, &len);

    }

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

    dprintf("Created channel named %s", Tcl_GetChannelName(statePtr->self));
    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));
    Tcl_DStringFree(&upperChannelTranslation);
    Tcl_DStringFree(&upperChannelEncoding);
    Tcl_DStringFree(&upperChannelEOFChar);

	    Tcl_SetErrorCode(interp, "TLS", "IMPORT", "HOSTNAME", "FAILED", (char *) NULL);
	    Tls_Free((tls_free_type *) statePtr);
	    return TCL_ERROR;
	}
    }

    /* Resume session id */
    if (session_id && strlen(session_id) <= SSL_MAX_SID_CTX_LENGTH) {
    if (session_id && sess_len <= SSL_MAX_SID_CTX_LENGTH) {
	/* SSL_set_session() */
	if (!SSL_SESSION_set1_id_context(SSL_get_session(statePtr->ssl),
	if (!SSL_SESSION_set1_id_context(SSL_get_session(statePtr->ssl), session_id, (unsigned int) sess_len)) {
		(const unsigned char *) session_id, (unsigned int) strlen(session_id))) {
	    Tcl_AppendResult(interp, "Resume session failed: ", GET_ERR_REASON(), (char *) NULL);
	    Tcl_SetErrorCode(interp, "TLS", "IMPORT", "SESSION", "FAILED", (char *) NULL);
	    Tls_Free((tls_free_type *) statePtr);
	    return TCL_ERROR;
	}
    }

    /* Enable Application-Layer Protocol Negotiation. Examples are: http/1.0,
	http/1.1, h2, h3, ftp, imap, pop3, xmpp-client, xmpp-server, mqtt, irc, etc. */
    if (alpn) {
    if (alpnObj != NULL) {
	/* Convert a TCL list into a protocol-list in wire-format */
	unsigned char *protos, *p;
	unsigned int protos_len = 0;
	Tcl_Size cnt, i;
	int j;
	Tcl_Obj **list;

	if (Tcl_ListObjGetElements(interp, alpn, &cnt, &list) != TCL_OK) {
	if (Tcl_ListObjGetElements(interp, alpnObj, &cnt, &list) != TCL_OK) {
	    Tls_Free((tls_free_type *) statePtr);
	    return TCL_ERROR;
	}

	/* Determine the memory required for the protocol-list */
	for (i = 0; i < cnt; i++) {
	    Tcl_GetStringFromObj(list[i], &len);

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

	load_private_key = 1;
	if (SSL_CTX_use_certificate_ASN1(ctx, 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();

	if (SSL_CTX_use_certificate_file(ctx, certfile, SSL_FILETYPE_PEM) <= 0) {
#if 0
	    Tcl_AppendResult(interp, "unable to use default certificate file ", certfile, ": ",
		GET_ERR_REASON(), (char *) NULL);

    /* Get certificate for peer or self */
    if (objc == 2) {
	peer = SSL_get_peer_certificate(statePtr->ssl);
    } else {
	peer = SSL_get_certificate(statePtr->ssl);
    }

    /* Get X509 certificate info */
    if (peer) {
	objPtr = Tls_NewX509Obj(interp, peer);
	if (objc == 2) {
	    X509_free(peer);
	    peer = 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;
}

/*
 *-------------------------------------------------------------------

	LAPPEND_INT(interp, objPtr, "algorithm_bits", 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) */

	/* Indicates which SSL/TLS protocol version first defined the cipher */
	LAPPEND_STR(interp, objPtr, "min_version", SSL_CIPHER_get_version(cipher), -1);

	/* Cipher NID */
	/* Cipher NID, digest NID (none for AEAD cipher suites), Key Exchange NID, and authentication NID */
	LAPPEND_STR(interp, objPtr, "cipherNID", (char *)OBJ_nid2ln(SSL_CIPHER_get_cipher_nid(cipher)), -1);
	LAPPEND_STR(interp, objPtr, "digestNID", (char *)OBJ_nid2ln(SSL_CIPHER_get_digest_nid(cipher)), -1);
	LAPPEND_STR(interp, objPtr, "keyExchangeNID", (char *)OBJ_nid2ln(SSL_CIPHER_get_kx_nid(cipher)), -1);
	LAPPEND_STR(interp, objPtr, "authenticationNID", (char *)OBJ_nid2ln(SSL_CIPHER_get_auth_nid(cipher)), -1);

	/* message authentication code - Cipher is AEAD (e.g. GCM or ChaCha20/Poly1305) or not */
	/* Authenticated Encryption with associated data (AEAD) check */
	LAPPEND_BOOL(interp, objPtr, "cipher_is_aead", SSL_CIPHER_is_aead(cipher));

	/* Digest used during the SSL/TLS handshake when using the cipher. */
	md = SSL_CIPHER_get_handshake_digest(cipher);
	LAPPEND_STR(interp, objPtr, "handshake_digest", (char *)EVP_MD_name(md), -1);

	/* Get OpenSSL-specific ID, not IANA ID */
	LAPPEND_INT(interp, objPtr, "cipher_id", (int) SSL_CIPHER_get_id(cipher));

	/* Two-byte ID used in the TLS protocol of the given cipher */
	LAPPEND_INT(interp, objPtr, "protocol_id", (int) SSL_CIPHER_get_protocol_id(cipher));

	/* Textual description of the cipher */
	/* Textual description of the cipher. Includes: cipher name, protocol version, key
	   exchange, authentication, symmetric encryption method, message authentication code */
	if (SSL_CIPHER_description(cipher, buf, sizeof(buf)) != NULL) {
	    LAPPEND_STR(interp, objPtr, "description", buf, -1);
	}

	/* Digest used during the SSL/TLS handshake when using the cipher. */
	md = SSL_CIPHER_get_handshake_digest(cipher);
	LAPPEND_STR(interp, objPtr, "handshake_digest", (char *)EVP_MD_name(md), -1);
    }

    /* Session info */
    session = SSL_get_session(ssl);
    if (session != NULL) {
	const unsigned char *ticket;
	size_t len2;

    /* CA List */
    /* IF not a server, same as SSL_get0_peer_CA_list. If server same as SSL_CTX_get_client_CA_list */
    listPtr = Tcl_NewListObj(0, NULL);
    STACK_OF(X509_NAME) *ca_list;
    if ((ca_list = SSL_get_client_CA_list(ssl)) != NULL) {
	char buffer[BUFSIZ];

	for (int i = 0; i < sk_X509_NAME_num(ca_list); i++) {
	    X509_NAME *name = sk_X509_NAME_value(ca_list, i);
	    if (name) {
		X509_NAME_oneline(name, buffer, BUFSIZ);
		Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(buffer, -1));
	    }
	}
    }
    LAPPEND_OBJ(interp, objPtr, "caList", listPtr);
    LAPPEND_INT(interp, objPtr, "caListCount", sk_X509_NAME_num(ca_list));

    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 clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    Tcl_Obj *objPtr;
    (void) clientData;
    (void) objc;
    (void) objv;

    dprintf("Called");

    objPtr = Tcl_NewStringObj(OPENSSL_VERSION_TEXT, -1);
    Tcl_SetObjResult(interp, objPtr);

    return TCL_OK;
}

/*
 *-------------------------------------------------------------------
 *
 * MiscObjCmd -- misc commands

    }

    if (TlsLibInit(0) != 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::misc", MiscObjCmd, (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);
    Tls_DigestCommands(interp);
    Tls_EncryptCommands(interp);
    Tls_InfoCommands(interp);
    Tls_KDFCommands(interp);
    Tls_RandCommands(interp);

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

    return Tcl_PkgProvide(interp, PACKAGE_NAME, PACKAGE_VERSION);
}

    /* 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);
    Tcl_MutexUnlock(&init_mx);
#endif

    return status;
}