/*
 * Provides Custom BIO layer to interface OpenSSL with TCL. These functions
 * directly interface between the TCL IO channel and BIO buffers.
 *
 * Copyright (C) 1997-2000 Matt Newman <[email protected]>
 * Copyright (C) 2024 Brian O'Hagan
 *
 */
 * Provides BIO layer to interface OpenSSL to TCL.
 */

/*
		tlsBIO.c				tlsIO.c
  +------+                         +-----+                                     +------+
  |      |Tcl_WriteRaw <-- BioWrite| SSL |BIO_write <-- TlsOutputProc <-- Write|      |
  |socket|      <encrypted>        | BIO |            <unencrypted>            | App  |
  |      |Tcl_ReadRaw  -->  BioRead|     |BIO_Read  --> TlsInputProc  -->  Read|      |
  +------+                         +-----+                                     +------+
*/

#include "tlsInt.h"
#include <openssl/bio.h>

/* Called by SSL_write() */
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);

/* Define BIO methods structure */
static BIO_METHOD *BioMethods = NULL;



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

 *	Determine if should retry operation based on error code. Same
 *	conditions as BIO_sock_should_retry function.
 *
    ret = Tcl_WriteRaw(chan, buf, (Tcl_Size) bufLen);
 * Results:
 *	1 = retry, 0 = no retry
 *
 * Side effects:
 *	None
 *
 *-----------------------------------------------------------------------------
 */

static int BIOShouldRetry(int code) {
    int res = 0;
    dprintf("BIOShouldRetry %d=%s", code, Tcl_ErrnoMsg(code));
    tclEofChan = Tcl_Eof(chan);
    tclErrno = Tcl_GetErrno();

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

    BIO_clear_flags(bio, BIO_FLAGS_WRITE | BIO_FLAGS_SHOULD_RETRY);


    if (code == EAGAIN || code == EWOULDBLOCK || code == ENOTCONN || code == EPROTO ||
#ifdef _WIN32
	code == WSAEWOULDBLOCK ||
#endif
	code == EINTR || code == EINPROGRESS || code == EALREADY) {
	res = 1;
    }

    dprintf("BIOShouldRetry %d=%s, res=%d", code, Tcl_ErrnoMsg(code), res);

    return res;
}

/*
 *-----------------------------------------------------------------------------
 *
    if (tclEofChan && ret <= 0) {
	dprintf("Got EOF while reading, returning a Connection Reset error which maps to Soft EOF");
	Tcl_SetErrno(ECONNRESET);
 * BioWrite --
 *
 *	This function is used to read encrypted data from the BIO and write it
 *	into the socket. This function will be called in response to the
 *	application calling the BIO_write_ex() or BIO_write() functions.
 *
 * Results:
 *	Returns the number of bytes written to channel, 0 for EOF, or -1 for
 *	error.
	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);
 *
 * Side effects:
 *	Writes BIO data to channel.
 *
 *-----------------------------------------------------------------------------
 */

static int BioWrite(BIO *bio, const char *buf, int bufLen) {
    Tcl_Size ret;
    int is_eof, tclErrno;
    State *statePtr = (State *) BIO_get_data(bio);
    Tcl_Channel chan = Tls_GetParent(statePtr, 0);

    dprintf("[chan=%p] BioWrite(bio=%p, buf=%p, len=%d)", (void *)chan, (void *) bio, buf, bufLen);
    } else if (ret < 0) {
	dprintf("We got some kind of I/O error");

    BIO_clear_retry_flags(bio);
    Tcl_SetErrno(0);

    /* Write data to underlying channel */
    ret = Tcl_WriteRaw(chan, buf, (Tcl_Size) bufLen);
    is_eof = Tcl_Eof(chan);
    tclErrno = Tcl_GetErrno();

    dprintf("[chan=%p] BioWrite(%d) -> %" TCL_SIZE_MODIFIER "d [tclEof=%d; tclErrno=%d: %s]",
	(void *) chan, bufLen, ret, is_eof, tclErrno, Tcl_ErrnoMsg(tclErrno));
	if (tclErrno == EAGAIN) {
	    dprintf("It's EAGAIN");

    if (ret > 0) {
	dprintf("Successfully wrote %" TCL_SIZE_MODIFIER "d bytes of data", ret);

    } else if (ret == 0) {
	if (is_eof) {
	    dprintf("Got EOF while writing, returning a Connection Reset error which maps to Soft EOF");
	    Tcl_SetErrno(ECONNRESET);
	    BIO_set_flags(bio, BIO_FLAGS_IN_EOF);

	} else {
	    dprintf("Got 0 from Tcl_WriteRaw, and EOF is not set; ret = 0");
	    BIO_set_retry_write(bio);
	    dprintf("It's an unexpected error: %s/%i", Tcl_ErrnoMsg(tclErrno), tclErrno);

	    dprintf("Setting retry read flag");
	    BIO_set_retry_read(bio);
	}

    } else {
	dprintf("Successfully wrote %" TCL_SIZE_MODIFIER "d bytes of data", ret);
    }
	dprintf("We got some kind of I/O error");

	if (BIOShouldRetry(tclErrno)) {
	    dprintf("Try again for: %i=%s", tclErrno, Tcl_ErrnoMsg(tclErrno));
	    BIO_set_retry_write(bio);

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

	} else {
	    dprintf("Unexpected error: %i=%s", tclErrno, Tcl_ErrnoMsg(tclErrno));
	}
	    BIO_set_retry_read(bio);
	}
    }
    }

    dprintf("BioWrite returning %" TCL_SIZE_MODIFIER "d", ret);
    return (int) ret;
}

/*
 *-----------------------------------------------------------------------------
 *
 * BioRead --
 *
 *	This function is used to read encrypted data from the socket and
 *	write it into the BIO. This function will be called in response to the
 *	application calling the BIO_read_ex() or BIO_read() functions.
 *
 * Results:
 *	Returns the number of bytes read from channel, 0 for EOF, or -1 for
 *	error.
 *
 * Side effects:
 *	Reads channel data into BIO.
 *
 * Data is received in whole blocks known as records from the peer. A whole
 * record is processed (e.g. decrypted) in one go and is buffered by OpenSSL
 * until it is read by the application via a call to SSL_read. SSL_pending()
 * returns the number of bytes which have been processed, buffered, and are
 * available inside ssl for immediate read. SSL_has_pending() returns 1 if
 * data is buffered (whether processed or unprocessed) and 0 otherwise.
 *
 *-----------------------------------------------------------------------------
 */
/* Called by SSL_read()*/

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);
    int is_eof, tclErrno, is_blocked;
    State *statePtr = (State *) BIO_get_data(bio);
    Tcl_Channel chan = Tls_GetParent(statePtr, 0);

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

    if (buf == NULL) {
    if (buf == NULL || bufLen <= 0) {
	return 0;
    }

    BIO_clear_retry_flags(bio);
    Tcl_SetErrno(0);

    /* Read data from underlying channel */
    ret = Tcl_ReadRaw(chan, buf, (Tcl_Size) bufLen);

    tclEofChan = Tcl_Eof(chan);
    is_eof = Tcl_Eof(chan);
    tclErrno = Tcl_GetErrno();
    is_blocked = Tcl_InputBlocked(chan);

    dprintf("[chan=%p] BioRead(%d) -> %" TCL_SIZE_MODIFIER "d [tclEof=%d; tclErrno=%d]",
	(void *) chan, bufLen, ret, tclEofChan, tclErrno);
    dprintf("[chan=%p] BioRead(%d) -> %" TCL_SIZE_MODIFIER "d [tclEof=%d; blocked=%d; tclErrno=%d: %s]",
	(void *) chan, bufLen, ret, is_eof, is_blocked, tclErrno, Tcl_ErrnoMsg(tclErrno));

    BIO_clear_flags(bio, BIO_FLAGS_READ | BIO_FLAGS_SHOULD_RETRY);
    if (ret > 0) {
	dprintf("Successfully read %" TCL_SIZE_MODIFIER "d bytes of data", ret);

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

    } else if (ret == 0) {
	} else if (is_blocked) {
	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("Got input blocked from Tcl_ReadRaw. Setting retry read flag");
	    BIO_set_retry_read(bio);
	}

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

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


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

	} else {
	    dprintf("Unexpected error: %i=%s", tclErrno, Tcl_ErrnoMsg(tclErrno));
	}
    }
    if (ret != -1 || (ret == -1 && tclErrno == EAGAIN)) {
	if (BIO_should_write(bio)) {
	    dprintf("Setting should retry write flag");

    dprintf("BioRead returning %" TCL_SIZE_MODIFIER "d", ret);
	    BIO_set_retry_write(bio);
	}
    }

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

    return (int) ret;
}

/*
 *-----------------------------------------------------------------------------
 *
 * BioPuts --
 *
 *	This function is used to read a NULL terminated string from the BIO and
 *	write it to the channel. This function will be called in response to
 *	the application calling the BIO_puts() function.
 *
 * Results:
 *	Returns the number of bytes written to channel or 0 for error.
 *
 * Side effects:
 *	Writes data to channel.
 *
    return (int) ret;
}
 *-----------------------------------------------------------------------------
 */


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

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

/*
 *-----------------------------------------------------------------------------
 *
 * BioCtrl --
 *
 *	This function is used to process control messages in the BIO. This
 *	function will be called in response to the application calling the
 *	BIO_ctrl() function.
 *
 * Results:
 *	Function dependent
 *
 * Side effects:
 *	Function dependent
 *
 *-----------------------------------------------------------------------------
 */

static long BioCtrl(BIO *bio, int cmd, long num, void *ptr) {
    Tcl_Channel chan;
    long ret = 1;

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

    dprintf("BioCtrl(%p, 0x%x, 0x%lx, %p)", (void *) bio, cmd, num, ptr);

    switch (cmd) {
	case BIO_CTRL_RESET:
		/* opt - Resets BIO to initial state. Implements BIO_reset. */
		dprintf("Got BIO_CTRL_RESET");
		ret = 0;
		break;
	case BIO_C_FILE_SEEK:
		/* Return 1 for success (0 for file BIOs) and -1 for failure */
		dprintf("Got BIO_C_FILE_SEEK");
		ret = 0;
		break;
	case BIO_C_FILE_TELL:
		dprintf("Got BIO_C_FILE_TELL");
		ret = 0;
	case BIO_CTRL_EOF:
		/* opt - Returns whether EOF has been reached. Implements BIO_eof. */
		dprintf("Got BIO_CTRL_EOF");
		/* Returns 1 if EOF has been reached, 0 if not, or <0 for failure */
		ret = ((chan) ? (Tcl_Eof(chan) || BIO_test_flags(bio, BIO_FLAGS_IN_EOF)) : 1);
		break;
	case BIO_CTRL_INFO:
		/* opt - extra info on BIO. Implements BIO_get_mem_data */
		dprintf("Got BIO_CTRL_INFO");
		ret = 1;
		ret = 0;
		break;
	case BIO_C_SET_FD:
		dprintf("Unsupported call: BIO_C_SET_FD");
		ret = -1;
		break;
	case BIO_C_GET_FD:
		dprintf("Unsupported call: BIO_C_GET_FD");
		ret = -1;
		break;
	case BIO_CTRL_GET_CLOSE:
	case BIO_CTRL_SET:
		dprintf("Got BIO_CTRL_CLOSE");
		ret = BIO_get_shutdown(bio);
		/* man - set the 'IO' parameter */
		break;
	case BIO_CTRL_SET_CLOSE:
		dprintf("Got BIO_SET_CLOSE");
		BIO_set_shutdown(bio, num);
		break;
	case BIO_CTRL_EOF:
		dprintf("Got BIO_CTRL_EOF");
		dprintf("Got BIO_CTRL_SET");
		ret = ((chan) ? Tcl_Eof(chan) : 1);
		break;
	case BIO_CTRL_PENDING:
		dprintf("Got BIO_CTRL_PENDING");
		ret = ((chan) ? ((Tcl_InputBuffered(chan) ? 1 : 0)) : 0);
		dprintf("BIO_CTRL_PENDING(%d)", (int) ret);
		break;
	case BIO_CTRL_WPENDING:
		dprintf("Got BIO_CTRL_WPENDING");
		ret = 0;
		break;
	case BIO_CTRL_DUP:
		dprintf("Got BIO_CTRL_DUP");
	case BIO_CTRL_GET:
		/* man - get the 'IO' parameter */
		break;
	case BIO_CTRL_FLUSH:
		dprintf("Got BIO_CTRL_FLUSH");
		ret = ((chan) && (Tcl_WriteRaw(chan, "", 0) >= 0) ? 1 : -1);
		dprintf("Got BIO_CTRL_GET ");
		ret = 0;
		dprintf("BIO_CTRL_FLUSH returning value %li", ret);
		break;
	case BIO_CTRL_PUSH:
		/* opt - internal, used to signify change. Implements BIO_push */
		dprintf("Got BIO_CTRL_PUSH");
		ret = 0;
		break;
	case BIO_CTRL_POP:
		/* opt - internal, used to signify change. Implements BIO_pop */
		dprintf("Got BIO_CTRL_POP");
		ret = 0;
		break;
	case BIO_CTRL_SET:
		dprintf("Got BIO_CTRL_SET");
		ret = 0;
	case BIO_CTRL_GET_CLOSE:
		/* man - Get the close on BIO_free() flag set by BIO_CTRL_SET_CLOSE. Implements BIO_get_close */
		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, num);
		/* Returns 1 on success or <=0 for failure */
		ret = 1;
		break;
	case BIO_CTRL_GET :
		dprintf("Got BIO_CTRL_GET ");
	case BIO_CTRL_PENDING:
		/* opt - Return number of bytes in BIO waiting to be read. Implements BIO_pending. */
		dprintf("Got BIO_CTRL_PENDING");
		/* Return the amount of pending data or 0 for error */
		ret = ((chan) ? Tcl_InputBuffered(chan) : 0);
		break;
	case BIO_CTRL_FLUSH:
		/* opt - Flush any buffered output. Implements BIO_flush. */
		dprintf("Got BIO_CTRL_FLUSH");
		/* Use Tcl_WriteRaw instead of Tcl_Flush to operate on right chan in stack */
		/* Returns 1 for success, <=0 for error/retry. */
		ret = ((chan) && (Tcl_WriteRaw(chan, "", 0) >= 0) ? 1 : -1);
		/*ret = BioWrite(bio, NULL, 0);*/
		break;
	case BIO_CTRL_DUP:
		/* man - extra stuff for 'duped' BIO. Implements BIO_dup_state */
		dprintf("Got BIO_CTRL_DUP");
		ret = 1;
		break;
	case BIO_CTRL_WPENDING:
		/* opt - Return number of bytes in BIO still to be written. Implements BIO_wpending. */
		dprintf("Got BIO_CTRL_WPENDING");
		/* Return the amount of pending data or 0 for error */
		ret = ((chan) ? Tcl_OutputBuffered(chan) : 0);
		break;
	case BIO_CTRL_SET_CALLBACK:
		/* opt - Sets an informational callback. Implements BIO_set_info_callback */
		ret = 0;
		break;
#ifdef BIO_CTRL_GET_KTLS_SEND
	case BIO_CTRL_GET_CALLBACK:
		/* opt - Get and return the info callback. Implements BIO_get_info_callback */
		ret = 0;
		break;

	case BIO_C_FILE_SEEK:
		/* Not used for sockets. Tcl_Seek only works on top chan. Implements BIO_seek() */
		dprintf("Got BIO_C_FILE_SEEK");
		ret = 0; /* Return 0 success and -1 for failure */
		break;
	case BIO_C_FILE_TELL:
		/* Not used for sockets. Tcl_Tell only works on top chan. Implements BIO_tell() */
		dprintf("Got BIO_C_FILE_TELL");
		ret = 0; /* Return 0 success and -1 for failure */
		break;
	case BIO_C_SET_FD:
		/* Implements BIO_set_fd */
		dprintf("Unsupported call: BIO_C_SET_FD");
		ret = -1;
		break;
	case BIO_C_GET_FD:
		/* Implements BIO_get_fd() */
		dprintf("Unsupported call: BIO_C_GET_FD");
		ret = -1;
		break;

#if OPENSSL_VERSION_NUMBER >= 0x30000000L && defined(BIO_CTRL_GET_KTLS_SEND)
	case BIO_CTRL_GET_KTLS_SEND:
		/* Implements BIO_get_ktls_send */
		dprintf("Got BIO_CTRL_GET_KTLS_SEND");
		/* Returns 1 if the BIO is using the Kernel TLS data-path for sending, 0 if not */
		ret = 0;
		break;
#endif
#ifdef BIO_CTRL_GET_KTLS_RECV
#if OPENSSL_VERSION_NUMBER >= 0x30000000L && defined(BIO_CTRL_GET_KTLS_RECV)
	case BIO_CTRL_GET_KTLS_RECV:
		/* Implements BIO_get_ktls_recv */
		dprintf("Got BIO_CTRL_GET_KTLS_RECV");
		/* Returns 1 if the BIO is using the Kernel TLS data-path for receiving, 0 if not */
		ret = 0;
		break;
#endif
	default:
		dprintf("Got unknown control command (%i)", cmd);
		ret = 0;
		break;
    }
    dprintf("BioCtrl return value %li", ret);
    return ret;
}

/*
 *-----------------------------------------------------------------------------
 *
 * BioNew --
 *
 *	This function is used to create a new instance of the BIO. This
 *	function will be called in response to the application calling the
 *	BIO_new() function.
 *
 * Results:
 *	Returns boolean success result (1=success, 0=failure)
 *
 * Side effects:
 *	Initializes BIO structure.
 *
 *-----------------------------------------------------------------------------
 */

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

    if (bio == NULL) {
	return 0;
    }
    BIO_set_init(bio, 0);

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

/*
 *-----------------------------------------------------------------------------
 *
 * BioFree --
 *
 *	This function is used to destroy an instance of a BIO. This function
 *	will be called in response to the application calling the BIO_free()
 *	function.
 *
 * Results:
 *	Returns boolean success result
 *
 * Side effects:
 *	Initializes BIO structure.
 *
 *-----------------------------------------------------------------------------
 */

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

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

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

    /* Clear flags if set to BIO_CLOSE (close I/O stream when the BIO is freed) */
    if (BIO_get_shutdown(bio)) {
	if (BIO_get_init(bio)) {
	    /*shutdown(bio->num, 2) */
	    /*closesocket(bio->num) */
	}

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

/*
 *-----------------------------------------------------------------------------
 *
 * BIO_new_tcl --
 *
 *	This function is used to initialize the BIO method handlers.
 *
 * Results:
 *	Returns pointer to BIO or NULL for failure
 *
 * Side effects:
 *	Initializes BIO Methods.
 *
 *-----------------------------------------------------------------------------
 */

BIO *BIO_new_tcl(State *statePtr, int flags) {
    BIO *bio;
    static BIO_METHOD *BioMethods = NULL;
#ifdef TCLTLS_SSL_USE_FASTPATH
    Tcl_Channel parentChannel;
    const Tcl_ChannelType *parentChannelType;
    void *parentChannelFdIn_p, *parentChannelFdOut_p;

    int parentChannelFdIn, parentChannelFdOut, parentChannelFd;
    int validParentChannelFd;
    int tclGetChannelHandleRet;
#endif

    dprintf("BIO_new_tcl() called");

    /* Create custom BIO method */
    if (BioMethods == NULL) {
	/* BIO_TYPE_BIO = (19|BIO_TYPE_SOURCE_SINK) -- half a BIO pair */
	/* BIO_TYPE_CONNECT = (12|BIO_TYPE_SOURCE_SINK|BIO_TYPE_DESCRIPTOR) */
	/* BIO_TYPE_ACCEPT  = (13|BIO_TYPE_SOURCE_SINK|BIO_TYPE_DESCRIPTOR) */
	BioMethods = BIO_meth_new(BIO_TYPE_TCL, "tcl");
	BioMethods = BIO_meth_new(BIO_TYPE_BIO, "tcl");
	if (BioMethods == NULL) {
	    dprintf("Memory allocation error");

	    return NULL;
	}
	/* Not used BIO_meth_set_write_ex */
	BIO_meth_set_write(BioMethods, BioWrite);
	/* Not used BIO_meth_set_read_ex */
	BIO_meth_set_read(BioMethods, BioRead);
	BIO_meth_set_puts(BioMethods, BioPuts);
	BIO_meth_set_ctrl(BioMethods, BioCtrl);
	BIO_meth_set_create(BioMethods, BioNew);
	BIO_meth_set_destroy(BioMethods, BioFree);
    }

     * with the SSL library since it will likely be optimized for this.
     */
    parentChannel = Tls_GetParent(statePtr, 0);
    parentChannelType = Tcl_GetChannelType(parentChannel);

    validParentChannelFd = 0;
    if (strcmp(parentChannelType->typeName, "tcp") == 0) {
	void *parentChannelFdIn_p, *parentChannelFdOut_p;
	int tclGetChannelHandleRet;

	tclGetChannelHandleRet = Tcl_GetChannelHandle(parentChannel, TCL_READABLE, (ClientData) &parentChannelFdIn_p);
	if (tclGetChannelHandleRet == TCL_OK) {
	    tclGetChannelHandleRet = Tcl_GetChannelHandle(parentChannel, TCL_WRITABLE, (ClientData) &parentChannelFdOut_p);
	    if (tclGetChannelHandleRet == TCL_OK) {
		parentChannelFdIn = PTR2INT(parentChannelFdIn_p);
		parentChannelFdOut = PTR2INT(parentChannelFdOut_p);
		if (parentChannelFdIn == parentChannelFdOut) {
		    parentChannelFd = parentChannelFdIn;
		    validParentChannelFd = 1;
		}
	    }
	}
    }

    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;
	BIO_set_data(bio, statePtr);
	BIO_set_shutdown(bio, flags);
	BIO_set_init(bio, 1);
	return bio;
    }
#endif

    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);
    BIO_set_init(bio, 1); /* Enable read & write */
    return bio;
}

/*
 *-----------------------------------------------------------------------------
 *
 * BIO_cleanup --
 *
 *	This function is used to destroy a BIO_METHOD structure and free up any
 *	memory associated with it.
 *
 * Results:
 *	Standard TCL result
 *
 * Side effects:
 *	Destroys BIO Methods.
 *
 *-----------------------------------------------------------------------------
 */

int BIO_cleanup () {
    dprintf("BIO_cleanup() called");

    if (BioMethods != NULL) {
	BIO_meth_free(BioMethods);
	BioMethods = NULL;
    }
    return TCL_OK;
}