/*
 * Copyright (C) 1997-2000 Matt Newman <[email protected]>
 *
 * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tlsIO.c,v 1.7.2.2 2000/07/12 01:54:26 hobbs Exp $
 * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tlsIO.c,v 1.7.2.3 2000/07/21 05:32:57 hobbs Exp $
 *
 * TLS (aka SSL) Channel - can be layered on any bi-directional
 * Tcl_Channel (Note: Requires Trf Core Patch)
 *
 * This was built from scratch based upon observation of OpenSSL 0.9.2B
 *
 * Addition credit is due for Andreas Kupries ([email protected]), for

/*
 * This structure describes the channel type structure for TCP socket
 * based IO:
 */
#ifdef TCL_CHANNEL_VERSION_2
static Tcl_ChannelType tlsChannelType = {
    "tls",		/* Type name. */
    TCL_CHANNEL_VERSION_2,	/* A NG channel */
    TlsCloseProc,		/* Close proc. */
    TlsInputProc,		/* Input proc. */
    TlsOutputProc,		/* Output proc. */
    TCL_CHANNEL_VERSION_2,	/* A v2 channel (8.3.2/8.4a2+) */
    TlsCloseProc,	/* Close proc. */
    TlsInputProc,	/* Input proc. */
    TlsOutputProc,	/* Output proc. */
    NULL,		/* Seek proc. */
    NULL,		/* Set option proc. */
    TlsGetOptionProc,	/* Get option proc. */
    TlsWatchProc,		/* Initialize notifier. */
    TlsWatchProc,	/* Initialize notifier. */
    TlsGetHandleProc,	/* Get file handle out of channel. */
    NULL,		/* Close2Proc. */
    TlsBlockModeProc,	/* Set blocking/nonblocking mode.*/
    NULL,		/* FlushProc. */
    TlsNotifyProc,	/* handlerProc. */
};
#else
static Tcl_ChannelType tlsChannelType = {
    "tls",		/* Type name. */
    TlsBlockModeProc,	/* Set blocking/nonblocking mode.*/
    TlsCloseProc,		/* Close proc. */
    TlsInputProc,		/* Input proc. */
    TlsOutputProc,		/* Output proc. */
    TlsCloseProc,	/* Close proc. */
    TlsInputProc,	/* Input proc. */
    TlsOutputProc,	/* Output proc. */
    NULL,		/* Seek proc. */
    NULL,		/* Set option proc. */
    TlsGetOptionProc,	/* Get option proc. */
    TlsWatchProc,		/* Initialize notifier. */
    TlsWatchProc,	/* Initialize notifier. */
    TlsGetHandleProc,	/* Get file handle out of channel. */
};
#endif

Tcl_ChannelType *Tls_ChannelType()
{
    return &tlsChannelType;

TlsCloseProc(ClientData instanceData,	/* The socket to close. */
             Tcl_Interp *interp)	/* For error reporting - unused. */
{
    State *statePtr = (State *) instanceData;

    dprintf(stderr,"\nTlsCloseProc(0x%x)", statePtr);

#ifndef TCL_CHANNEL_VERSION_2
    /*
     * Remove event handler to underlying channel, this could
     * be because we are closing for real, or being "unstacked".
     */
#ifndef TCL_CHANNEL_VERSION_2

    Tcl_DeleteChannelHandler(Tls_GetParent(statePtr),
	TlsChannelHandler, (ClientData) statePtr);
#endif
    if (statePtr->timer != (Tcl_TimerToken)NULL) {
	Tcl_DeleteTimerHandler (statePtr->timer);
	statePtr->timer = (Tcl_TimerToken)NULL;
    }

    Tls_Clean(statePtr);
    Tcl_EventuallyFree( (ClientData)statePtr, Tls_Free);
    return TCL_OK;
}

/*

	/* Not initialized yet! */
	if (statePtr->flags & TLS_TCL_SERVER) {
	    err = SSL_accept(statePtr->ssl);
	} else {
	    err = SSL_connect(statePtr->ssl);
	}
	/*SSL_write(statePtr->ssl, (char*)&err, 0);	HACK!!! */
	if (err > 0)
	if (err > 0) {
	    BIO_flush(statePtr->bio);
	}

	if (err <= 0) {
	    int rc = SSL_get_error(statePtr->ssl, err);

	    if (rc == SSL_ERROR_SSL) {
		Tls_Error(statePtr,
		Tls_Error(statePtr, (char*)ERR_reason_error_string(ERR_get_error()));
			(char *)ERR_reason_error_string(ERR_get_error()));
		*errorCodePtr = ECONNABORTED;
		return -1;
	    } else if (BIO_should_retry(statePtr->bio)) {
		if (statePtr->flags & TLS_TCL_ASYNC) {
		    dprintf(stderr,"E! ");
		    *errorCodePtr = EAGAIN;
		    return -1;
		} else {
		    continue;
		}
	    } else if (err == 0) {
		dprintf(stderr,"CR! ");
		*errorCodePtr = ECONNRESET;
		return -1;
	    }
	    if (statePtr->flags & TLS_TCL_SERVER) {
		err = SSL_get_verify_result(statePtr->ssl);
		if (err != X509_V_OK) {
		    Tls_Error(statePtr,
		    Tls_Error(statePtr, (char*)X509_verify_cert_error_string(err));
			    (char *)X509_verify_cert_error_string(err));
		    *errorCodePtr = ECONNABORTED;
		    return -1;
		}
	    }
	    *errorCodePtr = Tcl_GetErrno();
	    dprintf(stderr,"ERR(%d, %d) ", rc, *errorCodePtr);
	    return -1;