Beispiel #1
0
	/* ARGSUSED */
static void
TransformWatchProc(
    ClientData instanceData,	/* Channel to watch. */
    int mask)			/* Events of interest. */
{
    TransformChannelData *dataPtr = 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);
    }
}
Beispiel #2
0
void
TclGetAndDetachPids(
    Tcl_Interp *interp,		/* Interpreter to append the PIDs to. */
    Tcl_Channel chan)		/* Handle for the pipeline. */
{
    PipeState *pipePtr;
    const Tcl_ChannelType *chanTypePtr;
    int i;
    char buf[TCL_INTEGER_SPACE];

    /*
     * Punt if the channel is not a command channel.
     */

    chanTypePtr = Tcl_GetChannelType(chan);
    if (chanTypePtr != &pipeChannelType) {
	return;
    }

    pipePtr = (PipeState *) Tcl_GetChannelInstanceData(chan);
    for (i = 0; i < pipePtr->numPids; i++) {
	TclFormatInt(buf, (long) TclpGetPid(pipePtr->pidPtr[i]));
	Tcl_AppendElement(interp, buf);
	Tcl_DetachPids(1, &(pipePtr->pidPtr[i]));
    }
    if (pipePtr->numPids > 0) {
	ckfree((char *) pipePtr->pidPtr);
	pipePtr->numPids = 0;
    }
}
Beispiel #3
0
void
TclGetAndDetachPids(
    Tcl_Interp *interp,		/* Interpreter to append the PIDs to. */
    Tcl_Channel chan)		/* Handle for the pipeline. */
{
    PipeState *pipePtr;
    const Tcl_ChannelType *chanTypePtr;
    Tcl_Obj *pidsObj;
    int i;

    /*
     * Punt if the channel is not a command channel.
     */

    chanTypePtr = Tcl_GetChannelType(chan);
    if (chanTypePtr != &pipeChannelType) {
        return;
    }

    pipePtr = Tcl_GetChannelInstanceData(chan);
    TclNewObj(pidsObj);
    for (i = 0; i < pipePtr->numPids; i++) {
        Tcl_ListObjAppendElement(NULL, pidsObj, Tcl_NewIntObj(
                                     PTR2INT(pipePtr->pidPtr[i])));
        Tcl_DetachPids(1, &pipePtr->pidPtr[i]);
    }
    Tcl_SetObjResult(interp, pidsObj);
    if (pipePtr->numPids > 0) {
        ckfree(pipePtr->pidPtr);
        pipePtr->numPids = 0;
    }
}
Beispiel #4
0
static int
TransformGetOptionProc(
    ClientData instanceData,
    Tcl_Interp *interp,
    const char *optionName,
    Tcl_DString *dsPtr)
{
    TransformChannelData *dataPtr = 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;
}
Beispiel #5
0
/*
** Attempt to extract a blob handle (type sqlite3_blob*) from the Tcl
** object passed as the second argument. If successful, set *ppBlob to
** point to the blob handle and return TCL_OK. Otherwise, store an error
** message in the tcl interpreter and return TCL_ERROR. The final value
** of *ppBlob is undefined in this case.
**
** If the object contains a string that begins with "incrblob_", then it
** is assumed to be the name of a Tcl channel opened using the [db incrblob] 
** command (see tclsqlite.c). Otherwise, it is assumed to be a pointer 
** encoded using the ptrToText() routine or similar.
*/
static int blobHandleFromObj(
  Tcl_Interp *interp, 
  Tcl_Obj *pObj,
  sqlite3_blob **ppBlob
){
  char *z;
  int n;

  z = Tcl_GetStringFromObj(pObj, &n);
  if( n==0 ){
    *ppBlob = 0;
  }else if( n>9 && 0==memcmp("incrblob_", z, 9) ){
    int notUsed;
    Tcl_Channel channel;
    ClientData instanceData;
    
    channel = Tcl_GetChannel(interp, z, &notUsed);
    if( !channel ) return TCL_ERROR;

    Tcl_Flush(channel);
    Tcl_Seek(channel, 0, SEEK_SET);

    instanceData = Tcl_GetChannelInstanceData(channel);
    *ppBlob = *((sqlite3_blob **)instanceData);
  }else{
    *ppBlob = (sqlite3_blob*)sqlite3TestTextToPtr(z);
  }

  return TCL_OK;
}
Beispiel #6
0
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 = 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);
}
Beispiel #7
0
/*
 * Find a slot for a new result id.  If the table is full, expand it by
 * a factor of 2.  However, do not expand past the hard max, as the client
 * is probably just not clearing result handles like they should.
 */
int
PgSetResultId(Tcl_Interp *interp, CONST84 char *connid_c, PGresult *res)
{
	Tcl_Channel conn_chan;
	Pg_ConnectionId *connid;
	int			resid,
				i;
	char		buf[32];


	conn_chan = Tcl_GetChannel(interp, connid_c, 0);
	if (conn_chan == NULL)
		return TCL_ERROR;
	connid = (Pg_ConnectionId *) Tcl_GetChannelInstanceData(conn_chan);

	/* search, starting at slot after the last one used */
	resid = connid->res_last;
	for (;;)
	{
		/* advance, with wraparound */
		if (++resid >= connid->res_max)
			resid = 0;
		/* this slot empty? */
		if (!connid->results[resid])
		{
			connid->res_last = resid;
			break;				/* success exit */
		}
		/* checked all slots? */
		if (resid == connid->res_last)
			break;				/* failure exit */
	}

	if (connid->results[resid])
	{
		/* no free slot found, so try to enlarge array */
		if (connid->res_max >= connid->res_hardmax)
		{
			Tcl_SetResult(interp, "hard limit on result handles reached",
						  TCL_STATIC);
			return TCL_ERROR;
		}
		connid->res_last = resid = connid->res_max;
		connid->res_max *= 2;
		if (connid->res_max > connid->res_hardmax)
			connid->res_max = connid->res_hardmax;
		connid->results = (PGresult **) ckrealloc((void *) connid->results,
								   sizeof(PGresult *) * connid->res_max);
		for (i = connid->res_last; i < connid->res_max; i++)
			connid->results[i] = NULL;
	}

	connid->results[resid] = res;
	sprintf(buf, "%s.%d", connid_c, resid);
	Tcl_SetResult(interp, buf, TCL_VOLATILE);
	return resid;
}
Beispiel #8
0
/*
 *-------------------------------------------------------------------
 *
 * TlsGetOptionProc --
 *
 *	Computes an option value for a SSL socket based channel, or a
 *	list of all options and their values.
 *
 * 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. */
	CONST84 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. */
{
    State *statePtr = (State *) instanceData;

    if (channelTypeVersion == TLS_CHANNEL_VERSION_2) {
	Tcl_Channel downChan = Tls_GetParent(statePtr);
	Tcl_DriverGetOptionProc *getOptionProc;

	getOptionProc = Tcl_ChannelGetOptionProc(Tcl_GetChannelType(downChan));
	if (getOptionProc != NULL) {
	    return (*getOptionProc)(Tcl_GetChannelInstanceData(downChan),
		    interp, optionName, dsPtr);
	} else if (optionName == (char*) NULL) {
	    /*
	     * Request is query for all options, this is ok.
	     */
	    return TCL_OK;
	}
	/*
	 * Request for a specific option has to fail, we don't have any.
	 */
	return TCL_ERROR;
    } else {
	size_t len = 0;

	if (optionName != (char *) NULL) {
	    len = strlen(optionName);
	}
#if 0
	if ((len == 0) || ((len > 1) && (optionName[1] == 'c') &&
		(strncmp(optionName, "-cipher", len) == 0))) {
	    if (len == 0) {
		Tcl_DStringAppendElement(dsPtr, "-cipher");
	    }
	    Tcl_DStringAppendElement(dsPtr, SSL_get_cipher(statePtr->ssl));
	    if (len) {
		return TCL_OK;
	    }
	}
#endif
	return TCL_OK;
    }
}
Beispiel #9
0
/* ARGSUSED */
int
Tcl_PidObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* Argument strings. */
{
    Tcl_Channel chan;
    PipeState *pipePtr;
    int i;
    Tcl_Obj *resultPtr;

    if (objc > 2) {
        Tcl_WrongNumArgs(interp, 1, objv, "?channelId?");
        return TCL_ERROR;
    }

    if (objc == 1) {
        Tcl_SetObjResult(interp, Tcl_NewLongObj((long) getpid()));
    } else {
        /*
         * Get the channel and make sure that it refers to a pipe.
         */

        chan = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), NULL);
        if (chan == NULL) {
            return TCL_ERROR;
        }
        if (Tcl_GetChannelType(chan) != &pipeChannelType) {
            return TCL_OK;
        }

        /*
         * Extract the process IDs from the pipe structure.
         */

        pipePtr = Tcl_GetChannelInstanceData(chan);
        resultPtr = Tcl_NewObj();
        for (i = 0; i < pipePtr->numPids; i++) {
            Tcl_ListObjAppendElement(NULL, resultPtr,
                                     Tcl_NewIntObj(PTR2INT(TclpGetPid(pipePtr->pidPtr[i]))));
        }
        Tcl_SetObjResult(interp, resultPtr);
    }
    return TCL_OK;
}
Beispiel #10
0
static int
TransformSetOptionProc(
    ClientData instanceData,
    Tcl_Interp *interp,
    const char *optionName,
    const char *value)
{
    TransformChannelData *dataPtr = 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);
}
Beispiel #11
0
/*
 * Get back the connection from the Id
 */
PGconn *
PgGetConnectionId(Tcl_Interp *interp, CONST84 char *id,
				  Pg_ConnectionId ** connid_p)
{
	Tcl_Channel conn_chan;
	Pg_ConnectionId *connid;

	conn_chan = Tcl_GetChannel(interp, id, 0);
	if (conn_chan == NULL || Tcl_GetChannelType(conn_chan) != &Pg_ConnType)
	{
		Tcl_ResetResult(interp);
		Tcl_AppendResult(interp, id, " is not a valid postgresql connection", 0);
		if (connid_p)
			*connid_p = NULL;
		return (PGconn *) NULL;
	}

	connid = (Pg_ConnectionId *) Tcl_GetChannelInstanceData(conn_chan);
	if (connid_p)
		*connid_p = connid;
	return connid->conn;
}
Beispiel #12
0
	/* ARGSUSED */
int
Tcl_PidObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* Argument strings. */
{
    if (objc > 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?channelId?");
	return TCL_ERROR;
    }
    if (objc == 1) {
	Tcl_SetObjResult(interp, Tcl_NewLongObj((long) getpid()));
    } else {
	Tcl_Channel chan;
	const Tcl_ChannelType *chanTypePtr;
	PipeState *pipePtr;
	int i;
	Tcl_Obj *resultPtr, *longObjPtr;

	chan = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), NULL);
	if (chan == (Tcl_Channel) NULL) {
	    return TCL_ERROR;
	}
	chanTypePtr = Tcl_GetChannelType(chan);
	if (chanTypePtr != &pipeChannelType) {
	    return TCL_OK;
	}
	pipePtr = (PipeState *) Tcl_GetChannelInstanceData(chan);
	resultPtr = Tcl_NewObj();
	for (i = 0; i < pipePtr->numPids; i++) {
	    longObjPtr = Tcl_NewLongObj((long) TclpGetPid(pipePtr->pidPtr[i]));
	    Tcl_ListObjAppendElement(NULL, resultPtr, longObjPtr);
	}
	Tcl_SetObjResult(interp, resultPtr);
    }
    return TCL_OK;
}
Beispiel #13
0
static int
getresid(Tcl_Interp *interp, CONST84 char *id, Pg_ConnectionId ** connid_p)
{
	Tcl_Channel conn_chan;
	char	   *mark;
	int			resid;
	Pg_ConnectionId *connid;

	if (!(mark = strchr(id, '.')))
		return -1;
	*mark = '\0';
	conn_chan = Tcl_GetChannel(interp, id, 0);
	*mark = '.';
	if (conn_chan == NULL || Tcl_GetChannelType(conn_chan) != &Pg_ConnType)
	{
		Tcl_SetResult(interp, "Invalid connection handle", TCL_STATIC);
		return -1;
	}

	if (Tcl_GetInt(interp, mark + 1, &resid) == TCL_ERROR)
	{
		Tcl_SetResult(interp, "Poorly formated result handle", TCL_STATIC);
		return -1;
	}

	connid = (Pg_ConnectionId *) Tcl_GetChannelInstanceData(conn_chan);

	if (resid < 0 || resid >= connid->res_max || connid->results[resid] == NULL)
	{
		Tcl_SetResult(interp, "Invalid result handle", TCL_STATIC);
		return -1;
	}

	*connid_p = connid;

	return resid;
}
Beispiel #14
0
int
Tk_CreateConsoleWindow(
    Tcl_Interp *interp)		/* Interpreter to use for prompting. */
{
    Tcl_Channel chan;
    ConsoleInfo *info;
    Tk_Window mainWindow;
    Tcl_Command token;
    int result = TCL_OK;
    int haveConsoleChannel = 1;

    /* Init an interp with Tcl and Tk */
    Tcl_Interp *consoleInterp = Tcl_CreateInterp();
    if (Tcl_Init(consoleInterp) != TCL_OK) {
	goto error;
    }
    if (Tk_Init(consoleInterp) != TCL_OK) {
	goto error;
    }

    /*
     * Fetch the instance data from whatever std channel is a
     * console channel.  If none, create fresh instance data.
     */

    if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDIN))
	    == &consoleChannelType) {
    } else if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDOUT))
	    == &consoleChannelType) {
    } else if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDERR))
	    == &consoleChannelType) {
    } else {
	haveConsoleChannel = 0;
    }

    if (haveConsoleChannel) {
	ChannelData *data = (ChannelData *) Tcl_GetChannelInstanceData(chan);
	info = data->info;
	if (info->consoleInterp) {
	    /* New ConsoleInfo for a new console window */
	    info = (ConsoleInfo *) ckalloc(sizeof(ConsoleInfo));
	    info->refCount = 0;

	    /* Update any console channels to make use of the new console */
	    if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDIN))
		    == &consoleChannelType) {
		data = (ChannelData *) Tcl_GetChannelInstanceData(chan);
		data->info->refCount--;
		data->info = info;
		data->info->refCount++;
	    }
	    if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDOUT))
		    == &consoleChannelType) {
		data = (ChannelData *) Tcl_GetChannelInstanceData(chan);
		data->info->refCount--;
		data->info = info;
		data->info->refCount++;
	    }
	    if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDERR))
		    == &consoleChannelType) {
		data = (ChannelData *) Tcl_GetChannelInstanceData(chan);
		data->info->refCount--;
		data->info = info;
		data->info->refCount++;
	    }
	}
    } else {
	info = (ConsoleInfo *) ckalloc(sizeof(ConsoleInfo));
	info->refCount = 0;
    }

    info->consoleInterp = consoleInterp;
    info->interp = interp;

    Tcl_CallWhenDeleted(consoleInterp, InterpDeleteProc, info);
    info->refCount++;
    Tcl_CreateThreadExitHandler(DeleteConsoleInterp, consoleInterp);

    /*
     * Add console commands to the interp
     */

    token = Tcl_CreateObjCommand(interp, "console", ConsoleObjCmd, info,
	    ConsoleDeleteProc);
    info->refCount++;

    /*
     * We don't have to count the ref held by the [consoleinterp] command
     * in the consoleInterp.  The ref held by the consoleInterp delete
     * handler takes care of us.
     */
    Tcl_CreateObjCommand(consoleInterp, "consoleinterp", InterpreterObjCmd,
	    info, NULL);

    mainWindow = Tk_MainWindow(interp);
    if (mainWindow) {
	Tk_CreateEventHandler(mainWindow, StructureNotifyMask,
		ConsoleEventProc, info);
	info->refCount++;
    }

    Tcl_Preserve(consoleInterp);
    result = Tcl_GlobalEval(consoleInterp, "source $tk_library/console.tcl");
    if (result == TCL_ERROR) {
	Tcl_SetReturnOptions(interp,
		Tcl_GetReturnOptions(consoleInterp, result));
	Tcl_SetObjResult(interp, Tcl_GetObjResult(consoleInterp));
    }
    Tcl_Release(consoleInterp);
    if (result == TCL_ERROR) {
	Tcl_DeleteCommandFromToken(interp, token);
	mainWindow = Tk_MainWindow(interp);
	if (mainWindow) {
	    Tk_DeleteEventHandler(mainWindow, StructureNotifyMask,
		    ConsoleEventProc, info);
	    if (--info->refCount <= 0) {
		ckfree((char *) info);
	    }
	}
	goto error;
    }
    return TCL_OK;

  error:
    Tcl_AddErrorInfo(interp, "\n    (creating console window)");
    if (!Tcl_InterpDeleted(consoleInterp)) {
	Tcl_DeleteInterp(consoleInterp);
    }
    return TCL_ERROR;
}
Beispiel #15
0
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 = 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 == 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.
     */

    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));
}
Beispiel #16
0
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;

    dprintf(stderr, "TlsWatchProc(0x%x)\n", mask);

    /* Pretend to be dead as long as the verify callback is running. 
     * Otherwise that callback could be invoked recursively. */
    if (statePtr->flags & TLS_TCL_CALLBACK) { return; }

    if (channelTypeVersion == TLS_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);
	}
    }
}