# We need to enumerate the list of .c to .o lines here.
#
# In the following lines, $(srcdir) refers to the toplevel directory
# containing your extension.  If your sources are in a subdirectory,
# you will have to modify the paths to reflect this:
#
# sample.$(OBJEXT): $(srcdir)/generic/sample.c
#	$(COMPILE) -c `@CYGPATH@ $(srcdir)/generic/sample.c` -o $@
#
# Setting the VPATH variable to a list of paths will cause the makefile
# to look into these paths when resolving .c to .obj dependencies.
# As necessary, add $(srcdir):$(srcdir)/compat:....
#========================================================================

VPATH = $(srcdir):$(srcdir)/generic:$(srcdir)/unix:$(srcdir)/win:$(srcdir)/macosx

    size_t len,			/* Protocol message length */
    SSL *ssl,			/* SSL context */
    void *arg)			/* Client state for TLS socket */
{
    State *statePtr = (State*)arg;
    Tcl_Interp *interp	= statePtr->interp;
    Tcl_Obj *cmdPtr;
    const char *ver, *type;
    BIO *bio;
    char buffer[15000];
    Tcl_Size blen = 0;
    buffer[0] = 0;

    dprintf("Called");

 * Side effects:
 *	none
 *
 *-------------------------------------------------------------------
 */

void KeyLogCallback(
    TCL_UNUSED(const SSL *),		/* Client state for TLS socket */
    const char *line)		/* Key data to be logged */
{
    char *str = getenv(SSLKEYLOGFILE);
    FILE *fd;

    dprintf("Called");

    dprintf("Called");

    if (ssl == NULL || arg == NULL) {
	return SSL_TLSEXT_ERR_NOACK;
    }

    /* Select protocol */
    if (SSL_select_next_proto((unsigned char **) out, outlen, statePtr->protos, (unsigned)statePtr->protos_len,
	in, inlen) == OPENSSL_NPN_NEGOTIATED) {
	/* Match found */
	res = SSL_TLSEXT_ERR_OK;
    } else {
	/* OPENSSL_NPN_NO_OVERLAP = No overlap, so use first item from client protocol list */
	res = SSL_TLSEXT_ERR_NOACK;
    }

	/* Check if there is sufficient data to extract */
	if (remaining <= 2) {
	    *alert = SSL_R_SSLV3_ALERT_ILLEGAL_PARAMETER;
	    return SSL_CLIENT_HELLO_ERROR;
	}

	/* Extract the length of the supplied list of names. */
	len = (size_t)(*(p++) << 8);
	len += *(p++);
	if (len + 2 != remaining) {
	    *alert = SSL_R_SSLV3_ALERT_ILLEGAL_PARAMETER;
	    return SSL_CLIENT_HELLO_ERROR;
	}
	remaining = len;

	/* The list in practice only has a single element, so we only consider the first one. */
	if (remaining == 0 || *p++ != TLSEXT_NAMETYPE_host_name) {
	    *alert = SSL_R_TLSV1_ALERT_INTERNAL_ERROR;
	    return SSL_CLIENT_HELLO_ERROR;
	}
	remaining--;

	/* Now we can finally pull out the byte array with the actual hostname. */
	if (remaining <= 2) {
	    *alert = SSL_R_TLSV1_ALERT_INTERNAL_ERROR;
	    return SSL_CLIENT_HELLO_ERROR;
	}
	len = (size_t)(*(p++) << 8);
	len += *(p++);
	if (len + 2 > remaining) {
	    *alert = SSL_R_TLSV1_ALERT_INTERNAL_ERROR;
	    return SSL_CLIENT_HELLO_ERROR;
	}
	remaining = len;
	servername = (const char *)p;

    }

    /* 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 = NULL, *p;
	size_t protos_len = 0;
	Tcl_Size cnt, i;
	int res = TCL_OK;
	Tcl_Obj **list;

	if (Tcl_ListObjGetElements(interp, alpn, &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);
	    if (len > 255) {
		Tcl_AppendResult(interp, "ALPN protocol names too long", (char *)NULL);
		Tcl_SetErrorCode(interp, "TLS", "IMPORT", "ALPN", "FAILED", (char *)NULL);
		res = TCL_ERROR;
		goto done;
	    }
	    protos_len += 1 + (size_t)len;
	}

	/* Build the complete protocol-list */
	protos = (unsigned char *)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++ = (unsigned char) len;
	    memcpy(p, str, (size_t) len);
	    p += len;
	}

	/* SSL_set_alpn_protos makes a copy of the protocol-list */
	/* Note: This function reverses the return value convention */
	if (SSL_set_alpn_protos(statePtr->ssl, protos, (unsigned)protos_len)) {
	    Tcl_AppendResult(interp, "Set ALPN protocols failed: ", GET_ERR_REASON(), (char *)NULL);
	    Tcl_SetErrorCode(interp, "TLS", "IMPORT", "ALPN", "FAILED", (char *)NULL);
	    res = TCL_ERROR;
	}

done:	for (i = 0; i < cnt; i++) {
	    Tcl_IncrRefCount(list[i]);

    char *ciphersuites,		/* List of cipher suites */
    int level,			/* Security level */
    char *DHparams)		/* DH parameters */
{
    Tcl_Interp *interp = statePtr->interp;
    SSL_CTX *ctx = NULL;
    Tcl_DString ds;
    uint64_t off = 0;
    int abort = 0;
    int load_private_key;
    const SSL_METHOD *method;
    method = isServer ? TLS_server_method() : TLS_client_method();

    dprintf("Called");

    /* Get user defined allowed protocols */

    X509 *peer;
    Tcl_Obj *objPtr;
    Tcl_Channel chan;
    char *channelName, *ciphers;
    int mode;
    const unsigned char *proto;
    unsigned int len;
    int nid;
    long res;

    dprintf("Called");

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

	LAPPEND_STR(interp, objPtr, "expansion", "none", -1);
#endif
    }

    /* Server info */
    {
	long mode = SSL_CTX_get_session_cache_mode(statePtr->ctx);
	const char *msg;

	if (mode & SSL_SESS_CACHE_OFF) {
	    msg = "off";
	} else if (mode & SSL_SESS_CACHE_CLIENT) {
	    msg = "client";
	} else if (mode & SSL_SESS_CACHE_SERVER) {
	    msg = "server";

		    BIO_free(out);
		} else {
		    out=BIO_new(BIO_s_file());
		    BIO_write_filename(out,keyout);
		    PEM_write_bio_PrivateKey(out,pkey,NULL,NULL,0,NULL,NULL);
		    /* PEM_write_bio_RSAPrivateKey(out, rsa, NULL, NULL, 0, NULL, NULL); */
		    BIO_free_all(out);
		}

		if ((cert=X509_new())==NULL) {
		    Tcl_SetResult(interp,"Error generating certificate request",NULL);
		    EVP_PKEY_free(pkey);
#if OPENSSL_VERSION_NUMBER < 0x30000000L
		    BN_free(bne);
#endif

 * Side effects:
 *	Shutdown SSL library
 *
 *------------------------------------------------------*
 */

void TlsLibShutdown(
    TCL_UNUSED(ClientData))
{
    dprintf("Called");

    BIO_cleanup();
}

/*

		dprintf("Got BIO_CTRL_CLOSE");
		/* Returns BIO_CLOSE, BIO_NOCLOSE, or <0 for failure. */
		ret = BIO_get_shutdown(bio);
		break;
	case BIO_CTRL_SET_CLOSE:
		/* man - Set the close on BIO_free() flag. Implements BIO_set_close. */
		dprintf("Got BIO_SET_CLOSE");
		BIO_set_shutdown(bio, (int)num);
		/* Returns 1 on success or <=0 for failure. */
		ret = 1;
		break;
	case BIO_CTRL_PENDING:
		/* opt - Return number of bytes in chan waiting to be read. Implements BIO_pending. */
		dprintf("Got BIO_CTRL_PENDING");
		/* Return the amount of pending data or 0 for error. */

 * Side effects:
 *	Closes the socket for the channel.
 *
 *-----------------------------------------------------------------------------
 */
static int TlsCloseProc(
    ClientData instanceData,	/* Connection state info */
    TCL_UNUSED(Tcl_Interp *))		/* Tcl interpreter to report errors to */
{
    State *statePtr = (State *) instanceData;

    dprintf("Close(%p)", (void *) statePtr);

    /* Send "close notify" shutdown notification. Will return 0 if in progress,
	and 1 when complete. Only closes the write direction of the connection;

#define TLS_TCL_SERVER		(1<<1)	/* Server-Side */
#define TLS_TCL_INIT		(1<<2)	/* Initializing connection */
#define TLS_TCL_DEBUG		(1<<3)	/* Show debug tracing */
#define TLS_TCL_CALLBACK	(1<<4)	/* In a callback, prevent update
					 * looping problem. [Bug 1652380] */
#define TLS_TCL_FATAL_ERROR	(1<<5)	/* Set on handshake failure or other fatal error. All
					 * further I/O will result in ECONNABORTED errors. */
#define TLS_TCL_FASTPATH	(1<<6)	/* The parent channel is being used
					 * directly by the SSL library. */
#define TLS_TCL_EOF		(1<<7)	/* At EOF. Can't read, but can write. */

/* Set timer delay */
#define TLS_TCL_DELAY (5)

/*
 * This structure describes the per-instance state of an SSL channel.
 *

	int vflags;		/* Verify flags */
	SSL *ssl;		/* Struct for SSL processing */
	SSL_CTX *ctx;		/* SSL Context */
	BIO *bio;		/* Struct for SSL processing */
	BIO *p_bio;		/* Parent BIO (that is layered on Tcl_Channel) */

	size_t protos_len; /* Length of protos */
	unsigned char *protos;	/* List of supported protocols in protocol format */

	const char *err;
} State;

#ifdef USE_TCL_STUBS
#ifndef Tcl_StackChannel

    const char *hex = "0123456789abcdef";

    if (resultObj == NULL) {
	return NULL;
    }

    for (int i = 0; i < ilen; i++) {
	*dptr++ = (unsigned char)hex[(*iptr>>4)&0xF];
	*dptr++ = (unsigned char)hex[(*iptr++)&0xF];
    }
    return resultObj;
}

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

 *	Purpose string
 *
 * Side effects:
 *	None
 *
 *-----------------------------------------------------------------------------
 */
const char *Tls_x509Purpose(X509 *cert) {
    const char *purpose = NULL;

    if (X509_check_purpose(cert, X509_PURPOSE_SSL_CLIENT, 0) > 0) {
	purpose = "SSL Client";
    } else if (X509_check_purpose(cert, X509_PURPOSE_SSL_SERVER, 0) > 0) {
	purpose = "SSL Server";
    } else if (X509_check_purpose(cert, X509_PURPOSE_NS_SSL_SERVER, 0) > 0) {
	purpose = "MSS SSL Server";

    Tcl_Size len;
    char buffer[1024];

    if (resultObj == NULL) {
	return NULL;
    }

    if ((names = (STACK_OF(GENERAL_NAME) *)X509_get_ext_d2i(cert, nid, NULL, 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, (GENERAL_NAME *) name), bio, buffer, 1024);
	    LAPPEND_STR(interp, resultObj, NULL, buffer, len);
	}
	sk_GENERAL_NAME_pop_free(names, GENERAL_NAME_free);

    STACK_OF(DIST_POINT) *crl;
    Tcl_Obj *resultObj = Tcl_NewListObj(0, NULL);

    if (resultObj == NULL) {
	return NULL;
    }

    if ((crl = (STACK_OF(DIST_POINT) *)X509_get_ext_d2i(cert, NID_crl_distribution_points, NULL, NULL)) != NULL) {
	for (int i=0; i < sk_DIST_POINT_num(crl); i++) {
	    DIST_POINT *dp = sk_DIST_POINT_value(crl, i);
	    DIST_POINT_NAME *distpoint = dp->distpoint;

	    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 = (ASN1_STRING *)GENERAL_NAME_get0_value(gen, &type);
		    if (type == GEN_URI) {
			LAPPEND_STR(interp, resultObj, (char *) NULL, (char *) ASN1_STRING_get0_data(uri), (Tcl_Size) ASN1_STRING_length(uri));
		    }
		}
	    } else if (distpoint->type == 1) {
		/* relative-name X509NAME */
		STACK_OF(X509_NAME_ENTRY) *sk_relname = distpoint->name.relativename;

    Tcl_Obj *resultObj = Tcl_NewListObj(0, NULL);
    unsigned char *buf;

    if (resultObj == NULL) {
	return NULL;
    }

    if ((ads = (STACK_OF(ACCESS_DESCRIPTION) *)X509_get_ext_d2i(cert, NID_info_access, NULL, NULL)) != NULL) {
	for (int i = 0; i < sk_ACCESS_DESCRIPTION_num(ads); i++) {
	    ad = (ACCESS_DESCRIPTION *)sk_ACCESS_DESCRIPTION_value(ads, i);
	    if (OBJ_obj2nid(ad->method) == NID_ad_ca_issuers && ad->location) {
		if (ad->location->type == GEN_URI) {
		    Tcl_Size len = (Tcl_Size) ASN1_STRING_to_UTF8(&buf, ad->location->d.uniformResourceIdentifier);
		    Tcl_ListObjAppendElement(interp, resultObj, Tcl_NewStringObj((char *) buf, len));
		    OPENSSL_free(buf);
		    break;
		}

    Tcl_Obj *resultObj = Tcl_NewListObj(0, NULL);
    BIO *bio = BIO_new(BIO_s_mem());
    int mdnid, pknid, bits;
    Tcl_Size len;
    unsigned int ulen;
    uint32_t xflags;
    unsigned long flags = XN_FLAG_RFC2253 | ASN1_STRFLGS_UTF8_CONVERT;
    flags &= ~(unsigned long)ASN1_STRFLGS_ESC_MSB;

    char *buffer = (char *)ckalloc(BUFSIZ > EVP_MAX_MD_SIZE ? BUFSIZ : EVP_MAX_MD_SIZE);

    dprintf("Called");

    if (interp == NULL || cert == NULL || bio == NULL || resultObj == NULL || buffer == NULL) {
	Tcl_DecrRefCount(resultObj);
	BIO_free(bio);
	if (buffer != NULL) ckfree(buffer);

	puts $fd $l
	puts $fd "---"
	close $fd
    }
    set callerSocket $s
    set ::errorInfo ""
    if {[catch {uplevel "#0" $l} msg]} {
	if {0} {
	    set fd [open remoteServer.log a]
	    puts $fd "error: $msg"
	    close $fd
	}
	set code error
    } else {
	set code success