/*
* tclIO.c --
*
* This file provides the generic portions (those that are the same on
* all platforms and for all channel types) of Tcl's IO facilities.
*
* Copyright (c) 1998-2000 Ajuba Solutions
* Copyright (c) 1995-1997 Sun Microsystems, Inc.
* Contributions from Don Porter, NIST, 2014. (not subject to US copyright)
*
* 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"
#include <assert.h>
/*
* For each channel handler registered in a call to Tcl_CreateChannelHandler,
* there is one record of the following type. All of records for a specific
* channel are chained together in a singly linked list which is stored in
* the channel structure.
*/
typedef struct ChannelHandler {
Channel *chanPtr; /* The channel structure for this channel. */
int mask; /* Mask of desired events. */
Tcl_ChannelProc *proc; /* Procedure to call in the type of
* Tcl_CreateChannelHandler. */
ClientData clientData; /* Argument to pass to procedure. */
struct ChannelHandler *nextPtr;
/* Next one in list of registered handlers. */
} ChannelHandler;
/*
* This structure keeps track of the current ChannelHandler being invoked in
* the current invocation of ChannelHandlerEventProc. There is a potential
* problem if a ChannelHandler is deleted while it is the current one, since
* ChannelHandlerEventProc needs to look at the nextPtr field. To handle this
* problem, structures of the type below indicate the next handler to be
* processed for any (recursively nested) dispatches in progress. The
* nextHandlerPtr field is updated if the handler being pointed to is deleted.
* The nextPtr field is used to chain together all recursive invocations, so
* that Tcl_DeleteChannelHandler can find all the recursively nested
* invocations of ChannelHandlerEventProc and compare the handler being
* deleted against the NEXT handler to be invoked in that invocation; when it
* finds such a situation, Tcl_DeleteChannelHandler updates the nextHandlerPtr
* field of the structure to the next handler.
*/
typedef struct NextChannelHandler {
ChannelHandler *nextHandlerPtr; /* The next handler to be invoked in
* this invocation. */
struct NextChannelHandler *nestedHandlerPtr;
/* Next nested invocation of
* ChannelHandlerEventProc. */
} NextChannelHandler;
/*
* The following structure describes the event that is added to the Tcl
* event queue by the channel handler check procedure.
*/
typedef struct ChannelHandlerEvent {
Tcl_Event header; /* Standard header for all events. */
Channel *chanPtr; /* The channel that is ready. */
int readyMask; /* Events that have occurred. */
} ChannelHandlerEvent;
/*
* The following structure is used by Tcl_GetsObj() to encapsulates the
* state for a "gets" operation.
*/
typedef struct GetsState {
Tcl_Obj *objPtr; /* The object to which UTF-8 characters
* will be appended. */
char **dstPtr; /* Pointer into objPtr's string rep where
* next character should be stored. */
Tcl_Encoding encoding; /* The encoding to use to convert raw bytes
* to UTF-8. */
ChannelBuffer *bufPtr; /* The current buffer of raw bytes being
* emptied. */
Tcl_EncodingState state; /* The encoding state just before the last
* external to UTF-8 conversion in
* FilterInputBytes(). */
int rawRead; /* The number of bytes removed from bufPtr
* in the last call to FilterInputBytes(). */
int bytesWrote; /* The number of bytes of UTF-8 data
* appended to objPtr during the last call to
* FilterInputBytes(). */
int charsWrote; /* The corresponding number of UTF-8
* characters appended to objPtr during the
* last call to FilterInputBytes(). */
int totalChars; /* The total number of UTF-8 characters
* appended to objPtr so far, just before the
* last call to FilterInputBytes(). */
} GetsState;
/*
* The following structure encapsulates the state for a background channel
* copy. Note that the data buffer for the copy will be appended to this
* structure.
*/
typedef struct CopyState {
struct Channel *readPtr; /* Pointer to input channel. */
struct Channel *writePtr; /* Pointer to output channel. */
int readFlags; /* Original read channel flags. */
int writeFlags; /* Original write channel flags. */
int toRead; /* Number of bytes to copy, or -1. */
Tcl_WideInt total; /* Total bytes transferred (written). */
Tcl_Interp *interp; /* Interp that started the copy. */
Tcl_Obj *cmdPtr; /* Command to be invoked at completion. */
int bufSize; /* Size of appended buffer. */
char buffer[1]; /* Copy buffer, this must be the last
* field. */
} CopyState;
/*
* All static variables used in this file are collected into a single instance
* of the following structure. For multi-threaded implementations, there is
* one instance of this structure for each thread.
*
* Notice that different structures with the same name appear in other files.
* The structure defined below is used in this file only.
*/
typedef struct ThreadSpecificData {
NextChannelHandler *nestedHandlerPtr;
/* This variable holds the list of nested
* ChannelHandlerEventProc invocations. */
ChannelState *firstCSPtr; /* List of all channels currently open,
* indexed by ChannelState, as only one
* ChannelState exists per set of stacked
* channels. */
Tcl_Channel stdinChannel; /* Static variable for the stdin channel. */
int stdinInitialized;
Tcl_Channel stdoutChannel; /* Static variable for the stdout channel. */
int stdoutInitialized;
Tcl_Channel stderrChannel; /* Static variable for the stderr channel. */
int stderrInitialized;
Tcl_Encoding binaryEncoding;
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;
/*
* Structure to record a close callback. One such record exists for
* each close callback registered for a channel.
*/
typedef struct CloseCallback {
Tcl_CloseProc *proc; /* The procedure to call. */
ClientData clientData; /* Arbitrary one-word data to pass
* to the callback. */
struct CloseCallback *nextPtr; /* For chaining close callbacks. */
} CloseCallback;
/*
* Static functions in this file:
*/
static ChannelBuffer * AllocChannelBuffer(int length);
static void PreserveChannelBuffer(ChannelBuffer *bufPtr);
static void ReleaseChannelBuffer(ChannelBuffer *bufPtr);
static int IsShared(ChannelBuffer *bufPtr);
static void ChannelTimerProc(ClientData clientData);
static int ChanRead(Channel *chanPtr, char *dst, int dstSize);
static int CheckChannelErrors(ChannelState *statePtr,
int direction);
static int CheckForDeadChannel(Tcl_Interp *interp,
ChannelState *statePtr);
static void CheckForStdChannelsBeingClosed(Tcl_Channel chan);
static void CleanupChannelHandlers(Tcl_Interp *interp,
Channel *chanPtr);
static int CloseChannel(Tcl_Interp *interp, Channel *chanPtr,
int errorCode);
static void CommonGetsCleanup(Channel *chanPtr);
static int CopyData(CopyState *csPtr, int mask);
static void CopyEventProc(ClientData clientData, int mask);
static void CreateScriptRecord(Tcl_Interp *interp,
Channel *chanPtr, int mask, Tcl_Obj *scriptPtr);
static void DeleteChannelTable(ClientData clientData,
Tcl_Interp *interp);
static void DeleteScriptRecord(Tcl_Interp *interp,
Channel *chanPtr, int mask);
static int DetachChannel(Tcl_Interp *interp, Tcl_Channel chan);
static void DiscardInputQueued(ChannelState *statePtr,
int discardSavedBuffers);
static void DiscardOutputQueued(ChannelState *chanPtr);
static int DoRead(Channel *chanPtr, char *dst, int bytesToRead);
static int DoReadChars(Channel *chan, Tcl_Obj *objPtr, int toRead,
int appendFlag);
static int FilterInputBytes(Channel *chanPtr,
GetsState *statePtr);
static int FlushChannel(Tcl_Interp *interp, Channel *chanPtr,
int calledFromAsyncFlush);
static int TclGetsObjBinary(Tcl_Channel chan, Tcl_Obj *objPtr);
static Tcl_Encoding GetBinaryEncoding();
static void FreeBinaryEncoding(ClientData clientData);
static Tcl_HashTable * GetChannelTable(Tcl_Interp *interp);
static int GetInput(Channel *chanPtr);
static int HaveVersion(const Tcl_ChannelType *typePtr,
Tcl_ChannelTypeVersion minimumVersion);
static void PeekAhead(Channel *chanPtr, char **dstEndPtr,
GetsState *gsPtr);
static int ReadBytes(ChannelState *statePtr, Tcl_Obj *objPtr,
int charsLeft);
static int ReadChars(ChannelState *statePtr, Tcl_Obj *objPtr,
int charsLeft, int *factorPtr);
static void RecycleBuffer(ChannelState *statePtr,
ChannelBuffer *bufPtr, int mustDiscard);
static int StackSetBlockMode(Channel *chanPtr, int mode);
static int SetBlockMode(Tcl_Interp *interp, Channel *chanPtr,
int mode);
static void StopCopy(CopyState *csPtr);
static void TranslateInputEOL(ChannelState *statePtr, char *dst,
const char *src, int *dstLenPtr, int *srcLenPtr);
static void UpdateInterest(Channel *chanPtr);
static int Write(Channel *chanPtr, const char *src,
int srcLen, Tcl_Encoding encoding);
static Tcl_Obj * FixLevelCode(Tcl_Obj *msg);
static void SpliceChannel(Tcl_Channel chan);
static void CutChannel(Tcl_Channel chan);
static int WillRead(Channel *chanPtr);
#define WriteChars(chanPtr, src, srcLen) \
Write(chanPtr, src, srcLen, chanPtr->state->encoding)
#define WriteBytes(chanPtr, src, srcLen) \
Write(chanPtr, src, srcLen, tclIdentityEncoding)
/*
* Simplifying helper macros. All may use their argument(s) multiple times.
* The ANSI C "prototypes" for the macros are listed below, together with a
* short description of what the macro does.
*
* --------------------------------------------------------------------------
* int BytesLeft(ChannelBuffer *bufPtr)
*
* Returns the number of bytes of data remaining in the buffer.
*
* int SpaceLeft(ChannelBuffer *bufPtr)
*
* Returns the number of bytes of space remaining at the end of the
* buffer.
*
* int IsBufferReady(ChannelBuffer *bufPtr)
*
* Returns whether a buffer has bytes available within it.
*
* int IsBufferEmpty(ChannelBuffer *bufPtr)
*
* Returns whether a buffer is entirely empty. Note that this is not the
* inverse of the above operation; trying to merge the two seems to lead
* to occasional crashes...
*
* int IsBufferFull(ChannelBuffer *bufPtr)
*
* Returns whether more data can be added to a buffer.
*
* int IsBufferOverflowing(ChannelBuffer *bufPtr)
*
* Returns whether a buffer has more data in it than it should.
*
* char *InsertPoint(ChannelBuffer *bufPtr)
*
* Returns a pointer to where characters should be added to the buffer.
*
* char *RemovePoint(ChannelBuffer *bufPtr)
*
* Returns a pointer to where characters should be removed from the
* buffer.
* --------------------------------------------------------------------------
*/
#define BytesLeft(bufPtr) ((bufPtr)->nextAdded - (bufPtr)->nextRemoved)
#define SpaceLeft(bufPtr) ((bufPtr)->bufLength - (bufPtr)->nextAdded)
#define IsBufferReady(bufPtr) ((bufPtr)->nextAdded > (bufPtr)->nextRemoved)
#define IsBufferEmpty(bufPtr) ((bufPtr)->nextAdded == (bufPtr)->nextRemoved)
#define IsBufferFull(bufPtr) ((bufPtr) && (bufPtr)->nextAdded >= (bufPtr)->bufLength)
#define IsBufferOverflowing(bufPtr) ((bufPtr)->nextAdded > (bufPtr)->bufLength)
#define InsertPoint(bufPtr) ((bufPtr)->buf + (bufPtr)->nextAdded)
#define RemovePoint(bufPtr) ((bufPtr)->buf + (bufPtr)->nextRemoved)
/*
* For working with channel state flag bits.
*/
#define SetFlag(statePtr, flag) ((statePtr)->flags |= (flag))
#define ResetFlag(statePtr, flag) ((statePtr)->flags &= ~(flag))
#define GotFlag(statePtr, flag) ((statePtr)->flags & (flag))
/*
* Macro for testing whether a string (in optionName, length len) matches a
* value (prefix matching rules). Arguments are the minimum length to match
* and the value to match against. (Can't use Tcl_GetIndexFromObj as this is
* used in a situation where no objects are available.)
*/
#define HaveOpt(minLength, nameString) \
((len > (minLength)) && (optionName[1] == (nameString)[1]) \
&& (strncmp(optionName, (nameString), len) == 0))
/*
* The ChannelObjType type. We actually store the ChannelState structure
* as that lives longest and we want to return the bottomChanPtr when
* requested (consistent with Tcl_GetChannel). The setFromAny and
* updateString can be NULL as they should not be called.
*/
static void DupChannelIntRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
static int SetChannelFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void FreeChannelIntRep(Tcl_Obj *objPtr);
static Tcl_ObjType chanObjType = {
"channel", /* name for this type */
FreeChannelIntRep, /* freeIntRepProc */
DupChannelIntRep, /* dupIntRepProc */
NULL, /* updateStringProc */
NULL /* setFromAnyProc SetChannelFromAny */
};
#define GET_CHANNELSTATE(objPtr) \
((ChannelState *) (objPtr)->internalRep.twoPtrValue.ptr1)
#define SET_CHANNELSTATE(objPtr, storePtr) \
((objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (storePtr))
#define GET_CHANNELINTERP(objPtr) \
((Tcl_Interp *) (objPtr)->internalRep.twoPtrValue.ptr2)
#define SET_CHANNELINTERP(objPtr, storePtr) \
((objPtr)->internalRep.twoPtrValue.ptr2 = (void *) (storePtr))
#define BUSY_STATE(st,fl) \
((((st)->csPtrR) && ((fl) & TCL_READABLE)) || \
(((st)->csPtrW) && ((fl) & TCL_WRITABLE)))
#define MAX_CHANNEL_BUFFER_SIZE (1024*1024)
/*
*---------------------------------------------------------------------------
*
* ChanRead --
*
* Read up to dstSize bytes using the inputProc of chanPtr, store
* them at dst, and return the number of bytes stored.
*
* Results:
* The return value of the driver inputProc,
* - number of bytes stored at dst, ot
* - -1 on error, with a Posix error code available to the
* caller by calling Tcl_GetErrno().
*
* Side effects:
* The CHANNEL_BLOCKED and CHANNEL_EOF flags of the channel state are
* set as appropriate.
* On EOF, the inputEncodingFlags are set to perform ending operations
* on decoding.
* TODO - Is this really the right place for that?
*
*---------------------------------------------------------------------------
*/
static int
ChanRead(
Channel *chanPtr,
char *dst,
int dstSize)
{
int bytesRead, result;
/*
* If the caller asked for zero bytes, we'd force the inputProc
* to return zero bytes, and then misinterpret that as EOF.
*/
assert(dstSize > 0);
/*
* Each read op must set the blocked and eof states anew, not let
* the effect of prior reads leak through.
*/
ResetFlag(chanPtr->state, CHANNEL_BLOCKED | CHANNEL_EOF);
if (WillRead(chanPtr) < 0) {
return -1;
}
bytesRead = chanPtr->typePtr->inputProc(chanPtr->instanceData,
dst, dstSize, &result);
/* Stop any flag leakage through stacked channel levels */
ResetFlag(chanPtr->state, CHANNEL_BLOCKED | CHANNEL_EOF);
if (bytesRead > 0) {
/*
* If we get a short read, signal up that we may be BLOCKED.
* We should avoid calling the driver because on some
* platforms we will block in the low level reading code even
* though the channel is set into nonblocking mode.
*/
if (bytesRead < dstSize) {
SetFlag(chanPtr->state, CHANNEL_BLOCKED);
}
} else if (bytesRead == 0) {
SetFlag(chanPtr->state, CHANNEL_EOF);
chanPtr->state->inputEncodingFlags |= TCL_ENCODING_END;
} else if (bytesRead < 0) {
if ((result == EWOULDBLOCK) || (result == EAGAIN)) {
SetFlag(chanPtr->state, CHANNEL_BLOCKED);
result = EAGAIN;
}
Tcl_SetErrno(result);
}
return bytesRead;
}
static inline Tcl_WideInt
ChanSeek(
Channel *chanPtr,
Tcl_WideInt offset,
int mode,
int *errnoPtr)
{
/*
* Note that we prefer the wideSeekProc if that field is available in the
* type and non-NULL.
*/
if (HaveVersion(chanPtr->typePtr, TCL_CHANNEL_VERSION_3) &&
chanPtr->typePtr->wideSeekProc != NULL) {
return chanPtr->typePtr->wideSeekProc(chanPtr->instanceData,
offset, mode, errnoPtr);
}
if (offset<Tcl_LongAsWide(LONG_MIN) || offset>Tcl_LongAsWide(LONG_MAX)) {
*errnoPtr = EOVERFLOW;
return Tcl_LongAsWide(-1);
}
return Tcl_LongAsWide(chanPtr->typePtr->seekProc(chanPtr->instanceData,
Tcl_WideAsLong(offset), mode, errnoPtr));
}
/*
*---------------------------------------------------------------------------
*
* TclInitIOSubsystem --
*
* Initialize all resources used by this subsystem on a per-process
* basis.
*
* Results:
* None.
*
* Side effects:
* Depends on the memory subsystems.
*
*---------------------------------------------------------------------------
*/
void
TclInitIOSubsystem(void)
{
/*
* By fetching thread local storage we take care of allocating it for each
* thread.
*/
(void) TCL_TSD_INIT(&dataKey);
}
/*
*-------------------------------------------------------------------------
*
* TclFinalizeIOSubsystem --
*
* Releases all resources used by this subsystem on a per-process basis.
* Closes all extant channels that have not already been closed because
* they were not owned by any interp.
*
* Results:
* None.
*
* Side effects:
* Depends on encoding and memory subsystems.
*
*-------------------------------------------------------------------------
*/
/* ARGSUSED */
void
TclFinalizeIOSubsystem(void)
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
Channel *chanPtr = NULL; /* Iterates over open channels. */
ChannelState *statePtr; /* State of channel stack */
int active = 1; /* Flag == 1 while there's still work to do */
/*
* Walk all channel state structures known to this thread and close
* corresponding channels.
*/
while (active) {
/*
* Iterate through the open channel list, and find the first channel
* that isn't dead. We start from the head of the list each time,
* because the close action on one channel can close others.
*/
active = 0;
for (statePtr = tsdPtr->firstCSPtr;
statePtr != NULL;
statePtr = statePtr->nextCSPtr) {
chanPtr = statePtr->topChanPtr;
if (!GotFlag(statePtr, CHANNEL_INCLOSE|CHANNEL_CLOSED|CHANNEL_DEAD)) {
active = 1;
break;
}
}
/*
* We've found a live channel. Close it.
*/
if (active) {
/*
* Set the channel back into blocking mode to ensure that we wait
* for all data to flush out.
*/
(void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr,
"-blocking", "on");
if ((chanPtr == (Channel *) tsdPtr->stdinChannel) ||
(chanPtr == (Channel *) tsdPtr->stdoutChannel) ||
(chanPtr == (Channel *) tsdPtr->stderrChannel)) {
/*
* Decrement the refcount which was earlier artificially
* bumped up to keep the channel from being closed.
*/
statePtr->refCount--;
}
if (statePtr->refCount <= 0) {
/*
* Close it only if the refcount indicates that the channel is
* not referenced from any interpreter. If it is, that
* interpreter will close the channel when it gets destroyed.
*/
(void) Tcl_Close(NULL, (Tcl_Channel) chanPtr);
} else {
/*
* The refcount is greater than zero, so flush the channel.
*/
Tcl_Flush((Tcl_Channel) chanPtr);
/*
* Call the device driver to actually close the underlying
* device for this channel.
*/
if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {
(chanPtr->typePtr->closeProc)(chanPtr->instanceData, NULL);
} else {
(chanPtr->typePtr->close2Proc)(chanPtr->instanceData,
NULL, 0);
}
/*
* Finally, we clean up the fields in the channel data
* structure since all of them have been deleted already. We
* mark the channel with CHANNEL_DEAD to prevent any further
* IO operations on it.
*/
chanPtr->instanceData = NULL;
SetFlag(statePtr, CHANNEL_DEAD);
}
}
}
TclpFinalizeSockets();
TclpFinalizePipes();
}
/*
*----------------------------------------------------------------------
*
* Tcl_SetStdChannel --
*
* This function is used to change the channels that are used for
* stdin/stdout/stderr in new interpreters.
*
* Results:
* None
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
void
Tcl_SetStdChannel(
Tcl_Channel channel,
int type) /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
switch (type) {
case TCL_STDIN:
tsdPtr->stdinInitialized = 1;
tsdPtr->stdinChannel = channel;
break;
case TCL_STDOUT:
tsdPtr->stdoutInitialized = 1;
tsdPtr->stdoutChannel = channel;
break;
case TCL_STDERR:
tsdPtr->stderrInitialized = 1;
tsdPtr->stderrChannel = channel;
break;
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_GetStdChannel --
*
* Returns the specified standard channel.
*
* Results:
* Returns the specified standard channel, or NULL.
*
* Side effects:
* May cause the creation of a standard channel and the underlying file.
*
*----------------------------------------------------------------------
*/
Tcl_Channel
Tcl_GetStdChannel(
int type) /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
{
Tcl_Channel channel = NULL;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
/*
* If the channels were not created yet, create them now and store them in
* the static variables.
*/
switch (type) {
case TCL_STDIN:
if (!tsdPtr->stdinInitialized) {
tsdPtr->stdinChannel = TclpGetDefaultStdChannel(TCL_STDIN);
tsdPtr->stdinInitialized = 1;
/*
* Artificially bump the refcount to ensure that the channel is
* only closed on exit.
*
* NOTE: Must only do this if stdinChannel is not NULL. It can be
* NULL in situations where Tcl is unable to connect to the
* standard input.
*/
if (tsdPtr->stdinChannel != NULL) {
Tcl_RegisterChannel(NULL, tsdPtr->stdinChannel);
}
}
channel = tsdPtr->stdinChannel;
break;
case TCL_STDOUT:
if (!tsdPtr->stdoutInitialized) {
tsdPtr->stdoutChannel = TclpGetDefaultStdChannel(TCL_STDOUT);
tsdPtr->stdoutInitialized = 1;
if (tsdPtr->stdoutChannel != NULL) {
Tcl_RegisterChannel(NULL, tsdPtr->stdoutChannel);
}
}
channel = tsdPtr->stdoutChannel;
break;
case TCL_STDERR:
if (!tsdPtr->stderrInitialized) {
tsdPtr->stderrChannel = TclpGetDefaultStdChannel(TCL_STDERR);
tsdPtr->stderrInitialized = 1;
if (tsdPtr->stderrChannel != NULL) {
Tcl_RegisterChannel(NULL, tsdPtr->stderrChannel);
}
}
channel = tsdPtr->stderrChannel;
break;
}
return channel;
}
/*
*----------------------------------------------------------------------
*
* Tcl_CreateCloseHandler
*
* Creates a close callback which will be called when the channel is
* closed.
*
* Results:
* None.
*
* Side effects:
* Causes the callback to be called in the future when the channel will
* be closed.
*
*----------------------------------------------------------------------
*/
void
Tcl_CreateCloseHandler(
Tcl_Channel chan, /* The channel for which to create the close
* callback. */
Tcl_CloseProc *proc, /* The callback routine to call when the
* channel will be closed. */
ClientData clientData) /* Arbitrary data to pass to the close
* callback. */
{
ChannelState *statePtr = ((Channel *) chan)->state;
CloseCallback *cbPtr;
cbPtr = (CloseCallback *) ckalloc(sizeof(CloseCallback));
cbPtr->proc = proc;
cbPtr->clientData = clientData;
cbPtr->nextPtr = statePtr->closeCbPtr;
statePtr->closeCbPtr = cbPtr;
}
/*
*----------------------------------------------------------------------
*
* Tcl_DeleteCloseHandler --
*
* Removes a callback that would have been called on closing the channel.
* If there is no matching callback then this function has no effect.
*
* Results:
* None.
*
* Side effects:
* The callback will not be called in the future when the channel is
* eventually closed.
*
*----------------------------------------------------------------------
*/
void
Tcl_DeleteCloseHandler(
Tcl_Channel chan, /* The channel for which to cancel the close
* callback. */
Tcl_CloseProc *proc, /* The procedure for the callback to
* remove. */
ClientData clientData) /* The callback data for the callback to
* remove. */
{
ChannelState *statePtr = ((Channel *) chan)->state;
CloseCallback *cbPtr, *cbPrevPtr;
for (cbPtr = statePtr->closeCbPtr, cbPrevPtr = NULL;
cbPtr != NULL; cbPtr = cbPtr->nextPtr) {
if ((cbPtr->proc == proc) && (cbPtr->clientData == clientData)) {
if (cbPrevPtr == NULL) {
statePtr->closeCbPtr = cbPtr->nextPtr;
} else {
cbPrevPtr->nextPtr = cbPtr->nextPtr;
}
ckfree((char *) cbPtr);
break;
} else {
cbPrevPtr = cbPtr;
}
}
}
/*
*----------------------------------------------------------------------
*
* GetChannelTable --
*
* Gets and potentially initializes the channel table for an interpreter.
* If it is initializing the table it also inserts channels for stdin,
* stdout and stderr if the interpreter is trusted.
*
* Results:
* A pointer to the hash table created, for use by the caller.
*
* Side effects:
* Initializes the channel table for an interpreter. May create channels
* for stdin, stdout and stderr.
*
*----------------------------------------------------------------------
*/
static Tcl_HashTable *
GetChannelTable(
Tcl_Interp *interp)
{
Tcl_HashTable *hTblPtr; /* Hash table of channels. */
Tcl_Channel stdinChan, stdoutChan, stderrChan;
hTblPtr = Tcl_GetAssocData(interp, "tclIO", NULL);
if (hTblPtr == NULL) {
hTblPtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
Tcl_InitHashTable(hTblPtr, TCL_STRING_KEYS);
Tcl_SetAssocData(interp, "tclIO",
(Tcl_InterpDeleteProc *) DeleteChannelTable, hTblPtr);
/*
* If the interpreter is trusted (not "safe"), insert channels for
* stdin, stdout and stderr (possibly creating them in the process).
*/
if (Tcl_IsSafe(interp) == 0) {
stdinChan = Tcl_GetStdChannel(TCL_STDIN);
if (stdinChan != NULL) {
Tcl_RegisterChannel(interp, stdinChan);
}
stdoutChan = Tcl_GetStdChannel(TCL_STDOUT);
if (stdoutChan != NULL) {
Tcl_RegisterChannel(interp, stdoutChan);
}
stderrChan = Tcl_GetStdChannel(TCL_STDERR);
if (stderrChan != NULL) {
Tcl_RegisterChannel(interp, stderrChan);
}
}
}
return hTblPtr;
}
/*
*----------------------------------------------------------------------
*
* DeleteChannelTable --
*
* Deletes the channel table for an interpreter, closing any open
* channels whose refcount reaches zero. This procedure is invoked when
* an interpreter is deleted, via the AssocData cleanup mechanism.
*
* Results:
* None.
*
* Side effects:
* Deletes the hash table of channels. May close channels. May flush
* output on closed channels. Removes any channeEvent handlers that were
* registered in this interpreter.
*
*----------------------------------------------------------------------
*/
static void
DeleteChannelTable(
ClientData clientData, /* The per-interpreter data structure. */
Tcl_Interp *interp) /* The interpreter being deleted. */
{
Tcl_HashTable *hTblPtr; /* The hash table. */
Tcl_HashSearch hSearch; /* Search variable. */
Tcl_HashEntry *hPtr; /* Search variable. */
Channel *chanPtr; /* Channel being deleted. */
ChannelState *statePtr; /* State of Channel being deleted. */
EventScriptRecord *sPtr, *prevPtr, *nextPtr;
/* Variables to loop over all channel events
* registered, to delete the ones that refer
* to the interpreter being deleted. */
/*
* Delete all the registered channels - this will close channels whose
* refcount reaches zero.
*/
hTblPtr = clientData;
for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch); hPtr != NULL;
hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch)) {
chanPtr = Tcl_GetHashValue(hPtr);
statePtr = chanPtr->state;
/*
* Remove any fileevents registered in this interpreter.
*/
for (sPtr = statePtr->scriptRecordPtr, prevPtr = NULL;
sPtr != NULL; sPtr = nextPtr) {
nextPtr = sPtr->nextPtr;
if (sPtr->interp == interp) {
if (prevPtr == NULL) {
statePtr->scriptRecordPtr = nextPtr;
} else {
prevPtr->nextPtr = nextPtr;
}
Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
TclChannelEventScriptInvoker, (ClientData) sPtr);
TclDecrRefCount(sPtr->scriptPtr);
ckfree((char *) sPtr);
} else {
prevPtr = sPtr;
}
}
/*
* Cannot call Tcl_UnregisterChannel because that procedure calls
* Tcl_GetAssocData to get the channel table, which might already be
* inaccessible from the interpreter structure. Instead, we emulate
* the behavior of Tcl_UnregisterChannel directly here.
*/
Tcl_DeleteHashEntry(hPtr);
SetFlag(statePtr, CHANNEL_TAINTED);
statePtr->refCount--;
if (statePtr->refCount <= 0) {
if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
(void) Tcl_Close(interp, (Tcl_Channel) chanPtr);
}
}
}
Tcl_DeleteHashTable(hTblPtr);
ckfree((char *) hTblPtr);
}
/*
*----------------------------------------------------------------------
*
* CheckForStdChannelsBeingClosed --
*
* Perform special handling for standard channels being closed. When
* given a standard channel, if the refcount is now 1, it means that the
* last reference to the standard channel is being explicitly closed. Now
* bump the refcount artificially down to 0, to ensure the normal
* handling of channels being closed will occur. Also reset the static
* pointer to the channel to NULL, to avoid dangling references.
*
* Results:
* None.
*
* Side effects:
* Manipulates the refcount on standard channels. May smash the global
* static pointer to a standard channel.
*
*----------------------------------------------------------------------
*/
static void
CheckForStdChannelsBeingClosed(
Tcl_Channel chan)
{
ChannelState *statePtr = ((Channel *) chan)->state;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (tsdPtr->stdinInitialized
&& tsdPtr->stdinChannel != NULL
&& statePtr == ((Channel *)tsdPtr->stdinChannel)->state) {
if (statePtr->refCount < 2) {
statePtr->refCount = 0;
tsdPtr->stdinChannel = NULL;
return;
}
} else if (tsdPtr->stdoutInitialized
&& tsdPtr->stdoutChannel != NULL
&& statePtr == ((Channel *)tsdPtr->stdoutChannel)->state) {
if (statePtr->refCount < 2) {
statePtr->refCount = 0;
tsdPtr->stdoutChannel = NULL;
return;
}
} else if (tsdPtr->stderrInitialized
&& tsdPtr->stderrChannel != NULL
&& statePtr == ((Channel *)tsdPtr->stderrChannel)->state) {
if (statePtr->refCount < 2) {
statePtr->refCount = 0;
tsdPtr->stderrChannel = NULL;
return;
}
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_IsStandardChannel --
*
* Test if the given channel is a standard channel. No attempt is made to
* check if the channel or the standard channels are initialized or
* otherwise valid.
*
* Results:
* Returns 1 if true, 0 if false.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
int
Tcl_IsStandardChannel(
Tcl_Channel chan) /* Channel to check. */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if ((chan == tsdPtr->stdinChannel)
|| (chan == tsdPtr->stdoutChannel)
|| (chan == tsdPtr->stderrChannel)) {
return 1;
} else {
return 0;
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_RegisterChannel --
*
* Adds an already-open channel to the channel table of an interpreter.
* If the interpreter passed as argument is NULL, it only increments the
* channel refCount.
*
* Results:
* None.
*
* Side effects:
* May increment the reference count of a channel.
*
*----------------------------------------------------------------------
*/
void
Tcl_RegisterChannel(
Tcl_Interp *interp, /* Interpreter in which to add the channel. */
Tcl_Channel chan) /* The channel to add to this interpreter
* channel table. */
{
Tcl_HashTable *hTblPtr; /* Hash table of channels. */
Tcl_HashEntry *hPtr; /* Search variable. */
int isNew; /* Is the hash entry new or does it exist? */
Channel *chanPtr; /* The actual channel. */
ChannelState *statePtr; /* State of the actual channel. */
/*
* Always (un)register bottom-most channel in the stack. This makes
* management of the channel list easier because no manipulation is
* necessary during (un)stack operation.
*/
chanPtr = ((Channel *) chan)->state->bottomChanPtr;
statePtr = chanPtr->state;
if (statePtr->channelName == NULL) {
Tcl_Panic("Tcl_RegisterChannel: channel without name");
}
if (interp != NULL) {
hTblPtr = GetChannelTable(interp);
hPtr = Tcl_CreateHashEntry(hTblPtr, statePtr->channelName, &isNew);
if (!isNew) {
if (chan == Tcl_GetHashValue(hPtr)) {
return;
}
Tcl_Panic("Tcl_RegisterChannel: duplicate channel names");
}
Tcl_SetHashValue(hPtr, chanPtr);
}
statePtr->refCount++;
}
/*
*----------------------------------------------------------------------
*
* Tcl_UnregisterChannel --
*
* Deletes the hash entry for a channel associated with an interpreter.
* If the interpreter given as argument is NULL, it only decrements the
* reference count. (This all happens in the Tcl_DetachChannel helper
* function).
*
* Finally, if the reference count of the channel drops to zero, it is
* deleted.
*
* Results:
* A standard Tcl result.
*
* Side effects:
* Calls Tcl_DetachChannel which deletes the hash entry for a channel
* associated with an interpreter.
*
* May delete the channel, which can have a variety of consequences,
* especially if we are forced to close the channel.
*
*----------------------------------------------------------------------
*/
int
Tcl_UnregisterChannel(
Tcl_Interp *interp, /* Interpreter in which channel is defined. */
Tcl_Channel chan) /* Channel to delete. */
{
ChannelState *statePtr; /* State of the real channel. */
statePtr = ((Channel *) chan)->state->bottomChanPtr->state;
if (GotFlag(statePtr, CHANNEL_INCLOSE)) {
if (interp != NULL) {
Tcl_AppendResult(interp, "Illegal recursive call to close "
"through close-handler of channel", NULL);
}
return TCL_ERROR;
}
if (DetachChannel(interp, chan) != TCL_OK) {
return TCL_OK;
}
statePtr = ((Channel *) chan)->state->bottomChanPtr->state;
/*
* Perform special handling for standard channels being closed. If the
* refCount is now 1 it means that the last reference to the standard
* channel is being explicitly closed, so bump the refCount down
* artificially to 0. This will ensure that the channel is actually
* closed, below. Also set the static pointer to NULL for the channel.
*/
CheckForStdChannelsBeingClosed(chan);
/*
* If the refCount reached zero, close the actual channel.
*/
if (statePtr->refCount <= 0) {
Tcl_Preserve((ClientData)statePtr);
if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
/*
* We don't want to re-enter Tcl_Close().
*/
if (!GotFlag(statePtr, CHANNEL_CLOSED)) {
if (Tcl_Close(interp, chan) != TCL_OK) {
SetFlag(statePtr, CHANNEL_CLOSED);
Tcl_Release((ClientData)statePtr);
return TCL_ERROR;
}
}
}
SetFlag(statePtr, CHANNEL_CLOSED);
Tcl_Release((ClientData)statePtr);
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* Tcl_DetachChannel --
*
* Deletes the hash entry for a channel associated with an interpreter.
* If the interpreter given as argument is NULL, it only decrements the
* reference count. Even if the ref count drops to zero, the channel is
* NOT closed or cleaned up. This allows a channel to be detached from an
* interpreter and left in the same state it was in when it was
* originally returned by 'Tcl_OpenFileChannel', for example.
*
* This function cannot be used on the standard channels, and will return
* TCL_ERROR if that is attempted.
*
* This function should only be necessary for special purposes in which
* you need to generate a pristine channel from one that has already been
* used. All ordinary purposes will almost always want to use
* Tcl_UnregisterChannel instead.
*
* Provided the channel is not attached to any other interpreter, it can
* then be closed with Tcl_Close, rather than with Tcl_UnregisterChannel.
*
* Results:
* A standard Tcl result. If the channel is not currently registered with
* the given interpreter, TCL_ERROR is returned, otherwise TCL_OK.
* However no error messages are left in the interp's result.
*
* Side effects:
* Deletes the hash entry for a channel associated with an interpreter.
*
*----------------------------------------------------------------------
*/
int
Tcl_DetachChannel(
Tcl_Interp *interp, /* Interpreter in which channel is defined. */
Tcl_Channel chan) /* Channel to delete. */
{
if (Tcl_IsStandardChannel(chan)) {
return TCL_ERROR;
}
return DetachChannel(interp, chan);
}
/*
*----------------------------------------------------------------------
*
* DetachChannel --
*
* Deletes the hash entry for a channel associated with an interpreter.
* If the interpreter given as argument is NULL, it only decrements the
* reference count. Even if the ref count drops to zero, the channel is
* NOT closed or cleaned up. This allows a channel to be detached from an
* interpreter and left in the same state it was in when it was
* originally returned by 'Tcl_OpenFileChannel', for example.
*
* Results:
* A standard Tcl result. If the channel is not currently registered with
* the given interpreter, TCL_ERROR is returned, otherwise TCL_OK.
* However no error messages are left in the interp's result.
*
* Side effects:
* Deletes the hash entry for a channel associated with an interpreter.
*
*----------------------------------------------------------------------
*/
static int
DetachChannel(
Tcl_Interp *interp, /* Interpreter in which channel is defined. */
Tcl_Channel chan) /* Channel to delete. */
{
Tcl_HashTable *hTblPtr; /* Hash table of channels. */
Tcl_HashEntry *hPtr; /* Search variable. */
Channel *chanPtr; /* The real IO channel. */
ChannelState *statePtr; /* State of the real channel. */
/*
* Always (un)register bottom-most channel in the stack. This makes
* management of the channel list easier because no manipulation is
* necessary during (un)stack operation.
*/
chanPtr = ((Channel *) chan)->state->bottomChanPtr;
statePtr = chanPtr->state;
if (interp != NULL) {
hTblPtr = Tcl_GetAssocData(interp, "tclIO", NULL);
if (hTblPtr == NULL) {
return TCL_ERROR;
}
hPtr = Tcl_FindHashEntry(hTblPtr, statePtr->channelName);
if (hPtr == NULL) {
return TCL_ERROR;
}
if ((Channel *) Tcl_GetHashValue(hPtr) != chanPtr) {
return TCL_ERROR;
}
Tcl_DeleteHashEntry(hPtr);
SetFlag(statePtr, CHANNEL_TAINTED);
/*
* Remove channel handlers that refer to this interpreter, so that
* they will not be present if the actual close is delayed and more
* events happen on the channel. This may occur if the channel is
* shared between several interpreters, or if the channel has async
* flushing active.
*/
CleanupChannelHandlers(interp, chanPtr);
}
statePtr->refCount--;
return TCL_OK;
}
/*
*---------------------------------------------------------------------------
*
* Tcl_GetChannel --
*
* Finds an existing Tcl_Channel structure by name in a given
* interpreter. This function is public because it is used by
* channel-type-specific functions.
*
* Results:
* A Tcl_Channel or NULL on failure. If failed, interp's result object
* contains an error message. *modePtr is filled with the modes in which
* the channel was opened.
*
* Side effects:
* None.
*
*---------------------------------------------------------------------------
*/
Tcl_Channel
Tcl_GetChannel(
Tcl_Interp *interp, /* Interpreter in which to find or create the
* channel. */
const char *chanName, /* The name of the channel. */
int *modePtr) /* Where to store the mode in which the
* channel was opened? Will contain an ORed
* combination of TCL_READABLE and
* TCL_WRITABLE, if non-NULL. */
{
Channel *chanPtr; /* The actual channel. */
Tcl_HashTable *hTblPtr; /* Hash table of channels. */
Tcl_HashEntry *hPtr; /* Search variable. */
const char *name; /* Translated name. */
/*
* Substitute "stdin", etc. Note that even though we immediately find the
* channel using Tcl_GetStdChannel, we still need to look it up in the
* specified interpreter to ensure that it is present in the channel
* table. Otherwise, safe interpreters would always have access to the
* standard channels.
*/
name = chanName;
if ((chanName[0] == 's') && (chanName[1] == 't')) {
chanPtr = NULL;
if (strcmp(chanName, "stdin") == 0) {
chanPtr = (Channel *) Tcl_GetStdChannel(TCL_STDIN);
} else if (strcmp(chanName, "stdout") == 0) {
chanPtr = (Channel *) Tcl_GetStdChannel(TCL_STDOUT);
} else if (strcmp(chanName, "stderr") == 0) {
chanPtr = (Channel *) Tcl_GetStdChannel(TCL_STDERR);
}
if (chanPtr != NULL) {
name = chanPtr->state->channelName;
}
}
hTblPtr = GetChannelTable(interp);
hPtr = Tcl_FindHashEntry(hTblPtr, name);
if (hPtr == NULL) {
Tcl_AppendResult(interp, "can not find channel named \"", chanName,
"\"", NULL);
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CHANNEL", chanName, NULL);
return NULL;
}
/*
* Always return bottom-most channel in the stack. This one lives the
* longest - other channels may go away unnoticed. The other APIs
* compensate where necessary to retrieve the topmost channel again.
*/
chanPtr = Tcl_GetHashValue(hPtr);
chanPtr = chanPtr->state->bottomChanPtr;
if (modePtr != NULL) {
*modePtr = GotFlag(chanPtr->state, TCL_READABLE|TCL_WRITABLE);
}
return (Tcl_Channel) chanPtr;
}
/*
*---------------------------------------------------------------------------
*
* TclGetChannelFromObj --
*
* Finds an existing Tcl_Channel structure by name in a given
* interpreter. This function is public because it is used by
* channel-type-specific functions.
*
* Results:
* A Tcl_Channel or NULL on failure. If failed, interp's result object
* contains an error message. *modePtr is filled with the modes in which
* the channel was opened.
*
* Side effects:
* None.
*
*---------------------------------------------------------------------------
*/
int
TclGetChannelFromObj(
Tcl_Interp *interp, /* Interpreter in which to find or create the
* channel. */
Tcl_Obj *objPtr,
Tcl_Channel *channelPtr,
int *modePtr, /* Where to store the mode in which the
* channel was opened? Will contain an ORed
* combination of TCL_READABLE and
* TCL_WRITABLE, if non-NULL. */
int flags)
{
ChannelState *statePtr;
if (SetChannelFromAny(interp, objPtr) != TCL_OK) {
return TCL_ERROR;
}
statePtr = GET_CHANNELSTATE(objPtr);
*channelPtr = (Tcl_Channel) (statePtr->bottomChanPtr);
if (modePtr != NULL) {
*modePtr = GotFlag(statePtr, TCL_READABLE|TCL_WRITABLE);
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* Tcl_CreateChannel --
*
* Creates a new entry in the hash table for a Tcl_Channel record.
*
* Results:
* Returns the new Tcl_Channel.
*
* Side effects:
* Creates a new Tcl_Channel instance and inserts it into the hash table.
*
*----------------------------------------------------------------------
*/
Tcl_Channel
Tcl_CreateChannel(
Tcl_ChannelType *typePtr, /* The channel type record. */
const char *chanName, /* Name of channel to record. */
ClientData instanceData, /* Instance specific data. */
int mask) /* TCL_READABLE & TCL_WRITABLE to indicate if
* the channel is readable, writable. */
{
Channel *chanPtr; /* The channel structure newly created. */
ChannelState *statePtr; /* The stack-level independent state info for
* the channel. */
const char *name;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
/*
* With the change of the Tcl_ChannelType structure to use a version in
* 8.3.2+, we have to make sure that our assumption that the structure
* remains a binary compatible size is true.
*
* If this assertion fails on some system, then it can be removed only if
* the user recompiles code with older channel drivers in the new system
* as well.
*/
assert(sizeof(Tcl_ChannelTypeVersion) == sizeof(Tcl_DriverBlockModeProc*));
/*
* JH: We could subsequently memset these to 0 to avoid the numerous
* assignments to 0/NULL below.
*/
chanPtr = (Channel *) ckalloc(sizeof(Channel));
statePtr = (ChannelState *) ckalloc(sizeof(ChannelState));
chanPtr->state = statePtr;
chanPtr->instanceData = instanceData;
chanPtr->typePtr = typePtr;
/*
* Set all the bits that are part of the stack-independent state
* information for the channel.
*/
if (chanName != NULL) {
char *tmp = ckalloc((unsigned) (strlen(chanName) + 1));
statePtr->channelName = tmp;
strcpy(tmp, chanName);
} else {
Tcl_Panic("Tcl_CreateChannel: NULL channel name");
}
statePtr->flags = mask;
/*
* Set the channel to system default encoding.
*
* Note the strange bit of protection taking place here. If the system
* encoding name is reported back as "binary", something weird is
* happening. Tcl provides no "binary" encoding, so someone else has
* provided one. We ignore it so as not to interfere with the "magic"
* interpretation that Tcl_Channels give to the "-encoding binary" option.
*/
statePtr->encoding = NULL;
name = Tcl_GetEncodingName(NULL);
if (strcmp(name, "binary") != 0) {
statePtr->encoding = Tcl_GetEncoding(NULL, name);
}
statePtr->inputEncodingState = NULL;
statePtr->inputEncodingFlags = TCL_ENCODING_START;
statePtr->outputEncodingState = NULL;
statePtr->outputEncodingFlags = TCL_ENCODING_START;
/*
* Set the channel up initially in AUTO input translation mode to accept
* "\n", "\r" and "\r\n". Output translation mode is set to a platform
* specific default value. The eofChar is set to 0 for both input and
* output, so that Tcl does not look for an in-file EOF indicator (e.g.
* ^Z) and does not append an EOF indicator to files.
*/
statePtr->inputTranslation = TCL_TRANSLATE_AUTO;
statePtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
statePtr->inEofChar = 0;
statePtr->outEofChar = 0;
statePtr->unreportedError = 0;
statePtr->refCount = 0;
statePtr->closeCbPtr = NULL;
statePtr->curOutPtr = NULL;
statePtr->outQueueHead = NULL;
statePtr->outQueueTail = NULL;
statePtr->saveInBufPtr = NULL;
statePtr->inQueueHead = NULL;
statePtr->inQueueTail = NULL;
statePtr->chPtr = NULL;
statePtr->interestMask = 0;
statePtr->scriptRecordPtr = NULL;
statePtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE;
statePtr->timer = NULL;
statePtr->csPtrR = NULL;
statePtr->csPtrW = NULL;
statePtr->outputStage = NULL;
/*
* As we are creating the channel, it is obviously the top for now.
*/
statePtr->topChanPtr = chanPtr;
statePtr->bottomChanPtr = chanPtr;
chanPtr->downChanPtr = NULL;
chanPtr->upChanPtr = NULL;
chanPtr->inQueueHead = NULL;
chanPtr->inQueueTail = NULL;
chanPtr->refCount = 0;
/*
* TIP #219, Tcl Channel Reflection API
*/
statePtr->chanMsg = NULL;
statePtr->unreportedMsg = NULL;
/*
* Link the channel into the list of all channels; create an on-exit
* handler if there is not one already, to close off all the channels in
* the list on exit.
*
* JH: Could call Tcl_SpliceChannel, but need to avoid NULL check.
*
* TIP #218.
* AK: Just initialize the field to NULL before invoking Tcl_SpliceChannel
* We need Tcl_SpliceChannel, for the threadAction calls. There is no
* real reason to duplicate all of this.
* NOTE: All drivers using thread actions now have to perform their TSD
* manipulation only in their thread action proc. Doing it when
* creating their instance structures will collide with the thread
* action activity and lead to damaged lists.
*/
statePtr->nextCSPtr = NULL;
SpliceChannel((Tcl_Channel) chanPtr);
/*
* Install this channel in the first empty standard channel slot, if the
* channel was previously closed explicitly.
*/
if ((tsdPtr->stdinChannel == NULL) && (tsdPtr->stdinInitialized == 1)) {
Tcl_SetStdChannel((Tcl_Channel) chanPtr, TCL_STDIN);
Tcl_RegisterChannel(NULL, (Tcl_Channel) chanPtr);
} else if ((tsdPtr->stdoutChannel == NULL) &&
(tsdPtr->stdoutInitialized == 1)) {
Tcl_SetStdChannel((Tcl_Channel) chanPtr, TCL_STDOUT);
Tcl_RegisterChannel(NULL, (Tcl_Channel) chanPtr);
} else if ((tsdPtr->stderrChannel == NULL) &&
(tsdPtr->stderrInitialized == 1)) {
Tcl_SetStdChannel((Tcl_Channel) chanPtr, TCL_STDERR);
Tcl_RegisterChannel(NULL, (Tcl_Channel) chanPtr);
}
return (Tcl_Channel) chanPtr;
}
/*
*----------------------------------------------------------------------
*
* Tcl_StackChannel --
*
* Replaces an entry in the hash table for a Tcl_Channel record. The
* replacement is a new channel with same name, it supercedes the
* replaced channel. Input and output of the superceded channel is now
* going through the newly created channel and allows the arbitrary
* filtering/manipulation of the dataflow.
*
* Andreas Kupries <a.kupries@westend.com>, 12/13/1998 "Trf-Patch for
* filtering channels"
*
* Results:
* Returns the new Tcl_Channel, which actually contains the saved
* information about prevChan.
*
* Side effects:
* A new channel structure is allocated and linked below the existing
* channel. The channel operations and client data of the existing
* channel are copied down to the newly created channel, and the current
* channel has its operations replaced by the new typePtr.
*
*----------------------------------------------------------------------
*/
Tcl_Channel
Tcl_StackChannel(
Tcl_Interp *interp, /* The interpreter we are working in */
Tcl_ChannelType *typePtr, /* The channel type record for the new
* channel. */
ClientData instanceData, /* Instance specific data for the new
* channel. */
int mask, /* TCL_READABLE & TCL_WRITABLE to indicate if
* the channel is readable, writable. */
Tcl_Channel prevChan) /* The channel structure to replace */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
Channel *chanPtr, *prevChanPtr;
ChannelState *statePtr;
Tcl_DriverThreadActionProc *threadActionProc;
/*
* Find the given channel (prevChan) in the list of all channels. If we do
* not find it, then it was never registered correctly.
*
* This operation should occur at the top of a channel stack.
*/
statePtr = (ChannelState *) tsdPtr->firstCSPtr;
prevChanPtr = ((Channel *) prevChan)->state->topChanPtr;
while ((statePtr != NULL) && (statePtr->topChanPtr != prevChanPtr)) {
statePtr = statePtr->nextCSPtr;
}
if (statePtr == NULL) {
if (interp) {
Tcl_AppendResult(interp, "couldn't find state for channel \"",
Tcl_GetChannelName(prevChan), "\"", NULL);
}
return NULL;
}
/*
* Here we check if the given "mask" matches the "flags" of the already
* existing channel.
*
* | - | R | W | RW |
* --+---+---+---+----+ <=> 0 != (chan->mask & prevChan->mask)
* - | | | | |
* R | | + | | + | The superceding channel is allowed to restrict
* W | | | + | + | the capabilities of the superceded one!
* RW| | + | + | + |
* --+---+---+---+----+
*/
if ((mask & (GotFlag(statePtr, TCL_READABLE | TCL_WRITABLE))) == 0) {
if (interp) {
Tcl_AppendResult(interp,
"reading and writing both disallowed for channel \"",
Tcl_GetChannelName(prevChan), "\"", NULL);
}
return NULL;
}
/*
* Flush the buffers. This ensures that any data still in them at this
* time is not handled by the new transformation. Restrict this to
* writable channels. Take care to hide a possible bg-copy in progress
* from Tcl_Flush and the CheckForChannelErrors inside.
*/
if ((mask & TCL_WRITABLE) != 0) {
CopyState *csPtrR = statePtr->csPtrR;
CopyState *csPtrW = statePtr->csPtrW;
statePtr->csPtrR = NULL;
statePtr->csPtrW = NULL;
/*
* TODO: Examine what can go wrong if Tcl_Flush() call disturbs
* the stacking state of this channel during its operations.
*/
if (Tcl_Flush((Tcl_Channel) prevChanPtr) != TCL_OK) {
statePtr->csPtrR = csPtrR;
statePtr->csPtrW = csPtrW;
if (interp) {
Tcl_AppendResult(interp, "could not flush channel \"",
Tcl_GetChannelName(prevChan), "\"", NULL);
}
return NULL;
}
statePtr->csPtrR = csPtrR;
statePtr->csPtrW = csPtrW;
}
/*
* Discard any input in the buffers. They are not yet read by the user of
* the channel, so they have to go through the new transformation before
* reading. As the buffers contain the untransformed form their contents
* are not only useless but actually distorts our view of the system.
*
* To preserve the information without having to read them again and to
* avoid problems with the location in the channel (seeking might be
* impossible) we move the buffers from the common state structure into
* the channel itself. We use the buffers in the channel below the new
* transformation to hold the data. In the future this allows us to write
* transformations which pre-read data and push the unused part back when
* they are going away.
*/
if (((mask & TCL_READABLE) != 0) && (statePtr->inQueueHead != NULL)) {
/*
* When statePtr->inQueueHead is not NULL, we know
* prevChanPtr->inQueueHead must be NULL.
*/
assert(prevChanPtr->inQueueHead == NULL);
assert(prevChanPtr->inQueueTail == NULL);
prevChanPtr->inQueueHead = statePtr->inQueueHead;
prevChanPtr->inQueueTail = statePtr->inQueueTail;
statePtr->inQueueHead = NULL;
statePtr->inQueueTail = NULL;
}
chanPtr = (Channel *) ckalloc(sizeof(Channel));
/*
* Save some of the current state into the new structure, reinitialize the
* parts which will stay with the transformation.
*
* Remarks:
*/
chanPtr->state = statePtr;
chanPtr->instanceData = instanceData;
chanPtr->typePtr = typePtr;
chanPtr->downChanPtr = prevChanPtr;
chanPtr->upChanPtr = NULL;
chanPtr->inQueueHead = NULL;
chanPtr->inQueueTail = NULL;
chanPtr->refCount = 0;
/*
* Place new block at the head of a possibly existing list of previously
* stacked channels.
*/
prevChanPtr->upChanPtr = chanPtr;
statePtr->topChanPtr = chanPtr;
/*
* TIP #218, Channel Thread Actions.
*
* We call the thread actions for the new channel directly. We _cannot_
* use SpliceChannel, because the (thread-)global list of all channels
* always contains the _ChannelState_ for a stack of channels, not the
* individual channels. And SpliceChannel would not only call the thread
* actions, but also add the shared ChannelState to this list a second
* time, mangling it.
*/
threadActionProc = Tcl_ChannelThreadActionProc(chanPtr->typePtr);
if (threadActionProc != NULL) {
(*threadActionProc)(chanPtr->instanceData, TCL_CHANNEL_THREAD_INSERT);
}
return (Tcl_Channel) chanPtr;
}
void
TclChannelPreserve(
Tcl_Channel chan)
{
((Channel *)chan)->refCount++;
}
void
TclChannelRelease(
Tcl_Channel chan)
{
Channel *chanPtr = (Channel *) chan;
if (chanPtr->refCount == 0) {
Tcl_Panic("Channel released more than preserved");
}
if (--chanPtr->refCount) {
return;
}
if (chanPtr->typePtr == NULL) {
ckfree((char *)chanPtr);
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_UnstackChannel --
*
* Unstacks an entry in the hash table for a Tcl_Channel record. This is
|