/*

 * tclIOGT.c --

 *

 *	Implements a generic transformation exposing the underlying API

 *	at the script level.  Contributed by Andreas Kupries.

 *

 * Copyright (c) 2000 Ajuba Solutions

 * Copyright (c) 1999-2000 Andreas Kupries (a.kupries@westend.com)

 *

 * See the file "license.terms" for information on usage and redistribution

 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.

 *

 * CVS: $Id: tclIOGT.c,v 1.7.2.2 2006/08/30 17:24:07 hobbs Exp $

 */

#include "tclInt.h"

#include "tclPort.h"

#include "tclIO.h"

/*

 * Forward declarations of internal procedures.

 * First the driver procedures of the transformation.

 */

static int		TransformBlockModeProc _ANSI_ARGS_ ((

				ClientData instanceData, int mode));

static int		TransformCloseProc _ANSI_ARGS_ ((

				ClientData instanceData, Tcl_Interp* interp));

static int		TransformInputProc _ANSI_ARGS_ ((

				ClientData instanceData,

				char* buf, int toRead, int* errorCodePtr));

static int		TransformOutputProc _ANSI_ARGS_ ((

				ClientData instanceData, CONST char *buf,

				int toWrite, int* errorCodePtr));

static int		TransformSeekProc _ANSI_ARGS_ ((

				ClientData instanceData, long offset,

				int mode, int* errorCodePtr));

static int		TransformSetOptionProc _ANSI_ARGS_((

				ClientData instanceData, Tcl_Interp *interp,

				CONST char *optionName, CONST char *value));

static int		TransformGetOptionProc _ANSI_ARGS_((

				ClientData instanceData, Tcl_Interp *interp,

				CONST char *optionName, Tcl_DString *dsPtr));

static void		TransformWatchProc _ANSI_ARGS_ ((

				ClientData instanceData, int mask));

static int		TransformGetFileHandleProc _ANSI_ARGS_ ((

				ClientData instanceData, int direction,

				ClientData* handlePtr));

static int		TransformNotifyProc _ANSI_ARGS_ ((

				ClientData instanceData, int mask));

static Tcl_WideInt	TransformWideSeekProc _ANSI_ARGS_ ((

				ClientData instanceData, Tcl_WideInt offset,

				int mode, int* errorCodePtr));

/*

 * Forward declarations of internal procedures.

 * Secondly the procedures for handling and generating fileeevents.

 */

static void		TransformChannelHandlerTimer _ANSI_ARGS_ ((

				ClientData clientData));

/*

 * Forward declarations of internal procedures.

 * Third, helper procedures encapsulating essential tasks.

 */

typedef struct TransformChannelData TransformChannelData;

static int		ExecuteCallback _ANSI_ARGS_ ((

				TransformChannelData* ctrl, Tcl_Interp* interp,

				unsigned char* op, unsigned char* buf,

				int bufLen, int transmit, int preserve));

/*

 * Action codes to give to 'ExecuteCallback' (argument 'transmit')

 * confering to the procedure what to do with the result of the script

 * it calls.

 */

#define TRANSMIT_DONT  (0) /* No transfer to do */

#define TRANSMIT_DOWN  (1) /* Transfer to the underlying channel */

#define TRANSMIT_SELF  (2) /* Transfer into our channel. */

#define TRANSMIT_IBUF  (3) /* Transfer to internal input buffer */

#define TRANSMIT_NUM   (4) /* Transfer number to 'maxRead' */

/*

 * Codes for 'preserve' of 'ExecuteCallback'

 */

#define P_PRESERVE    (1)

#define P_NO_PRESERVE (0)

/*

 * Strings for the action codes delivered to the script implementing

 * a transformation. Argument 'op' of 'ExecuteCallback'.

 */

#define A_CREATE_WRITE	(UCHARP ("create/write"))

#define A_DELETE_WRITE	(UCHARP ("delete/write"))

#define A_FLUSH_WRITE	(UCHARP ("flush/write"))

#define A_WRITE		(UCHARP ("write"))

#define A_CREATE_READ	(UCHARP ("create/read"))

#define A_DELETE_READ	(UCHARP ("delete/read"))

#define A_FLUSH_READ	(UCHARP ("flush/read"))

#define A_READ		(UCHARP ("read"))

#define A_QUERY_MAXREAD (UCHARP ("query/maxRead"))

#define A_CLEAR_READ	(UCHARP ("clear/read"))

/*

 * Management of a simple buffer.

 */

typedef struct ResultBuffer ResultBuffer;

static void		ResultClear  _ANSI_ARGS_ ((ResultBuffer* r));

static void		ResultInit   _ANSI_ARGS_ ((ResultBuffer* r));

static int		ResultLength _ANSI_ARGS_ ((ResultBuffer* r));

static int		ResultCopy   _ANSI_ARGS_ ((ResultBuffer* r,

				unsigned char* buf, int toRead));

static void		ResultAdd    _ANSI_ARGS_ ((ResultBuffer* r,

				unsigned char* buf, int toWrite));

/*

 * This structure describes the channel type structure for tcl based

 * transformations.

 */

static Tcl_ChannelType transformChannelType = {

    "transform",			/* Type name. */

    TCL_CHANNEL_VERSION_3,

    TransformCloseProc,			/* Close proc. */

    TransformInputProc,			/* Input proc. */

    TransformOutputProc,		/* Output proc. */

    TransformSeekProc,			/* Seek proc. */

    TransformSetOptionProc,		/* Set option proc. */

    TransformGetOptionProc,		/* Get option proc. */

    TransformWatchProc,			/* Initialize notifier. */

    TransformGetFileHandleProc,		/* Get OS handles out of channel. */

    NULL,				/* close2proc */

    TransformBlockModeProc,		/* Set blocking/nonblocking mode.*/

    NULL,				/* Flush proc. */

    TransformNotifyProc,                /* Handling of events bubbling up */

    TransformWideSeekProc,		/* Wide seek proc */

};

/*

 * Possible values for 'flags' field in control structure, see below.

 */

#define CHANNEL_ASYNC		(1<<0) /* non-blocking mode */

/*

 * Definition of the structure containing the information about the

 * internal input buffer.

 */

struct ResultBuffer {

    unsigned char* buf;       /* Reference to the buffer area */

    int		   allocated; /* Allocated size of the buffer area */

    int		   used;      /* Number of bytes in the buffer, <= allocated */

};

/*

 * Additional bytes to allocate during buffer expansion

 */

#define INCREMENT (512)

/*

 * Number of milliseconds to wait before firing an event to flush

 * out information waiting in buffers (fileevent support).

 */

#define FLUSH_DELAY (5)

/*

 * Convenience macro to make some casts easier to use.

 */

#define UCHARP(x) ((unsigned char*) (x))

#define NO_INTERP ((Tcl_Interp*) NULL)

/*

 * Definition of a structure used by all transformations generated here to

 * maintain their local state.

 */

struct TransformChannelData {

    /*

     * General section. Data to integrate the transformation into the channel

     * system.

     */

    Tcl_Channel self;     /* Our own Channel handle */

    int readIsFlushed;    /* Flag to note wether in.flushProc was called or not

			   */

    int flags;            /* Currently CHANNEL_ASYNC or zero */

    int watchMask;        /* Current watch/event/interest mask */

    int mode;             /* mode of parent channel, OR'ed combination of

			   * TCL_READABLE, TCL_WRITABLE */

    Tcl_TimerToken timer; /* Timer for automatic flushing of information

			   * sitting in an internal buffer. Required for full

			   * fileevent support */

    /*

     * Transformation specific data.

     */

    int maxRead;            /* Maximum allowed number of bytes to read, as

			     * given to us by the tcl script implementing the

			     * transformation. */

    Tcl_Interp*    interp;  /* Reference to the interpreter which created the

			     * transformation. Used to execute the code

			     * below. */

    Tcl_Obj*       command; /* Tcl code to execute for a buffer */

    ResultBuffer   result;  /* Internal buffer used to store the result of a

			     * transformation of incoming data. Additionally

			     * serves as buffer of all data not yet consumed by

			     * the reader. */

};

/*

 *----------------------------------------------------------------------

 *

 * TclChannelTransform --

 *

 *	Implements the Tcl "testchannel transform" debugging command.

 *	This is part of the testing environment.  This sets up a tcl

 *	script (cmdObjPtr) to be used as a transform on the channel.

 *

 * Results:

 *	A standard Tcl result.

 *

 * Side effects:

 *	None.

 *

 *----------------------------------------------------------------------

 */

	/* ARGSUSED */

int

TclChannelTransform(interp, chan, cmdObjPtr)

    Tcl_Interp	*interp;	/* Interpreter for result. */

    Tcl_Channel chan;		/* Channel to transform. */

    Tcl_Obj	*cmdObjPtr;	/* Script to use for transform. */

{

    Channel			*chanPtr;	/* The actual channel. */

    ChannelState		*statePtr;	/* state info for channel */

    int				mode;		/* rw mode of the channel */

    TransformChannelData	*dataPtr;

    int				res;

    Tcl_DString			ds;

    if (chan == (Tcl_Channel) NULL) {

	return TCL_ERROR;

    }

    chanPtr	= (Channel *) chan;

    statePtr	= chanPtr->state;

    chanPtr	= statePtr->topChanPtr;

    chan	= (Tcl_Channel) chanPtr;

    mode	= (statePtr->flags & (TCL_READABLE|TCL_WRITABLE));

    /*

     * Now initialize the transformation state and stack it upon the

     * specified channel. One of the necessary things to do is to

     * retrieve the blocking regime of the underlying channel and to

     * use the same for us too.

     */

    dataPtr = (TransformChannelData*) ckalloc(sizeof(TransformChannelData));

    Tcl_DStringInit (&ds);

    Tcl_GetChannelOption(interp, chan, "-blocking", &ds);

    dataPtr->readIsFlushed = 0;

    dataPtr->flags	= 0;

    if (ds.string[0] == '0') {

	dataPtr->flags |= CHANNEL_ASYNC;

    }

    Tcl_DStringFree (&ds);

    dataPtr->self	= chan;

    dataPtr->watchMask	= 0;

    dataPtr->mode	= mode;

    dataPtr->timer	= (Tcl_TimerToken) NULL;

    dataPtr->maxRead	= 4096; /* Initial value not relevant */

    dataPtr->interp	= interp;

    dataPtr->command	= cmdObjPtr;

    Tcl_IncrRefCount(dataPtr->command);

    ResultInit(&dataPtr->result);

    dataPtr->self = Tcl_StackChannel(interp, &transformChannelType,

	    (ClientData) dataPtr, mode, chan);

    if (dataPtr->self == (Tcl_Channel) NULL) {

	Tcl_AppendResult(interp, "\nfailed to stack channel \"",

		Tcl_GetChannelName(chan), "\"", (char *) NULL);

	Tcl_DecrRefCount(dataPtr->command);

	ResultClear(&dataPtr->result);

	ckfree((VOID *) dataPtr);

	return TCL_ERROR;

    }

    /*

     * At last initialize the transformation at the script level.

     */

    if (dataPtr->mode & TCL_WRITABLE) {

	res = ExecuteCallback (dataPtr, NO_INTERP, A_CREATE_WRITE,

		NULL, 0, TRANSMIT_DONT, P_NO_PRESERVE);

	if (res != TCL_OK) {

	    Tcl_UnstackChannel(interp, chan);

	    return TCL_ERROR;

	}

    }

    if (dataPtr->mode & TCL_READABLE) {

	res = ExecuteCallback (dataPtr, NO_INTERP, A_CREATE_READ,

		NULL, 0, TRANSMIT_DONT, P_NO_PRESERVE);

	if (res != TCL_OK) {

	    ExecuteCallback (dataPtr, NO_INTERP, A_DELETE_WRITE,

		    NULL, 0, TRANSMIT_DONT, P_NO_PRESERVE);

	    Tcl_UnstackChannel(interp, chan);

	    return TCL_ERROR;

	}

    }

    return TCL_OK;

}

/*

 *------------------------------------------------------*

 *

 *	ExecuteCallback --

 *

 *	Executes the defined callback for buffer and

 *	operation.

 *

 *	Sideeffects:

 *		As of the executed tcl script.

 *

 *	Result:

 *		A standard TCL error code. In case of an

 *		error a message is left in the result area

 *		of the specified interpreter.

 *

 *------------------------------------------------------*

 */

static int

ExecuteCallback (dataPtr, interp, op, buf, bufLen, transmit, preserve)

    TransformChannelData* dataPtr;  /* Transformation with the callback */

    Tcl_Interp*           interp;   /* Current interpreter, possibly NULL */

    unsigned char*        op;       /* Operation invoking the callback */

    unsigned char*        buf;      /* Buffer to give to the script. */

    int			  bufLen;   /* Ands its length */

    int                   transmit; /* Flag, determines whether the result

				     * of the callback is sent to the

				     * underlying channel or not. */

    int                   preserve; /* Flag. If true the procedure will

				     * preserver the result state of all

				     * accessed interpreters. */

{

    /*

     * Step 1, create the complete command to execute. Do this by appending

     * operation and buffer to operate upon to a copy of the callback

     * definition. We *cannot* create a list containing 3 objects and then use

     * 'Tcl_EvalObjv', because the command may contain additional prefixed

     * arguments. Feather's curried commands would come in handy here.

     */

    Tcl_Obj* resObj;		    /* See below, switch (transmit) */

    int resLen;

    unsigned char* resBuf;

    Tcl_SavedResult ciSave;

    int res = TCL_OK;

    Tcl_Obj* command = Tcl_DuplicateObj (dataPtr->command);

    Tcl_Obj* temp;

    if (preserve) {

	Tcl_SaveResult (dataPtr->interp, &ciSave);

    }

    if (command == (Tcl_Obj*) NULL) {

        /* Memory allocation problem */

        res = TCL_ERROR;

        goto cleanup;

    }

    Tcl_IncrRefCount(command);

    temp = Tcl_NewStringObj((char*) op, -1);

    if (temp == (Tcl_Obj*) NULL) {

        /* Memory allocation problem */

        res = TCL_ERROR;

        goto cleanup;

    }

    res = Tcl_ListObjAppendElement(dataPtr->interp, command, temp);

    if (res != TCL_OK)

	goto cleanup;

    /*

     * Use a byte-array to prevent the misinterpretation of binary data

     * coming through as UTF while at the tcl level.

     */

    temp = Tcl_NewByteArrayObj(buf, bufLen);

    if (temp == (Tcl_Obj*) NULL) {

        /* Memory allocation problem */

	res = TCL_ERROR;

        goto cleanup;

    }

    res = Tcl_ListObjAppendElement (dataPtr->interp, command, temp);

    if (res != TCL_OK)

        goto cleanup;

    /*

     * Step 2, execute the command at the global level of the interpreter

     * used to create the transformation. Destroy the command afterward.

     * If an error occured and the current interpreter is defined and not

     * equal to the interpreter for the callback, then copy the error

     * message into current interpreter. Don't copy if in preservation mode.

     */

    res = Tcl_EvalObjEx(dataPtr->interp, command, TCL_EVAL_GLOBAL);

    Tcl_DecrRefCount (command);

    command = (Tcl_Obj*) NULL;

    if ((res != TCL_OK) && (interp != NO_INTERP) &&

	    (dataPtr->interp != interp) && !preserve) {

        Tcl_SetObjResult(interp, Tcl_GetObjResult(dataPtr->interp));

	return res;

    }

    /*

     * Step 3, transmit a possible conversion result to the underlying

     * channel, or ourselves.

     */

    switch (transmit) {

	case TRANSMIT_DONT:

	    /* nothing to do */

	    break;

	case TRANSMIT_DOWN:

	    resObj = Tcl_GetObjResult(dataPtr->interp);

	    resBuf = (unsigned char*) Tcl_GetByteArrayFromObj(resObj, &resLen);

	    Tcl_WriteRaw(Tcl_GetStackedChannel(dataPtr->self),

		    (char*) resBuf, resLen);

	    break;

	case TRANSMIT_SELF:

	    resObj = Tcl_GetObjResult (dataPtr->interp);

	    resBuf = (unsigned char*) Tcl_GetByteArrayFromObj(resObj, &resLen);

	    Tcl_WriteRaw(dataPtr->self, (char*) resBuf, resLen);

	    break;

	case TRANSMIT_IBUF:

	    resObj = Tcl_GetObjResult (dataPtr->interp);

	    resBuf = (unsigned char*) Tcl_GetByteArrayFromObj(resObj, &resLen);

	    ResultAdd(&dataPtr->result, resBuf, resLen);

	    break;

	case TRANSMIT_NUM:

	    /* Interpret result as integer number */

	    resObj = Tcl_GetObjResult (dataPtr->interp);

	    Tcl_GetIntFromObj(dataPtr->interp, resObj, &dataPtr->maxRead);

	    break;

    }

    Tcl_ResetResult(dataPtr->interp);

    if (preserve) {

	Tcl_RestoreResult(dataPtr->interp, &ciSave);

    }

    return res;

    cleanup:

    if (preserve) {

	Tcl_RestoreResult(dataPtr->interp, &ciSave);

    }

    if (command != (Tcl_Obj*) NULL) {

        Tcl_DecrRefCount(command);

    }

    return res;

}

/*

 *------------------------------------------------------*

 *

 *	TransformBlockModeProc --

 *

 *	Trap handler. Called by the generic IO system

 *	during option processing to change the blocking

 *	mode of the channel.

 *

 *	Sideeffects:

 *		Forwards the request to the underlying

 *		channel.

 *

 *	Result:

 *		0 if successful, errno when failed.

 *

 *------------------------------------------------------*

 */

static int

TransformBlockModeProc (instanceData, mode)

    ClientData  instanceData; /* State of transformation */

    int         mode;         /* New blocking mode */

{

    TransformChannelData* dataPtr = (TransformChannelData*) instanceData;

    if (mode == TCL_MODE_NONBLOCKING) {

        dataPtr->flags |= CHANNEL_ASYNC;

    } else {

        dataPtr->flags &= ~(CHANNEL_ASYNC);

    }

    return 0;

}

/*

 *------------------------------------------------------*

 *

 *	TransformCloseProc --

 *

 *	Trap handler. Called by the generic IO system

 *	during destruction of the transformation channel.

 *

 *	Sideeffects:

 *		Releases the memory allocated in

 *		'Tcl_TransformObjCmd'.

 *

 *	Result:

 *		None.

 *

 *------------------------------------------------------*

 */

static int

TransformCloseProc (instanceData, interp)

    ClientData  instanceData;

    Tcl_Interp* interp;

{

    TransformChannelData* dataPtr = (TransformChannelData*) instanceData;

    /*

     * Important: In this procedure 'dataPtr->self' already points to

     * the underlying channel.

     */

    /*

     * There is no need to cancel an existing channel handler, this is already

     * done. Either by 'Tcl_UnstackChannel' or by the general cleanup in

     * 'Tcl_Close'.

     *

     * But we have to cancel an active timer to prevent it from firing on the

     * removed channel.

     */

    if (dataPtr->timer != (Tcl_TimerToken) NULL) {

        Tcl_DeleteTimerHandler (dataPtr->timer);

	dataPtr->timer = (Tcl_TimerToken) NULL;

    }

    /*

     * Now flush data waiting in internal buffers to output and input. The

     * input must be done despite the fact that there is no real receiver

     * for it anymore. But the scripts might have sideeffects other parts

     * of the system rely on (f.e. signaling the close to interested parties).

     */

    if (dataPtr->mode & TCL_WRITABLE) {

        ExecuteCallback (dataPtr, interp, A_FLUSH_WRITE,

		NULL, 0, TRANSMIT_DOWN, 1);

    }

    if ((dataPtr->mode & TCL_READABLE) && !dataPtr->readIsFlushed) {

	dataPtr->readIsFlushed = 1;

        ExecuteCallback (dataPtr, interp, A_FLUSH_READ,

		NULL, 0, TRANSMIT_IBUF, 1);

    }

    if (dataPtr->mode & TCL_WRITABLE) {

        ExecuteCallback (dataPtr, interp, A_DELETE_WRITE,

		NULL, 0, TRANSMIT_DONT, 1);

    }

    if (dataPtr->mode & TCL_READABLE) {

        ExecuteCallback (dataPtr, interp, A_DELETE_READ,

		NULL, 0, TRANSMIT_DONT, 1);

    }

    /*

     * General cleanup

     */

    ResultClear(&dataPtr->result);

    Tcl_DecrRefCount(dataPtr->command);

    ckfree((VOID*) dataPtr);

    return TCL_OK;

}

/*

 *------------------------------------------------------*

 *

 *	TransformInputProc --

 *

 *	Called by the generic IO system to convert read data.

 *

 *	Sideeffects:

 *		As defined by the conversion.

 *

 *	Result:

 *		A transformed buffer.

 *

 *------------------------------------------------------*

 */

static int

TransformInputProc (instanceData, buf, toRead, errorCodePtr)

    ClientData instanceData;

    char*      buf;

    int	       toRead;

    int*       errorCodePtr;

{

    TransformChannelData* dataPtr = (TransformChannelData*) instanceData;

    int gotBytes, read, res, copied;

    Tcl_Channel downChan;

    /* should assert (dataPtr->mode & TCL_READABLE) */

    if (toRead == 0) {

	/* Catch a no-op.

	 */

	return 0;

    }

    gotBytes = 0;

    downChan = Tcl_GetStackedChannel(dataPtr->self);

    while (toRead > 0) {

        /*

	 * Loop until the request is satisfied (or no data is available from

	 * below, possibly EOF).

	 */

        copied    = ResultCopy (&dataPtr->result, UCHARP (buf), toRead);

	toRead   -= copied;

	buf      += copied;

	gotBytes += copied;

	if (toRead == 0) {

	    /* The request was completely satisfied from our buffers.

	     * We can break out of the loop and return to the caller.

	     */

	    return gotBytes;

	}

	/*

	 * Length (dataPtr->result) == 0, toRead > 0 here . Use the incoming

	 * 'buf'! as target to store the intermediary information read

	 * from the underlying channel.

	 *

	 * Ask the tcl level how much data it allows us to read from

	 * the underlying channel. This feature allows the transform to

	 * signal EOF upstream although there is none downstream. Useful

	 * to control an unbounded 'fcopy', either through counting bytes,

	 * or by pattern matching.

	 */

	ExecuteCallback (dataPtr, NO_INTERP, A_QUERY_MAXREAD,

		NULL, 0, TRANSMIT_NUM /* -> maxRead */, 1);

	if (dataPtr->maxRead >= 0) {

	    if (dataPtr->maxRead < toRead) {

	        toRead = dataPtr->maxRead;

	    }

	} /* else: 'maxRead < 0' == Accept the current value of toRead */

	if (toRead <= 0) {

	    return gotBytes;

	}

	read = Tcl_ReadRaw(downChan, buf, toRead);

	if (read < 0) {

	    /* Report errors to caller. EAGAIN is a special situation.

	     * If we had some data before we report that instead of the

	     * request to re-try.

	     */

	    if ((Tcl_GetErrno() == EAGAIN) && (gotBytes > 0)) {

	        return gotBytes;

	    }

	    *errorCodePtr = Tcl_GetErrno();

	    return -1;      

	}

	if (read == 0) {

	    /*

	     * Check wether we hit on EOF in the underlying channel or

	     * not. If not differentiate between blocking and

	     * non-blocking modes. In non-blocking mode we ran

	     * temporarily out of data. Signal this to the caller via

	     * EWOULDBLOCK and error return (-1). In the other cases

	     * we simply return what we got and let the caller wait

	     * for more. On the other hand, if we got an EOF we have

	     * to convert and flush all waiting partial data.

	     */

	    if (! Tcl_Eof (downChan)) {

	        if ((gotBytes == 0) && (dataPtr->flags & CHANNEL_ASYNC)) {

		    *errorCodePtr = EWOULDBLOCK;

		    return -1;

		} else {

		    return gotBytes;

		}

	    } else {

	        if (dataPtr->readIsFlushed) {

		    /* Already flushed, nothing to do anymore

		     */

		    return gotBytes;

		}

		dataPtr->readIsFlushed = 1;

		ExecuteCallback (dataPtr, NO_INTERP, A_FLUSH_READ,

			NULL, 0, TRANSMIT_IBUF, P_PRESERVE);

		if (ResultLength (&dataPtr->result) == 0) {

		    /* we had nothing to flush */

		    return gotBytes;

		}

		continue; /* at: while (toRead > 0) */

	    }

	} /* read == 0 */

	/* Transform the read chunk and add the result to our

	 * read buffer (dataPtr->result)

	 */

	res = ExecuteCallback (dataPtr, NO_INTERP, A_READ,

		UCHARP (buf), read, TRANSMIT_IBUF, P_PRESERVE);

	if (res != TCL_OK) {

	    *errorCodePtr = EINVAL;

	    return -1;

	}

    } /* while toRead > 0 */

    return gotBytes;

}

/*

 *------------------------------------------------------*

 *

 *	TransformOutputProc --

 *

 *	Called by the generic IO system to convert data

 *	waiting to be written.

 *

 *	Sideeffects:

 *		As defined by the transformation.

 *

 *	Result:

 *		A transformed buffer.

 *

 *------------------------------------------------------*

 */

static int

TransformOutputProc (instanceData, buf, toWrite, errorCodePtr)

    ClientData instanceData;

    CONST char*      buf;

    int        toWrite;

    int*       errorCodePtr;

{

    TransformChannelData* dataPtr = (TransformChannelData*) instanceData;

    int res;

    /* should assert (dataPtr->mode & TCL_WRITABLE) */

    if (toWrite == 0) {

	/* Catch a no-op.

	 */

	return 0;

    }

    res = ExecuteCallback (dataPtr, NO_INTERP, A_WRITE,

	    UCHARP (buf), toWrite,

	    TRANSMIT_DOWN, P_NO_PRESERVE);

    if (res != TCL_OK) {

        *errorCodePtr = EINVAL;

	return -1;

    }

    return toWrite;

}

/*

 *------------------------------------------------------*

 *

 *	TransformSeekProc --

 *

 *	This procedure is called by the generic IO level

 *	to move the access point in a channel.

 *

 *	Sideeffects:

 *		Moves the location at which the channel

 *		will be accessed in future operations.

 *		Flushes all transformation buffers, then

 *		forwards it to the underlying channel.

 *

 *	Result:

 *		-1 if failed, the new position if

 *		successful. An output argument contains

 *		the POSIX error code if an error

 *		occurred, or zero.

 *

 *------------------------------------------------------*

 */

static int

TransformSeekProc (instanceData, offset, mode, errorCodePtr)

    ClientData  instanceData;	/* The channel to manipulate */

    long	offset;		/* Size of movement. */

    int         mode;		/* How to move */

    int*        errorCodePtr;	/* Location of error flag. */

{

    TransformChannelData* dataPtr	= (TransformChannelData*) instanceData;

    Tcl_Channel           parent        = Tcl_GetStackedChannel(dataPtr->self);

    Tcl_ChannelType*      parentType	= Tcl_GetChannelType(parent);

    Tcl_DriverSeekProc*   parentSeekProc = Tcl_ChannelSeekProc(parentType);

    if ((offset == 0) && (mode == SEEK_CUR)) {

        /* This is no seek but a request to tell the caller the current

	 * location. Simply pass the request down.

	 */

	return (*parentSeekProc) (Tcl_GetChannelInstanceData(parent),

		offset, mode, errorCodePtr);

    }

    /*

     * It is a real request to change the position. Flush all data waiting

     * for output and discard everything in the input buffers. Then pass

     * the request down, unchanged.

     */

    if (dataPtr->mode & TCL_WRITABLE) {

        ExecuteCallback (dataPtr, NO_INTERP, A_FLUSH_WRITE,

		NULL, 0, TRANSMIT_DOWN, P_NO_PRESERVE);

    }

    if (dataPtr->mode & TCL_READABLE) {

        ExecuteCallback (dataPtr, NO_INTERP, A_CLEAR_READ,

		NULL, 0, TRANSMIT_DONT, P_NO_PRESERVE);

	ResultClear(&dataPtr->result);

	dataPtr->readIsFlushed = 0;

    }

    return (*parentSeekProc) (Tcl_GetChannelInstanceData(parent),

	    offset, mode, errorCodePtr);

}

/*

 *----------------------------------------------------------------------

 *

 * TransformWideSeekProc --

 *

 *	This procedure is called by the generic IO level to move the

 *	access point in a channel, with a (potentially) 64-bit offset.

 *

 * Side effects:

 *	Moves the location at which the channel will be accessed in

 *	future operations.  Flushes all transformation buffers, then

 *	forwards it to the underlying channel.

 *

 * Result:

 *	-1 if failed, the new position if successful. An output

 *	argument contains the POSIX error code if an error occurred,

 *	or zero.

 *

 *----------------------------------------------------------------------

 */

static Tcl_WideInt

TransformWideSeekProc (instanceData, offset, mode, errorCodePtr)

    ClientData  instanceData;	/* The channel to manipulate */

    Tcl_WideInt offset;		/* Size of movement. */

    int         mode;		/* How to move */

    int*        errorCodePtr;	/* Location of error flag. */

{

    TransformChannelData* dataPtr =

	(TransformChannelData*) instanceData;

    Tcl_Channel parent =

	Tcl_GetStackedChannel(dataPtr->self);

    Tcl_ChannelType* parentType	=

	Tcl_GetChannelType(parent);

    Tcl_DriverSeekProc* parentSeekProc =

	Tcl_ChannelSeekProc(parentType);

    Tcl_DriverWideSeekProc* parentWideSeekProc =

	Tcl_ChannelWideSeekProc(parentType);

    ClientData parentData =

	Tcl_GetChannelInstanceData(parent);

    if ((offset == Tcl_LongAsWide(0)) && (mode == SEEK_CUR)) {

        /*

	 * This is no seek but a request to tell the caller the current

	 * location. Simply pass the request down.

	 */

	if (parentWideSeekProc != NULL) {

	    return (*parentWideSeekProc) (parentData, offset, mode,

		    errorCodePtr);

	}

	return Tcl_LongAsWide((*parentSeekProc) (parentData, 0, mode,

		errorCodePtr));

    }

    /*

     * It is a real request to change the position. Flush all data waiting

     * for output and discard everything in the input buffers. Then pass

     * the request down, unchanged.

     */

    if (dataPtr->mode & TCL_WRITABLE) {

        ExecuteCallback (dataPtr, NO_INTERP, A_FLUSH_WRITE,

		NULL, 0, TRANSMIT_DOWN, P_NO_PRESERVE);

    }

    if (dataPtr->mode & TCL_READABLE) {

        ExecuteCallback (dataPtr, NO_INTERP, A_CLEAR_READ,

		NULL, 0, TRANSMIT_DONT, P_NO_PRESERVE);

	ResultClear(&dataPtr->result);

	dataPtr->readIsFlushed = 0;

    }

    /*

     * If we have a wide seek capability, we should stick with that.

     */

    if (parentWideSeekProc != NULL) {

	return (*parentWideSeekProc) (parentData, offset, mode, errorCodePtr);

    }

    /*

     * We're transferring to narrow seeks at this point; this is a bit

     * complex because we have to check whether the seek is possible

     * first (i.e. whether we are losing information in truncating the

     * bits of the offset.)  Luckily, there's a defined error for what

     * happens when trying to go out of the representable range.

     */

    if (offset<Tcl_LongAsWide(LONG_MIN) || offset>Tcl_LongAsWide(LONG_MAX)) {

	*errorCodePtr = EOVERFLOW;

	return Tcl_LongAsWide(-1);

    }

    return Tcl_LongAsWide((*parentSeekProc) (parentData,

	    Tcl_WideAsLong(offset), mode, errorCodePtr));

}

/*

 *------------------------------------------------------*

 *

 *	TransformSetOptionProc --

 *

 *	Called by generic layer to handle the reconfi-