tcliogt.c

来自「tcl是工具命令语言」· C语言 代码 · 共 1,454 行 · 第 1/3 页

/*
 * 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 ([e-mail])
 *
 * 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 2002/05/24 21:19:06 dkf 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_2,
    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_GlobalEvalObj (dataPtr->interp, command);
    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);