--- /dev/null
+/*
+ * 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.
+ */
+
+#include "tclInt.h"
+#include "tclIO.h"
+\f
+/*
+ * Forward declarations of internal procedures. First the driver procedures of
+ * the transformation.
+ */
+
+static int TransformBlockModeProc(ClientData instanceData,
+ int mode);
+static int TransformCloseProc(ClientData instanceData,
+ Tcl_Interp *interp);
+static int TransformClose2Proc(ClientData instanceData,
+ Tcl_Interp *interp, int flags);
+static int TransformInputProc(ClientData instanceData, char *buf,
+ int toRead, int *errorCodePtr);
+static int TransformOutputProc(ClientData instanceData,
+ const char *buf, int toWrite, int *errorCodePtr);
+static int TransformSeekProc(ClientData instanceData, long offset,
+ int mode, int *errorCodePtr);
+static int TransformSetOptionProc(ClientData instanceData,
+ Tcl_Interp *interp, const char *optionName,
+ const char *value);
+static int TransformGetOptionProc(ClientData instanceData,
+ Tcl_Interp *interp, const char *optionName,
+ Tcl_DString *dsPtr);
+static void TransformWatchProc(ClientData instanceData, int mask);
+static int TransformGetFileHandleProc(ClientData instanceData,
+ int direction, ClientData *handlePtr);
+static int TransformNotifyProc(ClientData instanceData, int mask);
+static Tcl_WideInt TransformWideSeekProc(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(ClientData clientData);
+
+/*
+ * Forward declarations of internal procedures. Third, helper procedures
+ * encapsulating essential tasks.
+ */
+
+typedef struct TransformChannelData TransformChannelData;
+
+static int ExecuteCallback(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'), telling
+ * 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 inline void ResultClear(ResultBuffer *r);
+static inline void ResultInit(ResultBuffer *r);
+static inline int ResultEmpty(ResultBuffer *r);
+static inline int ResultCopy(ResultBuffer *r, unsigned char *buf,
+ size_t toRead);
+static inline void ResultAdd(ResultBuffer *r, unsigned char *buf,
+ size_t toWrite);
+
+/*
+ * This structure describes the channel type structure for Tcl-based
+ * transformations.
+ */
+
+static const Tcl_ChannelType transformChannelType = {
+ "transform", /* Type name. */
+ TCL_CHANNEL_VERSION_5, /* v5 channel */
+ 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. */
+ TransformClose2Proc, /* close2proc */
+ TransformBlockModeProc, /* Set blocking/nonblocking mode.*/
+ NULL, /* Flush proc. */
+ TransformNotifyProc, /* Handling of events bubbling up. */
+ TransformWideSeekProc, /* Wide seek proc. */
+ NULL, /* Thread action. */
+ NULL /* Truncate. */
+};
+
+/*
+ * 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. */
+ size_t allocated; /* Allocated size of the buffer area. */
+ size_t used; /* Number of bytes in the buffer, no more than
+ * number 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))
+
+/*
+ * 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 whether in.flushProc was
+ * called or not. */
+ int eofPending; /* Flag: EOF seen down, not raised up */
+ 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. Also
+ * serves as buffer of all data not yet
+ * consumed by the reader. */
+ int refCount;
+};
+
+static void
+PreserveData(
+ TransformChannelData *dataPtr)
+{
+ dataPtr->refCount++;
+}
+
+static void
+ReleaseData(
+ TransformChannelData *dataPtr)
+{
+ if (--dataPtr->refCount) {
+ return;
+ }
+ ResultClear(&dataPtr->result);
+ Tcl_DecrRefCount(dataPtr->command);
+ ckfree(dataPtr);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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(
+ 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; /* Read/write mode of the channel. */
+ int objc;
+ TransformChannelData *dataPtr;
+ Tcl_DString ds;
+
+ if (chan == NULL) {
+ return TCL_ERROR;
+ }
+
+ if (TCL_OK != Tcl_ListObjLength(interp, cmdObjPtr, &objc)) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("-command value is not a list", -1));
+ 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));
+
+ dataPtr->refCount = 1;
+ Tcl_DStringInit(&ds);
+ Tcl_GetChannelOption(interp, chan, "-blocking", &ds);
+ dataPtr->readIsFlushed = 0;
+ dataPtr->eofPending = 0;
+ dataPtr->flags = 0;
+ if (ds.string[0] == '0') {
+ dataPtr->flags |= CHANNEL_ASYNC;
+ }
+ Tcl_DStringFree(&ds);
+
+ dataPtr->watchMask = 0;
+ dataPtr->mode = mode;
+ dataPtr->timer = 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, dataPtr,
+ mode, chan);
+ if (dataPtr->self == NULL) {
+ Tcl_AppendPrintfToObj(Tcl_GetObjResult(interp),
+ "\nfailed to stack channel \"%s\"", Tcl_GetChannelName(chan));
+ ReleaseData(dataPtr);
+ return TCL_ERROR;
+ }
+ Tcl_Preserve(dataPtr->self);
+
+ /*
+ * At last initialize the transformation at the script level.
+ */
+
+ PreserveData(dataPtr);
+ if ((dataPtr->mode & TCL_WRITABLE) && ExecuteCallback(dataPtr, NULL,
+ A_CREATE_WRITE, NULL, 0, TRANSMIT_DONT, P_NO_PRESERVE) != TCL_OK){
+ Tcl_UnstackChannel(interp, chan);
+ ReleaseData(dataPtr);
+ return TCL_ERROR;
+ }
+
+ if ((dataPtr->mode & TCL_READABLE) && ExecuteCallback(dataPtr, NULL,
+ A_CREATE_READ, NULL, 0, TRANSMIT_DONT, P_NO_PRESERVE) != TCL_OK) {
+ ExecuteCallback(dataPtr, NULL, A_DELETE_WRITE, NULL, 0, TRANSMIT_DONT,
+ P_NO_PRESERVE);
+ Tcl_UnstackChannel(interp, chan);
+ ReleaseData(dataPtr);
+ return TCL_ERROR;
+ }
+
+ ReleaseData(dataPtr);
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ExecuteCallback --
+ *
+ * Executes the defined callback for buffer and operation.
+ *
+ * Side effects:
+ * 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(
+ 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, /* And 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 preserve
+ * the result state of all accessed
+ * interpreters. */
+{
+ Tcl_Obj *resObj; /* See below, switch (transmit). */
+ int resLen;
+ unsigned char *resBuf;
+ Tcl_InterpState state = NULL;
+ int res = TCL_OK;
+ Tcl_Obj *command = TclListObjCopy(NULL, dataPtr->command);
+ Tcl_Interp *eval = dataPtr->interp;
+
+ Tcl_Preserve(eval);
+
+ /*
+ * 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.
+ */
+
+ if (preserve == P_PRESERVE) {
+ state = Tcl_SaveInterpState(eval, res);
+ }
+
+ Tcl_IncrRefCount(command);
+ Tcl_ListObjAppendElement(NULL, command, Tcl_NewStringObj((char *) op, -1));
+
+ /*
+ * Use a byte-array to prevent the misinterpretation of binary data coming
+ * through as UTF while at the tcl level.
+ */
+
+ Tcl_ListObjAppendElement(NULL, command, Tcl_NewByteArrayObj(buf, bufLen));
+
+ /*
+ * 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(eval, command, TCL_EVAL_GLOBAL);
+ Tcl_DecrRefCount(command);
+ command = NULL;
+
+ if ((res != TCL_OK) && (interp != NULL) && (eval != interp)
+ && (preserve == P_NO_PRESERVE)) {
+ Tcl_SetObjResult(interp, Tcl_GetObjResult(eval));
+ Tcl_Release(eval);
+ 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:
+ if (dataPtr->self == NULL) {
+ break;
+ }
+ resObj = Tcl_GetObjResult(eval);
+ resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen);
+ Tcl_WriteRaw(Tcl_GetStackedChannel(dataPtr->self), (char *) resBuf,
+ resLen);
+ break;
+
+ case TRANSMIT_SELF:
+ if (dataPtr->self == NULL) {
+ break;
+ }
+ resObj = Tcl_GetObjResult(eval);
+ resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen);
+ Tcl_WriteRaw(dataPtr->self, (char *) resBuf, resLen);
+ break;
+
+ case TRANSMIT_IBUF:
+ resObj = Tcl_GetObjResult(eval);
+ resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen);
+ ResultAdd(&dataPtr->result, resBuf, resLen);
+ break;
+
+ case TRANSMIT_NUM:
+ /*
+ * Interpret result as integer number.
+ */
+
+ resObj = Tcl_GetObjResult(eval);
+ TclGetIntFromObj(eval, resObj, &dataPtr->maxRead);
+ break;
+ }
+
+ Tcl_ResetResult(eval);
+ if (preserve == P_PRESERVE) {
+ (void) Tcl_RestoreInterpState(eval, state);
+ }
+ Tcl_Release(eval);
+ return res;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TransformBlockModeProc --
+ *
+ * Trap handler. Called by the generic IO system during option processing
+ * to change the blocking mode of the channel.
+ *
+ * Side effects:
+ * Forwards the request to the underlying channel.
+ *
+ * Result:
+ * 0 if successful, errno when failed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TransformBlockModeProc(
+ 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;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TransformCloseProc/TransformClose2Proc --
+ *
+ * Trap handler. Called by the generic IO system during destruction of
+ * the transformation channel.
+ *
+ * Side effects:
+ * Releases the memory allocated in 'Tcl_TransformObjCmd'.
+ *
+ * Result:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TransformCloseProc(
+ ClientData instanceData,
+ Tcl_Interp *interp)
+{
+ TransformChannelData *dataPtr = 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 != NULL) {
+ Tcl_DeleteTimerHandler(dataPtr->timer);
+ dataPtr->timer = 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).
+ */
+
+ PreserveData(dataPtr);
+ if (dataPtr->mode & TCL_WRITABLE) {
+ ExecuteCallback(dataPtr, interp, A_FLUSH_WRITE, NULL, 0,
+ TRANSMIT_DOWN, P_PRESERVE);
+ }
+
+ if ((dataPtr->mode & TCL_READABLE) && !dataPtr->readIsFlushed) {
+ dataPtr->readIsFlushed = 1;
+ ExecuteCallback(dataPtr, interp, A_FLUSH_READ, NULL, 0, TRANSMIT_IBUF,
+ P_PRESERVE);
+ }
+
+ if (dataPtr->mode & TCL_WRITABLE) {
+ ExecuteCallback(dataPtr, interp, A_DELETE_WRITE, NULL, 0,
+ TRANSMIT_DONT, P_PRESERVE);
+ }
+ if (dataPtr->mode & TCL_READABLE) {
+ ExecuteCallback(dataPtr, interp, A_DELETE_READ, NULL, 0,
+ TRANSMIT_DONT, P_PRESERVE);
+ }
+ ReleaseData(dataPtr);
+
+ /*
+ * General cleanup.
+ */
+
+ Tcl_Release(dataPtr->self);
+ dataPtr->self = NULL;
+ ReleaseData(dataPtr);
+ return TCL_OK;
+}
+
+static int
+TransformClose2Proc(
+ ClientData instanceData,
+ Tcl_Interp *interp,
+ int flags)
+{
+ if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) == 0) {
+ return TransformCloseProc(instanceData, interp);
+ }
+ return EINVAL;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TransformInputProc --
+ *
+ * Called by the generic IO system to convert read data.
+ *
+ * Side effects:
+ * As defined by the conversion.
+ *
+ * Result:
+ * A transformed buffer.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TransformInputProc(
+ ClientData instanceData,
+ char *buf,
+ int toRead,
+ int *errorCodePtr)
+{
+ TransformChannelData *dataPtr = (TransformChannelData *)instanceData;
+ int gotBytes, read, copied;
+ Tcl_Channel downChan;
+
+ /*
+ * Should assert(dataPtr->mode & TCL_READABLE);
+ */
+
+ if (toRead == 0 || dataPtr->self == NULL) {
+ /*
+ * Catch a no-op. TODO: Is this a panic()?
+ */
+ return 0;
+ }
+
+ gotBytes = 0;
+ downChan = Tcl_GetStackedChannel(dataPtr->self);
+
+ PreserveData(dataPtr);
+ 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.
+ */
+
+ break;
+ }
+
+ /*
+ * 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, NULL, A_QUERY_MAXREAD, NULL, 0,
+ TRANSMIT_NUM /* -> maxRead */, P_PRESERVE);
+
+ if (dataPtr->maxRead >= 0) {
+ if (dataPtr->maxRead < toRead) {
+ toRead = dataPtr->maxRead;
+ }
+ } /* else: 'maxRead < 0' == Accept the current value of toRead. */
+ if (toRead <= 0) {
+ break;
+ }
+ if (dataPtr->eofPending) {
+ /*
+ * Already saw EOF from downChan; don't ask again.
+ * NOTE: Could move this up to avoid the last maxRead
+ * execution. Believe this would still be correct behavior,
+ * but the test suite tests the whole command callback
+ * sequence, so leave it unchanged for now.
+ */
+
+ break;
+ }
+
+ /*
+ * Get bytes from the underlying channel.
+ */
+
+ read = Tcl_ReadRaw(downChan, buf, toRead);
+ if (read < 0) {
+ if (Tcl_InputBlocked(downChan) && (gotBytes > 0)) {
+ /*
+ * Zero bytes available from downChan because blocked.
+ * But nonzero bytes already copied, so total is a
+ * valid blocked short read. Return to caller.
+ */
+
+ break;
+ }
+
+ /*
+ * Either downChan is not blocked (there's a real error).
+ * or it is and there are no bytes copied yet. In either
+ * case we want to pass the "error" along to the caller,
+ * either to report an error, or to signal to the caller
+ * that zero bytes are available because blocked.
+ */
+
+ *errorCodePtr = Tcl_GetErrno();
+ gotBytes = -1;
+ break;
+ } else if (read == 0) {
+
+ /*
+ * Zero returned from Tcl_ReadRaw() always indicates EOF
+ * on the down channel.
+ */
+
+ dataPtr->eofPending = 1;
+ dataPtr->readIsFlushed = 1;
+ ExecuteCallback(dataPtr, NULL, A_FLUSH_READ, NULL, 0,
+ TRANSMIT_IBUF, P_PRESERVE);
+
+ if (ResultEmpty(&dataPtr->result)) {
+ /*
+ * We had nothing to flush.
+ */
+
+ break;
+ }
+
+ continue; /* at: while (toRead > 0) */
+ } /* read == 0 */
+
+ /*
+ * Transform the read chunk and add the result to our read buffer
+ * (dataPtr->result).
+ */
+
+ if (ExecuteCallback(dataPtr, NULL, A_READ, UCHARP(buf), read,
+ TRANSMIT_IBUF, P_PRESERVE) != TCL_OK) {
+ *errorCodePtr = EINVAL;
+ gotBytes = -1;
+ break;
+ }
+ } /* while toRead > 0 */
+
+ if (gotBytes == 0) {
+ dataPtr->eofPending = 0;
+ }
+ ReleaseData(dataPtr);
+ return gotBytes;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TransformOutputProc --
+ *
+ * Called by the generic IO system to convert data waiting to be written.
+ *
+ * Side effects:
+ * As defined by the transformation.
+ *
+ * Result:
+ * A transformed buffer.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TransformOutputProc(
+ ClientData instanceData,
+ const char *buf,
+ int toWrite,
+ int *errorCodePtr)
+{
+ TransformChannelData *dataPtr = (TransformChannelData *)instanceData;
+
+ /*
+ * Should assert(dataPtr->mode & TCL_WRITABLE);
+ */
+
+ if (toWrite == 0) {
+ /*
+ * Catch a no-op.
+ */
+
+ return 0;
+ }
+
+ PreserveData(dataPtr);
+ if (ExecuteCallback(dataPtr, NULL, A_WRITE, UCHARP(buf), toWrite,
+ TRANSMIT_DOWN, P_NO_PRESERVE) != TCL_OK) {
+ *errorCodePtr = EINVAL;
+ toWrite = -1;
+ }
+ ReleaseData(dataPtr);
+
+ return toWrite;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TransformSeekProc --
+ *
+ * This procedure is called by the generic IO level to move the access
+ * point in a channel.
+ *
+ * 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 int
+TransformSeekProc(
+ 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);
+ const 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.
+ */
+
+ PreserveData(dataPtr);
+ if (dataPtr->mode & TCL_WRITABLE) {
+ ExecuteCallback(dataPtr, NULL, A_FLUSH_WRITE, NULL, 0, TRANSMIT_DOWN,
+ P_NO_PRESERVE);
+ }
+
+ if (dataPtr->mode & TCL_READABLE) {
+ ExecuteCallback(dataPtr, NULL, A_CLEAR_READ, NULL, 0, TRANSMIT_DONT,
+ P_NO_PRESERVE);
+ ResultClear(&dataPtr->result);
+ dataPtr->readIsFlushed = 0;
+ dataPtr->eofPending = 0;
+ }
+ ReleaseData(dataPtr);
+
+ return parentSeekProc(Tcl_GetChannelInstanceData(parent), offset, mode,
+ errorCodePtr);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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(
+ 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);
+ const 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 == 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.
+ */
+
+ PreserveData(dataPtr);
+ if (dataPtr->mode & TCL_WRITABLE) {
+ ExecuteCallback(dataPtr, NULL, A_FLUSH_WRITE, NULL, 0, TRANSMIT_DOWN,
+ P_NO_PRESERVE);
+ }
+
+ if (dataPtr->mode & TCL_READABLE) {
+ ExecuteCallback(dataPtr, NULL, A_CLEAR_READ, NULL, 0, TRANSMIT_DONT,
+ P_NO_PRESERVE);
+ ResultClear(&dataPtr->result);
+ dataPtr->readIsFlushed = 0;
+ dataPtr->eofPending = 0;
+ }
+ ReleaseData(dataPtr);
+
+ /*
+ * 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));
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TransformSetOptionProc --
+ *
+ * Called by generic layer to handle the reconfiguration of channel
+ * specific options. As this channel type does not have such, it simply
+ * passes all requests downstream.
+ *
+ * Side effects:
+ * As defined by the channel downstream.
+ *
+ * Result:
+ * A standard TCL error code.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TransformSetOptionProc(
+ ClientData instanceData,
+ Tcl_Interp *interp,
+ const char *optionName,
+ const char *value)
+{
+ TransformChannelData *dataPtr = (TransformChannelData *)instanceData;
+ Tcl_Channel downChan = Tcl_GetStackedChannel(dataPtr->self);
+ Tcl_DriverSetOptionProc *setOptionProc;
+
+ setOptionProc = Tcl_ChannelSetOptionProc(Tcl_GetChannelType(downChan));
+ if (setOptionProc == NULL) {
+ return TCL_ERROR;
+ }
+
+ return setOptionProc(Tcl_GetChannelInstanceData(downChan), interp,
+ optionName, value);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TransformGetOptionProc --
+ *
+ * Called by generic layer to handle requests for the values of channel
+ * specific options. As this channel type does not have such, it simply
+ * passes all requests downstream.
+ *
+ * Side effects:
+ * As defined by the channel downstream.
+ *
+ * Result:
+ * A standard TCL error code.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TransformGetOptionProc(
+ ClientData instanceData,
+ Tcl_Interp *interp,
+ const char *optionName,
+ Tcl_DString *dsPtr)
+{
+ TransformChannelData *dataPtr = (TransformChannelData *)instanceData;
+ Tcl_Channel downChan = Tcl_GetStackedChannel(dataPtr->self);
+ Tcl_DriverGetOptionProc *getOptionProc;
+
+ getOptionProc = Tcl_ChannelGetOptionProc(Tcl_GetChannelType(downChan));
+ if (getOptionProc != NULL) {
+ return getOptionProc(Tcl_GetChannelInstanceData(downChan), interp,
+ optionName, dsPtr);
+ } else if (optionName == NULL) {
+ /*
+ * Request is query for all options, this is ok.
+ */
+
+ return TCL_OK;
+ }
+
+ /*
+ * Request for a specific option has to fail, since we don't have any.
+ */
+
+ return TCL_ERROR;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TransformWatchProc --
+ *
+ * Initialize the notifier to watch for events from this channel.
+ *
+ * Side effects:
+ * Sets up the notifier so that a future event on the channel will be
+ * seen by Tcl.
+ *
+ * Result:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+TransformWatchProc(
+ ClientData instanceData, /* Channel to watch. */
+ int mask) /* Events of interest. */
+{
+ TransformChannelData *dataPtr = (TransformChannelData *)instanceData;
+ Tcl_Channel downChan;
+
+ /*
+ * The caller expressed interest in events occuring for this channel. We
+ * are forwarding the call to the underlying channel now.
+ */
+
+ dataPtr->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.
+ */
+
+ if (dataPtr->self == NULL) {
+ return;
+ }
+ downChan = Tcl_GetStackedChannel(dataPtr->self);
+
+ Tcl_GetChannelType(downChan)->watchProc(
+ Tcl_GetChannelInstanceData(downChan), mask);
+
+ /*
+ * Management of the internal timer.
+ */
+
+ if ((dataPtr->timer != NULL) &&
+ (!(mask & TCL_READABLE) || ResultEmpty(&dataPtr->result))) {
+ /*
+ * A pending timer exists, but either is there no (more) interest in
+ * the events it generates or nothing is available for reading, so
+ * remove it.
+ */
+
+ Tcl_DeleteTimerHandler(dataPtr->timer);
+ dataPtr->timer = NULL;
+ }
+
+ if ((dataPtr->timer == NULL) && (mask & TCL_READABLE)
+ && !ResultEmpty(&dataPtr->result)) {
+ /*
+ * There is no pending timer, but there is interest in readable events
+ * and we actually have data waiting, so generate a timer to flush
+ * that.
+ */
+
+ dataPtr->timer = Tcl_CreateTimerHandler(FLUSH_DELAY,
+ TransformChannelHandlerTimer, dataPtr);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TransformGetFileHandleProc --
+ *
+ * Called from Tcl_GetChannelHandle to retrieve OS specific file handle
+ * from inside this channel.
+ *
+ * Side effects:
+ * None.
+ *
+ * Result:
+ * The appropriate Tcl_File or NULL if not present.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TransformGetFileHandleProc(
+ ClientData instanceData, /* Channel to query. */
+ int direction, /* Direction of interest. */
+ ClientData *handlePtr) /* Place to store the handle into. */
+{
+ TransformChannelData *dataPtr = (TransformChannelData *)instanceData;
+
+ /*
+ * Return the handle belonging to parent channel. IOW, pass the request
+ * down and the result up.
+ */
+
+ return Tcl_GetChannelHandle(Tcl_GetStackedChannel(dataPtr->self),
+ direction, handlePtr);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TransformNotifyProc --
+ *
+ * Handler called by Tcl to inform us of activity on the underlying
+ * channel.
+ *
+ * Side effects:
+ * May process the incoming event by itself.
+ *
+ * Result:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TransformNotifyProc(
+ ClientData clientData, /* The state of the notified
+ * transformation. */
+ int mask) /* The mask of occuring events. */
+{
+ TransformChannelData *dataPtr = (TransformChannelData *)clientData;
+
+ /*
+ * An event occured in the underlying channel. This transformation doesn't
+ * process such events thus returns the incoming mask unchanged.
+ */
+
+ if (dataPtr->timer != 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
+ * TransformWatchProc).
+ */
+
+ Tcl_DeleteTimerHandler(dataPtr->timer);
+ dataPtr->timer = NULL;
+ }
+ return mask;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TransformChannelHandlerTimer --
+ *
+ * Called by the notifier (-> timer) to flush out information waiting in
+ * the input buffer.
+ *
+ * Side effects:
+ * As of 'Tcl_NotifyChannel'.
+ *
+ * Result:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TransformChannelHandlerTimer(
+ ClientData clientData) /* Transformation to query. */
+{
+ TransformChannelData *dataPtr = (TransformChannelData *)clientData;
+
+ dataPtr->timer = NULL;
+ if (!(dataPtr->watchMask&TCL_READABLE) || ResultEmpty(&dataPtr->result)) {
+ /*
+ * The timer fired, but either is there no (more) interest in the
+ * events it generates or nothing is available for reading, so ignore
+ * it and don't recreate it.
+ */
+
+ return;
+ }
+ Tcl_NotifyChannel(dataPtr->self, TCL_READABLE);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ResultClear --
+ *
+ * Deallocates any memory allocated by 'ResultAdd'.
+ *
+ * Side effects:
+ * See above.
+ *
+ * Result:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static inline void
+ResultClear(
+ ResultBuffer *r) /* Reference to the buffer to clear out. */
+{
+ r->used = 0;
+
+ if (r->allocated) {
+ ckfree(r->buf);
+ r->buf = NULL;
+ r->allocated = 0;
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ResultInit --
+ *
+ * Initializes the specified buffer structure. The structure will contain
+ * valid information for an emtpy buffer.
+ *
+ * Side effects:
+ * See above.
+ *
+ * Result:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static inline void
+ResultInit(
+ ResultBuffer *r) /* Reference to the structure to
+ * initialize. */
+{
+ r->used = 0;
+ r->allocated = 0;
+ r->buf = NULL;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ResultEmpty --
+ *
+ * Returns whether the number of bytes stored in the buffer is zero.
+ *
+ * Side effects:
+ * None.
+ *
+ * Result:
+ * A boolean.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static inline int
+ResultEmpty(
+ ResultBuffer *r) /* The structure to query. */
+{
+ return r->used == 0;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ResultCopy --
+ *
+ * Copies the requested number of bytes from the buffer into the
+ * specified array and removes them from the buffer afterward. Copies
+ * less if there is not enough data in the buffer.
+ *
+ * Side effects:
+ * See above.
+ *
+ * Result:
+ * The number of actually copied bytes, possibly less than 'toRead'.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static inline int
+ResultCopy(
+ ResultBuffer *r, /* The buffer to read from. */
+ unsigned char *buf, /* The buffer to copy into. */
+ size_t toRead) /* Number of requested bytes. */
+{
+ if (r->used == 0) {
+ /*
+ * Nothing to copy in the case of an empty buffer.
+ */
+
+ return 0;
+ } else if (r->used == toRead) {
+ /*
+ * We have just enough. Copy everything to the caller.
+ */
+
+ memcpy(buf, r->buf, toRead);
+ r->used = 0;
+ } else if (r->used > toRead) {
+ /*
+ * The internal buffer contains more than requested. Copy the
+ * requested subset to the caller, and shift the remaining bytes down.
+ */
+
+ memcpy(buf, r->buf, toRead);
+ memmove(r->buf, r->buf + toRead, r->used - toRead);
+ r->used -= toRead;
+ } else {
+ /*
+ * There is not enough in the buffer to satisfy the caller, so take
+ * everything.
+ */
+
+ memcpy(buf, r->buf, r->used);
+ toRead = r->used;
+ r->used = 0;
+ }
+ return toRead;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * ResultAdd --
+ *
+ * Adds the bytes in the specified array to the buffer, by appending it.
+ *
+ * Side effects:
+ * See above.
+ *
+ * Result:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static inline void
+ResultAdd(
+ ResultBuffer *r, /* The buffer to extend. */
+ unsigned char *buf, /* The buffer to read from. */
+ size_t toWrite) /* The number of bytes in 'buf'. */
+{
+ if (r->used + toWrite > r->allocated) {
+ /*
+ * Extension of the internal buffer is required.
+ */
+
+ if (r->allocated == 0) {
+ r->allocated = toWrite + INCREMENT;
+ r->buf = (unsigned char *)ckalloc(r->allocated);
+ } else {
+ r->allocated += toWrite + INCREMENT;
+ r->buf = (unsigned char *)ckrealloc(r->buf, r->allocated);
+ }
+ }
+
+ /*
+ * Now we may copy the data.
+ */
+
+ memcpy(r->buf + r->used, buf, toWrite);
+ r->used += toWrite;
+}
+\f
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
OSDN Git Service
