/*
 * 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 $
 *
 * 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

 * Local Defines
 */

/*
 * Forward declarations
 */

static int	TlsBlockModeProc _ANSI_ARGS_((ClientData instanceData,
			int mode));
static int	TlsCloseProc _ANSI_ARGS_ ((ClientData instanceData,
			Tcl_Interp *interp));
static int	TlsInputProc _ANSI_ARGS_((ClientData instanceData,
			char *buf, int bufSize, int *errorCodePtr));
static int	TlsOutputProc _ANSI_ARGS_((ClientData instanceData,
			char *buf, int toWrite, int *errorCodePtr));
static int	TlsGetOptionProc _ANSI_ARGS_ ((ClientData instanceData,
			Tcl_Interp *interp, char *optionName,
			Tcl_DString *dsPtr));
static void	TlsWatchProc _ANSI_ARGS_((ClientData instanceData, int mask));
static int	TlsGetHandleProc _ANSI_ARGS_ ((ClientData instanceData,
			int direction, ClientData *handlePtr));
static int	TlsNotifyProc _ANSI_ARGS_ ((ClientData instanceData,
			int mask));
static void	TlsChannelHandler _ANSI_ARGS_ ((ClientData clientData,
			int mask));
static void	TlsChannelHandlerTimer _ANSI_ARGS_ ((ClientData clientData));

/*
 * 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. */
    NULL,		/* Seek proc. */
    NULL,		/* Set option proc. */
    TlsGetOptionProc,	/* Get option proc. */
    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. */
    NULL,		/* Seek proc. */
    NULL,		/* Set option proc. */
    TlsGetOptionProc,	/* Get option proc. */
    TlsWatchProc,		/* Initialize notifier. */
    TlsGetHandleProc,	/* Get file handle out of channel. */
};
#endif

Tcl_ChannelType *Tls_ChannelType()
{
    return &tlsChannelType;
}

/*
 *-------------------------------------------------------------------
 *
 * TlsBlockModeProc --
 *
 *	This procedure is invoked by the generic IO level
 *       to set blocking and nonblocking modes
 * Results:
 *	0 if successful, errno when failed.
 *
 * Side effects:
 *	Sets the device into blocking or nonblocking mode.
 *
 *-------------------------------------------------------------------
 */

static int
TlsBlockModeProc(ClientData instanceData,	/* Socket state. */
                 int mode)			/* The mode to set. Can be one of
						* TCL_MODE_BLOCKING or
						* TCL_MODE_NONBLOCKING. */
{
    State *statePtr = (State *) instanceData;

    if (mode == TCL_MODE_NONBLOCKING) {

		"-blocking", (mode == TCL_MODE_NONBLOCKING) ? "0" : "1");
#endif
}

/*
 *-------------------------------------------------------------------
 *
 * TlsCloseProc --
 *
 *	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?
 *
 * Results:
 *	0 if successful, the value of Tcl_GetErrno() if failed.
 *
 * Side effects:
 *	Closes the socket of the channel.
 *
 *-------------------------------------------------------------------
 */
static int
TlsCloseProc(ClientData instanceData,	/* The socket to close. */
             Tcl_Interp *interp)	/* For error reporting - unused. */
{
    State *statePtr = (State *) instanceData;

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

    /*
     * 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;
}

/*
 *-------------------------------------------------------------------
 *
 * TlsInputProc --
 *
 *	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
 *	error occurred.
 *
 * Side effects:
 *	Reads input from the input device of the channel.
 *
 *-------------------------------------------------------------------
 */

static int
TlsInputProc(ClientData instanceData,	/* Socket state. */
             char *buf,			/* Where to store data read. */
             int bufSize,		/* How much space is available
                                         * in the buffer? */
             int *errorCodePtr)		/* Where to store error code. */
{
    State *statePtr = (State *) instanceData;
    int bytesRead;			/* How many bytes were read? */

    dprintf(stderr, "\nInput(%d) -> %d [%d]", bufSize, bytesRead, *errorCodePtr);
    return bytesRead;
}

/*
 *-------------------------------------------------------------------
 *
 * TlsOutputProc --
 *
 *	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.
 *
 * Side effects:
 *	Writes output on the output device of the channel.
 *
 *-------------------------------------------------------------------
 */

static int
TlsOutputProc(ClientData instanceData,	/* Socket state. */
              char *buf,			/* The data buffer. */
              int toWrite,		/* How many bytes to write? */
              int *errorCodePtr)	/* Where to store error code. */
{
    State *statePtr = (State *) instanceData;
    int written, err;

    dprintf(stderr, "\nOutput(%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.
 *
 *	Note: This code is based on code contributed by John Haxby.
 *
 * 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.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
static int
TlsGetOptionProc(ClientData instanceData,	/* Socket state. */
                 Tcl_Interp *interp,		/* For errors - can be NULL. */
                 char *optionName,		/* Name of the option to
                                                 * retrieve the value for, or
                                                 * NULL to get all options and
                                                 * their values. */
                 Tcl_DString *dsPtr)	         /* Where to store the computed value
                                                  * initialized by caller. */

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

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

#ifdef TCL_CHANNEL_VERSION_2
    Tcl_Channel     downChan;

    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.
     */

    downChan = Tls_GetParent(statePtr);

    (Tcl_GetChannelType(downChan))
	->watchProc(Tcl_GetChannelInstanceData(downChan), mask);

    /*
     * Management of the internal timer.
     */

    if (statePtr->timer != (Tcl_TimerToken) NULL) {
        Tcl_DeleteTimerHandler(statePtr->timer);
	statePtr->timer = (Tcl_TimerToken) NULL;
    }
    if ((mask & TCL_READABLE) && Tcl_InputBuffered(statePtr->self) > 0) {
        /*
	 * There is interest in readable events and we actually have
	 * data waiting, so generate a timer to flush that.
	 */
	statePtr->timer = Tcl_CreateTimerHandler(TLS_TCL_DELAY,
		TlsChannelHandlerTimer, (ClientData) statePtr);
    }
#else
    if (mask == statePtr->watchMask)
	return;

    if (statePtr->watchMask) {
	/*
	 * Remove event handler to underlying channel, this could
	 * be because we are closing for real, or being "unstacked".
	 */

	Tcl_DeleteChannelHandler(Tls_GetParent(statePtr),
		TlsChannelHandler, (ClientData) statePtr);
    }
    statePtr->watchMask = mask;
    if (statePtr->watchMask) {
	/*
	 * Setup active monitor for events on underlying Channel.
	 */

	Tcl_CreateChannelHandler(Tls_GetParent(statePtr),
		statePtr->watchMask, TlsChannelHandler, (ClientData) statePtr);
    }
#endif
}

/*
 *-------------------------------------------------------------------
 *
 * TlsGetHandleProc --
 *
 *	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. 
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
static int
TlsGetHandleProc(ClientData instanceData,	/* The socket state. */
                 int direction,		/* Which Tcl_File to retrieve? */
                 ClientData *handlePtr)	/* Where to store the handle.  */
{
    State *statePtr = (State *) instanceData;

    return Tcl_GetChannelHandle(Tls_GetParent(statePtr), direction, handlePtr);
}

/*
 *-------------------------------------------------------------------
 *
 * TlsNotifyProc --
 *
 *	Handler called by Tcl to inform us of activity
 *	on the underlying channel.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	May process the incoming event by itself.
 *
 *-------------------------------------------------------------------
 */

static int
TlsNotifyProc(instanceData, mask)
    ClientData	   instanceData; /* The state of the notified transformation */
    int		   mask;       /* The mask of occuring events */
{
    State *statePtr = (State *) instanceData;

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

    return mask;
}

#ifndef TCL_CHANNEL_VERSION_2
/*
 *------------------------------------------------------*
 *
 *      TlsChannelHandler --
 *
 *      ------------------------------------------------*
 *      Handler called by Tcl as a result of
 *      Tcl_CreateChannelHandler - to inform us of activity
 *      on the underlying channel.
 *      ------------------------------------------------*
 *
 *      Sideeffects:
 *              May generate subsequent calls to
 *              Tcl_NotifyChannel.
 *
 *      Result:
 *              None.
 *
 *------------------------------------------------------*
 */

static void
TlsChannelHandler (clientData, mask)
    ClientData     clientData;
    int            mask;
{
    State *statePtr = (State *) clientData;

dprintf(stderr, "HANDLER(0x%x)\n", mask);
    Tcl_Preserve( (ClientData)statePtr);

    if (mask & TCL_READABLE) {

    
    Tcl_NotifyChannel(statePtr->self, mask);
    
    if (statePtr->timer != (Tcl_TimerToken)NULL) {
	Tcl_DeleteTimerHandler(statePtr->timer);
	statePtr->timer = (Tcl_TimerToken)NULL;
    }
    if ((mask & TCL_READABLE) && Tcl_InputBuffered(statePtr->self) > 0) {
	/*
	 * Data is waiting, flush it out in short time
	 */
	statePtr->timer = Tcl_CreateTimerHandler(TLS_TCL_DELAY,
		TlsChannelHandlerTimer, (ClientData) statePtr);
    }
    Tcl_Release( (ClientData)statePtr);
}
#endif

/*
 *------------------------------------------------------*
 *
 *	TlsChannelHandlerTimer --
 *
 *	------------------------------------------------*
 *	Called by the notifier (-> timer) to flush out
 *	information waiting in channel buffers.
 *	------------------------------------------------*
 *
 *	Sideeffects:
 *		As of 'TlsChannelHandler'.
 *
 *	Result:
 *		None.
 *
 *------------------------------------------------------*
 */

static void
TlsChannelHandlerTimer (clientData)
ClientData clientData; /* Transformation to query */
{
    State *statePtr = (State *) clientData;
    int mask = 0;

    statePtr->timer = (Tcl_TimerToken) NULL;