#include <openssl/safestack.h>

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

/*
 * External functions
 */

/*
 * Forward declarations
 */

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

 *
 *	Monitors SSL certificate validation process. Used to control the
 *	behavior when the SSL_VERIFY_PEER flag is set. This is called
 *	whenever a certificate is inspected or decided invalid. Called for
 *	each certificate in the cert chain.
 *
 * Checks:
 *	certificate chain is checked starting with the deepest nesting level
 *	  (the root CA certificate) and worked upward to the peer's certificate.
 *	All signatures are valid, current time is within first and last validity time.
 *	Check that the certificate is issued by the issuer certificate issuer.
 *	Check the revocation status for each certificate.
 *	Check the validity of the given CRL and the cert revocation status.
 *	Check the policies of all the certificates
 *

    Tcl_IncrRefCount(cmdPtr);
    ok = EvalCallback(interp, statePtr, cmdPtr);
    Tcl_DecrRefCount(cmdPtr);

    dprintf("VerifyCallback: command result = %d", ok);

    /* statePtr->flags &= ~(TLS_TCL_CALLBACK); */
    return(ok);	/* By default, leave verification unchanged. */
}

/*
 *-------------------------------------------------------------------
 *
 * Tls_Error --
 *
 *	Calls callback with list of errors.
 *
 * Side effects:
 *	The err field of the currently operative State is set
 *	  to a string describing the SSL negotiation failure reason
 *
 *-------------------------------------------------------------------
 */

}

/*
 *-------------------------------------------------------------------
 *
 * Password Callback --
 *
 *	Called when a password for a private key loading/storing a PEM
 *	certificate with encryption. Evals callback script and returns
 *	the result as the password string in buf.
 *
 * Results:
 *	None
 *
 * Side effects:
 *	Calls callback (if defined)
 *
 * Returns:
 *	Password size in bytes or -1 for an error.
 *
 *-------------------------------------------------------------------
 */
static int
PasswordCallback(char *buf, int size, int rwflag, void *udata) {
    State *statePtr	= (State *) udata;
    Tcl_Interp *interp	= statePtr->interp;
    Tcl_Obj *cmdPtr;
    int code;


    dprintf("Called");

    /* If no callback, use default callback */
    if (statePtr->password == NULL) {
	if (Tcl_EvalEx(interp, "tls::password", -1, TCL_EVAL_GLOBAL) == TCL_OK) {
	    char *ret = (char *) Tcl_GetStringResult(interp);



	    strncpy(buf, ret, (size_t) size);

	    return (int)strlen(ret);
	} else {
	    return -1;
	}
    }

    /* Create command to eval with fn, rwflag, and size args */
    cmdPtr = Tcl_DuplicateObj(statePtr->password);

    }
    Tcl_DecrRefCount(cmdPtr);

    Tcl_Release((void *) statePtr);

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

    Tcl_ListObjAppendElement(interp, cmdPtr,
	Tcl_NewLongObj((long) SSL_SESSION_get_ticket_lifetime_hint(session)));

    /* Eval callback command */
    Tcl_IncrRefCount(cmdPtr);
    EvalCallback(interp, statePtr, cmdPtr);
    Tcl_DecrRefCount(cmdPtr);


    return 0;
}

/*
 *-------------------------------------------------------------------
 *
 * ALPN Callback for Servers and NPN Callback for Clients --

	res = SSL_CLIENT_HELLO_ERROR;
	*alert = SSL_R_TLSV1_ALERT_INTERNAL_ERROR;
    }
    Tcl_DecrRefCount(cmdPtr);
    return res;
}





/*
 *-------------------------------------------------------------------
 *
 * CiphersObjCmd -- list available ciphers
 *
 *	This procedure is invoked to process the "tls::ciphers" command
 *	to list available ciphers, based upon protocol selected.

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

    int ret = 1;
    int err = 0;

    dprintf("Called");

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

    ERR_clear_error();

    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);
    if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {
	Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan),
		"\": not a TLS channel", (char *)NULL);
	Tcl_SetErrorCode(interp, "TLS", "HANDSHAKE", "CHANNEL", "INVALID", (char *)NULL);
	return(TCL_ERROR);
    }
    statePtr = (State *)Tcl_GetChannelInstanceData(chan);

    dprintf("Calling Tls_WaitForConnect");
    ret = Tls_WaitForConnect(statePtr, &err, 1);
    dprintf("Tls_WaitForConnect returned: %i", ret);

	Tcl_AppendResult(interp, "handshake failed: ", errStr, (char *)NULL);
	if ((result = SSL_get_verify_result(statePtr->ssl)) != X509_V_OK) {
	    Tcl_AppendResult(interp, " due to \"", X509_verify_cert_error_string(result), "\"", (char *)NULL);
	}
	Tcl_SetErrorCode(interp, "TLS", "HANDSHAKE", "FAILED", (char *)NULL);
	dprintf("Returning TCL_ERROR with handshake failed: %s", errStr);
	return(TCL_ERROR);
    } else {
	if (err != 0) {
	    dprintf("Got an error with a completed handshake: err = %i", err);
	}
	ret = 1;
    }

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

/*
 *-------------------------------------------------------------------
 *
 * ImportObjCmd --
 *

    ERR_clear_error();

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

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

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

    Tcl_DStringFree(&upperChannelEncoding);
    Tcl_DStringFree(&upperChannelEOFChar);
    Tcl_DStringFree(&upperChannelBlocking);

    /*
     * SSL Initialization
     */

    statePtr->ssl = SSL_new(statePtr->ctx);
    if (!statePtr->ssl) {
	/* SSL library error */
	Tcl_AppendResult(interp, "couldn't construct ssl session: ", GET_ERR_REASON(), (char *)NULL);
	Tcl_SetErrorCode(interp, "TLS", "IMPORT", "INIT", "FAILED", (char *)NULL);
	Tls_Free((void *)statePtr);
	return TCL_ERROR;

	    char *str = Tcl_GetStringFromObj(list[j], &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 functions reverses the return value convention */
	if (SSL_set_alpn_protos(statePtr->ssl, protos, protos_len)) {
	    Tcl_AppendResult(interp, "Set ALPN protocols failed: ", GET_ERR_REASON(), (char *)NULL);
	    Tcl_SetErrorCode(interp, "TLS", "IMPORT", "ALPN", "FAILED", (char *)NULL);
	    Tls_Free((void *)statePtr);
	    ckfree(protos);
	    return TCL_ERROR;
	}

    }

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

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

	Tcl_AppendResult(interp, "SSL2 protocol not supported", (char *)NULL);
	return NULL;
    }
    if (ENABLED(proto, TLS_PROTO_SSL3)) {
	Tcl_AppendResult(interp, "SSL3 protocol not supported", (char *)NULL);
	return NULL;
    }
#if defined(NO_TLS1) || defined(OPENSSL_NO_TLS1) || defined(OPENSSL_NO_TLS1_METHOD)
    if (ENABLED(proto, TLS_PROTO_TLS1)) {
	Tcl_AppendResult(interp, "TLS 1.0 protocol not supported", (char *)NULL);
	return NULL;
    }
#endif
#if defined(NO_TLS1_1) || defined(OPENSSL_NO_TLS1_1) || defined(OPENSSL_NO_TLS1_1_METHOD)
    if (ENABLED(proto, TLS_PROTO_TLS1_1)) {
	Tcl_AppendResult(interp, "TLS 1.1 protocol not supported", (char *)NULL);
	return NULL;
    }
#endif
#if defined(NO_TLS1_2) || defined(OPENSSL_NO_TLS1_2) || defined(OPENSSL_NO_TLS1_2_METHOD)
    if (ENABLED(proto, TLS_PROTO_TLS1_2)) {
	Tcl_AppendResult(interp, "TLS 1.2 protocol not supported", (char *)NULL);
	return NULL;
    }
#endif
#if defined(NO_TLS1_3) || defined(OPENSSL_NO_TLS1_3) || defined(OPENSSL_NO_TLS1_3_METHOD)
    if (ENABLED(proto, TLS_PROTO_TLS1_3)) {
	Tcl_AppendResult(interp, "TLS 1.3 protocol not supported", (char *)NULL);
	return NULL;
    }
#endif
    if (proto == 0) {
	/* Use full range */

	break;
#endif
#if !defined(NO_TLS1_2) && !defined(OPENSSL_NO_TLS1_2) && !defined(OPENSSL_NO_TLS1_2_METHOD)
    case TLS_PROTO_TLS1_2:
	method = isServer ? TLSv1_2_server_method() : TLSv1_2_client_method();
	break;
#endif
#if !defined(NO_TLS1_3) && !defined(OPENSSL_NO_TLS1_3) && !defined(OPENSSL_NO_TLS1_3_METHOD)
    case TLS_PROTO_TLS1_3:
	/* Use the generic method and constraint range after context is created */
	method = isServer ? TLS_server_method() : TLS_client_method();
	break;
#endif
    default:
	/* Negotiate highest available SSL/TLS version */
	method = isServer ? TLS_server_method() : TLS_client_method();
#if !defined(NO_TLS1) && !defined(OPENSSL_NO_TLS1) && !defined(OPENSSL_NO_TLS1_METHOD)
	off |= (ENABLED(proto, TLS_PROTO_TLS1)   ? 0 : SSL_OP_NO_TLSv1);
#endif
#if !defined(NO_TLS1_1) && !defined(OPENSSL_NO_TLS1_1) && !defined(OPENSSL_NO_TLS1_1_METHOD)
	off |= (ENABLED(proto, TLS_PROTO_TLS1_1) ? 0 : SSL_OP_NO_TLSv1_1);
#endif
#if !defined(NO_TLS1_2) && !defined(OPENSSL_NO_TLS1_2) && !defined(OPENSSL_NO_TLS1_2_METHOD)
	off |= (ENABLED(proto, TLS_PROTO_TLS1_2) ? 0 : SSL_OP_NO_TLSv1_2);
#endif
#if !defined(NO_TLS1_3) && !defined(OPENSSL_NO_TLS1_3) && !defined(OPENSSL_NO_TLS1_3_METHOD)
	off |= (ENABLED(proto, TLS_PROTO_TLS1_3) ? 0 : SSL_OP_NO_TLSv1_3);
#endif
	break;
    }

    ERR_clear_error();

    ctx = SSL_CTX_new(method);
    if (!ctx) {
	return(NULL);
    }

    if (getenv(SSLKEYLOGFILE)) {
	SSL_CTX_set_keylog_callback(ctx, KeyLogCallback);
    }

#if !defined(NO_TLS1_3) && !defined(OPENSSL_NO_TLS1_3)

    }

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

    /* read a Diffie-Hellman parameters file, or use the built-in one */

#ifdef OPENSSL_NO_DH
    if (DHparams != NULL) {
	Tcl_AppendResult(interp, "DH parameter support not available", (char *)NULL);
	SSL_CTX_free(ctx);
	return NULL;
    }
#else
    {
	DH* dh;
	if (DHparams != NULL) {
	    BIO *bio;

	    bio = BIO_new_file(F2N(DHparams, &ds), "r");
	    if (!bio) {
		Tcl_DStringFree(&ds);
		Tcl_AppendResult(interp, "Could not find DH parameters file", (char *)NULL);
		SSL_CTX_free(ctx);
		return NULL;
	    }

		SSL_CTX_free(ctx);
		return NULL;
	    }
	}
	/* Now we know that a key and cert have been set against
	 * the SSL context */
	if (!SSL_CTX_check_private_key(ctx)) {
	    Tcl_AppendResult(interp,
		    "private key does not match the certificate public key",
		    (char *)NULL);
	    SSL_CTX_free(ctx);
	    return NULL;
	}
    }

    /* Set to use default location and file for Certificate Authority (CA) certificates. The
     * verify path and store can be overridden by the SSL_CERT_DIR env var. The verify file can
     * be overridden by the SSL_CERT_FILE env var. */
    if (!SSL_CTX_set_default_verify_paths(ctx)) {
	abort++;
    }

    /* Overrides for the CA verify path and file */
    {
#if OPENSSL_VERSION_NUMBER < 0x30000000L
	if (CApath != NULL || CAfile != NULL) {
	    Tcl_DString ds1;


	    if (!SSL_CTX_load_verify_locations(ctx, F2N(CAfile, &ds), F2N(CApath, &ds1))) {
		abort++;
	    }
	    Tcl_DStringFree(&ds);
	    Tcl_DStringFree(&ds1);

	    /* Set list of CAs to send to client when requesting a client certificate */

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


    channelName = Tcl_GetString(objv[(objc == 2 ? 1 : 2)]);
    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);
    if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {
	Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan),
		"\": not a TLS channel", (char *)NULL);
	Tcl_SetErrorCode(interp, "TLS", "STATUS", "CHANNEL", "INVALID", (char *)NULL);
	return TCL_ERROR;
    }

    const SSL *ssl;
    const SSL_CIPHER *cipher;
    const SSL_SESSION *session;
    const EVP_MD *md;

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

    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);
    if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {
	Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan),
	    "\": not a TLS channel", NULL);
	Tcl_SetErrorCode(interp, "TLS", "CONNECTION", "CHANNEL", "INVALID", (char *)NULL);
	return(TCL_ERROR);
    }

    objPtr = Tcl_NewListObj(0, NULL);

    /* Connection info */
    statePtr = (State *)Tcl_GetChannelInstanceData(chan);
    ssl = statePtr->ssl;

    dprintf("Called");

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?args?");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], commands,
	    "command", 0,&cmd) != TCL_OK) {
	return TCL_ERROR;
    }

    ERR_clear_error();

    isStr = (cmd == C_STRREQ);
    switch ((enum command) cmd) {

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

		X509_set_version(cert,2);
		ASN1_INTEGER_set(X509_get_serialNumber(cert),serial);
		X509_gmtime_adj(X509_getm_notBefore(cert),0);
		X509_gmtime_adj(X509_getm_notAfter(cert),(long)60*60*24*days);
		X509_set_pubkey(cert,pkey);

		name=X509_get_subject_name(cert);

		X509_NAME_add_entry_by_txt(name,"C", MBSTRING_ASC, (unsigned char *) k_C, -1, -1, 0);
		X509_NAME_add_entry_by_txt(name,"ST", MBSTRING_ASC, (unsigned char *) k_ST, -1, -1, 0);
		X509_NAME_add_entry_by_txt(name,"L", MBSTRING_ASC, (unsigned char *) k_L, -1, -1, 0);
		X509_NAME_add_entry_by_txt(name,"O", MBSTRING_ASC, (unsigned char *) k_O, -1, -1, 0);
		X509_NAME_add_entry_by_txt(name,"OU", MBSTRING_ASC, (unsigned char *) k_OU, -1, -1, 0);
		X509_NAME_add_entry_by_txt(name,"CN", MBSTRING_ASC, (unsigned char *) k_CN, -1, -1, 0);
		X509_NAME_add_entry_by_txt(name,"Email", MBSTRING_ASC, (unsigned char *) k_Email, -1, -1, 0);

		X509_set_subject_name(cert,name);

		if (!X509_sign(cert,pkey,EVP_sha256())) {
		    X509_free(cert);
		    EVP_PKEY_free(pkey);
#if OPENSSL_VERSION_NUMBER < 0x30000000L

 *		A standard Tcl error code.
 *
 *------------------------------------------------------*
 */

DLLEXPORT int Tls_SafeInit(Tcl_Interp *interp) {
    dprintf("Called");
    return(Tls_Init(interp));
}

/*
 *------------------------------------------------------*
 *
 *	TlsLibInit --
 *

    size_t num_locks;
#endif

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

	    return(TCL_OK);
	}

	dprintf("Asked to uninitialize");

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

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

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

	return(TCL_OK);
    }

    if (initialized) {
	dprintf("Called, but using cached value");
	return(status);
    }

    dprintf("Called");

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

    BIO_new_tcl(NULL, 0);

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

    return(status);
}

#define BIO_meth_set_read(bio, val)      (bio)->bread = val;
#define BIO_meth_set_puts(bio, val)      (bio)->bputs = val;
#define BIO_meth_set_ctrl(bio, val)      (bio)->ctrl = val;
#define BIO_meth_set_create(bio, val)    (bio)->create = val;
#define BIO_meth_set_destroy(bio, val)   (bio)->destroy = val;
#endif


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

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

    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;

    } else if (ret == 0) {
	dprintf("Got 0 from Tcl_WriteRaw, and EOF is not set; ret = 0");
	dprintf("Setting retry read flag");
	BIO_set_retry_read(bio);

    } else if (ret < 0) {
	dprintf("We got some kind of I/O error");

	if (tclErrno == EAGAIN) {
	    dprintf("It's EAGAIN");
	} else {
	    dprintf("It's an unexpected error: %s/%i", Tcl_ErrnoMsg(tclErrno), tclErrno);
	}

    } else {
	dprintf("Successfully wrote %" TCL_SIZE_MODIFIER "d bytes of data", ret);
    }

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

    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;

    } else if (ret == 0) {
	dprintf("Got 0 from Tcl_Read or Tcl_ReadRaw, and EOF is not set; ret = 0");
	dprintf("Setting retry read flag");
	BIO_set_retry_read(bio);

    } else if (ret < 0) {
	dprintf("We got some kind of I/O error");

	if (tclErrno == EAGAIN) {
	    dprintf("It's EAGAIN");
	} else {
	    dprintf("It's an unexpected error: %s/%i", Tcl_ErrnoMsg(tclErrno), tclErrno);
	}

    } else {
	dprintf("Successfully read %" TCL_SIZE_MODIFIER "d bytes of data", ret);
    }

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

	case BIO_CTRL_GET_KTLS_RECV:
		dprintf("Got BIO_CTRL_GET_KTLS_RECV");
		ret = 0;
		break;
#endif
	default:
		dprintf("Got unknown control command (%i)", cmd);
		ret = -2;
		break;
    }
    return ret;
}

static int BioNew(BIO *bio) {
    dprintf("BioNew(%p) called", bio);

    BIO_set_init(bio, 0);
    BIO_set_data(bio, NULL);
    BIO_clear_flags(bio, -1);
    return 1;
}

static int BioFree(BIO *bio) {
    if (bio == NULL) {
	return(0);
    }

    dprintf("BioFree(%p) called", bio);

    if (BIO_get_shutdown(bio)) {
	if (BIO_get_init(bio)) {
	    /*shutdown(bio->num, 2) */

	BIO_meth_set_create(BioMethods, BioNew);
	BIO_meth_set_destroy(BioMethods, BioFree);
    }

    if (statePtr == NULL) {
	dprintf("Asked to setup a NULL state, just creating the initial configuration");

	return(NULL);
    }

#ifdef TCLTLS_SSL_USE_FASTPATH
    /*
     * If the channel can be mapped back to a file descriptor, just use the file descriptor
     * with the SSL library since it will likely be optimized for this.
     */

	}
    }

    if (validParentChannelFd) {
	dprintf("We found a shortcut, this channel is backed by a socket: %i", parentChannelFdIn);
	bio = BIO_new_socket(parentChannelFd, flags);
	statePtr->flags |= TLS_TCL_FASTPATH;
	return(bio);
    }

    dprintf("Falling back to Tcl I/O for this channel");
#endif

    bio = BIO_new(BioMethods);
    BIO_set_data(bio, statePtr);
    BIO_set_shutdown(bio, flags);
    BIO_set_init(bio, 1);
    return(bio);
}

    State *statePtr = (State *)instanceData;

    if (mode == TCL_MODE_NONBLOCKING) {
	statePtr->flags |= TLS_TCL_ASYNC;
    } else {
	statePtr->flags &= ~(TLS_TCL_ASYNC);
    }
    return(0);
}

/*
 *-------------------------------------------------------------------
 *
 * TlsClose2Proc --
 *

    *errorCodePtr = 0;

    dprintf("WaitForConnect(%p)", statePtr);
    dprintFlags(statePtr);

    if (!(statePtr->flags & TLS_TCL_INIT)) {
	dprintf("Tls_WaitForConnect called on already initialized channel -- returning with immediate success");
	return(0);
    }

    if (statePtr->flags & TLS_TCL_HANDSHAKE_FAILED) {
	/*
	 * Different types of operations have different requirements
	 * SSL being established
	 */
	if (handshakeFailureIsPermanent) {
	    dprintf("Asked to wait for a TLS handshake that has already failed.  Returning fatal error");
	    *errorCodePtr = ECONNABORTED;
	} else {
	    dprintf("Asked to wait for a TLS handshake that has already failed.  Returning soft error");
	    *errorCodePtr = ECONNRESET;
	}
	Tls_Error(statePtr, "Wait for failed handshake");
	return(-1);
    }

    for (;;) {
	ERR_clear_error();

	/* Not initialized yet! Also calls SSL_do_handshake. */
	if (statePtr->flags & TLS_TCL_SERVER) {
	    dprintf("Calling SSL_accept()");
	    err = SSL_accept(statePtr->ssl);

	} else {
	    dprintf("Calling SSL_connect()");
	    err = SSL_connect(statePtr->ssl);
	}

	if (err > 0) {
	    dprintf("Accept or connect was successful");

	if (bioShouldRetry) {
	    dprintf("The I/O did not complete -- but we should try it again");

	    if (statePtr->flags & TLS_TCL_ASYNC) {
		dprintf("Returning EAGAIN so that it can be retried later");
		*errorCodePtr = EAGAIN;
		Tls_Error(statePtr, "Handshake not complete, will retry later");
		return(-1);
	    } else {
		dprintf("Doing so now");
		continue;
	    }
	}

	dprintf("We have either completely established the session or completely failed it -- there is no more need to ever retry it though");
	break;
    }

    switch (rc) {
	case SSL_ERROR_NONE:
	    /* The TLS/SSL I/O operation completed */
	    dprintf("The connection is good");
	    *errorCodePtr = 0;
	    break;

	case SSL_ERROR_ZERO_RETURN:
	    /* The TLS/SSL peer has closed the connection for writing by sending the close_notify alert */
	    dprintf("SSL_ERROR_ZERO_RETURN: Connect returned an invalid value...");
	    *errorCodePtr = EINVAL;
	    Tls_Error(statePtr, "Peer has closed the connection for writing by sending the close_notify alert");
	    return(-1);

	case SSL_ERROR_SYSCALL:
	    /* Some non-recoverable, fatal I/O error occurred */
	    dprintf("SSL_ERROR_SYSCALL");

	    if (backingError == 0 && err == 0) {
		dprintf("EOF reached")

		    *errorCodePtr = ECONNABORTED;
		}
		Tls_Error(statePtr, (char *) ERR_reason_error_string(backingError));
	    }

	    statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED;
	    return -1;

	case SSL_ERROR_SSL:
	    /* A non-recoverable, fatal error in the SSL library occurred, usually a protocol error */
	    dprintf("SSL_ERROR_SSL: Got permanent fatal SSL error, aborting immediately");
	    if (SSL_get_verify_result(statePtr->ssl) != X509_V_OK) {
		Tls_Error(statePtr, (char *) X509_verify_cert_error_string(SSL_get_verify_result(statePtr->ssl)));
	    }
	    if (backingError != 0) {
		Tls_Error(statePtr, (char *) ERR_reason_error_string(backingError));
	    }
	    statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED;
	    *errorCodePtr = ECONNABORTED;
	    return(-1);
	default:
	    /* The operation did not complete and should be retried later. */
	    dprintf("Operation did not complete, call function again later: %i", rc);
	    *errorCodePtr = EAGAIN;
	    dprintf("ERR(%d, %d) ", rc, *errorCodePtr);
	    Tls_Error(statePtr, "Operation did not complete, call function again later");
	    return(-1);
    }

    dprintf("Removing the \"TLS_TCL_INIT\" flag since we have completed the handshake");
    statePtr->flags &= ~TLS_TCL_INIT;

    dprintf("Returning in success");
    *errorCodePtr = 0;

    *errorCodePtr = 0;

    dprintf("BIO_read(%d)", bufSize);

    if (statePtr->flags & TLS_TCL_CALLBACK) {
	/* don't process any bytes while verify callback is running */
	dprintf("Callback is running, reading 0 bytes");
	return(0);
    }

    dprintf("Calling Tls_WaitForConnect");
    tlsConnect = Tls_WaitForConnect(statePtr, errorCodePtr, 0);
    if (tlsConnect < 0) {
	dprintf("Got an error waiting to connect (tlsConnect = %i, *errorCodePtr = %i)", tlsConnect, *errorCodePtr);
	Tls_Error(statePtr, strerror(*errorCodePtr));

	bytesRead = -1;
	if (*errorCodePtr == ECONNRESET) {
	    dprintf("Got connection reset");
	    /* Soft EOF */
	    *errorCodePtr = 0;
	    bytesRead = 0;
	}
	return(bytesRead);
    }

    /*
     * We need to clear the SSL error stack now because we sometimes reach
     * this function with leftover errors in the stack.  If BIO_read
     * returns -1 and intends EAGAIN, there is a leftover error, it will be
     * misconstrued as an error, not EAGAIN.

    }
#endif

    switch (err) {
	case SSL_ERROR_NONE:
	    dprintBuffer(buf, bytesRead);
	    break;

	case SSL_ERROR_SSL:
	    /* A non-recoverable, fatal error in the SSL library occurred, usually a protocol error */
	    dprintf("SSL error, indicating that the connection has been aborted");
	    if (backingError != 0) {
		Tls_Error(statePtr, (char *) ERR_reason_error_string(backingError));
	    } else if (SSL_get_verify_result(statePtr->ssl) != X509_V_OK) {
		Tls_Error(statePtr, (char *) X509_verify_cert_error_string(SSL_get_verify_result(statePtr->ssl)));

    dprintf("BIO_write(%p, %d)", (void *) statePtr, toWrite);
    dprintBuffer(buf, toWrite);

    if (statePtr->flags & TLS_TCL_CALLBACK) {
	dprintf("Don't process output while callbacks are running");
	written = -1;
	*errorCodePtr = EAGAIN;
	return(-1);
    }

    dprintf("Calling Tls_WaitForConnect");
    tlsConnect = Tls_WaitForConnect(statePtr, errorCodePtr, 1);
    if (tlsConnect < 0) {
	dprintf("Got an error waiting to connect (tlsConnect = %i, *errorCodePtr = %i)", tlsConnect, *errorCodePtr);
	Tls_Error(statePtr, strerror(*errorCodePtr));

	written = -1;
	if (*errorCodePtr == ECONNRESET) {
	    dprintf("Got connection reset");
	    /* Soft EOF */
	    *errorCodePtr = 0;
	    written = 0;
	}
	return(written);
    }

    if (toWrite == 0) {
	dprintf("zero-write");
	err = BIO_flush(statePtr->bio);

	if (err <= 0) {
	    dprintf("Flushing failed");
	    Tls_Error(statePtr, "Flush failed");

	    *errorCodePtr = EIO;
	    written = 0;
	    return(-1);
	}

	written = 0;
	*errorCodePtr = 0;
	return(0);
    }

    /*
     * We need to clear the SSL error stack now because we sometimes reach
     * this function with leftover errors in the stack.  If BIO_write
     * returns -1 and intends EAGAIN, there is a leftover error, it will be
     * misconstrued as an error, not EAGAIN.
     *
     * Alternatively, we may want to handle the <0 return codes from
     * BIO_write specially (as advised in the RSA docs).  TLS's lower level
     * BIO functions play with the retry flags though, and this seems to
     * work correctly.  Similar fix in TlsInputProc. - hobbs
     */
    ERR_clear_error();
    written = BIO_write(statePtr->bio, buf, toWrite);
    dprintf("BIO_write(%p, %d) -> [%d]", (void *) statePtr, toWrite, written);

    err = SSL_get_error(statePtr->ssl, written);
    backingError = ERR_get_error();

    switch (err) {
	case SSL_ERROR_NONE:
	    if (written < 0) {
		written = 0;
	    }
	    break;

	case SSL_ERROR_WANT_WRITE:
	    dprintf("Got SSL_ERROR_WANT_WRITE, mapping it to EAGAIN");
	    *errorCodePtr = EAGAIN;
	    written = -1;
	    Tls_Error(statePtr, "SSL_ERROR_WANT_WRITE");
	    break;

	case SSL_ERROR_WANT_READ:
	    dprintf(" write R BLOCK");
	    Tls_Error(statePtr, "SSL_ERROR_WANT_READ");
	    break;

	case SSL_ERROR_WANT_X509_LOOKUP:
	    dprintf(" write X BLOCK");
	    Tls_Error(statePtr, "SSL_ERROR_WANT_X509_LOOKUP");
	    break;

	case SSL_ERROR_ZERO_RETURN:
	    dprintf(" closed");
	    written = 0;
	    *errorCodePtr = 0;
	    Tls_Error(statePtr, "Peer has closed the connection for writing by sending the close_notify alert");
	    break;

	case SSL_ERROR_SYSCALL:
	    /* Some non-recoverable, fatal I/O error occurred */

	    if (backingError == 0 && written == 0) {
		dprintf("EOF reached")
		*errorCodePtr = 0;
		written = 0;

	    } else {
		dprintf("I/O error occurred (backingError = %lu)", backingError);
		*errorCodePtr = Tcl_GetErrno();
		written = -1;
		Tls_Error(statePtr, (char *) ERR_reason_error_string(backingError));
	    }
	    break;

	case SSL_ERROR_SSL:
	    /* A non-recoverable, fatal error in the SSL library occurred, usually a protocol error */
	    dprintf("SSL error, indicating that the connection has been aborted");
	    if (backingError != 0) {
		Tls_Error(statePtr, (char *) ERR_reason_error_string(backingError));
	    } else if (SSL_get_verify_result(statePtr->ssl) != X509_V_OK) {
		Tls_Error(statePtr, (char *) X509_verify_cert_error_string(SSL_get_verify_result(statePtr->ssl)));
	    } else {
		Tls_Error(statePtr, "Unknown SSL error");
	    }
	    *errorCodePtr = ECONNABORTED;
	    written = -1;
	    break;

	default:
	    dprintf("unknown error: %d", err);
	    Tls_Error(statePtr, "Unknown error");
	    break;
    }

    dprintf("Output(%d) -> %d", toWrite, written);
    return(written);
}

/*
 *-------------------------------------------------------------------
 *
 * TlsSetOptionProc --
 *

static int TlsGetHandleProc(
    void *instanceData,    /* Socket state. */
    int direction,		/* TCL_READABLE or TCL_WRITABLE */
    void **handlePtr)	/* Handle associated with the channel */
{
    State *statePtr = (State *)instanceData;

    return(Tcl_GetChannelHandle(Tls_GetParent(statePtr, TLS_TCL_FASTPATH), direction, handlePtr));
}

/*
 *-------------------------------------------------------------------
 *
 * TlsNotifyProc --
 *

	}

	dprintf("Tls_WaitForConnect returned an error");
    }

    dprintf("Returning %i", mask);

    return(mask);
}

/*
 *------------------------------------------------------*
 *
 *    TlsChannelHandlerTimer --
 *

}

Tcl_Channel Tls_GetParent(State *statePtr, int maskFlags) {
    dprintf("Requested to get parent of channel %p", statePtr->self);

    if ((statePtr->flags & ~maskFlags) & TLS_TCL_FASTPATH) {
	dprintf("Asked to get the parent channel while we are using FastPath -- returning NULL");
	return(NULL);
    }
    return Tcl_GetStackedChannel(statePtr->self);
}

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