/* 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); } }
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; } }
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; } }
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; }
/* ** 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, ¬Used); 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; }
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); }
/* * 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; }
/* *------------------------------------------------------------------- * * 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; } }
/* 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; }
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); }
/* * 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; }
/* 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; }
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; }
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; }
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)); }
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); } } }