# stub library C source files to compile in TEA_ADD_STUB_SOURCES,
# and runtime Tcl library files in TEA_ADD_TCL_SOURCES.
# This defines PKG(_STUB)_SOURCES, PKG(_STUB)_OBJECTS, PKG_HEADERS
# and PKG_TCL_SOURCES.
#-----------------------------------------------------------------------


    vars="tls.c tlsBIO.c tlsDigest.c tlsIO.c tlsX509.c"
    for i in $vars; do
	case $i in
	    \$*)
		# allow $-var names
		PKG_SOURCES="$PKG_SOURCES $i"
		PKG_OBJECTS="$PKG_OBJECTS $i"
		;;

# public headers that need to be installed in TEA_ADD_HEADERS,
# stub library C source files to compile in TEA_ADD_STUB_SOURCES,
# and runtime Tcl library files in TEA_ADD_TCL_SOURCES.
# This defines PKG(_STUB)_SOURCES, PKG(_STUB)_OBJECTS, PKG_HEADERS
# and PKG_TCL_SOURCES.
#-----------------------------------------------------------------------

TEA_ADD_SOURCES([tls.c tlsBIO.c tlsDigest.c tlsIO.c tlsX509.c])
TEA_ADD_HEADERS([generic/tls.h])
TEA_ADD_INCLUDES([])
TEA_ADD_LIBS([])
TEA_ADD_CFLAGS([])
TEA_ADD_STUB_SOURCES([])
TEA_ADD_TCL_SOURCES([library/tls.tcl])

	    <dd><b>tls::socket</b> <em> ?-server command? ?options? port</em></dd>
	    <dd><b>tls::handshake</b> <em> channel</em></dd>
	    <dd><b>tls::status </b> <em>?-local? channel</em></dd>
	    <dd><b>tls::connection </b> <em>channel</em></dd>
	    <dd><b>tls::import</b> <em>channel ?options?</em></dd>
	    <dd><b>tls::unimport</b> <em>channel</em></dd>
	    <dt>&nbsp;</dt>
	    <dd><b>tls::ciphers</b> <em>?protocol? ?verbose? ?supported?</em></dd>
	    <dd><b>tls::protocols</b></dd>
	    <dd><b>tls::version</b></dd>
	    <dt>&nbsp;</dt>
	    <dd><b>tls::digest</b> <em>type data</em></dd>
	    <dd><b>tls::digests</b></dd>
	    <dd><b>tls::md4</b> <em>data</em></dd>
	    <dd><b>tls::md5</b> <em>data</em></dd>
	    <dd><b>tls::sha1</b> <em>data</em></dd>
	    <dd><b>tls::sha256</b> <em>data</em></dd>
	</dl>
    </dd>
    <dd><a href="#COMMANDS">COMMANDS</a></dd>
    <dd><a href="#CALLBACK OPTIONS">CALLBACK OPTIONS</a></dd>
    <dd><a href="#HTTPS EXAMPLE">HTTPS EXAMPLE</a></dd>
    <dd><a href="#SEE ALSO">SPECIAL CONSIDERATIONS</a></dd>
    <dd><a href="#SEE ALSO">SEE ALSO</a></dd>
</dl>

<hr>

<h3><a name="NAME">NAME</a></h3>

<p><strong>tls</strong> - binding to <strong>OpenSSL</strong>
toolkit.</p>

<h3><a name="SYNOPSIS">SYNOPSIS</a></h3>

<p><b>package require Tcl 8.5</b><br>
<b>package require tls</b><br>
<br>
<a href="#tls::init"><b>tls::init</b> <i>?options?</i></a><br>
<a href="#tls::socket"><b>tls::socket</b> <i>?options? host port</i><br>
<a href="#tls::socket"><b>tls::socket</b> <i>?-server command? ?options? port</i></a><br>
<a href="#tls::status"><b>tls::status</b> <i>?-local? channel</i></a><br>
<a href="#tls::connection"><b>tls::connection</b> <i>channel</i></a><br>
<a href="#tls::handshake"><b>tls::handshake</b> <i>channel</i></a><br>
<a href="#tls::import"><b>tls::import</b> <i>channel ?options?</i></a><br>
<a href="#tls::unimport"><b>tls::unimport</b> <i>channel</i></a><br>
<br>
<a href="#tls::ciphers"><b>tls::ciphers</b> <i>?protocol? ?verbose? ?supported?</i></a><br>
<a href="#tls::protocols"><b>tls::protocols</b></a><br>
<a href="#tls::version"><b>tls::version</b></a><br>
<br>
<a href="#tls::digest"><b>tls::digest</b> <i>type data</i></a><br>
<a href="#tls::digests"><b>tls::digests</b></a><br>
<a href="#tls::md4"><b>tls::md4</b> <i>data</i></a><br>
<a href="#tls::md5"><b>tls::md5</b> <i>data</i></a><br>
<a href="#tls::sha1"><b>tls::sha1</b> <i>data</i></a><br>
<a href="#tls::sha256"><b>tls::sha256</b> <i>data</i></a><br>
</p>

<h3><a name="DESCRIPTION">DESCRIPTION</a></h3>

<p>This extension provides a generic binding to <a
href="http://www.openssl.org/">OpenSSL</a>, utilizing the
<strong>Tcl_StackChannel</strong>

	<dd>Unique session master key.</dd>
	<dt><strong>session_cache_mode</strong> <em>mode</em></dt>
	<dd>Server cache mode (client, server, or both).</dd>
    </dl>
</blockquote>

    <dt><a name="tls::ciphers"><strong>tls::ciphers</strong>
    <em>?protocol? ?verbose? ?supported?</em></a></dt>
    <dd>Without any args, returns a list of all ciphers. With
	<em>protocol</em>, only the ciphers supportted for that protocol
	are returned where <em>protocol</em> must be one of <b>ssl2, ssl3,
	tls1, tls1.1, tls1.2,</b> or <b>tls1.3</b>. If <em>verbose</em> is
	specified as true then a verbose, human readable list is returned
	with additional information on the cipher. If <em>supported</em>
	is specified as true, then only the ciphers supported for protocol
	will be listed.</dd>

    <dt><a name="tls::protocols"><strong>tls::protocols</strong></a></dt>
    <dd>Returns a list of supported protocols. Valid values are:
	<b>ssl2</b>, <b>ssl3</b>, <b>tls1</b>, <b>tls1.1</b>, <b>tls1.2</b>,
	and <b>tls1.3</b>. Exact list depends on OpenSSL version and
	compile time flags.</dd>

    <dt><a name="tls::version"><strong>tls::version</strong></a></dt>
    <dd>Returns the OpenSSL version string.</dd>

    <br>
    <dt><a name="tls::digest"><strong>tls::digest</strong> <em>type data</em></a></dt>
    <dd>Calculate the message digest for <em>data</em> using <em>type</em>
	hash algorithm. Returns value as a hex string. Type can be any
	OpenSSL supported hash algorithm including: <b>md4</b>, <b>md5</b>,
	<b>sha1</b>, <b>sha256</b>, <b>sha512</b>, <b>sha3-256</b>, etc.
	See <b>digests</b> command for a full list.</dd>

    <dt><a name="tls::digests"><strong>tls::digests</strong></a></dt>
    <dd>Returns a list of the valid hash algorithms used to create message digests.</dd>

    <dt><a name="tls::md4"><strong>tls::md4</strong> <em>data</em></a></dt>
    <dd>Return the MD4 message-digest for <em>data</em>.</dd>

    <dt><a name="tls::md5"><strong>tls::md5</strong> <em>data</em></a></dt>
    <dd>Return the MD5 message-digest for <em>data</em>.</dd>

    <dt><a name="tls::sha1"><strong>tls::sha1</strong> <em>data</em></a></dt>
    <dd>Return the SHA1 secure hash algorithm digest for <em>data</em>.</dd>

    <dt><a name="tls::sha256"><strong>tls::sha256</strong> <em>data</em></a></dt>
    <dd>Return the SHA-2 SHA256 secure hash algorithm digest for <em>data</em>.</dd>
</dl>

<h3><a name="CALLBACK OPTIONS">CALLBACK OPTIONS</a></h3>

<p>
As indicated above, individual channels can be given their own callbacks
to handle intermediate processing by the OpenSSL library, using the

/*
 *  Copyright (C) 1997-2000 Matt Newman <[email protected]>
 *
 * Stylized option processing - requires consistent
 * external vars: opt, idx, objc, objv
 */

#ifndef _TCL_OPTS_H
#define _TCL_OPTS_H

#define OPTFLAG(option, var, val)		\
    if (strcmp(opt, (option)) == 0) {		\
	var = val;				\
	continue;				\
    }

#define OPT_PROLOG(option)			\
    if (strcmp(opt, (option)) == 0) {		\
	if (++idx >= objc) {			\
	    Tcl_AppendResult(interp,		\
		"no argument given for ",	\
		(option), " option",		\
		(char *) NULL);			\
	    return TCL_ERROR;			\
	}

#define OPT_POSTLOG()				\
	continue;				\
    }

#define OPTOBJ(option, var)			\
    OPT_PROLOG(option)				\
    var = objv[idx];				\
    OPT_POSTLOG()

#define OPTSTR(option, var)			\
    OPT_PROLOG(option)				\

    OPT_PROLOG(option)				\
    if (Tcl_GetBooleanFromObj(interp, objv[idx],\
	    &(var)) != TCL_OK) {		\
	    return TCL_ERROR;			\
    }						\
    OPT_POSTLOG()

#define OPTBYTE(option, var, lvar)		\
    OPT_PROLOG(option)				\
    var = Tcl_GetByteArrayFromObj(objv[idx], &(lvar));\
    OPT_POSTLOG()

#define OPTBAD(type, list)			\
    Tcl_AppendResult(interp, "bad ", (type),	\
		" \"", opt, "\": must be ",	\
		(list), (char *) NULL)

#endif /* _TCL_OPTS_H */

 *
 */

#include "tlsInt.h"
#include "tclOpts.h"
#include <stdio.h>
#include <stdlib.h>
#include <openssl/crypto.h>
#include <openssl/ssl.h>
#include <openssl/evp.h>
#include <openssl/objects.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

    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) {
	Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(msg, -1));

    } else if ((msg = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), NULL)) != NULL) {
	Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(msg, -1));

    } else {
	listPtr = Tcl_NewListObj(0, NULL);
	while ((err = ERR_get_error()) != 0) {
	    Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(ERR_reason_error_string(err), -1));
	}

    }
    Tcl_DecrRefCount(cmdPtr);

    Tcl_Release((ClientData) statePtr);

    /* If successful, pass back password string and truncate if too long */
    if (code == TCL_OK) {
	int len;
	char *ret = (char *) Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &len);
	if (len > size-1) {
	    len = size-1;
	}
	strncpy(buf, ret, (size_t) len);
	buf[len] = '\0';
	Tcl_Release((ClientData) interp);
	return(len);
    }
    Tcl_Release((ClientData) interp);
    return -1;
}

/*
 *-------------------------------------------------------------------

    cmdPtr = Tcl_DuplicateObj(statePtr->callback);
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("session", -1));
    Tcl_ListObjAppendElement(interp, cmdPtr,
	    Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1));

    /* Session id */
    session_id = SSL_SESSION_get_id(session, &ulen);
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewByteArrayObj(session_id, (int) ulen));

    /* Session ticket */
    SSL_SESSION_get0_ticket(session, &ticket, &len2);
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewByteArrayObj(ticket, (int) len2));

    /* Lifetime - number of seconds */
    Tcl_ListObjAppendElement(interp, cmdPtr,
	Tcl_NewLongObj((long) SSL_SESSION_get_ticket_lifetime_hint(session)));

    /* Eval callback command */
    Tcl_IncrRefCount(cmdPtr);

    servername = (const char *)p;

    /* Create command to eval */
    cmdPtr = Tcl_DuplicateObj(statePtr->vcmd);
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("hello", -1));
    Tcl_ListObjAppendElement(interp, cmdPtr,
	    Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1));
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(servername, (int) len));

    /* Eval callback command */
    Tcl_IncrRefCount(cmdPtr);
    if ((code = EvalCallback(interp, statePtr, cmdPtr)) > 1) {
	res = SSL_CLIENT_HELLO_RETRY;
	*alert = SSL_R_TLSV1_ALERT_USER_CANCELLED;
    } else if (code == 1) {

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

/*
 *-------------------------------------------------------------------
 *
 * Hash List Command --
 *
 *	Return a list of all valid hash algorithms or message digests.
 *
 * Results:
 *	A standard Tcl result list.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
void ListCallback(const OBJ_NAME *obj, void *arg) {
    Tcl_Obj *objPtr = (Tcl_Obj *) arg;
    if (1 || !obj->alias) {
	/* Filter out signed digests (a.k.a signature algorithms) */
	if (strstr(obj->name, "rsa") == NULL && strstr(obj->name, "RSA") == NULL) {
	    Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewStringObj(obj->name,-1));
	}
    }
}

int
DigestListCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    Tcl_Obj *objPtr = Tcl_NewListObj(0, NULL);

#if OPENSSL_VERSION_NUMBER < 0x10100000L
    OpenSSL_add_all_digests(); /* Make sure they're loaded */
#endif

    OBJ_NAME_do_all(OBJ_NAME_TYPE_MD_METH, ListCallback, (void *) objPtr);
    Tcl_ResetResult(interp);
    Tcl_SetObjResult(interp, objPtr);

    return TCL_OK;
	clientData = clientData;
	objc = objc;
	objv = objv;
}

/*
 * Valid SSL and TLS Protocol Versions
 */
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
};

/*
 *-------------------------------------------------------------------
 *
 * 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 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;
    const SSL_METHOD *method;

    dprintf("Called");

    if ((objc < 1) || (objc > 4)) {
	Tcl_WrongNumArgs(interp, 1, objv, "?protocol? ?verbose? ?supported?");
	return TCL_ERROR;
    }
    if (objc == 1) {
	/* List all ciphers */
	Tcl_Obj *objPtr = Tcl_NewListObj(0, NULL);

#if OPENSSL_VERSION_NUMBER < 0x10100000L
	OpenSSL_add_all_ciphers(); /* Make sure they're loaded */
#endif

	OBJ_NAME_do_all(OBJ_NAME_TYPE_CIPHER_METH, ListCallback, (void *) objPtr);
	Tcl_ResetResult(interp);
	Tcl_SetObjResult(interp, objPtr);
	return TCL_OK;

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

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

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

    return TCL_OK;
	clientData = clientData;
}

/*
 *-------------------------------------------------------------------
 *
 * 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;

    dprintf("Called");

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

    return TCL_OK;
	clientData = clientData;
	objc = objc;
	objv = objv;
}

/*
 *-------------------------------------------------------------------
 *
 * 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.

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

    ERR_clear_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_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 *vcmd	        = NULL;
    Tcl_DString upperChannelTranslation, upperChannelBlocking, upperChannelEncoding, upperChannelEOFChar;
    int idx, len;

    int flags		        = TLS_TCL_INIT;
    int server		        = 0;	/* is connection incoming or outgoing? */
    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 */

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "channel ?options?");
	return TCL_ERROR;
    }

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

    for (idx = 2; idx < objc; idx++) {
	char *opt = Tcl_GetStringFromObj(objv[idx], NULL);

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

	OPTOBJ("-alpn", alpn);
	OPTSTR("-cadir", CAdir);
	OPTSTR("-cafile", CAfile);

		"\": not a TLS channel", NULL);
	    Tcl_SetErrorCode(interp, "TLS", "IMPORT", "CHANNEL", "INVALID", (char *) 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)) == NULL) {
	    Tls_Free((char *) statePtr);
	    return TCL_ERROR;
	}
    }

    statePtr->ctx = ctx;

    /* 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) {
	/* 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);
		Tcl_SetErrorCode(interp, "TLS", "IMPORT", "ALPN", "FAILED", (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;
	}

	/* SSL_set_alpn_protos makes a copy of the protocol-list */
	/* 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);

    int off = 0;
    int load_private_key;
    const SSL_METHOD *method;

    dprintf("Called");

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

    /* 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 NULL;
    }
#endif
#if defined(NO_SSL3) || defined(OPENSSL_NO_SSL3)
    if (ENABLED(proto, TLS_PROTO_SSL3)) {
	Tcl_AppendResult(interp, "SSL3 protocol not supported", NULL);
	return NULL;
    }
#endif
#if defined(NO_TLS1) || defined(OPENSSL_NO_TLS1)
    if (ENABLED(proto, TLS_PROTO_TLS1)) {
	Tcl_AppendResult(interp, "TLS 1.0 protocol not supported", NULL);
	return NULL;
    }
#endif
#if defined(NO_TLS1_1) || defined(OPENSSL_NO_TLS1_1)
    if (ENABLED(proto, TLS_PROTO_TLS1_1)) {
	Tcl_AppendResult(interp, "TLS 1.1 protocol not supported", NULL);
	return NULL;
    }
#endif
#if defined(NO_TLS1_2) || defined(OPENSSL_NO_TLS1_2)
    if (ENABLED(proto, TLS_PROTO_TLS1_2)) {
	Tcl_AppendResult(interp, "TLS 1.2 protocol not supported", NULL);
	return NULL;
    }
#endif
#if defined(NO_TLS1_3) || defined(OPENSSL_NO_TLS1_3)
    if (ENABLED(proto, TLS_PROTO_TLS1_3)) {
	Tcl_AppendResult(interp, "TLS 1.3 protocol not supported", NULL);
	return NULL;
    }
#endif
    if (proto == 0) {
	/* Use full range */
	SSL_CTX_set_min_proto_version(ctx, 0);
	SSL_CTX_set_max_proto_version(ctx, 0);

    }
#endif

    /* Force cipher selection order by server */
    if (!isServer) {
	SSL_CTX_set_options(ctx, SSL_OP_CIPHER_SERVER_PREFERENCE);
    }

#if OPENSSL_VERSION_NUMBER < 0x10100000L
    OpenSSL_add_all_algorithms(); /* Load ciphers and digests */
#endif

    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, SSL_OP_NO_COMPRESSION);	/* disable compression even if supported */
    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. On by default in OpenSSL 1.1.1. */

    if (objc < 2 || objc > 3 || (objc == 3 && !strcmp(Tcl_GetString(objv[1]), "-local"))) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-local? channel");
	return TCL_ERROR;
    }

    /* Get channel Id */
    channelName = Tcl_GetStringFromObj(objv[(objc == 2 ? 1 : 2)], NULL);
    chan = Tcl_GetChannel(interp, channelName, &mode);
    if (chan == (Tcl_Channel) NULL) {
	return TCL_ERROR;
    }

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

    }

    /* Verify mode depth */
    LAPPEND_INT(interp, objPtr, "verifyDepth", SSL_get_verify_depth(statePtr->ssl));

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

    /* Valid for non-RSA signature and TLS 1.3 */
    if (objc == 2) {
	res = SSL_get_peer_signature_nid(statePtr->ssl, &nid);
    } else {
	res = SSL_get_signature_nid(statePtr->ssl, &nid);

    const EVP_MD *md;

    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()) {

	size_t len2;
	unsigned int ulen;
	const unsigned char *session_id, *proto;
	char buffer[SSL_MAX_MASTER_KEY_LENGTH];

	/* Report the selected protocol as a result of the ALPN negotiation */
	SSL_SESSION_get0_alpn_selected(session, &proto, &len2);
	LAPPEND_STR(interp, objPtr, "alpn", (char *) proto, (int) len2);

	/* Report the selected protocol as a result of the NPN negotiation */
#ifdef USE_NPN
	SSL_get0_next_proto_negotiated(ssl, &proto, &ulen);
	LAPPEND_STR(interp, objPtr, "npn", (char *) proto, (int) ulen);
#endif

	/* Resumable session */
	LAPPEND_BOOL(interp, objPtr, "resumable", SSL_SESSION_is_resumable(session));

	/* Session start time (seconds since epoch) */
	LAPPEND_LONG(interp, objPtr, "start_time", SSL_SESSION_get_time(session));

	/* Timeout value - SSL_CTX_get_timeout (in seconds) */
	LAPPEND_LONG(interp, objPtr, "timeout", SSL_SESSION_get_timeout(session));

	/* Session id - TLSv1.2 and below only */
	session_id = SSL_SESSION_get_id(session, &ulen);
	LAPPEND_BARRAY(interp, objPtr, "session_id", session_id, (int) ulen);

	/* Session context */
	session_id = SSL_SESSION_get0_id_context(session, &ulen);
	LAPPEND_BARRAY(interp, objPtr, "session_context", session_id, (int) ulen);

	/* Session ticket - client only */
	SSL_SESSION_get0_ticket(session, &ticket, &len2);
	LAPPEND_BARRAY(interp, objPtr, "session_ticket", ticket, (int) len2);

	/* Session ticket lifetime hint (in seconds) */
	LAPPEND_LONG(interp, objPtr, "lifetime", SSL_SESSION_get_ticket_lifetime_hint(session));

	/* Ticket app data */
	SSL_SESSION_get0_ticket_appdata(session, &ticket, &len2);
	LAPPEND_BARRAY(interp, objPtr, "ticket_app_data", ticket, (int) len2);

	/* Get master key */
	len2 = SSL_SESSION_get_master_key(session, buffer, SSL_MAX_MASTER_KEY_LENGTH);
	LAPPEND_BARRAY(interp, objPtr, "master_key", buffer, (int) len2);

	/* Compression id */
	unsigned int id = SSL_SESSION_get_compress_id(session);
	LAPPEND_STR(interp, objPtr, "compression_id", id == 1 ? "zlib" : "none", -1);
    }

    /* Compression info */

    return TCL_OK;
	clientData = clientData;
}

/*
 *-------------------------------------------------------------------
 *




























 * MiscObjCmd -- misc commands
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
static int
MiscObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    static const char *commands [] = { "req", "strreq", NULL };
    enum command { C_REQ, C_STRREQ, C_DUMMY };

    int cmd, isStr;
    char buffer[16384];

    dprintf("Called");

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?args?");
	return TCL_ERROR;

    switch ((enum command) cmd) {
	case C_REQ:
	case C_STRREQ: {
	    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;

	    pemout=Tcl_GetString(objv[4]);
	    if (isStr) {
		Tcl_SetVar(interp,keyout,"",0);
		Tcl_SetVar(interp,pemout,"",0);
	    }

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

#endif
    if (Tcl_PkgRequire(interp, "Tcl", "8.5-", 0) == NULL) {
	return TCL_ERROR;
    }
#endif

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


    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::misc", MiscObjCmd, (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::ciphers", CiphersObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::protocols", ProtocolsObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::version", VersionObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);

    Tls_DigestCommands(interp);
    Tcl_CreateObjCommand(interp, "tls::digests", DigestListCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);

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

    return Tcl_PkgProvide(interp, PACKAGE_NAME, PACKAGE_VERSION);
}

/*
 * Copyright (C) 1997-2000 Matt Newman <[email protected]>
 *
 * Provides BIO layer to interface openssl to Tcl.
 */

#include "tlsInt.h"

static int BioWrite(BIO *bio, const char *buf, int bufLen) {
    Tcl_Channel chan;
    int ret;
    int tclEofChan, tclErrno;

    chan = Tls_GetParent((State *) BIO_get_data(bio), 0);

    dprintf("[chan=%p] BioWrite(%p, <buf>, %d)", (void *)chan, (void *) bio, bufLen);

    ret = (int) Tcl_WriteRaw(chan, buf, bufLen);

    tclEofChan = Tcl_Eof(chan);
    tclErrno = Tcl_GetErrno();


    dprintf("[chan=%p] BioWrite(%d) -> %d [tclEof=%d; tclErrno=%d]", (void *) chan, bufLen, ret, tclEofChan, Tcl_GetErrno());

    BIO_clear_flags(bio, BIO_FLAGS_WRITE | BIO_FLAGS_SHOULD_RETRY);

    if (tclEofChan && ret <= 0) {
	dprintf("Got EOF while reading, returning a Connection Reset error which maps to Soft EOF");
	Tcl_SetErrno(ECONNRESET);
	ret = 0;

    if (ret != -1 || (ret == -1 && tclErrno == EAGAIN)) {
	if (BIO_should_read(bio)) {
	    dprintf("Setting should retry read flag");

	    BIO_set_retry_read(bio);
	}
    }
    return(ret);
}

static int BioRead(BIO *bio, char *buf, int bufLen) {
    Tcl_Channel chan;
    Tcl_Size ret = 0;
    int tclEofChan, tclErrno;

    chan = Tls_GetParent((State *) BIO_get_data(bio), 0);

    dprintf("[chan=%p] BioRead(%p, <buf>, %d)", (void *) chan, (void *) bio, bufLen);

    if (buf == NULL) {
	return 0;
    }

    ret = Tcl_ReadRaw(chan, buf, bufLen);

    tclEofChan = Tcl_Eof(chan);
    tclErrno = Tcl_GetErrno();


    dprintf("[chan=%p] BioRead(%d) -> %d [tclEof=%d; tclErrno=%d]", (void *) chan, bufLen, ret, tclEofChan, tclErrno);

    BIO_clear_flags(bio, BIO_FLAGS_READ | BIO_FLAGS_SHOULD_RETRY);

    if (tclEofChan && ret <= 0) {
	dprintf("Got EOF while reading, returning a Connection Reset error which maps to Soft EOF");
	Tcl_SetErrno(ECONNRESET);
	ret = 0;

	if (BIO_should_write(bio)) {
	    dprintf("Setting should retry write flag");

	    BIO_set_retry_write(bio);
	}
    }

    dprintf("BioRead(%p, <buf>, %d) [%p] returning %i", (void *) bio, bufLen, (void *) chan, ret);


    return(ret);
}

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

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

/*
 * Digest Commands
 *
 * Copyright (C) 2023 Brian O'Hagan
 *
 */

#include "tlsInt.h"
#include "tclOpts.h"
#include <tcl.h>
#include <stdio.h>
#include <string.h>
#include <openssl/evp.h>

/* Constants */
const char *hex = "0123456789ABCDEF";
#define REASON()	ERR_reason_error_string(ERR_get_error())


/*******************************************************************/

/*
 *-------------------------------------------------------------------
 *
 * DigestFile --
 *
 *	Return message digest for file using user specified hash function.
 *
 * Returns:
 *	TCL_OK or TCL_ERROR
 *
 * Side effects:
 *	Result is message digest or error message
 *
 *-------------------------------------------------------------------
 */
int
DigestFile(Tcl_Interp *interp, Tcl_Obj *filename, const EVP_MD *md, int format) {
    EVP_MD_CTX *ctx;
    Tcl_Channel chan;
    char buf[32768];
    unsigned char md_buf[EVP_MAX_MD_SIZE];
    unsigned int md_len;

    /* Open file channel */
    chan = Tcl_FSOpenFileChannel(interp, filename, "rb", 0444);
    if (chan == NULL) {
	return TCL_ERROR;
    }

    /* Configure channel */
    if (Tcl_SetChannelOption(interp, chan, "-translation", "binary") == TCL_ERROR ||
	Tcl_SetChannelOption(interp, chan, "-buffersize", "32768") == TCL_ERROR) {
	Tcl_Close(interp, chan);
	return TCL_ERROR;
    }

    /* Create message digest context */
    ctx = EVP_MD_CTX_new();
    if (ctx == NULL) {
	Tcl_AppendResult(interp, "Create digest context failed: ", REASON(), NULL);
	Tcl_Close(interp, chan);
	return TCL_ERROR;
    }

    /* Initialize hash function */
#if OPENSSL_VERSION_NUMBER < 0x30000000L
    if (!EVP_DigestInit_ex(ctx, md, NULL))
#else
    if (!EVP_DigestInit_ex2(ctx, md, NULL))
#endif
    {
	Tcl_AppendResult(interp, "Initialize digest failed: ", REASON(), NULL);
	Tcl_Close(interp, chan);
	EVP_MD_CTX_free(ctx);
	return TCL_ERROR;
    }

    /* Read file data and update hash function */
    while (!Tcl_Eof(chan)) {
	int len = Tcl_ReadRaw(chan, buf, 32768);
	if (!EVP_DigestUpdate(ctx, &buf, (size_t) len)) {
	    Tcl_AppendResult(interp, "Update digest failed: ", REASON(), NULL);
	    Tcl_Close(interp, chan);
	    EVP_MD_CTX_free(ctx);
	    return TCL_ERROR;
	}
    }

    /* Close channel */
    if (Tcl_Close(interp, chan) == TCL_ERROR) {
	EVP_MD_CTX_free(ctx);
	return TCL_ERROR;
    }

    /* Finalize hash function and calculate message digest */
    if (!EVP_DigestFinal_ex(ctx, md_buf, &md_len)) {
	Tcl_AppendResult(interp, "Finalize digest failed: ", REASON(), NULL);
	EVP_MD_CTX_free(ctx);
	return TCL_ERROR;
    }
    EVP_MD_CTX_free(ctx);

    /* Return message digest as either a binary or hex string */
    if (format == 0) {
	Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(md_buf, md_len));

    } else {
	Tcl_Obj *resultObj = Tcl_NewObj();
	unsigned char *ptr = Tcl_SetByteArrayLength(resultObj, md_len*2);

	for (unsigned int i = 0; i < md_len; i++) {
	    *ptr++ = hex[(md_buf[i] >> 4) & 0x0F];
	    *ptr++ = hex[md_buf[i] & 0x0F];
	}
	Tcl_SetObjResult(interp, resultObj);
    }
    return TCL_OK;
}

/*******************************************************************/

/*
 *-------------------------------------------------------------------
 *
 * DigestHashFunction --
 *
 *	 Calculate message digest using hash function.
 *
 * Returns:
 *	TCL_OK or TCL_ERROR
 *
 * Side effects:
 *	Sets result to message digest or error message
 *
 *-------------------------------------------------------------------
 */
int
DigestHashFunction(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], const EVP_MD *md, int format) {
    char *data;
    int len;
    unsigned int md_len;
    unsigned char md_buf[EVP_MAX_MD_SIZE];

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

    /* Get data */
    data = Tcl_GetByteArrayFromObj(objv[1], &len);
    if (data == NULL || len == 0) {
	Tcl_SetResult(interp, "No data", NULL);
	return TCL_ERROR;
    }

    /* Calculate hash value, create bin/hex representation, and write to result */
    if (EVP_Digest(data, (size_t) len, md_buf, &md_len, md, NULL)) {
	if (format == 0) {
	    Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(md_buf, md_len));

	} else {
	    Tcl_Obj *resultObj = Tcl_NewObj();
	    unsigned char *ptr = Tcl_SetByteArrayLength(resultObj, md_len*2);

	    for (unsigned int i = 0; i < md_len; i++) {
		*ptr++ = hex[(md_buf[i] >> 4) & 0x0F];
		*ptr++ = hex[md_buf[i] & 0x0F];
	    }
	Tcl_SetObjResult(interp, resultObj);
	}

    } else {
	Tcl_AppendResult(interp, "Hash calculation error:", REASON(), (char *) NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------
 *
 * DigestObjCmd --
 *
 *	Return message digest using user specified hash function.
 *
 * Returns:
 *	TCL_OK or TCL_ERROR
 *
 * Side effects:
 *	Sets result to message digest or error message
 *
 *-------------------------------------------------------------------
 */
static int
DigestObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    int idx, len, format = 1, key_len = 0, data_len = 0;
    const char *digestname;
    Tcl_Obj *dataObj = NULL, *fileObj = NULL;
    unsigned char *key = NULL;
    const EVP_MD *md;

    Tcl_ResetResult(interp);

    if (objc < 3 || objc > 5) {
	Tcl_WrongNumArgs(interp, 1, objv, "type ?-bin|-hex? [-channel chan | -file filename | ?-data? data]");
	return TCL_ERROR;
    }

    /* Get digest */
    digestname = Tcl_GetStringFromObj(objv[1], &len);
    if (digestname == NULL || (md = EVP_get_digestbyname(digestname)) == NULL) {
	Tcl_AppendResult(interp, "Invalid digest type \"", digestname, "\"", NULL);
	return TCL_ERROR;
    }

    /* Optimal case for blob of data */
    if (objc == 3) {
	return DigestHashFunction(interp, --objc, ++objv, md, format);
    }

    /* Get options */
    for (idx = 2; idx < objc-1; idx++) {
	char *opt = Tcl_GetStringFromObj(objv[idx], NULL);

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

	OPTFLAG("-bin", format, 0);
	OPTFLAG("-binary", format, 0);
	OPTFLAG("-hex", format, 1);
	OPTFLAG("-hexadecimal", format, 1);
	OPTOBJ("-data", dataObj);
	OPTOBJ("-file", fileObj);
	OPTOBJ("-filename", fileObj);

	OPTBAD("option", "-bin, -data, -file, -filename, -key, or -hex");
	return TCL_ERROR;
    }

    /* If no option for last arg, then its the data */
    if (idx < objc) {
	dataObj = objv[idx];
    }

    /* Calc digest on file or data blob */
    if (fileObj != NULL) {
	return DigestFile(interp, fileObj, md, format);
    } else if (dataObj != NULL) {
	Tcl_Obj *objs[2];
	objs[0] = NULL;
	objs[1] = dataObj;
	return DigestHashFunction(interp, 2, objs, md, format);
    }

    Tcl_AppendResult(interp, "No data specified.", NULL);
    return TCL_ERROR;
}

/*
 *-------------------------------------------------------------------
 *
 * Message Digest Convenience Commands --
 *
 *	Convenience commands for message digests.
 *
 * Returns:
 *	TCL_OK or TCL_ERROR
 *
 * Side effects:
 *	Sets result to message digest or error message
 *
 *-------------------------------------------------------------------
 */
int DigestMD4Cmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    return DigestHashFunction(interp, objc, objv, EVP_md4(), 1);
}

int DigestMD5Cmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    return DigestHashFunction(interp, objc, objv, EVP_md5(), 1);
}

int DigestSHA1Cmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    return DigestHashFunction(interp, objc, objv, EVP_sha1(), 1);
}

int DigestSHA256Cmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    return DigestHashFunction(interp, objc, objv, EVP_sha256(), 1);
}

/*
 *-------------------------------------------------------------------
 *
 * Tls_DigestCommands --
 *
 *	Create digest commands
 *
 * Returns:
 *	TCL_OK or TCL_ERROR
 *
 * Side effects:
 *	Creates commands
 *
 *-------------------------------------------------------------------
 */
int Tls_DigestCommands(Tcl_Interp *interp) {
    Tcl_CreateObjCommand(interp, "tls::digest", DigestObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::md4", DigestMD4Cmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::md5", DigestMD5Cmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::sha1", DigestSHA1Cmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::sha256", DigestSHA256Cmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    return TCL_OK;
}

#   endif
#endif

/*
 * Backwards compatibility for size type change
 */
#if TCL_MAJOR_VERSION < 9 && TCL_MINOR_VERSION < 7
#   define Tcl_Size int




#endif

#include <openssl/ssl.h>
#include <openssl/err.h>
#include <openssl/rand.h>
#include <openssl/opensslv.h>

Tcl_Obj         *Tls_NewX509Obj(Tcl_Interp *interp, X509 *cert);
Tcl_Obj		*Tls_NewCAObj(Tcl_Interp *interp, const SSL *ssl, int peer);
void            Tls_Error(State *statePtr, char *msg);
void            Tls_Free(char *blockPtr);
void            Tls_Clean(State *statePtr);
int             Tls_WaitForConnect(State *statePtr, int *errorCodePtr, int handshakeFailureIsPermanent);
int             Tls_DigestCommands(Tcl_Interp *interp);

BIO             *BIO_new_tcl(State* statePtr, int flags);

#define PTR2INT(x) ((int) ((intptr_t) (x)))

#endif /* _TLSINT_H */

/* Define maximum certificate size. Max PEM size 100kB and DER size is 24kB. */
#define CERT_STR_SIZE 32768


/*
 * Binary string to hex string
 */
int String_to_Hex(unsigned char* input, int ilen, unsigned char *output, int olen) {
    int count = 0;
    unsigned char *iptr = input;
    unsigned char *optr = &output[0];
    const char *hex = "0123456789ABCDEF";

    for (int i = 0; i < ilen && count < olen - 1; i++, count += 2) {

        *optr++ = hex[(*iptr>>4)&0xF];
        *optr++ = hex[(*iptr++)&0xF];
    }
    *optr = 0;
    return count;
}

/*
 * BIO to Buffer
 */
int BIO_to_Buffer(int result, BIO *bio, void *buffer, int size) {

 */
Tcl_Obj *Tls_x509Identifier(ASN1_OCTET_STRING *astring) {
    Tcl_Obj *resultPtr = NULL;
    int len = 0;
    char buffer[1024];

    if (astring != NULL) {
	len = String_to_Hex(ASN1_STRING_get0_data(astring),
	    ASN1_STRING_length(astring), buffer, 1024);
    }
    resultPtr = Tcl_NewStringObj(buffer, len);
    return resultPtr;
}

/*
 * Get Key Usage
 */
Tcl_Obj *Tls_x509KeyUsage(Tcl_Interp *interp, X509 *cert, uint32_t xflags) {

    }

    if (names = X509_get_ext_d2i(cert, nid, NULL, NULL)) {
	for (int i=0; i < sk_GENERAL_NAME_num(names); i++) {
	    const GENERAL_NAME *name = sk_GENERAL_NAME_value(names, i);

	    len = BIO_to_Buffer(name && GENERAL_NAME_print(bio, name), bio, buffer, 1024);
	    LAPPEND_STR(interp, listPtr, NULL, buffer, len);
	}
	sk_GENERAL_NAME_pop_free(names, GENERAL_NAME_free);
    }
    return listPtr;
}

/*

	    if (distpoint->type == 0) {
		/* full-name GENERALIZEDNAME */
		for (int j = 0; j < sk_GENERAL_NAME_num(distpoint->name.fullname); j++) {
		    GENERAL_NAME *gen = sk_GENERAL_NAME_value(distpoint->name.fullname, j);
		    int type;
		    ASN1_STRING *uri = GENERAL_NAME_get0_value(gen, &type);
		    if (type == GEN_URI) {
			LAPPEND_STR(interp, listPtr, NULL, ASN1_STRING_get0_data(uri), ASN1_STRING_length(uri));
		    }
		}
	    } else if (distpoint->type == 1) {
		/* relative-name X509NAME */
		STACK_OF(X509_NAME_ENTRY) *sk_relname = distpoint->name.relativename;
		for (int j = 0; j < sk_X509_NAME_ENTRY_num(sk_relname); j++) {
		    X509_NAME_ENTRY *e = sk_X509_NAME_ENTRY_value(sk_relname, j);
		    ASN1_STRING *d = X509_NAME_ENTRY_get_data(e);
		    LAPPEND_STR(interp, listPtr, NULL, ASN1_STRING_data(d), ASN1_STRING_length(d));
		}
	    }
	}
	CRL_DIST_POINTS_free(crl);
    }
    return listPtr;
}

    if (ads = X509_get_ext_d2i(cert, NID_info_access, NULL, NULL)) {
	for (int i = 0; i < sk_ACCESS_DESCRIPTION_num(ads); i++) {
	    ad = sk_ACCESS_DESCRIPTION_value(ads, i);
	    if (OBJ_obj2nid(ad->method) == NID_ad_ca_issuers && ad->location) {
		if (ad->location->type == GEN_URI) {
		    len = ASN1_STRING_to_UTF8(&buf, ad->location->d.uniformResourceIdentifier);
		    Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(buf, len));
		    OPENSSL_free(buf);
		    break;
		}
	    }
	}
	/* sk_ACCESS_DESCRIPTION_pop_free(ads, ACCESS_DESCRIPTION_free); */
	AUTHORITY_INFO_ACCESS_free(ads);

	int sig_nid;

	X509_get0_signature(&sig, &sig_alg, cert);
	/* sig_nid = X509_get_signature_nid(cert) */
	sig_nid = OBJ_obj2nid(sig_alg->algorithm);
	LAPPEND_STR(interp, certPtr, "signatureAlgorithm", OBJ_nid2ln(sig_nid), -1);
	len = (sig_nid != NID_undef) ? String_to_Hex(sig->data, sig->length, buffer, BUFSIZ) : 0;
	LAPPEND_STR(interp, certPtr, "signatureValue", buffer, len);
    }

    /* Version of the encoded certificate - RFC 5280 section 4.1.2.1 */
    LAPPEND_LONG(interp, certPtr, "version", X509_get_version(cert)+1);

    /* Unique number assigned by CA to certificate - RFC 5280 section 4.1.2.2 */
    len = BIO_to_Buffer(i2a_ASN1_INTEGER(bio, X509_get0_serialNumber(cert)), bio, buffer, BUFSIZ);
    LAPPEND_STR(interp, certPtr, "serialNumber", buffer, len);

    /* Signature algorithm used by the CA to sign the certificate. Must match
	signatureAlgorithm. RFC 5280 section 4.1.2.3 */
    LAPPEND_STR(interp, certPtr, "signature", OBJ_nid2ln(X509_get_signature_nid(cert)), -1);

    /* Issuer identifies the entity that signed and issued the cert. RFC 5280 section 4.1.2.4 */
    len = BIO_to_Buffer(X509_NAME_print_ex(bio, X509_get_issuer_name(cert), 0, flags), bio, buffer, BUFSIZ);
    LAPPEND_STR(interp, certPtr, "issuer", buffer, len);

    /* Certificate validity period is the interval the CA warrants that it will
	maintain info on the status of the certificate. RFC 5280 section 4.1.2.5 */
    /* Get Validity - Not Before */
    len = BIO_to_Buffer(ASN1_TIME_print(bio, X509_get0_notBefore(cert)), bio, buffer, BUFSIZ);
    LAPPEND_STR(interp, certPtr, "notBefore", buffer, len);

    /* Get Validity - Not After */
    len = BIO_to_Buffer(ASN1_TIME_print(bio, X509_get0_notAfter(cert)), bio, buffer, BUFSIZ);
    LAPPEND_STR(interp, certPtr, "notAfter", buffer, len);

    /* Subject identifies the entity associated with the public key stored in
	the subject public key field. RFC 5280 section 4.1.2.6 */
    len = BIO_to_Buffer(X509_NAME_print_ex(bio, X509_get_subject_name(cert), 0, flags), bio, buffer, BUFSIZ);
    LAPPEND_STR(interp, certPtr, "subject", buffer, len);

    /* SHA1 Digest (Fingerprint) of cert - DER representation */
    if (X509_digest(cert, EVP_sha1(), md, &len)) {
    len = String_to_Hex(md, len, buffer, BUFSIZ);
	LAPPEND_STR(interp, certPtr, "sha1_hash", buffer, len);
    }

    /* SHA256 Digest (Fingerprint) of cert - DER representation */
    if (X509_digest(cert, EVP_sha256(), md, &len)) {
    len = String_to_Hex(md, len, buffer, BUFSIZ);
	LAPPEND_STR(interp, certPtr, "sha256_hash", buffer, len);
    }

    /* Subject Public Key Info specifies the public key and identifies the
	algorithm with which the key is used. RFC 5280 section 4.1.2.7 */
    if (X509_get_signature_info(cert, &mdnid, &pknid, &bits, &xflags)) {
	ASN1_BIT_STRING *key;
	unsigned int n;

	LAPPEND_STR(interp, certPtr, "signingDigest", OBJ_nid2ln(mdnid), -1);
	LAPPEND_STR(interp, certPtr, "publicKeyAlgorithm", OBJ_nid2ln(pknid), -1);
	LAPPEND_INT(interp, certPtr, "bits", bits); /* Effective security bits */

	key = X509_get0_pubkey_bitstr(cert);
	len = String_to_Hex(key->data, key->length, buffer, BUFSIZ);
	LAPPEND_STR(interp, certPtr, "publicKey", buffer, len);

	len = 0;
	if (X509_pubkey_digest(cert, EVP_get_digestbynid(pknid), md, &n)) {
	    len = String_to_Hex(md, (int)n, buffer, BUFSIZ);
	}
	LAPPEND_STR(interp, certPtr, "publicKeyHash", buffer, len);

	/* digest of the DER representation of the certificate */
	len = 0;
	if (X509_digest(cert, EVP_get_digestbynid(mdnid), md, &n)) {
	    len = String_to_Hex(md, (int)n, buffer, BUFSIZ);
	}
	LAPPEND_STR(interp, certPtr, "signatureHash", buffer, len);
    }

    /* Certificate Purpose. Call before checking for extensions. */
    LAPPEND_STR(interp, certPtr, "purpose", Tls_x509Purpose(cert), -1);
    LAPPEND_OBJ(interp, certPtr, "certificatePurpose", Tls_x509Purposes(interp, cert));

    /* Get extensions flags */

	and/or issuer names over time. RFC 5280 section 4.1.2.8 */
    {
	const ASN1_BIT_STRING *iuid, *suid;
        X509_get0_uids(cert, &iuid, &suid);

	Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("issuerUniqueId", -1));
	if (iuid != NULL) {
	    Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewByteArrayObj((char *)iuid->data, iuid->length));
	} else {
	    Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("", -1));
	}

	Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("subjectUniqueId", -1));
	if (suid != NULL) {
	    Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewByteArrayObj((char *)suid->data, suid->length));
	} else {
	    Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("", -1));
	}
    }

    /* X509 v3 Extensions - RFC 5280 section 4.1.2.9 */
    LAPPEND_INT(interp, certPtr, "extCount", X509_get_ext_count(cert));

    /* Subject Information Access - RFC 5280 section 4.2.2.2, NID_sinfo_access */

    /* Certificate Alias. If uses a PKCS#12 structure, alias will reflect the
	friendlyName attribute (RFC 2985). */
    {
	len = 0;
        char *string = X509_alias_get0(cert, &len);
	LAPPEND_STR(interp, certPtr, "alias", string, len);
    }

    /* Certificate and dump all data */
    {
	char certStr[CERT_STR_SIZE];

	/* Get certificate */
	len = BIO_to_Buffer(PEM_write_bio_X509(bio, cert), bio, certStr, CERT_STR_SIZE);
	LAPPEND_STR(interp, certPtr, "certificate", certStr, len);

	/* Get all cert info */
	len = BIO_to_Buffer(X509_print_ex(bio, cert, flags, 0), bio, certStr, CERT_STR_SIZE);
	LAPPEND_STR(interp, certPtr, "all", certStr, len);
    }

    BIO_free(bio);
    return certPtr;
}

# Group,Name,Constraints,Setup,Body,Cleanup,Match,Result,Output,Error Output,Return Codes
command,package require tls,,,,,,,,,
command,,,,,,,,,,
command,# Make sure path includes location of OpenSSL executable,,,,,,,,,
command,"if {[info exists ::env(OPENSSL)]} {set ::env(path) [string cat [file join $::env(OPENSSL) bin] "";"" $::env(path)]}",,,,,,,,,
command,,,,,,,,,,
command,# Constraints,,,,,,,,,
command,set protocols [list ssl2 ssl3 tls1 tls1.1 tls1.2 tls1.3],,,,,,,,,
command,foreach protocol $protocols {::tcltest::testConstraint $protocol 0},,,,,,,,,
command,foreach protocol [::tls::protocols] {::tcltest::testConstraint $protocol 1},,,,,,,,,
command,"::tcltest::testConstraint OpenSSL [string match ""OpenSSL*"" [::tls::version]]",,,,,,,,,
,,,,,,,,,,
command,# Helper functions,,,,,,,,,
command,"proc lcompare {list1 list2} {set m """";set u """";foreach i $list1 {if {$i ni $list2} {lappend m $i}};foreach i $list2 {if {$i ni $list1} {lappend u $i}};return [list ""missing"" $m ""unexpected"" $u]}",,,,,,,,,
command,proc exec_get {delim args} {return [split [exec openssl {*}$args] $delim]},,,,,,,,,
command,"proc exec_get_ciphers {} {set list [list];set data [exec openssl list -cipher-algorithms];foreach line [split $data ""\n""] {foreach {cipher null alias} [split [string trim $line]] {lappend list [string tolower $cipher]}};return [lsort -unique $list]}",,,,,,,,,
command,"proc exec_get_digests {} {set list [list];set data [exec openssl dgst -list];foreach line [split $data ""\n""] {foreach digest $line {if {[string match ""-*"" $digest]} {lappend list [string trimleft $digest ""-""]}}};return [lsort $list]}",,,,,,,,,
command,proc list_toupper {list} {set result [list];foreach element $list {lappend result [string toupper $element]};return $result},,,,,,,,,
,,,,,,,,,,
command,# Test list ciphers,,,,,,,,,
CiphersAll,,,,lcompare [lsort [exec_get_ciphers]] [lsort [list_toupper [::tls::ciphers]]],,,missing {} unexpected {},,,
,,,,,,,,,,
command,# Test list ciphers for protocols,,,,,,,,,
CiphersProtocols,SSL2,ssl2,,"lcompare [exec_get "":"" ciphers -ssl2] [::tls::ciphers ssl2]",,,missing {} unexpected {},,,
CiphersProtocols,SSL3,ssl3,,"lcompare [exec_get "":"" ciphers -ssl3] [::tls::ciphers ssl3]",,,missing {} unexpected {},,,
CiphersProtocols,TLS1,tls1,,"lcompare [exec_get "":"" ciphers -tls1] [::tls::ciphers tls1]",,,missing {} unexpected {},,,
CiphersProtocols,TLS1.1,tls1.1,,"lcompare [exec_get "":"" ciphers -tls1_1] [::tls::ciphers tls1.1]",,,missing {} unexpected {},,,
CiphersProtocols,TLS1.2,tls1.2,,"lcompare [exec_get "":"" ciphers -tls1_2] [::tls::ciphers tls1.2]",,,missing {} unexpected {},,,
CiphersProtocols,TLS1.3,tls1.3,,"lcompare [exec_get "":"" ciphers -tls1_3] [::tls::ciphers tls1.3]",,,missing {} unexpected {},,,
,,,,,,,,,,
command,# Test cipher descriptions,,,,,,,,,
CiphersDescriptions,SSL2,ssl2,,"lcompare [exec_get ""\r\n"" ciphers -ssl2 -v] [split [string trim [::tls::ciphers ssl2 1]] \n]",,,missing {} unexpected {},,,
CiphersDescriptions,SSL3,ssl3,,"lcompare [exec_get ""\r\n"" ciphers -ssl3 -v] [split [string trim [::tls::ciphers ssl3 1]] \n]",,,missing {} unexpected {},,,
CiphersDescriptions,TLS1,tls1,,"lcompare [exec_get ""\r\n"" ciphers -tls1 -v] [split [string trim [::tls::ciphers tls1 1]] \n]",,,missing {} unexpected {},,,
CiphersDescriptions,TLS1.1,tls1.1,,"lcompare [exec_get ""\r\n"" ciphers -tls1_1 -v] [split [string trim [::tls::ciphers tls1.1 1]] \n]",,,missing {} unexpected {},,,
CiphersDescriptions,TLS1.2,tls1.2,,"lcompare [exec_get ""\r\n"" ciphers -tls1_2 -v] [split [string trim [::tls::ciphers tls1.2 1]] \n]",,,missing {} unexpected {},,,
CiphersDescriptions,TLS1.3,tls1.3,,"lcompare [exec_get ""\r\n"" ciphers -tls1_3 -v] [split [string trim [::tls::ciphers tls1.3 1]] \n]",,,missing {} unexpected {},,,
,,,,,,,,,,
command,# Test protocol specific ciphers,,,,,,,,,
CiphersSpecific,SSL2,ssl2,,"lcompare [exec_get "":"" ciphers -ssl2 -s] [::tls::ciphers ssl2 0 1]",,,missing {} unexpected {},,,
CiphersSpecific,SSL3,ssl3,,"lcompare [exec_get "":"" ciphers -ssl3 -s] [::tls::ciphers ssl3 0 1]",,,missing {} unexpected {},,,
CiphersSpecific,TLS1,tls1,,"lcompare [exec_get "":"" ciphers -tls1 -s] [::tls::ciphers tls1 0 1]",,,missing {} unexpected {},,,
CiphersSpecific,TLS1.1,tls1.1,,"lcompare [exec_get "":"" ciphers -tls1_1 -s] [::tls::ciphers tls1.1 0 1]",,,missing {} unexpected {},,,
CiphersSpecific,TLS1.2,tls1.2,,"lcompare [exec_get "":"" ciphers -tls1_2 -s] [::tls::ciphers tls1.2 0 1]",,,missing {} unexpected {},,,
CiphersSpecific,TLS1.3,tls1.3,,"lcompare [exec_get "":"" ciphers -tls1_3 -s] [::tls::ciphers tls1.3 0 1]",,,missing {} unexpected {},,,
,,,,,,,,,,
command,# Test list digests,,,,,,,,,
Digest List,Digest List,,,lcompare [lsort [exec_get_digests]] [lsort [tls::digests]],,,missing {} unexpected {},,,
,,,,,,,,,,
command,# Test Digests,,,,,,,,,
Digest,md4 opt,,,"tls::md4 ""Example string for message digest tests.""",,,181CDCF9DB9B6FA8FC0A3BF9C34E29D9,,,
Digest,md5 opt,,,"tls::md5 ""Example string for message digest tests.""",,,CCB1BE2E11D8183E843FF73DA8C6D206,,,
Digest,sha1 opt,,,"tls::sha1 ""Example string for message digest tests.""",,,3AEFE840CA492C387E903F15ED6019E7AD833B47,,,
Digest,sha256 opt,,,"tls::sha256 ""Example string for message digest tests.""",,,B7DFDDEB0314A74FF56A8AC1E3DC57DF09BB52A96DA50F6549EB62CA61A0A491,,,
Digest,md4,,,"tls::digest md4 ""Example string for message digest tests.""",,,181CDCF9DB9B6FA8FC0A3BF9C34E29D9,,,
Digest,md5,,,"tls::digest md5 ""Example string for message digest tests.""",,,CCB1BE2E11D8183E843FF73DA8C6D206,,,
Digest,sha1,,,"tls::digest sha1 ""Example string for message digest tests.""",,,3AEFE840CA492C387E903F15ED6019E7AD833B47,,,
Digest,sha256,,,"tls::digest sha256 ""Example string for message digest tests.""",,,B7DFDDEB0314A74FF56A8AC1E3DC57DF09BB52A96DA50F6549EB62CA61A0A491,,,
,,,,,,,,,,
command,# Test protocols,,,,,,,,,
Protocols,All,,,lcompare $protocols [::tls::protocols],,,missing {ssl2 ssl3} unexpected {},,,
,,,,,,,,,,
command,# Test version,,,,,,,,,
Version,All,,,::tls::version,,glob,*,,,
Version,OpenSSL,OpenSSL,,::tls::version,,glob,OpenSSL*,,,

# Auto generated test cases for ciphers.csv

# Load Tcl Test package
if {[lsearch [namespace children] ::tcltest] == -1} {
	package require tcltest
	namespace import ::tcltest::*
}

set auto_path [concat [list [file dirname [file dirname [info script]]]] $auto_path]

package require tls

# Make sure path includes location of OpenSSL executable
if {[info exists ::env(OPENSSL)]} {set ::env(path) [string cat [file join $::env(OPENSSL) bin] ";" $::env(path)]}

# Constraints
set protocols [list ssl2 ssl3 tls1 tls1.1 tls1.2 tls1.3]
foreach protocol $protocols {::tcltest::testConstraint $protocol 0}
foreach protocol [::tls::protocols] {::tcltest::testConstraint $protocol 1}
::tcltest::testConstraint OpenSSL [string match "OpenSSL*" [::tls::version]]
# Helper functions
proc lcompare {list1 list2} {set m "";set u "";foreach i $list1 {if {$i ni $list2} {lappend m $i}};foreach i $list2 {if {$i ni $list1} {lappend u $i}};return [list "missing" $m "unexpected" $u]}
proc exec_get {delim args} {return [split [exec openssl {*}$args] $delim]}
proc exec_get_ciphers {} {set list [list];set data [exec openssl list -cipher-algorithms];foreach line [split $data "\n"] {foreach {cipher null alias} [split [string trim $line]] {lappend list [string tolower $cipher]}};return [lsort -unique $list]}
proc exec_get_digests {} {set list [list];set data [exec openssl dgst -list];foreach line [split $data "\n"] {foreach digest $line {if {[string match "-*" $digest]} {lappend list [string trimleft $digest "-"]}}};return [lsort $list]}
proc list_toupper {list} {set result [list];foreach element $list {lappend result [string toupper $element]};return $result}
# Test list ciphers


test CiphersAll-1.1 {} -body {
	lcompare [lsort [exec_get_ciphers]] [lsort [list_toupper [::tls::ciphers]]]
    } -result {missing {} unexpected {}}
# Test list ciphers for protocols


test CiphersProtocols-2.1 {SSL2} -constraints {ssl2} -body {
	lcompare [exec_get ":" ciphers -ssl2] [::tls::ciphers ssl2]
    } -result {missing {} unexpected {}}

test CiphersProtocols-2.2 {SSL3} -constraints {ssl3} -body {
	lcompare [exec_get ":" ciphers -ssl3] [::tls::ciphers ssl3]
    } -result {missing {} unexpected {}}

test CiphersProtocols-2.3 {TLS1} -constraints {tls1} -body {
	lcompare [exec_get ":" ciphers -tls1] [::tls::ciphers tls1]
    } -result {missing {} unexpected {}}

test CiphersProtocols-2.4 {TLS1.1} -constraints {tls1.1} -body {
	lcompare [exec_get ":" ciphers -tls1_1] [::tls::ciphers tls1.1]
    } -result {missing {} unexpected {}}

test CiphersProtocols-2.5 {TLS1.2} -constraints {tls1.2} -body {
	lcompare [exec_get ":" ciphers -tls1_2] [::tls::ciphers tls1.2]
    } -result {missing {} unexpected {}}

test CiphersProtocols-2.6 {TLS1.3} -constraints {tls1.3} -body {
	lcompare [exec_get ":" ciphers -tls1_3] [::tls::ciphers tls1.3]
    } -result {missing {} unexpected {}}
# Test cipher descriptions


test CiphersDescriptions-3.1 {SSL2} -constraints {ssl2} -body {
	lcompare [exec_get "\r\n" ciphers -ssl2 -v] [split [string trim [::tls::ciphers ssl2 1]] \n]
    } -result {missing {} unexpected {}}

test CiphersDescriptions-3.2 {SSL3} -constraints {ssl3} -body {
	lcompare [exec_get "\r\n" ciphers -ssl3 -v] [split [string trim [::tls::ciphers ssl3 1]] \n]
    } -result {missing {} unexpected {}}

test CiphersDescriptions-3.3 {TLS1} -constraints {tls1} -body {
	lcompare [exec_get "\r\n" ciphers -tls1 -v] [split [string trim [::tls::ciphers tls1 1]] \n]
    } -result {missing {} unexpected {}}

test CiphersDescriptions-3.4 {TLS1.1} -constraints {tls1.1} -body {
	lcompare [exec_get "\r\n" ciphers -tls1_1 -v] [split [string trim [::tls::ciphers tls1.1 1]] \n]
    } -result {missing {} unexpected {}}

test CiphersDescriptions-3.5 {TLS1.2} -constraints {tls1.2} -body {
	lcompare [exec_get "\r\n" ciphers -tls1_2 -v] [split [string trim [::tls::ciphers tls1.2 1]] \n]
    } -result {missing {} unexpected {}}

test CiphersDescriptions-3.6 {TLS1.3} -constraints {tls1.3} -body {
	lcompare [exec_get "\r\n" ciphers -tls1_3 -v] [split [string trim [::tls::ciphers tls1.3 1]] \n]
    } -result {missing {} unexpected {}}
# Test protocol specific ciphers


test CiphersSpecific-4.1 {SSL2} -constraints {ssl2} -body {
	lcompare [exec_get ":" ciphers -ssl2 -s] [::tls::ciphers ssl2 0 1]

test CiphersSpecific-4.5 {TLS1.2} -constraints {tls1.2} -body {
	lcompare [exec_get ":" ciphers -tls1_2 -s] [::tls::ciphers tls1.2 0 1]
    } -result {missing {} unexpected {}}

test CiphersSpecific-4.6 {TLS1.3} -constraints {tls1.3} -body {
	lcompare [exec_get ":" ciphers -tls1_3 -s] [::tls::ciphers tls1.3 0 1]
    } -result {missing {} unexpected {}}
# Test list digests


test Digest_List-5.1 {Digest List} -body {
	lcompare [lsort [exec_get_digests]] [lsort [tls::digests]]
    } -result {missing {} unexpected {}}
# Test Digests


test Digest-6.1 {md4 opt} -body {
	tls::md4 "Example string for message digest tests."
    } -result {181CDCF9DB9B6FA8FC0A3BF9C34E29D9}

test Digest-6.2 {md5 opt} -body {
	tls::md5 "Example string for message digest tests."
    } -result {CCB1BE2E11D8183E843FF73DA8C6D206}

test Digest-6.3 {sha1 opt} -body {
	tls::sha1 "Example string for message digest tests."
    } -result {3AEFE840CA492C387E903F15ED6019E7AD833B47}

test Digest-6.4 {sha256 opt} -body {
	tls::sha256 "Example string for message digest tests."
    } -result {B7DFDDEB0314A74FF56A8AC1E3DC57DF09BB52A96DA50F6549EB62CA61A0A491}

test Digest-6.5 {md4} -body {
	tls::digest md4 "Example string for message digest tests."
    } -result {181CDCF9DB9B6FA8FC0A3BF9C34E29D9}

test Digest-6.6 {md5} -body {
	tls::digest md5 "Example string for message digest tests."
    } -result {CCB1BE2E11D8183E843FF73DA8C6D206}

test Digest-6.7 {sha1} -body {
	tls::digest sha1 "Example string for message digest tests."
    } -result {3AEFE840CA492C387E903F15ED6019E7AD833B47}

test Digest-6.8 {sha256} -body {
	tls::digest sha256 "Example string for message digest tests."
    } -result {B7DFDDEB0314A74FF56A8AC1E3DC57DF09BB52A96DA50F6549EB62CA61A0A491}
# Test protocols


test Protocols-7.1 {All} -body {
	lcompare $protocols [::tls::protocols]
    } -result {missing {ssl2 ssl3} unexpected {}}
# Test version


test Version-8.1 {All} -body {
	::tls::version
    } -match {glob} -result {*}

test Version-8.2 {OpenSSL} -constraints {OpenSSL} -body {
	::tls::version
    } -match {glob} -result {OpenSSL*}

# Cleanup
::tcltest::cleanupTests
return

# Define the object files and resource file that make up the extension.
# Note the resource file does not makes sense if doing a static library build
# hence it is under that condition. TMP_DIR is the output directory
# defined by rules for object files.
PRJ_OBJS = $(TMP_DIR)\tls.obj \
	$(TMP_DIR)\tlsBIO.obj \
	$(TMP_DIR)\tlsDigest.obj \
	$(TMP_DIR)\tlsIO.obj \
	$(TMP_DIR)\tlsX509.obj

# Define any additional project include flags
# SSL_INSTALL_FOLDER = with the OpenSSL installation folder following.
PRJ_INCLUDES = -I"$(SSL_INSTALL_FOLDER)\include" -I"$(OPENSSL_INSTALL_DIR)\include"

# Define any additional compiler flags that might be required for the project
PRJ_DEFINES = -D NO_SSL2 -D NO_SSL3 -D _CRT_SECURE_NO_WARNINGS

#
# SSL Libs:
#    1. ${LIBCRYPTO}.dll
#    2. ${LIBSSL}.dll
# Where LIBCRYPTO (#1.) and LIBSSL (#2.) are defined as follows:
#    v1.1: libcrypto-1.1-x64.dll and libssl-1.1-x64.dll
#    v3: libcrypto-3-x64.dll and libssl-3-x64.dll
# On *nix libcrypto.so.* and libssl.so.* (where suffix is a version indicator).
#
PRJ_LIBS = \
	"$(SSL_INSTALL_FOLDER)\lib\libssl.lib" \
	"$(SSL_INSTALL_FOLDER)\lib\libcrypto.lib" \
	WS2_32.LIB GDI32.LIB ADVAPI32.LIB CRYPT32.LIB USER32.LIB

# Define the standard targets
!include "targets.vc"

# Project specific targets

all:

clean: default-clean

# We must define a pkgindex target that will create a pkgIndex.tcl
# file in the $(OUT_DIR) directory. We can just redirect to the
# default-pkgindex target for our sample extension.
pkgindex: default-pkgindex

# The default install target only installs binaries and scripts so add
# an additional target for our documentation. Note this *adds* a target
# since no commands are listed after it. The original targets for
# install (from targets.vc) will remain.
install: default-pkgindex-tea default-install default-install-docs-html

# Test package
test: default-test