* This was built from scratch based upon observation of OpenSSL 0.9.2B
 *
 * Addition credit is due for Andreas Kupries ([email protected]), for
 * providing the Tcl_ReplaceChannel mechanism and working closely with me
 * to enhance it to support full fileevent semantics.
 *
 * Also work done by the follow people provided the impetus to do this "right":
 *	tclSSL (Colin McCormack, Shared Technology)
 *	SSLtcl (Peter Antman)
 *    tclSSL (Colin McCormack, Shared Technology)
 *    SSLtcl (Peter Antman)
 *
 */

#include "tlsInt.h"

/*
 * Forward declarations
 */
static int  TlsBlockModeProc (void *instanceData, int mode);
static int  TlsCloseProc (void *instanceData, Tcl_Interp *interp);
static int  TlsClose2Proc (void *instanceData, Tcl_Interp *interp, int flags);
static int  TlsInputProc (void *instanceData, char *buf, int bufSize, int *errorCodePtr);
static int  TlsOutputProc (void *instanceData, const char *buf, int toWrite, int *errorCodePtr);
static int  TlsGetOptionProc (void *instanceData, Tcl_Interp *interp, const char *optionName, Tcl_DString *dsPtr);
static void TlsWatchProc (void *instanceData, int mask);
static int  TlsGetHandleProc (void *instanceData, int direction, void **handlePtr);
static int  TlsNotifyProc (void *instanceData, int mask);
static void TlsChannelHandlerTimer (void *clientData);
static void TlsChannelHandlerTimer(void *clientData);

/*
 * TLS Channel Type
 */
static const Tcl_ChannelType tlsChannelType = {
  "tls",                             /* typeName                             */
  TCL_CHANNEL_VERSION_5,             /* version                              */
  TlsCloseProc,                      /* closeProc                            */
  TlsInputProc,                      /* inputProc                            */
  TlsOutputProc,                     /* outputProc                           */
  0,                                 /* seekProc                             */
  0,                                 /* setOptionProc                        */
  TlsGetOptionProc,                  /* getOptionProc                        */
  TlsWatchProc,                      /* watchProc                            */
  TlsGetHandleProc,                  /* getHandleProc                        */
  TlsClose2Proc,                     /* close2Proc                           */
  TlsBlockModeProc,                  /* blockModeProc                        */
  0,                                 /* flushProc                            */
  TlsNotifyProc,                     /* handlerProc                          */
  0,                                 /* wideSeekProc                         */
  0,                                 /* threadActionProc                     */
  0                                  /* truncateProc                         */
};


/*
 *-------------------------------------------------------------------
 *
 * Tls_ChannelType --
 *
 *	Return the correct TLS channel driver info
 *
 * Results:
 *	The correct channel driver for the current version of Tcl.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
const Tcl_ChannelType *Tls_ChannelType(void) {
	return &tlsChannelType;
}

/*
 *-------------------------------------------------------------------
 *
 * TlsBlockModeProc --
 *
 *	This procedure is invoked by the generic IO level
 *    This procedure is invoked by the generic IO level
 *       to set blocking and nonblocking modes
 *
 * Results:
 *	0 if successful, errno when failed.
 *    0 if successful or POSIX error code if failed.
 *
 * Side effects:
 *	Sets the device into blocking or nonblocking mode.
 *    Sets the device into blocking or nonblocking mode.
 *
 *-------------------------------------------------------------------
 */
static int TlsBlockModeProc(void *instanceData, int mode) {
	State *statePtr = (State *) instanceData;
    State *statePtr = (State *) instanceData;

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

	return(0);
    return(0);
}

/*
 *-------------------------------------------------------------------
 *
 * TlsCloseProc --
 *
 *	This procedure is invoked by the generic IO level to perform
 *	channel-type-specific cleanup when a SSL socket based channel
 *	is closed.
 *    This procedure is invoked by the generic IO level to perform
 *    channel-type-specific cleanup when a SSL socket based channel
 *    is closed.
 *
 *	Note: we leave the underlying socket alone, is this right?
 *    Note: we leave the underlying socket alone, is this right?
 *
 * Results:
 *	0 if successful, the value of Tcl_GetErrno() if failed.
 *    0 if successful or POSIX error code if failed.
 *
 * Side effects:
 *	Closes the socket of the channel.
 *    Closes the socket of the channel.
 *
 *-------------------------------------------------------------------
 */
static int TlsCloseProc(void *instanceData, TCL_UNUSED(Tcl_Interp *)) {
	State *statePtr = (State *) instanceData;
static int TlsCloseProc(
    void *instanceData,
    TCL_UNUSED(Tcl_Interp *))
{
    State *statePtr = (State *) instanceData;

	dprintf("TlsCloseProc(%p)", statePtr);
    dprintf("TlsCloseProc(%p)", statePtr);

	Tls_Clean(statePtr);
	Tcl_EventuallyFree(statePtr, Tls_Free);

    Tls_Clean(statePtr);
    Tcl_EventuallyFree(statePtr, Tls_Free);
    return TCL_OK;
	dprintf("Returning TCL_OK");

}
	return(TCL_OK);
}


static int TlsClose2Proc(
    void *instanceData,    /* The socket state. */
    Tcl_Interp *interp,		/* For errors - can be NULL. */
    int flags)			/* Flags to close read and/or write side of channel */
{
static int TlsClose2Proc(void *instanceData, Tcl_Interp *interp, int flags) {
	if (!(flags&(TCL_CLOSE_READ|TCL_CLOSE_WRITE))) {
	    return TlsCloseProc(instanceData, interp);
	}
	return EINVAL;
    if (!(flags&(TCL_CLOSE_READ|TCL_CLOSE_WRITE))) {
	return TlsCloseProc(instanceData, interp);
    }
    return EINVAL;
}

/*
 *------------------------------------------------------*
 *
 *	Tls_WaitForConnect --
 * Tls_WaitForConnect --
 *
 *	Sideeffects:
 *		Issues SSL_accept or SSL_connect
 * Result:
 *    0 if successful, -1 if failed.
 *
 *	Result:
 *		None.
 * Side effects:
 *    Issues SSL_accept or SSL_connect
 *
 *------------------------------------------------------*
 */
int Tls_WaitForConnect(State *statePtr, int *errorCodePtr, int handshakeFailureIsPermanent) {
	unsigned long backingError;
	int err, rc;
	int bioShouldRetry;
    unsigned long backingError;
    int err, rc;
    int bioShouldRetry;

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

	if (!(statePtr->flags & TLS_TCL_INIT)) {
		dprintf("Tls_WaitForConnect called on already initialized channel -- returning with immediate success");
		*errorCodePtr = 0;
		return(0);
	}
    if (!(statePtr->flags & TLS_TCL_INIT)) {
	dprintf("Tls_WaitForConnect called on already initialized channel -- returning with immediate success");
	*errorCodePtr = 0;
	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;
		}
		return(-1);
	}
    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;
	}
	return(-1);
    }

	for (;;) {
		/* Not initialized yet! */
		if (statePtr->flags & TLS_TCL_SERVER) {
			dprintf("Calling SSL_accept()");
    for (;;) {
	/* Not initialized yet! */
	if (statePtr->flags & TLS_TCL_SERVER) {
	    dprintf("Calling SSL_accept()");

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

			err = SSL_connect(statePtr->ssl);
		}
	    err = SSL_connect(statePtr->ssl);
	}

		if (err > 0) {
			dprintf("That seems to have gone okay");
	if (err > 0) {
	    dprintf("That seems to have gone okay");

			err = BIO_flush(statePtr->bio);
	    err = BIO_flush(statePtr->bio);

			if (err <= 0) {
				dprintf("Flushing the lower layers failed, this will probably terminate this session");
			}
		}
	    if (err <= 0) {
		dprintf("Flushing the lower layers failed, this will probably terminate this session");
	    }
	}

		rc = SSL_get_error(statePtr->ssl, err);
	rc = SSL_get_error(statePtr->ssl, err);

		dprintf("Got error: %i (rc = %i)", err, rc);
	dprintf("Got error: %i (rc = %i)", err, rc);

		bioShouldRetry = 0;
		if (err <= 0) {
			if (rc == SSL_ERROR_WANT_CONNECT || rc == SSL_ERROR_WANT_ACCEPT || rc == SSL_ERROR_WANT_READ || rc == SSL_ERROR_WANT_WRITE) {
				bioShouldRetry = 1;
			} else if (BIO_should_retry(statePtr->bio)) {
				bioShouldRetry = 1;
			} else if (rc == SSL_ERROR_SYSCALL && Tcl_GetErrno() == EAGAIN) {
				bioShouldRetry = 1;
			}
		} else {
			if (!SSL_is_init_finished(statePtr->ssl)) {
				bioShouldRetry = 1;
			}
		}
	bioShouldRetry = 0;
	if (err <= 0) {
	    if (rc == SSL_ERROR_WANT_CONNECT || rc == SSL_ERROR_WANT_ACCEPT || rc == SSL_ERROR_WANT_READ || rc == SSL_ERROR_WANT_WRITE) {
		bioShouldRetry = 1;
	    } else if (BIO_should_retry(statePtr->bio)) {
		bioShouldRetry = 1;
	    } else if (rc == SSL_ERROR_SYSCALL && Tcl_GetErrno() == EAGAIN) {
		bioShouldRetry = 1;
	    }
	} else {
	    if (!SSL_is_init_finished(statePtr->ssl)) {
		bioShouldRetry = 1;
	    }
	}

		if (bioShouldRetry) {
			dprintf("The I/O did not complete -- but we should try it again");
	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");
	    if (statePtr->flags & TLS_TCL_ASYNC) {
		dprintf("Returning EAGAIN so that it can be retried later");

				*errorCodePtr = EAGAIN;
		*errorCodePtr = EAGAIN;

				return(-1);
			} else {
				dprintf("Doing so now");
		return(-1);
	    } else {
		dprintf("Doing so now");

				continue;
			}
		}
		continue;
	    }
	}

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


	*errorCodePtr = EINVAL;
    *errorCodePtr = EINVAL;

	switch (rc) {
		case SSL_ERROR_NONE:
			/* The connection is up, we are done here */
			dprintf("The connection is up");
			break;
		case SSL_ERROR_ZERO_RETURN:
			dprintf("SSL_ERROR_ZERO_RETURN: Connect returned an invalid value...")
			return(-1);
		case SSL_ERROR_SYSCALL:
			backingError = ERR_get_error();
    switch (rc) {
	case SSL_ERROR_NONE:
	    /* The connection is up, we are done here */
	    dprintf("The connection is up");
	    break;
	case SSL_ERROR_ZERO_RETURN:
	    dprintf("SSL_ERROR_ZERO_RETURN: Connect returned an invalid value...")
	    return(-1);
	case SSL_ERROR_SYSCALL:
	    backingError = ERR_get_error();

			if (backingError == 0 && err == 0) {
				dprintf("EOF reached")
				*errorCodePtr = ECONNRESET;
			} else if (backingError == 0 && err == -1) {
				dprintf("I/O error occured (errno = %lu)", (unsigned long) Tcl_GetErrno());
				*errorCodePtr = Tcl_GetErrno();
				if (*errorCodePtr == ECONNRESET) {
					*errorCodePtr = ECONNABORTED;
				}
			} else {
				dprintf("I/O error occured (backingError = %lu)", backingError);
				*errorCodePtr = backingError;
				if (*errorCodePtr == ECONNRESET) {
					*errorCodePtr = ECONNABORTED;
				}
			}
	    if (backingError == 0 && err == 0) {
		dprintf("EOF reached")
		*errorCodePtr = ECONNRESET;
	    } else if (backingError == 0 && err == -1) {
		dprintf("I/O error occurred (errno = %lu)", (unsigned long) Tcl_GetErrno());
		*errorCodePtr = Tcl_GetErrno();
		if (*errorCodePtr == ECONNRESET) {
		    *errorCodePtr = ECONNABORTED;
		}
	    } else {
		dprintf("I/O error occurred (backingError = %lu)", backingError);
		*errorCodePtr = backingError;
		if (*errorCodePtr == ECONNRESET) {
		    *errorCodePtr = ECONNABORTED;
		}
		}

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

			return(-1);
		case SSL_ERROR_SSL:
			dprintf("Got permanent fatal SSL error, aborting immediately");
			Tls_Error(statePtr, (char *)ERR_reason_error_string(ERR_get_error()));
			statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED;
			*errorCodePtr = ECONNABORTED;
			return(-1);
		case SSL_ERROR_WANT_CONNECT:
		case SSL_ERROR_WANT_ACCEPT:
		case SSL_ERROR_WANT_X509_LOOKUP:
		default:
			dprintf("We got a confusing reply: %i", rc);
			*errorCodePtr = Tcl_GetErrno();
			dprintf("ERR(%d, %d) ", rc, *errorCodePtr);
			return(-1);
	}
		return(-1);
	case SSL_ERROR_SSL:
	    dprintf("Got permanent fatal SSL error, aborting immediately");
		Tls_Error(statePtr, (char *)ERR_reason_error_string(ERR_get_error()));
	    statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED;
	    *errorCodePtr = ECONNABORTED;
	    return(-1);
	case SSL_ERROR_WANT_CONNECT:
	case SSL_ERROR_WANT_ACCEPT:
	case SSL_ERROR_WANT_X509_LOOKUP:
	default:
	    dprintf("We got a confusing reply: %i", rc);
	    *errorCodePtr = Tcl_GetErrno();
	    dprintf("ERR(%d, %d) ", rc, *errorCodePtr);
	    return(-1);
    }

#if 0
	if (statePtr->flags & TLS_TCL_SERVER) {
		dprintf("This is an TLS server, checking the certificate for the peer");
    if (statePtr->flags & TLS_TCL_SERVER) {
	dprintf("This is an TLS server, checking the certificate for the peer");

		err = SSL_get_verify_result(statePtr->ssl);
		if (err != X509_V_OK) {
			dprintf("Invalid certificate, returning in failure");
	err = SSL_get_verify_result(statePtr->ssl);
	if (err != X509_V_OK) {
		dprintf("Invalid certificate, returning in failure");

			Tls_Error(statePtr, (char *)X509_verify_cert_error_string(err));
			statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED;
			*errorCodePtr = ECONNABORTED;
			return(-1);
		}
	}
		Tls_Error(statePtr, (char *)X509_verify_cert_error_string(err));
		statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED;
		*errorCodePtr = ECONNABORTED;
		return(-1);
	}
    }
#endif

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

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

	return(0);
    return 0;
}

/*
 *-------------------------------------------------------------------
 *
 * TlsInputProc --
 *
 *	This procedure is invoked by the generic IO level
 *    This procedure is invoked by the generic IO level
 *       to read input from a SSL socket based channel.
 *
 * Results:
 *	The number of bytes read is returned or -1 on error. An output
 *	argument contains the POSIX error code on error, or zero if no
 *    Returns the number of bytes read or -1 on error. Sets errorCodePtr
 *    to a POSIX error code if an error occurred, or 0 if none.
 *	error occurred.
 *
 * Side effects:
 *	Reads input from the input device of the channel.
 *    Reads input from the input device of the channel.
 *
 *-------------------------------------------------------------------
 */

static int TlsInputProc(void *instanceData, char *buf, int bufSize, int *errorCodePtr) {
	unsigned long backingError;
	State *statePtr = (State *) instanceData;
	int bytesRead;
	int tlsConnect;
	int err;
static int TlsInputProc(
    void *instanceData,
    char *buf,
    int bufSize,
    int *errorCodePtr)
{
    unsigned long backingError;
    State *statePtr = (State *) instanceData;
    int bytesRead;
    int tlsConnect;
    int err;

	*errorCodePtr = 0;
    *errorCodePtr = 0;

	dprintf("BIO_read(%d)", bufSize);
    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);
	}
    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);
    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);

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

		return(bytesRead);
	}
	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.
	 *
	 * Alternatively, we may want to handle the <0 return codes from
	 * BIO_read 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 TlsOutputProc. - hobbs
	 */
	ERR_clear_error();
	bytesRead = BIO_read(statePtr->bio, buf, bufSize);
	dprintf("BIO_read -> %d", 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.
     *
     * Alternatively, we may want to handle the <0 return codes from
     * BIO_read 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 TlsOutputProc. - hobbs
     */
    ERR_clear_error();
    bytesRead = BIO_read(statePtr->bio, buf, bufSize);
    dprintf("BIO_read -> %d", bytesRead);

	err = SSL_get_error(statePtr->ssl, bytesRead);
    err = SSL_get_error(statePtr->ssl, bytesRead);

#if 0
	if (bytesRead <= 0) {
		if (BIO_should_retry(statePtr->bio)) {
			dprintf("I/O failed, will retry based on EAGAIN");
			*errorCodePtr = EAGAIN;
		}
	}
    if (bytesRead <= 0) {
	if (BIO_should_retry(statePtr->bio)) {
	    dprintf("I/O failed, will retry based on EAGAIN");
	    *errorCodePtr = EAGAIN;
	}
    }
#endif

	switch (err) {
		case SSL_ERROR_NONE:
			dprintBuffer(buf, bytesRead);
			break;
		case SSL_ERROR_SSL:
			dprintf("SSL negotiation error, indicating that the connection has been aborted");
    switch (err) {
	case SSL_ERROR_NONE:
	    dprintBuffer(buf, bytesRead);
	    break;
	case SSL_ERROR_SSL:
	    dprintf("SSL negotiation error, indicating that the connection has been aborted");

			Tls_Error(statePtr, TCLTLS_SSL_ERROR(statePtr->ssl, bytesRead));
			*errorCodePtr = ECONNABORTED;
			bytesRead = -1;
	    Tls_Error(statePtr, TCLTLS_SSL_ERROR(statePtr->ssl, bytesRead));
	    *errorCodePtr = ECONNABORTED;
	    bytesRead = -1;

			break;
		case SSL_ERROR_SYSCALL:
			backingError = ERR_get_error();
	    break;
	case SSL_ERROR_SYSCALL:
		backingError = ERR_get_error();

			if (backingError == 0 && bytesRead == 0) {
		if (backingError == 0 && bytesRead == 0) {
				dprintf("EOF reached")
				*errorCodePtr = 0;
				bytesRead = 0;
			} else if (backingError == 0 && bytesRead == -1) {
				dprintf("I/O error occured (errno = %lu)", (unsigned long) Tcl_GetErrno());
		} else if (backingError == 0 && bytesRead == -1) {
				dprintf("I/O error occurred (errno = %lu)", (unsigned long) Tcl_GetErrno());
				*errorCodePtr = Tcl_GetErrno();
				bytesRead = -1;
			} else {
				dprintf("I/O error occured (backingError = %lu)", backingError);
		} else {
				dprintf("I/O error occurred (backingError = %lu)", backingError);
				*errorCodePtr = backingError;
				bytesRead = -1;
			}
		}

			break;
		break;
		case SSL_ERROR_ZERO_RETURN:
			dprintf("Got SSL_ERROR_ZERO_RETURN, this means an EOF has been reached");
			bytesRead = 0;
			*errorCodePtr = 0;
			break;
		case SSL_ERROR_WANT_READ:
			dprintf("Got SSL_ERROR_WANT_READ, mapping this to EAGAIN");
			bytesRead = -1;
			*errorCodePtr = EAGAIN;
			break;
		default:
			dprintf("Unknown error (err = %i), mapping to EOF", err);
			*errorCodePtr = 0;
			bytesRead = 0;
			break;
	}
		*errorCodePtr = 0;
		bytesRead = 0;
		break;
    }

	dprintf("Input(%d) -> %d [%d]", bufSize, bytesRead, *errorCodePtr);
	return(bytesRead);
    dprintf("Input(%d) -> %d [%d]", bufSize, bytesRead, *errorCodePtr);
    return bytesRead;
}

/*
 *-------------------------------------------------------------------
 *
 * TlsOutputProc --
 *
 *	This procedure is invoked by the generic IO level
 *    This procedure is invoked by the generic IO level
 *       to write output to a SSL socket based channel.
 *
 * Results:
 *	The number of bytes written is returned. An output argument is
 *	set to a POSIX error code if an error occurred, or zero.
 *    Returns the number of bytes written or -1 on error. Sets errorCodePtr
 *    to a POSIX error code if an error occurred, or 0 if none.
 *
 * Side effects:
 *	Writes output on the output device of the channel.
 *    Writes output on the output device of the channel.
 *
 *-------------------------------------------------------------------
 */

static int TlsOutputProc(void *instanceData, const char *buf, int toWrite, int *errorCodePtr) {
	unsigned long backingError;
	State *statePtr = (State *) instanceData;
	int written, err;
	int tlsConnect;
static int TlsOutputProc(
    void *instanceData,
    const char *buf,
    int toWrite,
    int *errorCodePtr)
{
    unsigned long backingError;
    State *statePtr = (State *) instanceData;
    int written, err;
    int tlsConnect;

	*errorCodePtr = 0;
    *errorCodePtr = 0;

	dprintf("BIO_write(%p, %d)", (void *) statePtr, toWrite);
	dprintBuffer(buf, toWrite);
    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);
	}
    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);
    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);

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

		return(written);
	}
	return(written);
    }

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

		if (err <= 0) {
			dprintf("Flushing failed");
	if (err <= 0) {
	    dprintf("Flushing failed");

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

		written = 0;
		*errorCodePtr = 0;
		return(0);
	}
	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);
    /*
     * 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);
	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;
			break;
		case SSL_ERROR_WANT_READ:
			dprintf(" write R BLOCK");
			break;
		case SSL_ERROR_WANT_X509_LOOKUP:
			dprintf(" write X BLOCK");
			break;
		case SSL_ERROR_ZERO_RETURN:
			dprintf(" closed");
			written = 0;
			*errorCodePtr = 0;
			break;
		case SSL_ERROR_SYSCALL:
			backingError = ERR_get_error();
    err = SSL_get_error(statePtr->ssl, written);
    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;
	    break;
	case SSL_ERROR_WANT_READ:
	    dprintf(" write R BLOCK");
	    break;
	case SSL_ERROR_WANT_X509_LOOKUP:
	    dprintf(" write X BLOCK");
	    break;
	case SSL_ERROR_ZERO_RETURN:
	    dprintf(" closed");
	    written = 0;
	    *errorCodePtr = 0;
	    break;
	case SSL_ERROR_SYSCALL:
	    backingError = ERR_get_error();

			if (backingError == 0 && written == 0) {
				dprintf("EOF reached")
				*errorCodePtr = 0;
				written = 0;
			} else if (backingError == 0 && written == -1) {
				dprintf("I/O error occured (errno = %lu)", (unsigned long) Tcl_GetErrno());
				*errorCodePtr = Tcl_GetErrno();
				written = -1;
			} else {
				dprintf("I/O error occured (backingError = %lu)", backingError);
				*errorCodePtr = backingError;
				written = -1;
			}
	    if (backingError == 0 && written == 0) {
		dprintf("EOF reached")
		*errorCodePtr = 0;
		written = 0;
	    } else if (backingError == 0 && written == -1) {
		dprintf("I/O error occurred (errno = %lu)", (unsigned long) Tcl_GetErrno());
		*errorCodePtr = Tcl_GetErrno();
		written = -1;
	    } else {
		dprintf("I/O error occurred (backingError = %lu)", backingError);
		*errorCodePtr = backingError;
		written = -1;
	    }

			break;
		case SSL_ERROR_SSL:
			Tls_Error(statePtr, TCLTLS_SSL_ERROR(statePtr->ssl, written));
			*errorCodePtr = ECONNABORTED;
			written = -1;
			break;
		default:
			dprintf(" unknown err: %d", err);
			break;
	}
	    break;
	case SSL_ERROR_SSL:
	    Tls_Error(statePtr, TCLTLS_SSL_ERROR(statePtr->ssl, written));
	    *errorCodePtr = ECONNABORTED;
	    written = -1;
	    break;
	default:
	    dprintf(" unknown err: %d", err);
	    break;
    }

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

/*
 *-------------------------------------------------------------------
 *
 * TlsGetOptionProc --
 *
 *	Computes an option value for a SSL socket based channel, or a
 *	list of all options and their values.
 *    Gets an option value for a SSL socket based channel, or a
 *    list of all options and their values.
 *
 * Results:
 *	A standard Tcl result. The value of the specified option or a
 *	list of all options and	their values is returned in the
 *	supplied DString.
 *    A standard Tcl result. The value of the specified option or a
 *    list of all options and their values is returned in the
 *    supplied DString.
 *
 * Side effects:
 *	None.
 *    None.
 *
 *-------------------------------------------------------------------
 */
static int
TlsGetOptionProc(
TlsGetOptionProc(void *instanceData,	/* Socket state. */
	Tcl_Interp *interp,		/* For errors - can be NULL. */
	const char *optionName,		/* Name of the option to
    void *instanceData,	/* Socket state. */
    Tcl_Interp *interp,		/* For errors - can be NULL. */
    const char *optionName,	/* Name of the option to retrieve the value for, or
					 * retrieve the value for, or
					 * NULL to get all options and
				 * NULL to get all options and their values. */
					 * their values. */
	Tcl_DString *dsPtr)		/* Where to store the computed value
    Tcl_DString *dsPtr)	/* Where to store the computed value initialized by caller. */
					 * initialized by caller. */
{
    State *statePtr = (State *) instanceData;

   Tcl_Channel downChan = Tls_GetParent(statePtr, TLS_TCL_FASTPATH);
   Tcl_DriverGetOptionProc *getOptionProc;
    Tcl_Channel downChan = Tls_GetParent(statePtr, TLS_TCL_FASTPATH);
    Tcl_DriverGetOptionProc *getOptionProc;

    getOptionProc = Tcl_ChannelGetOptionProc(Tcl_GetChannelType(downChan));
    if (getOptionProc != NULL) {
        return (*getOptionProc)(Tcl_GetChannelInstanceData(downChan), interp, optionName, dsPtr);
	return (*getOptionProc)(Tcl_GetChannelInstanceData(downChan), interp, optionName, dsPtr);
    } else if (optionName == (char*) NULL) {
        /*
         * Request is query for all options, this is ok.
         */
         return TCL_OK;
	/*
	 * Request is query for all options, this is ok.
	 */
	return TCL_OK;
    }
    /*
     * Request for a specific option has to fail, we don't have any.
     */
    return TCL_ERROR;
}

/*
 *-------------------------------------------------------------------
 *
 * TlsWatchProc --
 *
 *	Initialize the notifier to watch Tcl_Files from this channel.
 *    Initialize the notifier to watch Tcl_Files from this channel.
 *
 * Results:
 *	None.
 *    None.
 *
 * Side effects:
 *	Sets up the notifier so that a future event on the channel
 *	will be seen by Tcl.
 *    Sets up the notifier so that a future event on the channel
 *    will be seen by Tcl.
 *
 *-------------------------------------------------------------------
 */

static void
TlsWatchProc(void *instanceData,	/* The socket state. */
             int mask)			/* Events of interest; an OR-ed
TlsWatchProc(
    void *instanceData,    /* The socket state. */
    int mask)			/* Events of interest; an OR-ed combination of
                                         * combination of TCL_READABLE,
                                         * TCL_WRITABLE and TCL_EXCEPTION. */
				 * TCL_READABLE, TCL_WRITABLE and TCL_EXCEPTION. */
{
    Tcl_Channel     downChan;
    State *statePtr = (State *) instanceData;

    dprintf("TlsWatchProc(0x%x)", mask);

    /* Pretend to be dead as long as the verify callback is running.
     * Otherwise that callback could be invoked recursively. */
    if (statePtr->flags & TLS_TCL_CALLBACK) {
        dprintf("Callback is on-going, doing nothing");
        return;
	dprintf("Callback is on-going, doing nothing");
	return;
    }

    dprintFlags(statePtr);

    downChan = Tls_GetParent(statePtr, TLS_TCL_FASTPATH);

    if (statePtr->flags & TLS_TCL_HANDSHAKE_FAILED) {
        dprintf("Asked to watch a socket with a failed handshake -- nothing can happen here");
	dprintf("Asked to watch a socket with a failed handshake -- nothing can happen here");

	dprintf("Unregistering interest in the lower channel");
	(Tcl_GetChannelType(downChan))->watchProc(Tcl_GetChannelInstanceData(downChan), 0);

	(Tcl_GetChannelType(downChan))->watchProc(Tcl_GetChannelInstanceData(downChan), 0);
	statePtr->watchMask = 0;

        return;
	return;
    }

	statePtr->watchMask = mask;
    statePtr->watchMask = mask;

	/* No channel handlers any more. We will be notified automatically
	 * about events on the channel below via a call to our
	 * 'TransformNotifyProc'. But we have to pass the interest down now.
	 * We are allowed to add additional 'interest' to the mask if we want
	 * to. But this transformation has no such interest. It just passes
	 * the request down, unchanged.
	 */
    /* No channel handlers any more. We will be notified automatically
     * about events on the channel below via a call to our
     * 'TransformNotifyProc'. But we have to pass the interest down now.
     * We are allowed to add additional 'interest' to the mask if we want
     * to. But this transformation has no such interest. It just passes
     * the request down, unchanged.
     */


        dprintf("Registering our interest in the lower channel (chan=%p)", (void *) downChan);
	(Tcl_GetChannelType(downChan))
    dprintf("Registering our interest in the lower channel (chan=%p)", (void *) downChan);
    (Tcl_GetChannelType(downChan))
	    ->watchProc(Tcl_GetChannelInstanceData(downChan), mask);

	/*
	 * Management of the internal timer.
	 */
    /*
     * Management of the internal timer.
     */

	if (statePtr->timer != (Tcl_TimerToken) NULL) {
            dprintf("A timer was found, deleting it");
	    Tcl_DeleteTimerHandler(statePtr->timer);
	    statePtr->timer = (Tcl_TimerToken) NULL;
	}
    if (statePtr->timer != (Tcl_TimerToken) NULL) {
	dprintf("A timer was found, deleting it");
	Tcl_DeleteTimerHandler(statePtr->timer);
	statePtr->timer = (Tcl_TimerToken) NULL;
    }

	if (mask & TCL_READABLE) {
		if (Tcl_InputBuffered(statePtr->self) > 0 || BIO_ctrl_pending(statePtr->bio) > 0) {
			/*
			 * There is interest in readable events and we actually have
			 * data waiting, so generate a timer to flush that.
			 */
			dprintf("Creating a new timer since data appears to be waiting");
			statePtr->timer = Tcl_CreateTimerHandler(TLS_TCL_DELAY, TlsChannelHandlerTimer, statePtr);
		}
    if ((mask & TCL_READABLE) &&
	((Tcl_InputBuffered(statePtr->self) > 0) || (BIO_ctrl_pending(statePtr->bio) > 0))) {
	/*
	 * There is interest in readable events and we actually have
	 * data waiting, so generate a timer to flush that.
	 */
	dprintf("Creating a new timer since data appears to be waiting");
	statePtr->timer = Tcl_CreateTimerHandler(TLS_TCL_DELAY, TlsChannelHandlerTimer, statePtr);
    }
	}
}

/*
 *-------------------------------------------------------------------
 *
 * TlsGetHandleProc --
 *
 *	Called from Tcl_GetChannelFile to retrieve o/s file handler
 *	from the SSL socket based channel.
 *    Called from Tcl_GetChannelFile to retrieve o/s file handler
 *    from the SSL socket based channel.
 *
 * Results:
 *	The appropriate Tcl_File or NULL if not present.
 *    The appropriate Tcl_File handle or NULL if none.
 *
 * Side effects:
 *	None.
 *    None.
 *
 *-------------------------------------------------------------------
 */
static int TlsGetHandleProc(void *instanceData, int direction, void **handlePtr) {
	State *statePtr = (State *) instanceData;
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));
    return(Tcl_GetChannelHandle(Tls_GetParent(statePtr, TLS_TCL_FASTPATH), direction, handlePtr));
}

/*
 *-------------------------------------------------------------------
 *
 * TlsNotifyProc --
 *
 *	Handler called by Tcl to inform us of activity
 *	on the underlying channel.
 *    Handler called by Tcl to inform us of activity
 *    on the underlying channel.
 *
 * Results:
 *	None.
 *    Type of event or 0 if failed
 *
 * Side effects:
 *	May process the incoming event by itself.
 *    May process the incoming event by itself.
 *
 *-------------------------------------------------------------------
 */

static int TlsNotifyProc(void *instanceData, int mask) {
	State *statePtr = (State *) instanceData;
	int errorCode;
static int TlsNotifyProc(
    void *instanceData,    /* Socket state. */
    int mask)			/* type of event that occurred:
				 * OR-ed combination of TCL_READABLE or TCL_WRITABLE */
{
    State *statePtr = (State *)instanceData;
    int errorCode;

	/*
	 * An event occured in the underlying channel.  This
	 * transformation doesn't process such events thus returns the
	 * incoming mask unchanged.
	 */
	if (statePtr->timer != (Tcl_TimerToken) NULL) {
		/*
		 * Delete an existing timer. It was not fired, yet we are
		 * here, so the channel below generated such an event and we
		 * don't have to. The renewal of the interest after the
		 * execution of channel handlers will eventually cause us to
		 * recreate the timer (in WatchProc).
		 */
		Tcl_DeleteTimerHandler(statePtr->timer);
		statePtr->timer = (Tcl_TimerToken) NULL;
	}
    /*
     * An event occurred in the underlying channel.  This
     * transformation doesn't process such events thus returns the
     * incoming mask unchanged.
     */
    if (statePtr->timer != (Tcl_TimerToken) NULL) {
	/*
	 * Delete an existing timer. It was not fired, yet we are
	 * here, so the channel below generated such an event and we
	 * don't have to. The renewal of the interest after the
	 * execution of channel handlers will eventually cause us to
	 * recreate the timer (in WatchProc).
	 */
	Tcl_DeleteTimerHandler(statePtr->timer);
	statePtr->timer = (Tcl_TimerToken) NULL;
    }

	if (statePtr->flags & TLS_TCL_CALLBACK) {
		dprintf("Returning 0 due to callback");
		return 0;
	}
    if (statePtr->flags & TLS_TCL_CALLBACK) {
	dprintf("Returning 0 due to callback");
	return 0;
    }

	dprintf("Calling Tls_WaitForConnect");
	errorCode = 0;
	if (Tls_WaitForConnect(statePtr, &errorCode, 1) < 0) {
		if (errorCode == EAGAIN) {
			dprintf("Async flag could be set (didn't check) and errorCode == EAGAIN:  Returning 0");
    dprintf("Calling Tls_WaitForConnect");
    errorCode = 0;
    if (Tls_WaitForConnect(statePtr, &errorCode, 1) < 0) {
	if (errorCode == EAGAIN) {
	    dprintf("Async flag could be set (didn't check) and errorCode == EAGAIN:  Returning 0");

			return 0;
		}
	    return 0;
	}

		dprintf("Tls_WaitForConnect returned an error");
	}
	dprintf("Tls_WaitForConnect returned an error");
    }

	dprintf("Returning %i", mask);
    dprintf("Returning %i", mask);

	return(mask);
    return(mask);
}

#if 0
/*
 *------------------------------------------------------*
 *
 *      TlsChannelHandler --

 *		As of 'TlsChannelHandler'.
 *
 *	Result:
 *		None.
 *
 *------------------------------------------------------*
 */


/*
 *-------------------------------------------------------------------
 *
 * Tls_ChannelType --
 *
 *    Return the correct TLS channel driver info
 *
 * Results:
 *    The correct channel driver for the current version of Tcl.
 *
 * Side effects:
 *    None.
 *
 *-------------------------------------------------------------------
 */
static const Tcl_ChannelType tlsChannelType = {
    "tls",			/* Type name */
    TCL_CHANNEL_VERSION_5,	/* v5 channel */
    TlsCloseProc,		/* Close proc */
    TlsInputProc,		/* Input proc */
    TlsOutputProc,		/* Output proc */
    0,			/* Seek proc */
    0,		/* Set option proc */
    TlsGetOptionProc,		/* Get option proc */
    TlsWatchProc,		/* Initialize notifier */
    TlsGetHandleProc,		/* Get OS handles out of channel */
    TlsClose2Proc,		/* close2proc */
    TlsBlockModeProc,		/* Set blocking/nonblocking mode*/
    0,			/* Flush proc */
    TlsNotifyProc,		/* Handling of events bubbling up */
    0,			/* Wide seek proc */
    NULL,			/* Thread action */
    NULL			/* Truncate */
};

const Tcl_ChannelType *Tls_ChannelType(void) {
    return &tlsChannelType;
}


static void TlsChannelHandlerTimer(void *clientData) {
	State *statePtr = (State *) clientData;
	int mask = 0;

	dprintf("Called");