sl@0: /* sl@0: * tclIO.c -- sl@0: * sl@0: * This file provides the generic portions (those that are the same on sl@0: * all platforms and for all channel types) of Tcl's IO facilities. sl@0: * sl@0: * Copyright (c) 1998-2000 Ajuba Solutions sl@0: * Copyright (c) 1995-1997 Sun Microsystems, Inc. sl@0: * Portions Copyright (c) 2007-2008 Nokia Corporation and/or its subsidiaries. All rights reserved. sl@0: * sl@0: * See the file "license.terms" for information on usage and redistribution sl@0: * of this file, and for a DISCLAIMER OF ALL WARRANTIES. sl@0: * sl@0: * RCS: @(#) $Id: tclIO.c,v 1.61.2.23 2007/05/24 19:31:55 dgp Exp $ sl@0: */ sl@0: sl@0: #include "tclInt.h" sl@0: #include "tclPort.h" sl@0: #include "tclIO.h" sl@0: #include sl@0: #if defined(__SYMBIAN32__) && defined(__WINSCW__) sl@0: #include "tclSymbianGlobals.h" sl@0: #define dataKey getdataKey(3) sl@0: #endif sl@0: sl@0: #ifndef TCL_INHERIT_STD_CHANNELS sl@0: #define TCL_INHERIT_STD_CHANNELS 1 sl@0: #endif sl@0: sl@0: sl@0: /* sl@0: * All static variables used in this file are collected into a single sl@0: * instance of the following structure. For multi-threaded implementations, sl@0: * there is one instance of this structure for each thread. sl@0: * sl@0: * Notice that different structures with the same name appear in other sl@0: * files. The structure defined below is used in this file only. sl@0: */ sl@0: sl@0: typedef struct ThreadSpecificData { sl@0: sl@0: /* sl@0: * This variable holds the list of nested ChannelHandlerEventProc sl@0: * invocations. sl@0: */ sl@0: NextChannelHandler *nestedHandlerPtr; sl@0: sl@0: /* sl@0: * List of all channels currently open, indexed by ChannelState, sl@0: * as only one ChannelState exists per set of stacked channels. sl@0: */ sl@0: ChannelState *firstCSPtr; sl@0: #ifdef oldcode sl@0: /* sl@0: * Has a channel exit handler been created yet? sl@0: */ sl@0: int channelExitHandlerCreated; sl@0: sl@0: /* sl@0: * Has the channel event source been created and registered with the sl@0: * notifier? sl@0: */ sl@0: int channelEventSourceCreated; sl@0: #endif sl@0: /* sl@0: * Static variables to hold channels for stdin, stdout and stderr. sl@0: */ sl@0: Tcl_Channel stdinChannel; sl@0: int stdinInitialized; sl@0: Tcl_Channel stdoutChannel; sl@0: int stdoutInitialized; sl@0: Tcl_Channel stderrChannel; sl@0: int stderrInitialized; sl@0: sl@0: } ThreadSpecificData; sl@0: sl@0: #if !defined(__SYMBIAN32__) || !defined(__WINSCW__) sl@0: static Tcl_ThreadDataKey dataKey; sl@0: #endif sl@0: sl@0: /* sl@0: * Static functions in this file: sl@0: */ sl@0: sl@0: static ChannelBuffer * AllocChannelBuffer _ANSI_ARGS_((int length)); sl@0: static void ChannelTimerProc _ANSI_ARGS_(( sl@0: ClientData clientData)); sl@0: static int CheckChannelErrors _ANSI_ARGS_((ChannelState *statePtr, sl@0: int direction)); sl@0: static int CheckFlush _ANSI_ARGS_((Channel *chanPtr, sl@0: ChannelBuffer *bufPtr, int newlineFlag)); sl@0: static int CheckForDeadChannel _ANSI_ARGS_((Tcl_Interp *interp, sl@0: ChannelState *statePtr)); sl@0: static void CheckForStdChannelsBeingClosed _ANSI_ARGS_(( sl@0: Tcl_Channel chan)); sl@0: static void CleanupChannelHandlers _ANSI_ARGS_(( sl@0: Tcl_Interp *interp, Channel *chanPtr)); sl@0: static int CloseChannel _ANSI_ARGS_((Tcl_Interp *interp, sl@0: Channel *chanPtr, int errorCode)); sl@0: static void CommonGetsCleanup _ANSI_ARGS_((Channel *chanPtr, sl@0: Tcl_Encoding encoding)); sl@0: static int CopyAndTranslateBuffer _ANSI_ARGS_(( sl@0: ChannelState *statePtr, char *result, sl@0: int space)); sl@0: static int CopyBuffer _ANSI_ARGS_(( sl@0: Channel *chanPtr, char *result, int space)); sl@0: static int CopyData _ANSI_ARGS_((CopyState *csPtr, int mask)); sl@0: static void CopyEventProc _ANSI_ARGS_((ClientData clientData, sl@0: int mask)); sl@0: static void CreateScriptRecord _ANSI_ARGS_(( sl@0: Tcl_Interp *interp, Channel *chanPtr, sl@0: int mask, Tcl_Obj *scriptPtr)); sl@0: static void DeleteChannelTable _ANSI_ARGS_(( sl@0: ClientData clientData, Tcl_Interp *interp)); sl@0: static void DeleteScriptRecord _ANSI_ARGS_((Tcl_Interp *interp, sl@0: Channel *chanPtr, int mask)); sl@0: static int DetachChannel _ANSI_ARGS_((Tcl_Interp *interp, sl@0: Tcl_Channel chan)); sl@0: static void DiscardInputQueued _ANSI_ARGS_((ChannelState *statePtr, sl@0: int discardSavedBuffers)); sl@0: static void DiscardOutputQueued _ANSI_ARGS_(( sl@0: ChannelState *chanPtr)); sl@0: static int DoRead _ANSI_ARGS_((Channel *chanPtr, char *srcPtr, sl@0: int slen)); sl@0: static int DoWrite _ANSI_ARGS_((Channel *chanPtr, CONST char *src, sl@0: int srcLen)); sl@0: static int DoReadChars _ANSI_ARGS_ ((Channel* chan, sl@0: Tcl_Obj* objPtr, int toRead, int appendFlag)); sl@0: static int DoWriteChars _ANSI_ARGS_ ((Channel* chan, sl@0: CONST char* src, int len)); sl@0: static int FilterInputBytes _ANSI_ARGS_((Channel *chanPtr, sl@0: GetsState *statePtr)); sl@0: static int FlushChannel _ANSI_ARGS_((Tcl_Interp *interp, sl@0: Channel *chanPtr, int calledFromAsyncFlush)); sl@0: static Tcl_HashTable * GetChannelTable _ANSI_ARGS_((Tcl_Interp *interp)); sl@0: static int GetInput _ANSI_ARGS_((Channel *chanPtr)); sl@0: static int HaveVersion _ANSI_ARGS_((Tcl_ChannelType *typePtr, sl@0: Tcl_ChannelTypeVersion minimumVersion)); sl@0: static void PeekAhead _ANSI_ARGS_((Channel *chanPtr, sl@0: char **dstEndPtr, GetsState *gsPtr)); sl@0: static int ReadBytes _ANSI_ARGS_((ChannelState *statePtr, sl@0: Tcl_Obj *objPtr, int charsLeft, sl@0: int *offsetPtr)); sl@0: static int ReadChars _ANSI_ARGS_((ChannelState *statePtr, sl@0: Tcl_Obj *objPtr, int charsLeft, sl@0: int *offsetPtr, int *factorPtr)); sl@0: static void RecycleBuffer _ANSI_ARGS_((ChannelState *statePtr, sl@0: ChannelBuffer *bufPtr, int mustDiscard)); sl@0: static int StackSetBlockMode _ANSI_ARGS_((Channel *chanPtr, sl@0: int mode)); sl@0: static int SetBlockMode _ANSI_ARGS_((Tcl_Interp *interp, sl@0: Channel *chanPtr, int mode)); sl@0: static void StopCopy _ANSI_ARGS_((CopyState *csPtr)); sl@0: static int TranslateInputEOL _ANSI_ARGS_((ChannelState *statePtr, sl@0: char *dst, CONST char *src, sl@0: int *dstLenPtr, int *srcLenPtr)); sl@0: static int TranslateOutputEOL _ANSI_ARGS_((ChannelState *statePtr, sl@0: char *dst, CONST char *src, sl@0: int *dstLenPtr, int *srcLenPtr)); sl@0: static void UpdateInterest _ANSI_ARGS_((Channel *chanPtr)); sl@0: static int WriteBytes _ANSI_ARGS_((Channel *chanPtr, sl@0: CONST char *src, int srcLen)); sl@0: static int WriteChars _ANSI_ARGS_((Channel *chanPtr, sl@0: CONST char *src, int srcLen)); sl@0: sl@0: sl@0: /* sl@0: *--------------------------------------------------------------------------- sl@0: * sl@0: * TclInitIOSubsystem -- sl@0: * sl@0: * Initialize all resources used by this subsystem on a per-process sl@0: * basis. sl@0: * sl@0: * Results: sl@0: * None. sl@0: * sl@0: * Side effects: sl@0: * Depends on the memory subsystems. sl@0: * sl@0: *--------------------------------------------------------------------------- sl@0: */ sl@0: sl@0: void sl@0: TclInitIOSubsystem() sl@0: { sl@0: /* sl@0: * By fetching thread local storage we take care of sl@0: * allocating it for each thread. sl@0: */ sl@0: (void) TCL_TSD_INIT(&dataKey); sl@0: } sl@0: sl@0: /* sl@0: *------------------------------------------------------------------------- sl@0: * sl@0: * TclFinalizeIOSubsystem -- sl@0: * sl@0: * Releases all resources used by this subsystem on a per-thread sl@0: * basis. Closes all extant channels that have not already been sl@0: * closed because they were not owned by any interp. sl@0: * sl@0: * Results: sl@0: * None. sl@0: * sl@0: * Side effects: sl@0: * Depends on encoding and memory subsystems. sl@0: * sl@0: *------------------------------------------------------------------------- sl@0: */ sl@0: sl@0: /* ARGSUSED */ sl@0: void sl@0: TclFinalizeIOSubsystem(void) sl@0: { sl@0: ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); sl@0: Channel *chanPtr = NULL; /* Iterates over open channels. */ sl@0: ChannelState *statePtr; /* State of channel stack */ sl@0: int active = 1; /* Flag == 1 while there's still work to do */ sl@0: sl@0: /* sl@0: * Walk all channel state structures known to this thread and sl@0: * close corresponding channels. sl@0: */ sl@0: sl@0: while (active) { sl@0: sl@0: /* sl@0: * Iterate through the open channel list, and find the first sl@0: * channel that isn't dead. We start from the head of the list sl@0: * each time, because the close action on one channel can close sl@0: * others. sl@0: */ sl@0: sl@0: active = 0; sl@0: for (statePtr = tsdPtr->firstCSPtr; sl@0: statePtr != NULL; sl@0: statePtr = statePtr->nextCSPtr) { sl@0: chanPtr = statePtr->topChanPtr; sl@0: if (!(statePtr->flags & CHANNEL_DEAD)) { sl@0: active = 1; sl@0: break; sl@0: } sl@0: } sl@0: sl@0: /* sl@0: * We've found a live channel. Close it. sl@0: */ sl@0: sl@0: if (active) { sl@0: sl@0: /* sl@0: * Set the channel back into blocking mode to ensure that we sl@0: * wait for all data to flush out. sl@0: */ sl@0: sl@0: (void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr, sl@0: "-blocking", "on"); sl@0: sl@0: if ((chanPtr == (Channel *) tsdPtr->stdinChannel) || sl@0: (chanPtr == (Channel *) tsdPtr->stdoutChannel) || sl@0: (chanPtr == (Channel *) tsdPtr->stderrChannel)) { sl@0: /* sl@0: * Decrement the refcount which was earlier artificially sl@0: * bumped up to keep the channel from being closed. sl@0: */ sl@0: sl@0: statePtr->refCount--; sl@0: } sl@0: sl@0: if (statePtr->refCount <= 0) { sl@0: /* sl@0: * Close it only if the refcount indicates that the channel sl@0: * is not referenced from any interpreter. If it is, that sl@0: * interpreter will close the channel when it gets destroyed. sl@0: */ sl@0: sl@0: (void) Tcl_Close(NULL, (Tcl_Channel) chanPtr); sl@0: } else { sl@0: /* sl@0: * The refcount is greater than zero, so flush the channel. sl@0: */ sl@0: sl@0: Tcl_Flush((Tcl_Channel) chanPtr); sl@0: sl@0: /* sl@0: * Call the device driver to actually close the underlying sl@0: * device for this channel. sl@0: */ sl@0: sl@0: if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) { sl@0: (chanPtr->typePtr->closeProc)(chanPtr->instanceData, NULL); sl@0: } else { sl@0: (chanPtr->typePtr->close2Proc)(chanPtr->instanceData, sl@0: NULL, 0); sl@0: } sl@0: sl@0: /* sl@0: * Finally, we clean up the fields in the channel data sl@0: * structure since all of them have been deleted already. sl@0: * We mark the channel with CHANNEL_DEAD to prevent any sl@0: * further IO operations sl@0: * on it. sl@0: */ sl@0: sl@0: chanPtr->instanceData = NULL; sl@0: statePtr->flags |= CHANNEL_DEAD; sl@0: } sl@0: } sl@0: } sl@0: sl@0: TclpFinalizeSockets(); sl@0: TclpFinalizePipes(); sl@0: } sl@0: sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_SetStdChannel -- sl@0: * sl@0: * This function is used to change the channels that are used sl@0: * for stdin/stdout/stderr in new interpreters. sl@0: * sl@0: * Results: sl@0: * None sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C void sl@0: Tcl_SetStdChannel(channel, type) sl@0: Tcl_Channel channel; sl@0: int type; /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */ sl@0: { sl@0: ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); sl@0: switch (type) { sl@0: case TCL_STDIN: sl@0: tsdPtr->stdinInitialized = 1; sl@0: tsdPtr->stdinChannel = channel; sl@0: break; sl@0: case TCL_STDOUT: sl@0: tsdPtr->stdoutInitialized = 1; sl@0: tsdPtr->stdoutChannel = channel; sl@0: break; sl@0: case TCL_STDERR: sl@0: tsdPtr->stderrInitialized = 1; sl@0: tsdPtr->stderrChannel = channel; sl@0: break; sl@0: } sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_GetStdChannel -- sl@0: * sl@0: * Returns the specified standard channel. sl@0: * sl@0: * Results: sl@0: * Returns the specified standard channel, or NULL. sl@0: * sl@0: * Side effects: sl@0: * May cause the creation of a standard channel and the underlying sl@0: * file. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: EXPORT_C Tcl_Channel sl@0: Tcl_GetStdChannel(type) sl@0: int type; /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */ sl@0: { sl@0: Tcl_Channel channel = NULL; sl@0: ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); sl@0: sl@0: /* sl@0: * If the channels were not created yet, create them now and sl@0: * store them in the static variables. sl@0: */ sl@0: sl@0: switch (type) { sl@0: case TCL_STDIN: sl@0: if (!tsdPtr->stdinInitialized) { sl@0: tsdPtr->stdinChannel = TclpGetDefaultStdChannel(TCL_STDIN); sl@0: tsdPtr->stdinInitialized = 1; sl@0: sl@0: /* sl@0: * Artificially bump the refcount to ensure that the channel sl@0: * is only closed on exit. sl@0: * sl@0: * NOTE: Must only do this if stdinChannel is not NULL. It sl@0: * can be NULL in situations where Tcl is unable to connect sl@0: * to the standard input. sl@0: */ sl@0: sl@0: if (tsdPtr->stdinChannel != (Tcl_Channel) NULL) { sl@0: (void) Tcl_RegisterChannel((Tcl_Interp *) NULL, sl@0: tsdPtr->stdinChannel); sl@0: } sl@0: } sl@0: channel = tsdPtr->stdinChannel; sl@0: break; sl@0: case TCL_STDOUT: sl@0: if (!tsdPtr->stdoutInitialized) { sl@0: tsdPtr->stdoutChannel = TclpGetDefaultStdChannel(TCL_STDOUT); sl@0: tsdPtr->stdoutInitialized = 1; sl@0: if (tsdPtr->stdoutChannel != (Tcl_Channel) NULL) { sl@0: (void) Tcl_RegisterChannel((Tcl_Interp *) NULL, sl@0: tsdPtr->stdoutChannel); sl@0: } sl@0: } sl@0: channel = tsdPtr->stdoutChannel; sl@0: break; sl@0: case TCL_STDERR: sl@0: if (!tsdPtr->stderrInitialized) { sl@0: tsdPtr->stderrChannel = TclpGetDefaultStdChannel(TCL_STDERR); sl@0: tsdPtr->stderrInitialized = 1; sl@0: if (tsdPtr->stderrChannel != (Tcl_Channel) NULL) { sl@0: (void) Tcl_RegisterChannel((Tcl_Interp *) NULL, sl@0: tsdPtr->stderrChannel); sl@0: } sl@0: } sl@0: channel = tsdPtr->stderrChannel; sl@0: break; sl@0: } sl@0: return channel; sl@0: } sl@0: sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_CreateCloseHandler sl@0: * sl@0: * Creates a close callback which will be called when the channel is sl@0: * closed. sl@0: * sl@0: * Results: sl@0: * None. sl@0: * sl@0: * Side effects: sl@0: * Causes the callback to be called in the future when the channel sl@0: * will be closed. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C void sl@0: Tcl_CreateCloseHandler(chan, proc, clientData) sl@0: Tcl_Channel chan; /* The channel for which to create the sl@0: * close callback. */ sl@0: Tcl_CloseProc *proc; /* The callback routine to call when the sl@0: * channel will be closed. */ sl@0: ClientData clientData; /* Arbitrary data to pass to the sl@0: * close callback. */ sl@0: { sl@0: ChannelState *statePtr; sl@0: CloseCallback *cbPtr; sl@0: sl@0: statePtr = ((Channel *) chan)->state; sl@0: sl@0: cbPtr = (CloseCallback *) ckalloc((unsigned) sizeof(CloseCallback)); sl@0: cbPtr->proc = proc; sl@0: cbPtr->clientData = clientData; sl@0: sl@0: cbPtr->nextPtr = statePtr->closeCbPtr; sl@0: statePtr->closeCbPtr = cbPtr; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_DeleteCloseHandler -- sl@0: * sl@0: * Removes a callback that would have been called on closing sl@0: * the channel. If there is no matching callback then this sl@0: * function has no effect. sl@0: * sl@0: * Results: sl@0: * None. sl@0: * sl@0: * Side effects: sl@0: * The callback will not be called in the future when the channel sl@0: * is eventually closed. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C void sl@0: Tcl_DeleteCloseHandler(chan, proc, clientData) sl@0: Tcl_Channel chan; /* The channel for which to cancel the sl@0: * close callback. */ sl@0: Tcl_CloseProc *proc; /* The procedure for the callback to sl@0: * remove. */ sl@0: ClientData clientData; /* The callback data for the callback sl@0: * to remove. */ sl@0: { sl@0: ChannelState *statePtr; sl@0: CloseCallback *cbPtr, *cbPrevPtr; sl@0: sl@0: statePtr = ((Channel *) chan)->state; sl@0: for (cbPtr = statePtr->closeCbPtr, cbPrevPtr = (CloseCallback *) NULL; sl@0: cbPtr != (CloseCallback *) NULL; sl@0: cbPtr = cbPtr->nextPtr) { sl@0: if ((cbPtr->proc == proc) && (cbPtr->clientData == clientData)) { sl@0: if (cbPrevPtr == (CloseCallback *) NULL) { sl@0: statePtr->closeCbPtr = cbPtr->nextPtr; sl@0: } sl@0: ckfree((char *) cbPtr); sl@0: break; sl@0: } else { sl@0: cbPrevPtr = cbPtr; sl@0: } sl@0: } sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * GetChannelTable -- sl@0: * sl@0: * Gets and potentially initializes the channel table for an sl@0: * interpreter. If it is initializing the table it also inserts sl@0: * channels for stdin, stdout and stderr if the interpreter is sl@0: * trusted. sl@0: * sl@0: * Results: sl@0: * A pointer to the hash table created, for use by the caller. sl@0: * sl@0: * Side effects: sl@0: * Initializes the channel table for an interpreter. May create sl@0: * channels for stdin, stdout and stderr. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static Tcl_HashTable * sl@0: GetChannelTable(interp) sl@0: Tcl_Interp *interp; sl@0: { sl@0: Tcl_HashTable *hTblPtr; /* Hash table of channels. */ sl@0: Tcl_Channel stdinChan, stdoutChan, stderrChan; sl@0: sl@0: hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL); sl@0: if (hTblPtr == (Tcl_HashTable *) NULL) { sl@0: hTblPtr = (Tcl_HashTable *) ckalloc((unsigned) sizeof(Tcl_HashTable)); sl@0: Tcl_InitHashTable(hTblPtr, TCL_STRING_KEYS); sl@0: sl@0: (void) Tcl_SetAssocData(interp, "tclIO", sl@0: (Tcl_InterpDeleteProc *) DeleteChannelTable, sl@0: (ClientData) hTblPtr); sl@0: sl@0: /* sl@0: * If the interpreter is trusted (not "safe"), insert channels sl@0: * for stdin, stdout and stderr (possibly creating them in the sl@0: * process). sl@0: */ sl@0: sl@0: if (Tcl_IsSafe(interp) == 0) { sl@0: stdinChan = Tcl_GetStdChannel(TCL_STDIN); sl@0: if (stdinChan != NULL) { sl@0: Tcl_RegisterChannel(interp, stdinChan); sl@0: } sl@0: stdoutChan = Tcl_GetStdChannel(TCL_STDOUT); sl@0: if (stdoutChan != NULL) { sl@0: Tcl_RegisterChannel(interp, stdoutChan); sl@0: } sl@0: stderrChan = Tcl_GetStdChannel(TCL_STDERR); sl@0: if (stderrChan != NULL) { sl@0: Tcl_RegisterChannel(interp, stderrChan); sl@0: } sl@0: } sl@0: sl@0: } sl@0: return hTblPtr; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * DeleteChannelTable -- sl@0: * sl@0: * Deletes the channel table for an interpreter, closing any open sl@0: * channels whose refcount reaches zero. This procedure is invoked sl@0: * when an interpreter is deleted, via the AssocData cleanup sl@0: * mechanism. sl@0: * sl@0: * Results: sl@0: * None. sl@0: * sl@0: * Side effects: sl@0: * Deletes the hash table of channels. May close channels. May flush sl@0: * output on closed channels. Removes any channeEvent handlers that were sl@0: * registered in this interpreter. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static void sl@0: DeleteChannelTable(clientData, interp) sl@0: ClientData clientData; /* The per-interpreter data structure. */ sl@0: Tcl_Interp *interp; /* The interpreter being deleted. */ sl@0: { sl@0: Tcl_HashTable *hTblPtr; /* The hash table. */ sl@0: Tcl_HashSearch hSearch; /* Search variable. */ sl@0: Tcl_HashEntry *hPtr; /* Search variable. */ sl@0: Channel *chanPtr; /* Channel being deleted. */ sl@0: ChannelState *statePtr; /* State of Channel being deleted. */ sl@0: EventScriptRecord *sPtr, *prevPtr, *nextPtr; sl@0: /* Variables to loop over all channel events sl@0: * registered, to delete the ones that refer sl@0: * to the interpreter being deleted. */ sl@0: sl@0: /* sl@0: * Delete all the registered channels - this will close channels whose sl@0: * refcount reaches zero. sl@0: */ sl@0: sl@0: hTblPtr = (Tcl_HashTable *) clientData; sl@0: for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch); sl@0: hPtr != (Tcl_HashEntry *) NULL; sl@0: hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch)) { sl@0: sl@0: chanPtr = (Channel *) Tcl_GetHashValue(hPtr); sl@0: statePtr = chanPtr->state; sl@0: sl@0: /* sl@0: * Remove any fileevents registered in this interpreter. sl@0: */ sl@0: sl@0: for (sPtr = statePtr->scriptRecordPtr, sl@0: prevPtr = (EventScriptRecord *) NULL; sl@0: sPtr != (EventScriptRecord *) NULL; sl@0: sPtr = nextPtr) { sl@0: nextPtr = sPtr->nextPtr; sl@0: if (sPtr->interp == interp) { sl@0: if (prevPtr == (EventScriptRecord *) NULL) { sl@0: statePtr->scriptRecordPtr = nextPtr; sl@0: } else { sl@0: prevPtr->nextPtr = nextPtr; sl@0: } sl@0: sl@0: Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr, sl@0: TclChannelEventScriptInvoker, (ClientData) sPtr); sl@0: sl@0: Tcl_DecrRefCount(sPtr->scriptPtr); sl@0: ckfree((char *) sPtr); sl@0: } else { sl@0: prevPtr = sPtr; sl@0: } sl@0: } sl@0: sl@0: /* sl@0: * Cannot call Tcl_UnregisterChannel because that procedure calls sl@0: * Tcl_GetAssocData to get the channel table, which might already sl@0: * be inaccessible from the interpreter structure. Instead, we sl@0: * emulate the behavior of Tcl_UnregisterChannel directly here. sl@0: */ sl@0: sl@0: Tcl_DeleteHashEntry(hPtr); sl@0: statePtr->refCount--; sl@0: if (statePtr->refCount <= 0) { sl@0: if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) { sl@0: (void) Tcl_Close(interp, (Tcl_Channel) chanPtr); sl@0: } sl@0: } sl@0: } sl@0: Tcl_DeleteHashTable(hTblPtr); sl@0: ckfree((char *) hTblPtr); sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * CheckForStdChannelsBeingClosed -- sl@0: * sl@0: * Perform special handling for standard channels being closed. When sl@0: * given a standard channel, if the refcount is now 1, it means that sl@0: * the last reference to the standard channel is being explicitly sl@0: * closed. Now bump the refcount artificially down to 0, to ensure the sl@0: * normal handling of channels being closed will occur. Also reset the sl@0: * static pointer to the channel to NULL, to avoid dangling references. sl@0: * sl@0: * Results: sl@0: * None. sl@0: * sl@0: * Side effects: sl@0: * Manipulates the refcount on standard channels. May smash the global sl@0: * static pointer to a standard channel. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static void sl@0: CheckForStdChannelsBeingClosed(chan) sl@0: Tcl_Channel chan; sl@0: { sl@0: ChannelState *statePtr = ((Channel *) chan)->state; sl@0: ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); sl@0: sl@0: if ((chan == tsdPtr->stdinChannel) && (tsdPtr->stdinInitialized)) { sl@0: if (statePtr->refCount < 2) { sl@0: statePtr->refCount = 0; sl@0: tsdPtr->stdinChannel = NULL; sl@0: return; sl@0: } sl@0: } else if ((chan == tsdPtr->stdoutChannel) sl@0: && (tsdPtr->stdoutInitialized)) { sl@0: if (statePtr->refCount < 2) { sl@0: statePtr->refCount = 0; sl@0: tsdPtr->stdoutChannel = NULL; sl@0: return; sl@0: } sl@0: } else if ((chan == tsdPtr->stderrChannel) sl@0: && (tsdPtr->stderrInitialized)) { sl@0: if (statePtr->refCount < 2) { sl@0: statePtr->refCount = 0; sl@0: tsdPtr->stderrChannel = NULL; sl@0: return; sl@0: } sl@0: } sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_IsStandardChannel -- sl@0: * sl@0: * Test if the given channel is a standard channel. No attempt sl@0: * is made to check if the channel or the standard channels sl@0: * are initialized or otherwise valid. sl@0: * sl@0: * Results: sl@0: * Returns 1 if true, 0 if false. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: EXPORT_C int sl@0: Tcl_IsStandardChannel(chan) sl@0: Tcl_Channel chan; /* Channel to check. */ sl@0: { sl@0: ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); sl@0: sl@0: if ((chan == tsdPtr->stdinChannel) sl@0: || (chan == tsdPtr->stdoutChannel) sl@0: || (chan == tsdPtr->stderrChannel)) { sl@0: return 1; sl@0: } else { sl@0: return 0; sl@0: } sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_RegisterChannel -- sl@0: * sl@0: * Adds an already-open channel to the channel table of an interpreter. sl@0: * If the interpreter passed as argument is NULL, it only increments sl@0: * the channel refCount. sl@0: * sl@0: * Results: sl@0: * None. sl@0: * sl@0: * Side effects: sl@0: * May increment the reference count of a channel. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C void sl@0: Tcl_RegisterChannel(interp, chan) sl@0: Tcl_Interp *interp; /* Interpreter in which to add the channel. */ sl@0: Tcl_Channel chan; /* The channel to add to this interpreter sl@0: * channel table. */ sl@0: { sl@0: Tcl_HashTable *hTblPtr; /* Hash table of channels. */ sl@0: Tcl_HashEntry *hPtr; /* Search variable. */ sl@0: int new; /* Is the hash entry new or does it exist? */ sl@0: Channel *chanPtr; /* The actual channel. */ sl@0: ChannelState *statePtr; /* State of the actual channel. */ sl@0: sl@0: /* sl@0: * Always (un)register bottom-most channel in the stack. This makes sl@0: * management of the channel list easier because no manipulation is sl@0: * necessary during (un)stack operation. sl@0: */ sl@0: chanPtr = ((Channel *) chan)->state->bottomChanPtr; sl@0: statePtr = chanPtr->state; sl@0: sl@0: if (statePtr->channelName == (CONST char *) NULL) { sl@0: panic("Tcl_RegisterChannel: channel without name"); sl@0: } sl@0: if (interp != (Tcl_Interp *) NULL) { sl@0: hTblPtr = GetChannelTable(interp); sl@0: hPtr = Tcl_CreateHashEntry(hTblPtr, statePtr->channelName, &new); sl@0: if (new == 0) { sl@0: if (chan == (Tcl_Channel) Tcl_GetHashValue(hPtr)) { sl@0: return; sl@0: } sl@0: sl@0: panic("Tcl_RegisterChannel: duplicate channel names"); sl@0: } sl@0: Tcl_SetHashValue(hPtr, (ClientData) chanPtr); sl@0: } sl@0: sl@0: statePtr->refCount++; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_UnregisterChannel -- sl@0: * sl@0: * Deletes the hash entry for a channel associated with an interpreter. sl@0: * If the interpreter given as argument is NULL, it only decrements the sl@0: * reference count. (This all happens in the Tcl_DetachChannel helper sl@0: * function). sl@0: * sl@0: * Finally, if the reference count of the channel drops to zero, sl@0: * it is deleted. sl@0: * sl@0: * Results: sl@0: * A standard Tcl result. sl@0: * sl@0: * Side effects: sl@0: * Calls Tcl_DetachChannel which deletes the hash entry for a channel sl@0: * associated with an interpreter. sl@0: * sl@0: * May delete the channel, which can have a variety of consequences, sl@0: * especially if we are forced to close the channel. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C int sl@0: Tcl_UnregisterChannel(interp, chan) sl@0: Tcl_Interp *interp; /* Interpreter in which channel is defined. */ sl@0: Tcl_Channel chan; /* Channel to delete. */ sl@0: { sl@0: ChannelState *statePtr; /* State of the real channel. */ sl@0: sl@0: statePtr = ((Channel *) chan)->state->bottomChanPtr->state; sl@0: sl@0: if (statePtr->flags & CHANNEL_INCLOSE) { sl@0: if (interp != (Tcl_Interp*) NULL) { sl@0: Tcl_AppendResult(interp, sl@0: "Illegal recursive call to close through close-handler of channel", sl@0: (char *) NULL); sl@0: } sl@0: return TCL_ERROR; sl@0: } sl@0: sl@0: if (DetachChannel(interp, chan) != TCL_OK) { sl@0: return TCL_OK; sl@0: } sl@0: sl@0: statePtr = ((Channel *) chan)->state->bottomChanPtr->state; sl@0: sl@0: /* sl@0: * Perform special handling for standard channels being closed. If the sl@0: * refCount is now 1 it means that the last reference to the standard sl@0: * channel is being explicitly closed, so bump the refCount down sl@0: * artificially to 0. This will ensure that the channel is actually sl@0: * closed, below. Also set the static pointer to NULL for the channel. sl@0: */ sl@0: sl@0: CheckForStdChannelsBeingClosed(chan); sl@0: sl@0: /* sl@0: * If the refCount reached zero, close the actual channel. sl@0: */ sl@0: sl@0: if (statePtr->refCount <= 0) { sl@0: sl@0: /* sl@0: * Ensure that if there is another buffer, it gets flushed sl@0: * whether or not we are doing a background flush. sl@0: */ sl@0: sl@0: if ((statePtr->curOutPtr != NULL) && sl@0: (statePtr->curOutPtr->nextAdded > sl@0: statePtr->curOutPtr->nextRemoved)) { sl@0: statePtr->flags |= BUFFER_READY; sl@0: } sl@0: Tcl_Preserve((ClientData)statePtr); sl@0: if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) { sl@0: /* We don't want to re-enter Tcl_Close */ sl@0: if (!(statePtr->flags & CHANNEL_CLOSED)) { sl@0: if (Tcl_Close(interp, chan) != TCL_OK) { sl@0: statePtr->flags |= CHANNEL_CLOSED; sl@0: Tcl_Release((ClientData)statePtr); sl@0: return TCL_ERROR; sl@0: } sl@0: } sl@0: } sl@0: statePtr->flags |= CHANNEL_CLOSED; sl@0: Tcl_Release((ClientData)statePtr); sl@0: } sl@0: return TCL_OK; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_DetachChannel -- sl@0: * sl@0: * Deletes the hash entry for a channel associated with an interpreter. sl@0: * If the interpreter given as argument is NULL, it only decrements the sl@0: * reference count. Even if the ref count drops to zero, the sl@0: * channel is NOT closed or cleaned up. This allows a channel to sl@0: * be detached from an interpreter and left in the same state it sl@0: * was in when it was originally returned by 'Tcl_OpenFileChannel', sl@0: * for example. sl@0: * sl@0: * This function cannot be used on the standard channels, and sl@0: * will return TCL_ERROR if that is attempted. sl@0: * sl@0: * This function should only be necessary for special purposes sl@0: * in which you need to generate a pristine channel from one sl@0: * that has already been used. All ordinary purposes will almost sl@0: * always want to use Tcl_UnregisterChannel instead. sl@0: * sl@0: * Provided the channel is not attached to any other interpreter, sl@0: * it can then be closed with Tcl_Close, rather than with sl@0: * Tcl_UnregisterChannel. sl@0: * sl@0: * Results: sl@0: * A standard Tcl result. If the channel is not currently registered sl@0: * with the given interpreter, TCL_ERROR is returned, otherwise sl@0: * TCL_OK. However no error messages are left in the interp's result. sl@0: * sl@0: * Side effects: sl@0: * Deletes the hash entry for a channel associated with an sl@0: * interpreter. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C int sl@0: Tcl_DetachChannel(interp, chan) sl@0: Tcl_Interp *interp; /* Interpreter in which channel is defined. */ sl@0: Tcl_Channel chan; /* Channel to delete. */ sl@0: { sl@0: if (Tcl_IsStandardChannel(chan)) { sl@0: return TCL_ERROR; sl@0: } sl@0: sl@0: return DetachChannel(interp, chan); sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * DetachChannel -- sl@0: * sl@0: * Deletes the hash entry for a channel associated with an interpreter. sl@0: * If the interpreter given as argument is NULL, it only decrements the sl@0: * reference count. Even if the ref count drops to zero, the sl@0: * channel is NOT closed or cleaned up. This allows a channel to sl@0: * be detached from an interpreter and left in the same state it sl@0: * was in when it was originally returned by 'Tcl_OpenFileChannel', sl@0: * for example. sl@0: * sl@0: * Results: sl@0: * A standard Tcl result. If the channel is not currently registered sl@0: * with the given interpreter, TCL_ERROR is returned, otherwise sl@0: * TCL_OK. However no error messages are left in the interp's result. sl@0: * sl@0: * Side effects: sl@0: * Deletes the hash entry for a channel associated with an sl@0: * interpreter. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static int sl@0: DetachChannel(interp, chan) sl@0: Tcl_Interp *interp; /* Interpreter in which channel is defined. */ sl@0: Tcl_Channel chan; /* Channel to delete. */ sl@0: { sl@0: Tcl_HashTable *hTblPtr; /* Hash table of channels. */ sl@0: Tcl_HashEntry *hPtr; /* Search variable. */ sl@0: Channel *chanPtr; /* The real IO channel. */ sl@0: ChannelState *statePtr; /* State of the real channel. */ sl@0: sl@0: /* sl@0: * Always (un)register bottom-most channel in the stack. This makes sl@0: * management of the channel list easier because no manipulation is sl@0: * necessary during (un)stack operation. sl@0: */ sl@0: chanPtr = ((Channel *) chan)->state->bottomChanPtr; sl@0: statePtr = chanPtr->state; sl@0: sl@0: if (interp != (Tcl_Interp *) NULL) { sl@0: hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL); sl@0: if (hTblPtr == (Tcl_HashTable *) NULL) { sl@0: return TCL_ERROR; sl@0: } sl@0: hPtr = Tcl_FindHashEntry(hTblPtr, statePtr->channelName); sl@0: if (hPtr == (Tcl_HashEntry *) NULL) { sl@0: return TCL_ERROR; sl@0: } sl@0: if ((Channel *) Tcl_GetHashValue(hPtr) != chanPtr) { sl@0: return TCL_ERROR; sl@0: } sl@0: Tcl_DeleteHashEntry(hPtr); sl@0: sl@0: /* sl@0: * Remove channel handlers that refer to this interpreter, so that they sl@0: * will not be present if the actual close is delayed and more events sl@0: * happen on the channel. This may occur if the channel is shared sl@0: * between several interpreters, or if the channel has async sl@0: * flushing active. sl@0: */ sl@0: sl@0: CleanupChannelHandlers(interp, chanPtr); sl@0: } sl@0: sl@0: statePtr->refCount--; sl@0: sl@0: return TCL_OK; sl@0: } sl@0: sl@0: sl@0: /* sl@0: *--------------------------------------------------------------------------- sl@0: * sl@0: * Tcl_GetChannel -- sl@0: * sl@0: * Finds an existing Tcl_Channel structure by name in a given sl@0: * interpreter. This function is public because it is used by sl@0: * channel-type-specific functions. sl@0: * sl@0: * Results: sl@0: * A Tcl_Channel or NULL on failure. If failed, interp's result sl@0: * object contains an error message. *modePtr is filled with the sl@0: * modes in which the channel was opened. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *--------------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C Tcl_Channel sl@0: Tcl_GetChannel(interp, chanName, modePtr) sl@0: Tcl_Interp *interp; /* Interpreter in which to find or create sl@0: * the channel. */ sl@0: CONST char *chanName; /* The name of the channel. */ sl@0: int *modePtr; /* Where to store the mode in which the sl@0: * channel was opened? Will contain an ORed sl@0: * combination of TCL_READABLE and sl@0: * TCL_WRITABLE, if non-NULL. */ sl@0: { sl@0: Channel *chanPtr; /* The actual channel. */ sl@0: Tcl_HashTable *hTblPtr; /* Hash table of channels. */ sl@0: Tcl_HashEntry *hPtr; /* Search variable. */ sl@0: CONST char *name; /* Translated name. */ sl@0: sl@0: /* sl@0: * Substitute "stdin", etc. Note that even though we immediately sl@0: * find the channel using Tcl_GetStdChannel, we still need to look sl@0: * it up in the specified interpreter to ensure that it is present sl@0: * in the channel table. Otherwise, safe interpreters would always sl@0: * have access to the standard channels. sl@0: */ sl@0: sl@0: name = chanName; sl@0: if ((chanName[0] == 's') && (chanName[1] == 't')) { sl@0: chanPtr = NULL; sl@0: if (strcmp(chanName, "stdin") == 0) { sl@0: chanPtr = (Channel *) Tcl_GetStdChannel(TCL_STDIN); sl@0: } else if (strcmp(chanName, "stdout") == 0) { sl@0: chanPtr = (Channel *) Tcl_GetStdChannel(TCL_STDOUT); sl@0: } else if (strcmp(chanName, "stderr") == 0) { sl@0: chanPtr = (Channel *) Tcl_GetStdChannel(TCL_STDERR); sl@0: } sl@0: if (chanPtr != NULL) { sl@0: name = chanPtr->state->channelName; sl@0: } sl@0: } sl@0: sl@0: hTblPtr = GetChannelTable(interp); sl@0: hPtr = Tcl_FindHashEntry(hTblPtr, name); sl@0: if (hPtr == (Tcl_HashEntry *) NULL) { sl@0: Tcl_AppendResult(interp, "can not find channel named \"", sl@0: chanName, "\"", (char *) NULL); sl@0: return NULL; sl@0: } sl@0: sl@0: /* sl@0: * Always return bottom-most channel in the stack. This one lives sl@0: * the longest - other channels may go away unnoticed. sl@0: * The other APIs compensate where necessary to retrieve the sl@0: * topmost channel again. sl@0: */ sl@0: chanPtr = (Channel *) Tcl_GetHashValue(hPtr); sl@0: chanPtr = chanPtr->state->bottomChanPtr; sl@0: if (modePtr != NULL) { sl@0: *modePtr = (chanPtr->state->flags & (TCL_READABLE|TCL_WRITABLE)); sl@0: } sl@0: sl@0: return (Tcl_Channel) chanPtr; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_CreateChannel -- sl@0: * sl@0: * Creates a new entry in the hash table for a Tcl_Channel sl@0: * record. sl@0: * sl@0: * Results: sl@0: * Returns the new Tcl_Channel. sl@0: * sl@0: * Side effects: sl@0: * Creates a new Tcl_Channel instance and inserts it into the sl@0: * hash table. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C Tcl_Channel sl@0: Tcl_CreateChannel(typePtr, chanName, instanceData, mask) sl@0: Tcl_ChannelType *typePtr; /* The channel type record. */ sl@0: CONST char *chanName; /* Name of channel to record. */ sl@0: ClientData instanceData; /* Instance specific data. */ sl@0: int mask; /* TCL_READABLE & TCL_WRITABLE to indicate sl@0: * if the channel is readable, writable. */ sl@0: { sl@0: Channel *chanPtr; /* The channel structure newly created. */ sl@0: ChannelState *statePtr; /* The stack-level independent state info sl@0: * for the channel. */ sl@0: CONST char *name; sl@0: ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); sl@0: sl@0: /* sl@0: * With the change of the Tcl_ChannelType structure to use a version in sl@0: * 8.3.2+, we have to make sure that our assumption that the structure sl@0: * remains a binary compatible size is true. sl@0: * sl@0: * If this assertion fails on some system, then it can be removed sl@0: * only if the user recompiles code with older channel drivers in sl@0: * the new system as well. sl@0: */ sl@0: sl@0: assert(sizeof(Tcl_ChannelTypeVersion) == sizeof(Tcl_DriverBlockModeProc*)); sl@0: sl@0: /* sl@0: * JH: We could subsequently memset these to 0 to avoid the sl@0: * numerous assignments to 0/NULL below. sl@0: */ sl@0: chanPtr = (Channel *) ckalloc((unsigned) sizeof(Channel)); sl@0: statePtr = (ChannelState *) ckalloc((unsigned) sizeof(ChannelState)); sl@0: chanPtr->state = statePtr; sl@0: sl@0: chanPtr->instanceData = instanceData; sl@0: chanPtr->typePtr = typePtr; sl@0: sl@0: /* sl@0: * Set all the bits that are part of the stack-independent state sl@0: * information for the channel. sl@0: */ sl@0: sl@0: if (chanName != (char *) NULL) { sl@0: char *tmp = ckalloc((unsigned) (strlen(chanName) + 1)); sl@0: statePtr->channelName = tmp; sl@0: strcpy(tmp, chanName); sl@0: } else { sl@0: panic("Tcl_CreateChannel: NULL channel name"); sl@0: } sl@0: sl@0: statePtr->flags = mask; sl@0: sl@0: /* sl@0: * Set the channel to system default encoding. sl@0: */ sl@0: sl@0: statePtr->encoding = NULL; sl@0: name = Tcl_GetEncodingName(NULL); sl@0: if (strcmp(name, "binary") != 0) { sl@0: statePtr->encoding = Tcl_GetEncoding(NULL, name); sl@0: } sl@0: statePtr->inputEncodingState = NULL; sl@0: statePtr->inputEncodingFlags = TCL_ENCODING_START; sl@0: statePtr->outputEncodingState = NULL; sl@0: statePtr->outputEncodingFlags = TCL_ENCODING_START; sl@0: sl@0: /* sl@0: * Set the channel up initially in AUTO input translation mode to sl@0: * accept "\n", "\r" and "\r\n". Output translation mode is set to sl@0: * a platform specific default value. The eofChar is set to 0 for both sl@0: * input and output, so that Tcl does not look for an in-file EOF sl@0: * indicator (e.g. ^Z) and does not append an EOF indicator to files. sl@0: */ sl@0: sl@0: statePtr->inputTranslation = TCL_TRANSLATE_AUTO; sl@0: statePtr->outputTranslation = TCL_PLATFORM_TRANSLATION; sl@0: statePtr->inEofChar = 0; sl@0: statePtr->outEofChar = 0; sl@0: sl@0: statePtr->unreportedError = 0; sl@0: statePtr->refCount = 0; sl@0: statePtr->closeCbPtr = (CloseCallback *) NULL; sl@0: statePtr->curOutPtr = (ChannelBuffer *) NULL; sl@0: statePtr->outQueueHead = (ChannelBuffer *) NULL; sl@0: statePtr->outQueueTail = (ChannelBuffer *) NULL; sl@0: statePtr->saveInBufPtr = (ChannelBuffer *) NULL; sl@0: statePtr->inQueueHead = (ChannelBuffer *) NULL; sl@0: statePtr->inQueueTail = (ChannelBuffer *) NULL; sl@0: statePtr->chPtr = (ChannelHandler *) NULL; sl@0: statePtr->interestMask = 0; sl@0: statePtr->scriptRecordPtr = (EventScriptRecord *) NULL; sl@0: statePtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE; sl@0: statePtr->timer = NULL; sl@0: statePtr->csPtr = NULL; sl@0: sl@0: statePtr->outputStage = NULL; sl@0: if ((statePtr->encoding != NULL) && (statePtr->flags & TCL_WRITABLE)) { sl@0: statePtr->outputStage = (char *) sl@0: ckalloc((unsigned) (statePtr->bufSize + 2)); sl@0: } sl@0: sl@0: /* sl@0: * As we are creating the channel, it is obviously the top for now sl@0: */ sl@0: statePtr->topChanPtr = chanPtr; sl@0: statePtr->bottomChanPtr = chanPtr; sl@0: chanPtr->downChanPtr = (Channel *) NULL; sl@0: chanPtr->upChanPtr = (Channel *) NULL; sl@0: chanPtr->inQueueHead = (ChannelBuffer*) NULL; sl@0: chanPtr->inQueueTail = (ChannelBuffer*) NULL; sl@0: sl@0: /* sl@0: * Link the channel into the list of all channels; create an on-exit sl@0: * handler if there is not one already, to close off all the channels sl@0: * in the list on exit. sl@0: * sl@0: * JH: Could call Tcl_SpliceChannel, but need to avoid NULL check. sl@0: * sl@0: * TIP #218. sl@0: * AK: Just initialize the field to NULL before invoking Tcl_SpliceChannel sl@0: * We need Tcl_SpliceChannel, for the threadAction calls. sl@0: * There is no real reason to duplicate all of this. sl@0: * NOTE: All drivers using thread actions now have to perform their TSD sl@0: * manipulation only in their thread action proc. Doing it when sl@0: * creating their instance structures will collide with the thread sl@0: * action activity and lead to damaged lists. sl@0: */ sl@0: sl@0: statePtr->nextCSPtr = (ChannelState *) NULL; sl@0: Tcl_SpliceChannel ((Tcl_Channel) chanPtr); sl@0: sl@0: /* sl@0: * Install this channel in the first empty standard channel slot, if sl@0: * the channel was previously closed explicitly. sl@0: */ sl@0: #if TCL_INHERIT_STD_CHANNELS sl@0: if ((tsdPtr->stdinChannel == NULL) && sl@0: (tsdPtr->stdinInitialized == 1)) { sl@0: Tcl_SetStdChannel((Tcl_Channel) chanPtr, TCL_STDIN); sl@0: Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr); sl@0: } else if ((tsdPtr->stdoutChannel == NULL) && sl@0: (tsdPtr->stdoutInitialized == 1)) { sl@0: Tcl_SetStdChannel((Tcl_Channel) chanPtr, TCL_STDOUT); sl@0: Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr); sl@0: } else if ((tsdPtr->stderrChannel == NULL) && sl@0: (tsdPtr->stderrInitialized == 1)) { sl@0: Tcl_SetStdChannel((Tcl_Channel) chanPtr, TCL_STDERR); sl@0: Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr); sl@0: } sl@0: #endif sl@0: return (Tcl_Channel) chanPtr; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_StackChannel -- sl@0: * sl@0: * Replaces an entry in the hash table for a Tcl_Channel sl@0: * record. The replacement is a new channel with same name, sl@0: * it supercedes the replaced channel. Input and output of sl@0: * the superceded channel is now going through the newly sl@0: * created channel and allows the arbitrary filtering/manipulation sl@0: * of the dataflow. sl@0: * sl@0: * Andreas Kupries , 12/13/1998 sl@0: * "Trf-Patch for filtering channels" sl@0: * sl@0: * Results: sl@0: * Returns the new Tcl_Channel, which actually contains the sl@0: * saved information about prevChan. sl@0: * sl@0: * Side effects: sl@0: * A new channel structure is allocated and linked below sl@0: * the existing channel. The channel operations and client sl@0: * data of the existing channel are copied down to the newly sl@0: * created channel, and the current channel has its operations sl@0: * replaced by the new typePtr. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C Tcl_Channel sl@0: Tcl_StackChannel(interp, typePtr, instanceData, mask, prevChan) sl@0: Tcl_Interp *interp; /* The interpreter we are working in */ sl@0: Tcl_ChannelType *typePtr; /* The channel type record for the new sl@0: * channel. */ sl@0: ClientData instanceData; /* Instance specific data for the new sl@0: * channel. */ sl@0: int mask; /* TCL_READABLE & TCL_WRITABLE to indicate sl@0: * if the channel is readable, writable. */ sl@0: Tcl_Channel prevChan; /* The channel structure to replace */ sl@0: { sl@0: ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); sl@0: Channel *chanPtr, *prevChanPtr; sl@0: ChannelState *statePtr; sl@0: sl@0: /* sl@0: * Find the given channel in the list of all channels. sl@0: * If we don't find it, then it was never registered correctly. sl@0: * sl@0: * This operation should occur at the top of a channel stack. sl@0: */ sl@0: sl@0: statePtr = (ChannelState *) tsdPtr->firstCSPtr; sl@0: prevChanPtr = ((Channel *) prevChan)->state->topChanPtr; sl@0: sl@0: while ((statePtr != NULL) && (statePtr->topChanPtr != prevChanPtr)) { sl@0: statePtr = statePtr->nextCSPtr; sl@0: } sl@0: sl@0: if (statePtr == NULL) { sl@0: if (interp) { sl@0: Tcl_AppendResult(interp, "couldn't find state for channel \"", sl@0: Tcl_GetChannelName(prevChan), "\"", (char *) NULL); sl@0: } sl@0: return (Tcl_Channel) NULL; sl@0: } sl@0: sl@0: /* sl@0: * Here we check if the given "mask" matches the "flags" sl@0: * of the already existing channel. sl@0: * sl@0: * | - | R | W | RW | sl@0: * --+---+---+---+----+ <=> 0 != (chan->mask & prevChan->mask) sl@0: * - | | | | | sl@0: * R | | + | | + | The superceding channel is allowed to sl@0: * W | | | + | + | restrict the capabilities of the sl@0: * RW| | + | + | + | superceded one ! sl@0: * --+---+---+---+----+ sl@0: */ sl@0: sl@0: if ((mask & (statePtr->flags & (TCL_READABLE | TCL_WRITABLE))) == 0) { sl@0: if (interp) { sl@0: Tcl_AppendResult(interp, sl@0: "reading and writing both disallowed for channel \"", sl@0: Tcl_GetChannelName(prevChan), "\"", (char *) NULL); sl@0: } sl@0: return (Tcl_Channel) NULL; sl@0: } sl@0: sl@0: /* sl@0: * Flush the buffers. This ensures that any data still in them sl@0: * at this time is not handled by the new transformation. Restrict sl@0: * this to writable channels. Take care to hide a possible bg-copy sl@0: * in progress from Tcl_Flush and the CheckForChannelErrors inside. sl@0: */ sl@0: sl@0: if ((mask & TCL_WRITABLE) != 0) { sl@0: CopyState *csPtr; sl@0: sl@0: csPtr = statePtr->csPtr; sl@0: statePtr->csPtr = (CopyState*) NULL; sl@0: sl@0: if (Tcl_Flush((Tcl_Channel) prevChanPtr) != TCL_OK) { sl@0: statePtr->csPtr = csPtr; sl@0: if (interp) { sl@0: Tcl_AppendResult(interp, "could not flush channel \"", sl@0: Tcl_GetChannelName(prevChan), "\"", (char *) NULL); sl@0: } sl@0: return (Tcl_Channel) NULL; sl@0: } sl@0: sl@0: statePtr->csPtr = csPtr; sl@0: } sl@0: /* sl@0: * Discard any input in the buffers. They are not yet read by the sl@0: * user of the channel, so they have to go through the new sl@0: * transformation before reading. As the buffers contain the sl@0: * untransformed form their contents are not only useless but actually sl@0: * distorts our view of the system. sl@0: * sl@0: * To preserve the information without having to read them again and sl@0: * to avoid problems with the location in the channel (seeking might sl@0: * be impossible) we move the buffers from the common state structure sl@0: * into the channel itself. We use the buffers in the channel below sl@0: * the new transformation to hold the data. In the future this allows sl@0: * us to write transformations which pre-read data and push the unused sl@0: * part back when they are going away. sl@0: */ sl@0: sl@0: if (((mask & TCL_READABLE) != 0) && sl@0: (statePtr->inQueueHead != (ChannelBuffer*) NULL)) { sl@0: /* sl@0: * Remark: It is possible that the channel buffers contain data from sl@0: * some earlier push-backs. sl@0: */ sl@0: sl@0: statePtr->inQueueTail->nextPtr = prevChanPtr->inQueueHead; sl@0: prevChanPtr->inQueueHead = statePtr->inQueueHead; sl@0: sl@0: if (prevChanPtr->inQueueTail == (ChannelBuffer*) NULL) { sl@0: prevChanPtr->inQueueTail = statePtr->inQueueTail; sl@0: } sl@0: sl@0: statePtr->inQueueHead = (ChannelBuffer*) NULL; sl@0: statePtr->inQueueTail = (ChannelBuffer*) NULL; sl@0: } sl@0: sl@0: chanPtr = (Channel *) ckalloc((unsigned) sizeof(Channel)); sl@0: sl@0: /* sl@0: * Save some of the current state into the new structure, sl@0: * reinitialize the parts which will stay with the transformation. sl@0: * sl@0: * Remarks: sl@0: */ sl@0: sl@0: chanPtr->state = statePtr; sl@0: chanPtr->instanceData = instanceData; sl@0: chanPtr->typePtr = typePtr; sl@0: chanPtr->downChanPtr = prevChanPtr; sl@0: chanPtr->upChanPtr = (Channel *) NULL; sl@0: chanPtr->inQueueHead = (ChannelBuffer*) NULL; sl@0: chanPtr->inQueueTail = (ChannelBuffer*) NULL; sl@0: sl@0: /* sl@0: * Place new block at the head of a possibly existing list of previously sl@0: * stacked channels. sl@0: */ sl@0: sl@0: prevChanPtr->upChanPtr = chanPtr; sl@0: statePtr->topChanPtr = chanPtr; sl@0: sl@0: return (Tcl_Channel) chanPtr; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_UnstackChannel -- sl@0: * sl@0: * Unstacks an entry in the hash table for a Tcl_Channel sl@0: * record. This is the reverse to 'Tcl_StackChannel'. sl@0: * sl@0: * Results: sl@0: * A standard Tcl result. sl@0: * sl@0: * Side effects: sl@0: * If TCL_ERROR is returned, the posix error code will be set sl@0: * with Tcl_SetErrno. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C int sl@0: Tcl_UnstackChannel (interp, chan) sl@0: Tcl_Interp *interp; /* The interpreter we are working in */ sl@0: Tcl_Channel chan; /* The channel to unstack */ sl@0: { sl@0: Channel *chanPtr = (Channel *) chan; sl@0: ChannelState *statePtr = chanPtr->state; sl@0: int result = 0; sl@0: sl@0: /* sl@0: * This operation should occur at the top of a channel stack. sl@0: */ sl@0: sl@0: chanPtr = statePtr->topChanPtr; sl@0: sl@0: if (chanPtr->downChanPtr != (Channel *) NULL) { sl@0: /* sl@0: * Instead of manipulating the per-thread / per-interp list/hashtable sl@0: * of registered channels we wind down the state of the transformation, sl@0: * and then restore the state of underlying channel into the old sl@0: * structure. sl@0: */ sl@0: Channel *downChanPtr = chanPtr->downChanPtr; sl@0: sl@0: /* sl@0: * Flush the buffers. This ensures that any data still in them sl@0: * at this time _is_ handled by the transformation we are unstacking sl@0: * right now. Restrict this to writable channels. Take care to hide sl@0: * a possible bg-copy in progress from Tcl_Flush and the sl@0: * CheckForChannelErrors inside. sl@0: */ sl@0: sl@0: if (statePtr->flags & TCL_WRITABLE) { sl@0: CopyState* csPtr; sl@0: sl@0: csPtr = statePtr->csPtr; sl@0: statePtr->csPtr = (CopyState*) NULL; sl@0: sl@0: if (Tcl_Flush((Tcl_Channel) chanPtr) != TCL_OK) { sl@0: statePtr->csPtr = csPtr; sl@0: if (interp) { sl@0: Tcl_AppendResult(interp, "could not flush channel \"", sl@0: Tcl_GetChannelName((Tcl_Channel) chanPtr), "\"", sl@0: (char *) NULL); sl@0: } sl@0: return TCL_ERROR; sl@0: } sl@0: sl@0: statePtr->csPtr = csPtr; sl@0: } sl@0: sl@0: /* sl@0: * Anything in the input queue and the push-back buffers of sl@0: * the transformation going away is transformed data, but not sl@0: * yet read. As unstacking means that the caller does not want sl@0: * to see transformed data any more we have to discard these sl@0: * bytes. To avoid writing an analogue to 'DiscardInputQueued' sl@0: * we move the information in the push back buffers to the sl@0: * input queue and then call 'DiscardInputQueued' on that. sl@0: */ sl@0: sl@0: if (((statePtr->flags & TCL_READABLE) != 0) && sl@0: ((statePtr->inQueueHead != (ChannelBuffer*) NULL) || sl@0: (chanPtr->inQueueHead != (ChannelBuffer*) NULL))) { sl@0: sl@0: if ((statePtr->inQueueHead != (ChannelBuffer*) NULL) && sl@0: (chanPtr->inQueueHead != (ChannelBuffer*) NULL)) { sl@0: statePtr->inQueueTail->nextPtr = chanPtr->inQueueHead; sl@0: statePtr->inQueueTail = chanPtr->inQueueTail; sl@0: statePtr->inQueueHead = statePtr->inQueueTail; sl@0: sl@0: } else if (chanPtr->inQueueHead != (ChannelBuffer*) NULL) { sl@0: statePtr->inQueueHead = chanPtr->inQueueHead; sl@0: statePtr->inQueueTail = chanPtr->inQueueTail; sl@0: } sl@0: sl@0: chanPtr->inQueueHead = (ChannelBuffer*) NULL; sl@0: chanPtr->inQueueTail = (ChannelBuffer*) NULL; sl@0: sl@0: DiscardInputQueued (statePtr, 0); sl@0: } sl@0: sl@0: statePtr->topChanPtr = downChanPtr; sl@0: downChanPtr->upChanPtr = (Channel *) NULL; sl@0: sl@0: /* sl@0: * Leave this link intact for closeproc sl@0: * chanPtr->downChanPtr = (Channel *) NULL; sl@0: */ sl@0: sl@0: /* sl@0: * Close and free the channel driver state. sl@0: */ sl@0: sl@0: if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) { sl@0: result = (chanPtr->typePtr->closeProc)(chanPtr->instanceData, sl@0: interp); sl@0: } else { sl@0: result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData, sl@0: interp, 0); sl@0: } sl@0: sl@0: chanPtr->typePtr = NULL; sl@0: /* sl@0: * AK: Tcl_NotifyChannel may hold a reference to this block of memory sl@0: */ sl@0: Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC); sl@0: UpdateInterest(downChanPtr); sl@0: sl@0: if (result != 0) { sl@0: Tcl_SetErrno(result); sl@0: return TCL_ERROR; sl@0: } sl@0: } else { sl@0: /* sl@0: * This channel does not cover another one. sl@0: * Simply do a close, if necessary. sl@0: */ sl@0: sl@0: if (statePtr->refCount <= 0) { sl@0: if (Tcl_Close(interp, chan) != TCL_OK) { sl@0: return TCL_ERROR; sl@0: } sl@0: } sl@0: } sl@0: sl@0: return TCL_OK; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_GetStackedChannel -- sl@0: * sl@0: * Determines whether the specified channel is stacked upon another. sl@0: * sl@0: * Results: sl@0: * NULL if the channel is not stacked upon another one, or a reference sl@0: * to the channel it is stacked upon. This reference can be used in sl@0: * queries, but modification is not allowed. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C Tcl_Channel sl@0: Tcl_GetStackedChannel(chan) sl@0: Tcl_Channel chan; sl@0: { sl@0: Channel *chanPtr = (Channel *) chan; /* The actual channel. */ sl@0: sl@0: return (Tcl_Channel) chanPtr->downChanPtr; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_GetTopChannel -- sl@0: * sl@0: * Returns the top channel of a channel stack. sl@0: * sl@0: * Results: sl@0: * NULL if the channel is not stacked upon another one, or a reference sl@0: * to the channel it is stacked upon. This reference can be used in sl@0: * queries, but modification is not allowed. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C Tcl_Channel sl@0: Tcl_GetTopChannel(chan) sl@0: Tcl_Channel chan; sl@0: { sl@0: Channel *chanPtr = (Channel *) chan; /* The actual channel. */ sl@0: sl@0: return (Tcl_Channel) chanPtr->state->topChanPtr; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_GetChannelInstanceData -- sl@0: * sl@0: * Returns the client data associated with a channel. sl@0: * sl@0: * Results: sl@0: * The client data. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C ClientData sl@0: Tcl_GetChannelInstanceData(chan) sl@0: Tcl_Channel chan; /* Channel for which to return client data. */ sl@0: { sl@0: Channel *chanPtr = (Channel *) chan; /* The actual channel. */ sl@0: sl@0: return chanPtr->instanceData; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_GetChannelThread -- sl@0: * sl@0: * Given a channel structure, returns the thread managing it. sl@0: * TIP #10 sl@0: * sl@0: * Results: sl@0: * Returns the id of the thread managing the channel. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C Tcl_ThreadId sl@0: Tcl_GetChannelThread(chan) sl@0: Tcl_Channel chan; /* The channel to return managing thread for. */ sl@0: { sl@0: Channel *chanPtr = (Channel *) chan; /* The actual channel. */ sl@0: sl@0: return chanPtr->state->managingThread; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_GetChannelType -- sl@0: * sl@0: * Given a channel structure, returns the channel type structure. sl@0: * sl@0: * Results: sl@0: * Returns a pointer to the channel type structure. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C Tcl_ChannelType * sl@0: Tcl_GetChannelType(chan) sl@0: Tcl_Channel chan; /* The channel to return type for. */ sl@0: { sl@0: Channel *chanPtr = (Channel *) chan; /* The actual channel. */ sl@0: sl@0: return chanPtr->typePtr; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_GetChannelMode -- sl@0: * sl@0: * Computes a mask indicating whether the channel is open for sl@0: * reading and writing. sl@0: * sl@0: * Results: sl@0: * An OR-ed combination of TCL_READABLE and TCL_WRITABLE. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C int sl@0: Tcl_GetChannelMode(chan) sl@0: Tcl_Channel chan; /* The channel for which the mode is sl@0: * being computed. */ sl@0: { sl@0: ChannelState *statePtr = ((Channel *) chan)->state; sl@0: /* State of actual channel. */ sl@0: sl@0: return (statePtr->flags & (TCL_READABLE | TCL_WRITABLE)); sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_GetChannelName -- sl@0: * sl@0: * Returns the string identifying the channel name. sl@0: * sl@0: * Results: sl@0: * The string containing the channel name. This memory is sl@0: * owned by the generic layer and should not be modified by sl@0: * the caller. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C CONST char * sl@0: Tcl_GetChannelName(chan) sl@0: Tcl_Channel chan; /* The channel for which to return the name. */ sl@0: { sl@0: ChannelState *statePtr; /* State of actual channel. */ sl@0: sl@0: statePtr = ((Channel *) chan)->state; sl@0: return statePtr->channelName; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_GetChannelHandle -- sl@0: * sl@0: * Returns an OS handle associated with a channel. sl@0: * sl@0: * Results: sl@0: * Returns TCL_OK and places the handle in handlePtr, or returns sl@0: * TCL_ERROR on failure. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C int sl@0: Tcl_GetChannelHandle(chan, direction, handlePtr) sl@0: Tcl_Channel chan; /* The channel to get file from. */ sl@0: int direction; /* TCL_WRITABLE or TCL_READABLE. */ sl@0: ClientData *handlePtr; /* Where to store handle */ sl@0: { sl@0: Channel *chanPtr; /* The actual channel. */ sl@0: ClientData handle; sl@0: int result; sl@0: sl@0: chanPtr = ((Channel *) chan)->state->bottomChanPtr; sl@0: result = (chanPtr->typePtr->getHandleProc)(chanPtr->instanceData, sl@0: direction, &handle); sl@0: if (handlePtr) { sl@0: *handlePtr = handle; sl@0: } sl@0: return result; sl@0: } sl@0: sl@0: /* sl@0: *--------------------------------------------------------------------------- sl@0: * sl@0: * AllocChannelBuffer -- sl@0: * sl@0: * A channel buffer has BUFFER_PADDING bytes extra at beginning to sl@0: * hold any bytes of a native-encoding character that got split by sl@0: * the end of the previous buffer and need to be moved to the sl@0: * beginning of the next buffer to make a contiguous string so it sl@0: * can be converted to UTF-8. sl@0: * sl@0: * A channel buffer has BUFFER_PADDING bytes extra at the end to sl@0: * hold any bytes of a native-encoding character (generated from a sl@0: * UTF-8 character) that overflow past the end of the buffer and sl@0: * need to be moved to the next buffer. sl@0: * sl@0: * Results: sl@0: * A newly allocated channel buffer. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *--------------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static ChannelBuffer * sl@0: AllocChannelBuffer(length) sl@0: int length; /* Desired length of channel buffer. */ sl@0: { sl@0: ChannelBuffer *bufPtr; sl@0: int n; sl@0: sl@0: n = length + CHANNELBUFFER_HEADER_SIZE + BUFFER_PADDING + BUFFER_PADDING; sl@0: bufPtr = (ChannelBuffer *) ckalloc((unsigned) n); sl@0: bufPtr->nextAdded = BUFFER_PADDING; sl@0: bufPtr->nextRemoved = BUFFER_PADDING; sl@0: bufPtr->bufLength = length + BUFFER_PADDING; sl@0: bufPtr->nextPtr = (ChannelBuffer *) NULL; sl@0: return bufPtr; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * RecycleBuffer -- sl@0: * sl@0: * Helper function to recycle input and output buffers. Ensures sl@0: * that two input buffers are saved (one in the input queue and sl@0: * another in the saveInBufPtr field) and that curOutPtr is set sl@0: * to a buffer. Only if these conditions are met is the buffer sl@0: * freed to the OS. sl@0: * sl@0: * Results: sl@0: * None. sl@0: * sl@0: * Side effects: sl@0: * May free a buffer to the OS. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static void sl@0: RecycleBuffer(statePtr, bufPtr, mustDiscard) sl@0: ChannelState *statePtr; /* ChannelState in which to recycle buffers. */ sl@0: ChannelBuffer *bufPtr; /* The buffer to recycle. */ sl@0: int mustDiscard; /* If nonzero, free the buffer to the sl@0: * OS, always. */ sl@0: { sl@0: /* sl@0: * Do we have to free the buffer to the OS? sl@0: */ sl@0: sl@0: if (mustDiscard) { sl@0: ckfree((char *) bufPtr); sl@0: return; sl@0: } sl@0: sl@0: /* sl@0: * Only save buffers which are at least as big as the requested sl@0: * buffersize for the channel. This is to honor dynamic changes sl@0: * of the buffersize made by the user. sl@0: */ sl@0: sl@0: if ((bufPtr->bufLength - BUFFER_PADDING) < statePtr->bufSize) { sl@0: ckfree((char *) bufPtr); sl@0: return; sl@0: } sl@0: sl@0: /* sl@0: * Only save buffers for the input queue if the channel is readable. sl@0: */ sl@0: sl@0: if (statePtr->flags & TCL_READABLE) { sl@0: if (statePtr->inQueueHead == (ChannelBuffer *) NULL) { sl@0: statePtr->inQueueHead = bufPtr; sl@0: statePtr->inQueueTail = bufPtr; sl@0: goto keepit; sl@0: } sl@0: if (statePtr->saveInBufPtr == (ChannelBuffer *) NULL) { sl@0: statePtr->saveInBufPtr = bufPtr; sl@0: goto keepit; sl@0: } sl@0: } sl@0: sl@0: /* sl@0: * Only save buffers for the output queue if the channel is writable. sl@0: */ sl@0: sl@0: if (statePtr->flags & TCL_WRITABLE) { sl@0: if (statePtr->curOutPtr == (ChannelBuffer *) NULL) { sl@0: statePtr->curOutPtr = bufPtr; sl@0: goto keepit; sl@0: } sl@0: } sl@0: sl@0: /* sl@0: * If we reached this code we return the buffer to the OS. sl@0: */ sl@0: sl@0: ckfree((char *) bufPtr); sl@0: return; sl@0: sl@0: keepit: sl@0: bufPtr->nextRemoved = BUFFER_PADDING; sl@0: bufPtr->nextAdded = BUFFER_PADDING; sl@0: bufPtr->nextPtr = (ChannelBuffer *) NULL; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * DiscardOutputQueued -- sl@0: * sl@0: * Discards all output queued in the output queue of a channel. sl@0: * sl@0: * Results: sl@0: * None. sl@0: * sl@0: * Side effects: sl@0: * Recycles buffers. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static void sl@0: DiscardOutputQueued(statePtr) sl@0: ChannelState *statePtr; /* ChannelState for which to discard output. */ sl@0: { sl@0: ChannelBuffer *bufPtr; sl@0: sl@0: while (statePtr->outQueueHead != (ChannelBuffer *) NULL) { sl@0: bufPtr = statePtr->outQueueHead; sl@0: statePtr->outQueueHead = bufPtr->nextPtr; sl@0: RecycleBuffer(statePtr, bufPtr, 0); sl@0: } sl@0: statePtr->outQueueHead = (ChannelBuffer *) NULL; sl@0: statePtr->outQueueTail = (ChannelBuffer *) NULL; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * CheckForDeadChannel -- sl@0: * sl@0: * This function checks is a given channel is Dead. sl@0: * (A channel that has been closed but not yet deallocated.) sl@0: * sl@0: * Results: sl@0: * True (1) if channel is Dead, False (0) if channel is Ok sl@0: * sl@0: * Side effects: sl@0: * None sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static int sl@0: CheckForDeadChannel(interp, statePtr) sl@0: Tcl_Interp *interp; /* For error reporting (can be NULL) */ sl@0: ChannelState *statePtr; /* The channel state to check. */ sl@0: { sl@0: if (statePtr->flags & CHANNEL_DEAD) { sl@0: Tcl_SetErrno(EINVAL); sl@0: if (interp) { sl@0: Tcl_AppendResult(interp, sl@0: "unable to access channel: invalid channel", sl@0: (char *) NULL); sl@0: } sl@0: return 1; sl@0: } sl@0: return 0; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * FlushChannel -- sl@0: * sl@0: * This function flushes as much of the queued output as is possible sl@0: * now. If calledFromAsyncFlush is nonzero, it is being called in an sl@0: * event handler to flush channel output asynchronously. sl@0: * sl@0: * Results: sl@0: * 0 if successful, else the error code that was returned by the sl@0: * channel type operation. sl@0: * sl@0: * Side effects: sl@0: * May produce output on a channel. May block indefinitely if the sl@0: * channel is synchronous. May schedule an async flush on the channel. sl@0: * May recycle memory for buffers in the output queue. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static int sl@0: FlushChannel(interp, chanPtr, calledFromAsyncFlush) sl@0: Tcl_Interp *interp; /* For error reporting during close. */ sl@0: Channel *chanPtr; /* The channel to flush on. */ sl@0: int calledFromAsyncFlush; /* If nonzero then we are being sl@0: * called from an asynchronous sl@0: * flush callback. */ sl@0: { sl@0: ChannelState *statePtr = chanPtr->state; sl@0: /* State of the channel stack. */ sl@0: ChannelBuffer *bufPtr; /* Iterates over buffered output sl@0: * queue. */ sl@0: int toWrite; /* Amount of output data in current sl@0: * buffer available to be written. */ sl@0: int written; /* Amount of output data actually sl@0: * written in current round. */ sl@0: int errorCode = 0; /* Stores POSIX error codes from sl@0: * channel driver operations. */ sl@0: int wroteSome = 0; /* Set to one if any data was sl@0: * written to the driver. */ sl@0: sl@0: /* sl@0: * Prevent writing on a dead channel -- a channel that has been closed sl@0: * but not yet deallocated. This can occur if the exit handler for the sl@0: * channel deallocation runs before all channels are deregistered in sl@0: * all interpreters. sl@0: */ sl@0: sl@0: if (CheckForDeadChannel(interp, statePtr)) return -1; sl@0: sl@0: /* sl@0: * Loop over the queued buffers and attempt to flush as sl@0: * much as possible of the queued output to the channel. sl@0: */ sl@0: sl@0: while (1) { sl@0: sl@0: /* sl@0: * If the queue is empty and there is a ready current buffer, OR if sl@0: * the current buffer is full, then move the current buffer to the sl@0: * queue. sl@0: */ sl@0: sl@0: if (((statePtr->curOutPtr != (ChannelBuffer *) NULL) && sl@0: (statePtr->curOutPtr->nextAdded == statePtr->curOutPtr->bufLength)) sl@0: || ((statePtr->flags & BUFFER_READY) && sl@0: (statePtr->outQueueHead == (ChannelBuffer *) NULL))) { sl@0: statePtr->flags &= (~(BUFFER_READY)); sl@0: statePtr->curOutPtr->nextPtr = (ChannelBuffer *) NULL; sl@0: if (statePtr->outQueueHead == (ChannelBuffer *) NULL) { sl@0: statePtr->outQueueHead = statePtr->curOutPtr; sl@0: } else { sl@0: statePtr->outQueueTail->nextPtr = statePtr->curOutPtr; sl@0: } sl@0: statePtr->outQueueTail = statePtr->curOutPtr; sl@0: statePtr->curOutPtr = (ChannelBuffer *) NULL; sl@0: } sl@0: bufPtr = statePtr->outQueueHead; sl@0: sl@0: /* sl@0: * If we are not being called from an async flush and an async sl@0: * flush is active, we just return without producing any output. sl@0: */ sl@0: sl@0: if ((!calledFromAsyncFlush) && sl@0: (statePtr->flags & BG_FLUSH_SCHEDULED)) { sl@0: return 0; sl@0: } sl@0: sl@0: /* sl@0: * If the output queue is still empty, break out of the while loop. sl@0: */ sl@0: sl@0: if (bufPtr == (ChannelBuffer *) NULL) { sl@0: break; /* Out of the "while (1)". */ sl@0: } sl@0: sl@0: /* sl@0: * Produce the output on the channel. sl@0: */ sl@0: sl@0: toWrite = bufPtr->nextAdded - bufPtr->nextRemoved; sl@0: written = (chanPtr->typePtr->outputProc) (chanPtr->instanceData, sl@0: bufPtr->buf + bufPtr->nextRemoved, toWrite, sl@0: &errorCode); sl@0: sl@0: /* sl@0: * If the write failed completely attempt to start the asynchronous sl@0: * flush mechanism and break out of this loop - do not attempt to sl@0: * write any more output at this time. sl@0: */ sl@0: sl@0: if (written < 0) { sl@0: sl@0: /* sl@0: * If the last attempt to write was interrupted, simply retry. sl@0: */ sl@0: sl@0: if (errorCode == EINTR) { sl@0: errorCode = 0; sl@0: continue; sl@0: } sl@0: sl@0: /* sl@0: * If the channel is non-blocking and we would have blocked, sl@0: * start a background flushing handler and break out of the loop. sl@0: */ sl@0: sl@0: if ((errorCode == EWOULDBLOCK) || (errorCode == EAGAIN)) { sl@0: /* sl@0: * This used to check for CHANNEL_NONBLOCKING, and panic sl@0: * if the channel was blocking. However, it appears sl@0: * that setting stdin to -blocking 0 has some effect on sl@0: * the stdout when it's a tty channel (dup'ed underneath) sl@0: */ sl@0: if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) { sl@0: statePtr->flags |= BG_FLUSH_SCHEDULED; sl@0: UpdateInterest(chanPtr); sl@0: } sl@0: errorCode = 0; sl@0: break; sl@0: } sl@0: sl@0: /* sl@0: * Decide whether to report the error upwards or defer it. sl@0: */ sl@0: sl@0: if (calledFromAsyncFlush) { sl@0: if (statePtr->unreportedError == 0) { sl@0: statePtr->unreportedError = errorCode; sl@0: } sl@0: } else { sl@0: Tcl_SetErrno(errorCode); sl@0: if (interp != NULL) { sl@0: sl@0: /* sl@0: * Casting away CONST here is safe because the sl@0: * TCL_VOLATILE flag guarantees CONST treatment sl@0: * of the Posix error string. sl@0: */ sl@0: sl@0: Tcl_SetResult(interp, sl@0: (char *) Tcl_PosixError(interp), TCL_VOLATILE); sl@0: } sl@0: } sl@0: sl@0: /* sl@0: * When we get an error we throw away all the output sl@0: * currently queued. sl@0: */ sl@0: sl@0: DiscardOutputQueued(statePtr); sl@0: continue; sl@0: } else { sl@0: wroteSome = 1; sl@0: } sl@0: sl@0: bufPtr->nextRemoved += written; sl@0: sl@0: /* sl@0: * If this buffer is now empty, recycle it. sl@0: */ sl@0: sl@0: if (bufPtr->nextRemoved == bufPtr->nextAdded) { sl@0: statePtr->outQueueHead = bufPtr->nextPtr; sl@0: if (statePtr->outQueueHead == (ChannelBuffer *) NULL) { sl@0: statePtr->outQueueTail = (ChannelBuffer *) NULL; sl@0: } sl@0: RecycleBuffer(statePtr, bufPtr, 0); sl@0: } sl@0: } /* Closes "while (1)". */ sl@0: sl@0: /* sl@0: * If we wrote some data while flushing in the background, we are done. sl@0: * We can't finish the background flush until we run out of data and sl@0: * the channel becomes writable again. This ensures that all of the sl@0: * pending data has been flushed at the system level. sl@0: */ sl@0: sl@0: if (statePtr->flags & BG_FLUSH_SCHEDULED) { sl@0: if (wroteSome) { sl@0: return errorCode; sl@0: } else if (statePtr->outQueueHead == (ChannelBuffer *) NULL) { sl@0: statePtr->flags &= (~(BG_FLUSH_SCHEDULED)); sl@0: (chanPtr->typePtr->watchProc)(chanPtr->instanceData, sl@0: statePtr->interestMask); sl@0: } sl@0: } sl@0: sl@0: /* sl@0: * If the channel is flagged as closed, delete it when the refCount sl@0: * drops to zero, the output queue is empty and there is no output sl@0: * in the current output buffer. sl@0: */ sl@0: sl@0: if ((statePtr->flags & CHANNEL_CLOSED) && (statePtr->refCount <= 0) && sl@0: (statePtr->outQueueHead == (ChannelBuffer *) NULL) && sl@0: ((statePtr->curOutPtr == (ChannelBuffer *) NULL) || sl@0: (statePtr->curOutPtr->nextAdded == sl@0: statePtr->curOutPtr->nextRemoved))) { sl@0: return CloseChannel(interp, chanPtr, errorCode); sl@0: } sl@0: return errorCode; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * CloseChannel -- sl@0: * sl@0: * Utility procedure to close a channel and free associated resources. sl@0: * sl@0: * If the channel was stacked, then the it will copy the necessary sl@0: * elements of the NEXT channel into the TOP channel, in essence sl@0: * unstacking the channel. The NEXT channel will then be freed. sl@0: * sl@0: * If the channel was not stacked, then we will free all the bits sl@0: * for the TOP channel, including the data structure itself. sl@0: * sl@0: * Results: sl@0: * 1 if the channel was stacked, 0 otherwise. sl@0: * sl@0: * Side effects: sl@0: * May close the actual channel; may free memory. sl@0: * May change the value of errno. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static int sl@0: CloseChannel(interp, chanPtr, errorCode) sl@0: Tcl_Interp *interp; /* For error reporting. */ sl@0: Channel *chanPtr; /* The channel to close. */ sl@0: int errorCode; /* Status of operation so far. */ sl@0: { sl@0: int result = 0; /* Of calling driver close sl@0: * operation. */ sl@0: ChannelState *statePtr; /* state of the channel stack. */ sl@0: ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); sl@0: sl@0: if (chanPtr == NULL) { sl@0: return result; sl@0: } sl@0: statePtr = chanPtr->state; sl@0: sl@0: /* sl@0: * No more input can be consumed so discard any leftover input. sl@0: */ sl@0: sl@0: DiscardInputQueued(statePtr, 1); sl@0: sl@0: /* sl@0: * Discard a leftover buffer in the current output buffer field. sl@0: */ sl@0: sl@0: if (statePtr->curOutPtr != (ChannelBuffer *) NULL) { sl@0: ckfree((char *) statePtr->curOutPtr); sl@0: statePtr->curOutPtr = (ChannelBuffer *) NULL; sl@0: } sl@0: sl@0: /* sl@0: * The caller guarantees that there are no more buffers sl@0: * queued for output. sl@0: */ sl@0: sl@0: if (statePtr->outQueueHead != (ChannelBuffer *) NULL) { sl@0: panic("TclFlush, closed channel: queued output left"); sl@0: } sl@0: sl@0: /* sl@0: * If the EOF character is set in the channel, append that to the sl@0: * output device. sl@0: */ sl@0: sl@0: if ((statePtr->outEofChar != 0) && (statePtr->flags & TCL_WRITABLE)) { sl@0: int dummy; sl@0: char c; sl@0: sl@0: c = (char) statePtr->outEofChar; sl@0: (chanPtr->typePtr->outputProc) (chanPtr->instanceData, &c, 1, &dummy); sl@0: } sl@0: sl@0: /* sl@0: * Remove this channel from of the list of all channels. sl@0: */ sl@0: Tcl_CutChannel((Tcl_Channel) chanPtr); sl@0: sl@0: /* sl@0: * Close and free the channel driver state. sl@0: */ sl@0: sl@0: if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) { sl@0: result = (chanPtr->typePtr->closeProc)(chanPtr->instanceData, interp); sl@0: } else { sl@0: result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData, interp, sl@0: 0); sl@0: } sl@0: sl@0: /* sl@0: * Some resources can be cleared only if the bottom channel sl@0: * in a stack is closed. All the other channels in the stack sl@0: * are not allowed to remove. sl@0: */ sl@0: sl@0: if (chanPtr == statePtr->bottomChanPtr) { sl@0: if (statePtr->channelName != (char *) NULL) { sl@0: ckfree((char *) statePtr->channelName); sl@0: statePtr->channelName = NULL; sl@0: } sl@0: sl@0: Tcl_FreeEncoding(statePtr->encoding); sl@0: if (statePtr->outputStage != NULL) { sl@0: ckfree((char *) statePtr->outputStage); sl@0: statePtr->outputStage = (char *) NULL; sl@0: } sl@0: } sl@0: sl@0: /* sl@0: * If we are being called synchronously, report either sl@0: * any latent error on the channel or the current error. sl@0: */ sl@0: sl@0: if (statePtr->unreportedError != 0) { sl@0: errorCode = statePtr->unreportedError; sl@0: } sl@0: if (errorCode == 0) { sl@0: errorCode = result; sl@0: if (errorCode != 0) { sl@0: Tcl_SetErrno(errorCode); sl@0: } sl@0: } sl@0: sl@0: /* sl@0: * Cancel any outstanding timer. sl@0: */ sl@0: sl@0: Tcl_DeleteTimerHandler(statePtr->timer); sl@0: sl@0: /* sl@0: * Mark the channel as deleted by clearing the type structure. sl@0: */ sl@0: sl@0: if (chanPtr->downChanPtr != (Channel *) NULL) { sl@0: Channel *downChanPtr = chanPtr->downChanPtr; sl@0: sl@0: statePtr->nextCSPtr = tsdPtr->firstCSPtr; sl@0: tsdPtr->firstCSPtr = statePtr; sl@0: sl@0: statePtr->topChanPtr = downChanPtr; sl@0: downChanPtr->upChanPtr = (Channel *) NULL; sl@0: chanPtr->typePtr = NULL; sl@0: sl@0: Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC); sl@0: return Tcl_Close(interp, (Tcl_Channel) downChanPtr); sl@0: } sl@0: sl@0: /* sl@0: * There is only the TOP Channel, so we free the remaining sl@0: * pointers we have and then ourselves. Since this is the sl@0: * last of the channels in the stack, make sure to free the sl@0: * ChannelState structure associated with it. We use sl@0: * Tcl_EventuallyFree to allow for any last sl@0: */ sl@0: chanPtr->typePtr = NULL; sl@0: sl@0: Tcl_EventuallyFree((ClientData) statePtr, TCL_DYNAMIC); sl@0: Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC); sl@0: sl@0: return errorCode; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_CutChannel -- sl@0: * sl@0: * Removes a channel from the (thread-)global list of all channels sl@0: * (in that thread). This is actually the statePtr for the stack sl@0: * of channel. sl@0: * sl@0: * Results: sl@0: * Nothing. sl@0: * sl@0: * Side effects: sl@0: * Resets the field 'nextCSPtr' of the specified channel state to NULL. sl@0: * sl@0: * NOTE: sl@0: * The channel to cut out of the list must not be referenced sl@0: * in any interpreter. This is something this procedure cannot sl@0: * check (despite the refcount) because the caller usually wants sl@0: * fiddle with the channel (like transfering it to a different sl@0: * thread) and thus keeps the refcount artifically high to prevent sl@0: * its destruction. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C void sl@0: Tcl_CutChannel(chan) sl@0: Tcl_Channel chan; /* The channel being removed. Must sl@0: * not be referenced in any sl@0: * interpreter. */ sl@0: { sl@0: ThreadSpecificData* tsdPtr = TCL_TSD_INIT(&dataKey); sl@0: ChannelState *prevCSPtr; /* Preceding channel state in list of sl@0: * all states - used to splice a sl@0: * channel out of the list on close. */ sl@0: ChannelState *statePtr = ((Channel *) chan)->state; sl@0: /* state of the channel stack. */ sl@0: Tcl_DriverThreadActionProc *threadActionProc; sl@0: sl@0: /* sl@0: * Remove this channel from of the list of all channels sl@0: * (in the current thread). sl@0: */ sl@0: sl@0: if (tsdPtr->firstCSPtr && (statePtr == tsdPtr->firstCSPtr)) { sl@0: tsdPtr->firstCSPtr = statePtr->nextCSPtr; sl@0: } else { sl@0: for (prevCSPtr = tsdPtr->firstCSPtr; sl@0: prevCSPtr && (prevCSPtr->nextCSPtr != statePtr); sl@0: prevCSPtr = prevCSPtr->nextCSPtr) { sl@0: /* Empty loop body. */ sl@0: } sl@0: if (prevCSPtr == (ChannelState *) NULL) { sl@0: panic("FlushChannel: damaged channel list"); sl@0: } sl@0: prevCSPtr->nextCSPtr = statePtr->nextCSPtr; sl@0: } sl@0: sl@0: statePtr->nextCSPtr = (ChannelState *) NULL; sl@0: sl@0: /* TIP #218, Channel Thread Actions */ sl@0: threadActionProc = Tcl_ChannelThreadActionProc (Tcl_GetChannelType (chan)); sl@0: if (threadActionProc != NULL) { sl@0: (*threadActionProc) (Tcl_GetChannelInstanceData(chan), sl@0: TCL_CHANNEL_THREAD_REMOVE); sl@0: } sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_SpliceChannel -- sl@0: * sl@0: * Adds a channel to the (thread-)global list of all channels sl@0: * (in that thread). Expects that the field 'nextChanPtr' in sl@0: * the channel is set to NULL. sl@0: * sl@0: * Results: sl@0: * Nothing. sl@0: * sl@0: * Side effects: sl@0: * Nothing. sl@0: * sl@0: * NOTE: sl@0: * The channel to splice into the list must not be referenced in any sl@0: * interpreter. This is something this procedure cannot check sl@0: * (despite the refcount) because the caller usually wants figgle sl@0: * with the channel (like transfering it to a different thread) sl@0: * and thus keeps the refcount artifically high to prevent its sl@0: * destruction. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C void sl@0: Tcl_SpliceChannel(chan) sl@0: Tcl_Channel chan; /* The channel being added. Must sl@0: * not be referenced in any sl@0: * interpreter. */ sl@0: { sl@0: ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); sl@0: ChannelState *statePtr = ((Channel *) chan)->state; sl@0: Tcl_DriverThreadActionProc *threadActionProc; sl@0: sl@0: if (statePtr->nextCSPtr != (ChannelState *) NULL) { sl@0: panic("Tcl_SpliceChannel: trying to add channel used in different list"); sl@0: } sl@0: sl@0: statePtr->nextCSPtr = tsdPtr->firstCSPtr; sl@0: tsdPtr->firstCSPtr = statePtr; sl@0: sl@0: /* sl@0: * TIP #10. Mark the current thread as the new one managing this sl@0: * channel. Note: 'Tcl_GetCurrentThread' returns sensible sl@0: * values even for a non-threaded core. sl@0: */ sl@0: sl@0: statePtr->managingThread = Tcl_GetCurrentThread (); sl@0: sl@0: /* TIP #218, Channel Thread Actions */ sl@0: threadActionProc = Tcl_ChannelThreadActionProc (Tcl_GetChannelType (chan)); sl@0: if (threadActionProc != NULL) { sl@0: (*threadActionProc) (Tcl_GetChannelInstanceData(chan), sl@0: TCL_CHANNEL_THREAD_INSERT); sl@0: } sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_Close -- sl@0: * sl@0: * Closes a channel. sl@0: * sl@0: * Results: sl@0: * A standard Tcl result. sl@0: * sl@0: * Side effects: sl@0: * Closes the channel if this is the last reference. sl@0: * sl@0: * NOTE: sl@0: * Tcl_Close removes the channel as far as the user is concerned. sl@0: * However, it may continue to exist for a while longer if it has sl@0: * a background flush scheduled. The device itself is eventually sl@0: * closed and the channel record removed, in CloseChannel, above. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: /* ARGSUSED */ sl@0: EXPORT_C int sl@0: Tcl_Close(interp, chan) sl@0: Tcl_Interp *interp; /* Interpreter for errors. */ sl@0: Tcl_Channel chan; /* The channel being closed. Must sl@0: * not be referenced in any sl@0: * interpreter. */ sl@0: { sl@0: CloseCallback *cbPtr; /* Iterate over close callbacks sl@0: * for this channel. */ sl@0: Channel *chanPtr; /* The real IO channel. */ sl@0: ChannelState *statePtr; /* State of real IO channel. */ sl@0: int result; /* Of calling FlushChannel. */ sl@0: sl@0: if (chan == (Tcl_Channel) NULL) { sl@0: return TCL_OK; sl@0: } sl@0: sl@0: /* sl@0: * Perform special handling for standard channels being closed. If the sl@0: * refCount is now 1 it means that the last reference to the standard sl@0: * channel is being explicitly closed, so bump the refCount down sl@0: * artificially to 0. This will ensure that the channel is actually sl@0: * closed, below. Also set the static pointer to NULL for the channel. sl@0: */ sl@0: sl@0: CheckForStdChannelsBeingClosed(chan); sl@0: sl@0: /* sl@0: * This operation should occur at the top of a channel stack. sl@0: */ sl@0: sl@0: chanPtr = (Channel *) chan; sl@0: statePtr = chanPtr->state; sl@0: chanPtr = statePtr->topChanPtr; sl@0: sl@0: if (statePtr->refCount > 0) { sl@0: panic("called Tcl_Close on channel with refCount > 0"); sl@0: } sl@0: sl@0: if (statePtr->flags & CHANNEL_INCLOSE) { sl@0: if (interp) { sl@0: Tcl_AppendResult(interp, sl@0: "Illegal recursive call to close through close-handler of channel", sl@0: (char *) NULL); sl@0: } sl@0: return TCL_ERROR; sl@0: } sl@0: statePtr->flags |= CHANNEL_INCLOSE; sl@0: sl@0: /* sl@0: * When the channel has an escape sequence driven encoding such as sl@0: * iso2022, the terminated escape sequence must write to the buffer. sl@0: */ sl@0: if ((statePtr->encoding != NULL) && (statePtr->curOutPtr != NULL) sl@0: && (CheckChannelErrors(statePtr, TCL_WRITABLE) == 0)) { sl@0: statePtr->outputEncodingFlags |= TCL_ENCODING_END; sl@0: WriteChars(chanPtr, "", 0); sl@0: } sl@0: sl@0: Tcl_ClearChannelHandlers(chan); sl@0: sl@0: /* sl@0: * Invoke the registered close callbacks and delete their records. sl@0: */ sl@0: sl@0: while (statePtr->closeCbPtr != (CloseCallback *) NULL) { sl@0: cbPtr = statePtr->closeCbPtr; sl@0: statePtr->closeCbPtr = cbPtr->nextPtr; sl@0: (cbPtr->proc) (cbPtr->clientData); sl@0: ckfree((char *) cbPtr); sl@0: } sl@0: sl@0: statePtr->flags &= ~CHANNEL_INCLOSE; sl@0: sl@0: /* sl@0: * Ensure that the last output buffer will be flushed. sl@0: */ sl@0: sl@0: if ((statePtr->curOutPtr != (ChannelBuffer *) NULL) && sl@0: (statePtr->curOutPtr->nextAdded > statePtr->curOutPtr->nextRemoved)) { sl@0: statePtr->flags |= BUFFER_READY; sl@0: } sl@0: sl@0: /* sl@0: * If this channel supports it, close the read side, since we don't need it sl@0: * anymore and this will help avoid deadlocks on some channel types. sl@0: */ sl@0: sl@0: if (chanPtr->typePtr->closeProc == TCL_CLOSE2PROC) { sl@0: result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData, interp, sl@0: TCL_CLOSE_READ); sl@0: } else { sl@0: result = 0; sl@0: } sl@0: sl@0: /* sl@0: * The call to FlushChannel will flush any queued output and invoke sl@0: * the close function of the channel driver, or it will set up the sl@0: * channel to be flushed and closed asynchronously. sl@0: */ sl@0: sl@0: statePtr->flags |= CHANNEL_CLOSED; sl@0: if ((FlushChannel(interp, chanPtr, 0) != 0) || (result != 0)) { sl@0: return TCL_ERROR; sl@0: } sl@0: return TCL_OK; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_ClearChannelHandlers -- sl@0: * sl@0: * Removes all channel handlers and event scripts from the channel, sl@0: * cancels all background copies involving the channel and any interest sl@0: * in events. sl@0: * sl@0: * Results: sl@0: * None. sl@0: * sl@0: * Side effects: sl@0: * See above. Deallocates memory. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C void sl@0: Tcl_ClearChannelHandlers (channel) sl@0: Tcl_Channel channel; sl@0: { sl@0: ChannelHandler *chPtr, *chNext; /* Iterate over channel handlers. */ sl@0: EventScriptRecord *ePtr, *eNextPtr; /* Iterate over eventscript records. */ sl@0: Channel *chanPtr; /* The real IO channel. */ sl@0: ChannelState *statePtr; /* State of real IO channel. */ sl@0: ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); sl@0: NextChannelHandler *nhPtr; sl@0: sl@0: /* sl@0: * This operation should occur at the top of a channel stack. sl@0: */ sl@0: sl@0: chanPtr = (Channel *) channel; sl@0: statePtr = chanPtr->state; sl@0: chanPtr = statePtr->topChanPtr; sl@0: sl@0: /* sl@0: * Cancel any outstanding timer. sl@0: */ sl@0: sl@0: Tcl_DeleteTimerHandler(statePtr->timer); sl@0: sl@0: /* sl@0: * Remove any references to channel handlers for this channel that sl@0: * may be about to be invoked. sl@0: */ sl@0: sl@0: for (nhPtr = tsdPtr->nestedHandlerPtr; sl@0: nhPtr != (NextChannelHandler *) NULL; sl@0: nhPtr = nhPtr->nestedHandlerPtr) { sl@0: if (nhPtr->nextHandlerPtr && sl@0: (nhPtr->nextHandlerPtr->chanPtr == chanPtr)) { sl@0: nhPtr->nextHandlerPtr = NULL; sl@0: } sl@0: } sl@0: sl@0: /* sl@0: * Remove all the channel handler records attached to the channel sl@0: * itself. sl@0: */ sl@0: sl@0: for (chPtr = statePtr->chPtr; sl@0: chPtr != (ChannelHandler *) NULL; sl@0: chPtr = chNext) { sl@0: chNext = chPtr->nextPtr; sl@0: ckfree((char *) chPtr); sl@0: } sl@0: statePtr->chPtr = (ChannelHandler *) NULL; sl@0: sl@0: /* sl@0: * Cancel any pending copy operation. sl@0: */ sl@0: sl@0: StopCopy(statePtr->csPtr); sl@0: sl@0: /* sl@0: * Must set the interest mask now to 0, otherwise infinite loops sl@0: * will occur if Tcl_DoOneEvent is called before the channel is sl@0: * finally deleted in FlushChannel. This can happen if the channel sl@0: * has a background flush active. sl@0: */ sl@0: sl@0: statePtr->interestMask = 0; sl@0: sl@0: /* sl@0: * Remove any EventScript records for this channel. sl@0: */ sl@0: sl@0: for (ePtr = statePtr->scriptRecordPtr; sl@0: ePtr != (EventScriptRecord *) NULL; sl@0: ePtr = eNextPtr) { sl@0: eNextPtr = ePtr->nextPtr; sl@0: Tcl_DecrRefCount(ePtr->scriptPtr); sl@0: ckfree((char *) ePtr); sl@0: } sl@0: statePtr->scriptRecordPtr = (EventScriptRecord *) NULL; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_Write -- sl@0: * sl@0: * Puts a sequence of bytes into an output buffer, may queue the sl@0: * buffer for output if it gets full, and also remembers whether the sl@0: * current buffer is ready e.g. if it contains a newline and we are in sl@0: * line buffering mode. Compensates stacking, i.e. will redirect the sl@0: * data from the specified channel to the topmost channel in a stack. sl@0: * sl@0: * No encoding conversions are applied to the bytes being read. sl@0: * sl@0: * Results: sl@0: * The number of bytes written or -1 in case of error. If -1, sl@0: * Tcl_GetErrno will return the error code. sl@0: * sl@0: * Side effects: sl@0: * May buffer up output and may cause output to be produced on the sl@0: * channel. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C int sl@0: Tcl_Write(chan, src, srcLen) sl@0: Tcl_Channel chan; /* The channel to buffer output for. */ sl@0: CONST char *src; /* Data to queue in output buffer. */ sl@0: int srcLen; /* Length of data in bytes, or < 0 for sl@0: * strlen(). */ sl@0: { sl@0: /* sl@0: * Always use the topmost channel of the stack sl@0: */ sl@0: Channel *chanPtr; sl@0: ChannelState *statePtr; /* state info for channel */ sl@0: sl@0: statePtr = ((Channel *) chan)->state; sl@0: chanPtr = statePtr->topChanPtr; sl@0: sl@0: if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) { sl@0: return -1; sl@0: } sl@0: sl@0: if (srcLen < 0) { sl@0: srcLen = strlen(src); sl@0: } sl@0: return DoWrite(chanPtr, src, srcLen); sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_WriteRaw -- sl@0: * sl@0: * Puts a sequence of bytes into an output buffer, may queue the sl@0: * buffer for output if it gets full, and also remembers whether the sl@0: * current buffer is ready e.g. if it contains a newline and we are in sl@0: * line buffering mode. Writes directly to the driver of the channel, sl@0: * does not compensate for stacking. sl@0: * sl@0: * No encoding conversions are applied to the bytes being read. sl@0: * sl@0: * Results: sl@0: * The number of bytes written or -1 in case of error. If -1, sl@0: * Tcl_GetErrno will return the error code. sl@0: * sl@0: * Side effects: sl@0: * May buffer up output and may cause output to be produced on the sl@0: * channel. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C int sl@0: Tcl_WriteRaw(chan, src, srcLen) sl@0: Tcl_Channel chan; /* The channel to buffer output for. */ sl@0: CONST char *src; /* Data to queue in output buffer. */ sl@0: int srcLen; /* Length of data in bytes, or < 0 for sl@0: * strlen(). */ sl@0: { sl@0: Channel *chanPtr = ((Channel *) chan); sl@0: ChannelState *statePtr = chanPtr->state; /* state info for channel */ sl@0: int errorCode, written; sl@0: sl@0: if (CheckChannelErrors(statePtr, TCL_WRITABLE | CHANNEL_RAW_MODE) != 0) { sl@0: return -1; sl@0: } sl@0: sl@0: if (srcLen < 0) { sl@0: srcLen = strlen(src); sl@0: } sl@0: sl@0: /* sl@0: * Go immediately to the driver, do all the error handling by ourselves. sl@0: * The code was stolen from 'FlushChannel'. sl@0: */ sl@0: sl@0: written = (chanPtr->typePtr->outputProc) (chanPtr->instanceData, sl@0: src, srcLen, &errorCode); sl@0: sl@0: if (written < 0) { sl@0: Tcl_SetErrno(errorCode); sl@0: } sl@0: sl@0: return written; sl@0: } sl@0: sl@0: /* sl@0: *--------------------------------------------------------------------------- sl@0: * sl@0: * Tcl_WriteChars -- sl@0: * sl@0: * Takes a sequence of UTF-8 characters and converts them for output sl@0: * using the channel's current encoding, may queue the buffer for sl@0: * output if it gets full, and also remembers whether the current sl@0: * buffer is ready e.g. if it contains a newline and we are in sl@0: * line buffering mode. Compensates stacking, i.e. will redirect the sl@0: * data from the specified channel to the topmost channel in a stack. sl@0: * sl@0: * Results: sl@0: * The number of bytes written or -1 in case of error. If -1, sl@0: * Tcl_GetErrno will return the error code. sl@0: * sl@0: * Side effects: sl@0: * May buffer up output and may cause output to be produced on the sl@0: * channel. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C int sl@0: Tcl_WriteChars(chan, src, len) sl@0: Tcl_Channel chan; /* The channel to buffer output for. */ sl@0: CONST char *src; /* UTF-8 characters to queue in output buffer. */ sl@0: int len; /* Length of string in bytes, or < 0 for sl@0: * strlen(). */ sl@0: { sl@0: ChannelState *statePtr; /* state info for channel */ sl@0: sl@0: statePtr = ((Channel *) chan)->state; sl@0: sl@0: if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) { sl@0: return -1; sl@0: } sl@0: sl@0: return DoWriteChars ((Channel*) chan, src, len); sl@0: } sl@0: sl@0: /* sl@0: *--------------------------------------------------------------------------- sl@0: * sl@0: * DoWriteChars -- sl@0: * sl@0: * Takes a sequence of UTF-8 characters and converts them for output sl@0: * using the channel's current encoding, may queue the buffer for sl@0: * output if it gets full, and also remembers whether the current sl@0: * buffer is ready e.g. if it contains a newline and we are in sl@0: * line buffering mode. Compensates stacking, i.e. will redirect the sl@0: * data from the specified channel to the topmost channel in a stack. sl@0: * sl@0: * Results: sl@0: * The number of bytes written or -1 in case of error. If -1, sl@0: * Tcl_GetErrno will return the error code. sl@0: * sl@0: * Side effects: sl@0: * May buffer up output and may cause output to be produced on the sl@0: * channel. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static int sl@0: DoWriteChars(chanPtr, src, len) sl@0: Channel* chanPtr; /* The channel to buffer output for. */ sl@0: CONST char *src; /* UTF-8 characters to queue in output buffer. */ sl@0: int len; /* Length of string in bytes, or < 0 for sl@0: * strlen(). */ sl@0: { sl@0: /* sl@0: * Always use the topmost channel of the stack sl@0: */ sl@0: ChannelState *statePtr; /* state info for channel */ sl@0: sl@0: statePtr = chanPtr->state; sl@0: chanPtr = statePtr->topChanPtr; sl@0: sl@0: if (len < 0) { sl@0: len = strlen(src); sl@0: } sl@0: if (statePtr->encoding == NULL) { sl@0: /* sl@0: * Inefficient way to convert UTF-8 to byte-array, but the sl@0: * code parallels the way it is done for objects. sl@0: */ sl@0: sl@0: Tcl_Obj *objPtr; sl@0: int result; sl@0: sl@0: objPtr = Tcl_NewStringObj(src, len); sl@0: src = (char *) Tcl_GetByteArrayFromObj(objPtr, &len); sl@0: result = WriteBytes(chanPtr, src, len); sl@0: Tcl_DecrRefCount(objPtr); sl@0: return result; sl@0: } sl@0: return WriteChars(chanPtr, src, len); sl@0: } sl@0: sl@0: /* sl@0: *--------------------------------------------------------------------------- sl@0: * sl@0: * Tcl_WriteObj -- sl@0: * sl@0: * Takes the Tcl object and queues its contents for output. If the sl@0: * encoding of the channel is NULL, takes the byte-array representation sl@0: * of the object and queues those bytes for output. Otherwise, takes sl@0: * the characters in the UTF-8 (string) representation of the object sl@0: * and converts them for output using the channel's current encoding. sl@0: * May flush internal buffers to output if one becomes full or is ready sl@0: * for some other reason, e.g. if it contains a newline and the channel sl@0: * is in line buffering mode. sl@0: * sl@0: * Results: sl@0: * The number of bytes written or -1 in case of error. If -1, sl@0: * Tcl_GetErrno() will return the error code. sl@0: * sl@0: * Side effects: sl@0: * May buffer up output and may cause output to be produced on the sl@0: * channel. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C int sl@0: Tcl_WriteObj(chan, objPtr) sl@0: Tcl_Channel chan; /* The channel to buffer output for. */ sl@0: Tcl_Obj *objPtr; /* The object to write. */ sl@0: { sl@0: /* sl@0: * Always use the topmost channel of the stack sl@0: */ sl@0: Channel *chanPtr; sl@0: ChannelState *statePtr; /* state info for channel */ sl@0: char *src; sl@0: int srcLen; sl@0: sl@0: statePtr = ((Channel *) chan)->state; sl@0: chanPtr = statePtr->topChanPtr; sl@0: sl@0: if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) { sl@0: return -1; sl@0: } sl@0: if (statePtr->encoding == NULL) { sl@0: src = (char *) Tcl_GetByteArrayFromObj(objPtr, &srcLen); sl@0: return WriteBytes(chanPtr, src, srcLen); sl@0: } else { sl@0: src = Tcl_GetStringFromObj(objPtr, &srcLen); sl@0: return WriteChars(chanPtr, src, srcLen); sl@0: } sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * WriteBytes -- sl@0: * sl@0: * Write a sequence of bytes into an output buffer, may queue the sl@0: * buffer for output if it gets full, and also remembers whether the sl@0: * current buffer is ready e.g. if it contains a newline and we are in sl@0: * line buffering mode. sl@0: * sl@0: * Results: sl@0: * The number of bytes written or -1 in case of error. If -1, sl@0: * Tcl_GetErrno will return the error code. sl@0: * sl@0: * Side effects: sl@0: * May buffer up output and may cause output to be produced on the sl@0: * channel. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static int sl@0: WriteBytes(chanPtr, src, srcLen) sl@0: Channel *chanPtr; /* The channel to buffer output for. */ sl@0: CONST char *src; /* Bytes to write. */ sl@0: int srcLen; /* Number of bytes to write. */ sl@0: { sl@0: ChannelState *statePtr = chanPtr->state; /* state info for channel */ sl@0: ChannelBuffer *bufPtr; sl@0: char *dst; sl@0: int dstMax, sawLF, savedLF, total, dstLen, toWrite; sl@0: sl@0: total = 0; sl@0: sawLF = 0; sl@0: savedLF = 0; sl@0: sl@0: /* sl@0: * Loop over all bytes in src, storing them in output buffer with sl@0: * proper EOL translation. sl@0: */ sl@0: sl@0: while (srcLen + savedLF > 0) { sl@0: bufPtr = statePtr->curOutPtr; sl@0: if (bufPtr == NULL) { sl@0: bufPtr = AllocChannelBuffer(statePtr->bufSize); sl@0: statePtr->curOutPtr = bufPtr; sl@0: } sl@0: dst = bufPtr->buf + bufPtr->nextAdded; sl@0: dstMax = bufPtr->bufLength - bufPtr->nextAdded; sl@0: dstLen = dstMax; sl@0: sl@0: toWrite = dstLen; sl@0: if (toWrite > srcLen) { sl@0: toWrite = srcLen; sl@0: } sl@0: sl@0: if (savedLF) { sl@0: /* sl@0: * A '\n' was left over from last call to TranslateOutputEOL() sl@0: * and we need to store it in this buffer. If the channel is sl@0: * line-based, we will need to flush it. sl@0: */ sl@0: sl@0: *dst++ = '\n'; sl@0: dstLen--; sl@0: sawLF++; sl@0: } sl@0: sawLF += TranslateOutputEOL(statePtr, dst, src, &dstLen, &toWrite); sl@0: dstLen += savedLF; sl@0: savedLF = 0; sl@0: sl@0: if (dstLen > dstMax) { sl@0: savedLF = 1; sl@0: dstLen = dstMax; sl@0: } sl@0: bufPtr->nextAdded += dstLen; sl@0: if (CheckFlush(chanPtr, bufPtr, sawLF) != 0) { sl@0: return -1; sl@0: } sl@0: total += dstLen; sl@0: src += toWrite; sl@0: srcLen -= toWrite; sl@0: sawLF = 0; sl@0: } sl@0: return total; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * WriteChars -- sl@0: * sl@0: * Convert UTF-8 bytes to the channel's external encoding and sl@0: * write the produced bytes into an output buffer, may queue the sl@0: * buffer for output if it gets full, and also remembers whether the sl@0: * current buffer is ready e.g. if it contains a newline and we are in sl@0: * line buffering mode. sl@0: * sl@0: * Results: sl@0: * The number of bytes written or -1 in case of error. If -1, sl@0: * Tcl_GetErrno will return the error code. sl@0: * sl@0: * Side effects: sl@0: * May buffer up output and may cause output to be produced on the sl@0: * channel. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static int sl@0: WriteChars(chanPtr, src, srcLen) sl@0: Channel *chanPtr; /* The channel to buffer output for. */ sl@0: CONST char *src; /* UTF-8 string to write. */ sl@0: int srcLen; /* Length of UTF-8 string in bytes. */ sl@0: { sl@0: ChannelState *statePtr = chanPtr->state; /* state info for channel */ sl@0: ChannelBuffer *bufPtr; sl@0: char *dst, *stage; sl@0: int saved, savedLF, sawLF, total, dstLen, stageMax, dstWrote; sl@0: int stageLen, toWrite, stageRead, endEncoding, result; sl@0: int consumedSomething; sl@0: Tcl_Encoding encoding; sl@0: char safe[BUFFER_PADDING]; sl@0: sl@0: total = 0; sl@0: sawLF = 0; sl@0: savedLF = 0; sl@0: saved = 0; sl@0: encoding = statePtr->encoding; sl@0: sl@0: /* sl@0: * Write the terminated escape sequence even if srcLen is 0. sl@0: */ sl@0: sl@0: endEncoding = ((statePtr->outputEncodingFlags & TCL_ENCODING_END) != 0); sl@0: sl@0: /* sl@0: * Loop over all UTF-8 characters in src, storing them in staging buffer sl@0: * with proper EOL translation. sl@0: */ sl@0: sl@0: consumedSomething = 1; sl@0: while (consumedSomething && (srcLen + savedLF + endEncoding > 0)) { sl@0: consumedSomething = 0; sl@0: stage = statePtr->outputStage; sl@0: stageMax = statePtr->bufSize; sl@0: stageLen = stageMax; sl@0: sl@0: toWrite = stageLen; sl@0: if (toWrite > srcLen) { sl@0: toWrite = srcLen; sl@0: } sl@0: sl@0: if (savedLF) { sl@0: /* sl@0: * A '\n' was left over from last call to TranslateOutputEOL() sl@0: * and we need to store it in the staging buffer. If the sl@0: * channel is line-based, we will need to flush the output sl@0: * buffer (after translating the staging buffer). sl@0: */ sl@0: sl@0: *stage++ = '\n'; sl@0: stageLen--; sl@0: sawLF++; sl@0: } sl@0: sawLF += TranslateOutputEOL(statePtr, stage, src, &stageLen, &toWrite); sl@0: sl@0: stage -= savedLF; sl@0: stageLen += savedLF; sl@0: savedLF = 0; sl@0: sl@0: if (stageLen > stageMax) { sl@0: savedLF = 1; sl@0: stageLen = stageMax; sl@0: } sl@0: src += toWrite; sl@0: srcLen -= toWrite; sl@0: sl@0: /* sl@0: * Loop over all UTF-8 characters in staging buffer, converting them sl@0: * to external encoding, storing them in output buffer. sl@0: */ sl@0: sl@0: while (stageLen + saved + endEncoding > 0) { sl@0: bufPtr = statePtr->curOutPtr; sl@0: if (bufPtr == NULL) { sl@0: bufPtr = AllocChannelBuffer(statePtr->bufSize); sl@0: statePtr->curOutPtr = bufPtr; sl@0: } sl@0: dst = bufPtr->buf + bufPtr->nextAdded; sl@0: dstLen = bufPtr->bufLength - bufPtr->nextAdded; sl@0: sl@0: if (saved != 0) { sl@0: /* sl@0: * Here's some translated bytes left over from the last sl@0: * buffer that we need to stick at the beginning of this sl@0: * buffer. sl@0: */ sl@0: sl@0: memcpy((VOID *) dst, (VOID *) safe, (size_t) saved); sl@0: bufPtr->nextAdded += saved; sl@0: dst += saved; sl@0: dstLen -= saved; sl@0: saved = 0; sl@0: } sl@0: sl@0: result = Tcl_UtfToExternal(NULL, encoding, stage, stageLen, sl@0: statePtr->outputEncodingFlags, sl@0: &statePtr->outputEncodingState, dst, sl@0: dstLen + BUFFER_PADDING, &stageRead, &dstWrote, NULL); sl@0: sl@0: /* Fix for SF #506297, reported by Martin Forssen sl@0: * . sl@0: * sl@0: * The encoding chosen in the script exposing the bug writes out sl@0: * three intro characters when TCL_ENCODING_START is set, but does sl@0: * not consume any input as TCL_ENCODING_END is cleared. As some sl@0: * output was generated the enclosing loop calls UtfToExternal sl@0: * again, again with START set. Three more characters in the out sl@0: * and still no use of input ... To break this infinite loop we sl@0: * remove TCL_ENCODING_START from the set of flags after the first sl@0: * call (no condition is required, the later calls remove an unset sl@0: * flag, which is a no-op). This causes the subsequent calls to sl@0: * UtfToExternal to consume and convert the actual input. sl@0: */ sl@0: sl@0: statePtr->outputEncodingFlags &= ~TCL_ENCODING_START; sl@0: /* sl@0: * The following code must be executed only when result is not 0. sl@0: */ sl@0: if (result && ((stageRead + dstWrote) == 0)) { sl@0: /* sl@0: * We have an incomplete UTF-8 character at the end of the sl@0: * staging buffer. It will get moved to the beginning of the sl@0: * staging buffer followed by more bytes from src. sl@0: */ sl@0: sl@0: src -= stageLen; sl@0: srcLen += stageLen; sl@0: stageLen = 0; sl@0: savedLF = 0; sl@0: break; sl@0: } sl@0: bufPtr->nextAdded += dstWrote; sl@0: if (bufPtr->nextAdded > bufPtr->bufLength) { sl@0: /* sl@0: * When translating from UTF-8 to external encoding, we sl@0: * allowed the translation to produce a character that sl@0: * crossed the end of the output buffer, so that we would sl@0: * get a completely full buffer before flushing it. The sl@0: * extra bytes will be moved to the beginning of the next sl@0: * buffer. sl@0: */ sl@0: sl@0: saved = bufPtr->nextAdded - bufPtr->bufLength; sl@0: memcpy((VOID *) safe, (VOID *) (dst + dstLen), (size_t) saved); sl@0: bufPtr->nextAdded = bufPtr->bufLength; sl@0: } sl@0: if (CheckFlush(chanPtr, bufPtr, sawLF) != 0) { sl@0: return -1; sl@0: } sl@0: sl@0: total += dstWrote; sl@0: stage += stageRead; sl@0: stageLen -= stageRead; sl@0: sawLF = 0; sl@0: sl@0: consumedSomething = 1; sl@0: sl@0: /* sl@0: * If all translated characters are written to the buffer, sl@0: * endEncoding is set to 0 because the escape sequence may be sl@0: * output. sl@0: */ sl@0: sl@0: if ((stageLen + saved == 0) && (result == 0)) { sl@0: endEncoding = 0; sl@0: } sl@0: } sl@0: } sl@0: sl@0: /* If nothing was written and it happened because there was no progress sl@0: * in the UTF conversion, we throw an error. sl@0: */ sl@0: sl@0: if (!consumedSomething && (total == 0)) { sl@0: Tcl_SetErrno (EINVAL); sl@0: return -1; sl@0: } sl@0: return total; sl@0: } sl@0: sl@0: /* sl@0: *--------------------------------------------------------------------------- sl@0: * sl@0: * TranslateOutputEOL -- sl@0: * sl@0: * Helper function for WriteBytes() and WriteChars(). Converts the sl@0: * '\n' characters in the source buffer into the appropriate EOL sl@0: * form specified by the output translation mode. sl@0: * sl@0: * EOL translation stops either when the source buffer is empty sl@0: * or the output buffer is full. sl@0: * sl@0: * When converting to CRLF mode and there is only 1 byte left in sl@0: * the output buffer, this routine stores the '\r' in the last sl@0: * byte and then stores the '\n' in the byte just past the end of the sl@0: * buffer. The caller is responsible for passing in a buffer that sl@0: * is large enough to hold the extra byte. sl@0: * sl@0: * Results: sl@0: * The return value is 1 if a '\n' was translated from the source sl@0: * buffer, or 0 otherwise -- this can be used by the caller to sl@0: * decide to flush a line-based channel even though the channel sl@0: * buffer is not full. sl@0: * sl@0: * *dstLenPtr is filled with how many bytes of the output buffer sl@0: * were used. As mentioned above, this can be one more that sl@0: * the output buffer's specified length if a CRLF was stored. sl@0: * sl@0: * *srcLenPtr is filled with how many bytes of the source buffer sl@0: * were consumed. sl@0: * sl@0: * Side effects: sl@0: * It may be obvious, but bears mentioning that when converting sl@0: * in CRLF mode (which requires two bytes of storage in the output sl@0: * buffer), the number of bytes consumed from the source buffer sl@0: * will be less than the number of bytes stored in the output buffer. sl@0: * sl@0: *--------------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static int sl@0: TranslateOutputEOL(statePtr, dst, src, dstLenPtr, srcLenPtr) sl@0: ChannelState *statePtr; /* Channel being read, for translation and sl@0: * buffering modes. */ sl@0: char *dst; /* Output buffer filled with UTF-8 chars by sl@0: * applying appropriate EOL translation to sl@0: * source characters. */ sl@0: CONST char *src; /* Source UTF-8 characters. */ sl@0: int *dstLenPtr; /* On entry, the maximum length of output sl@0: * buffer in bytes. On exit, the number of sl@0: * bytes actually used in output buffer. */ sl@0: int *srcLenPtr; /* On entry, the length of source buffer. sl@0: * On exit, the number of bytes read from sl@0: * the source buffer. */ sl@0: { sl@0: char *dstEnd; sl@0: int srcLen, newlineFound; sl@0: sl@0: newlineFound = 0; sl@0: srcLen = *srcLenPtr; sl@0: sl@0: switch (statePtr->outputTranslation) { sl@0: case TCL_TRANSLATE_LF: { sl@0: for (dstEnd = dst + srcLen; dst < dstEnd; ) { sl@0: if (*src == '\n') { sl@0: newlineFound = 1; sl@0: } sl@0: *dst++ = *src++; sl@0: } sl@0: *dstLenPtr = srcLen; sl@0: break; sl@0: } sl@0: case TCL_TRANSLATE_CR: { sl@0: for (dstEnd = dst + srcLen; dst < dstEnd;) { sl@0: if (*src == '\n') { sl@0: *dst++ = '\r'; sl@0: newlineFound = 1; sl@0: src++; sl@0: } else { sl@0: *dst++ = *src++; sl@0: } sl@0: } sl@0: *dstLenPtr = srcLen; sl@0: break; sl@0: } sl@0: case TCL_TRANSLATE_CRLF: { sl@0: /* sl@0: * Since this causes the number of bytes to grow, we sl@0: * start off trying to put 'srcLen' bytes into the sl@0: * output buffer, but allow it to store more bytes, as sl@0: * long as there's still source bytes and room in the sl@0: * output buffer. sl@0: */ sl@0: sl@0: char *dstStart, *dstMax; sl@0: CONST char *srcStart; sl@0: sl@0: dstStart = dst; sl@0: dstMax = dst + *dstLenPtr; sl@0: sl@0: srcStart = src; sl@0: sl@0: if (srcLen < *dstLenPtr) { sl@0: dstEnd = dst + srcLen; sl@0: } else { sl@0: dstEnd = dst + *dstLenPtr; sl@0: } sl@0: while (dst < dstEnd) { sl@0: if (*src == '\n') { sl@0: if (dstEnd < dstMax) { sl@0: dstEnd++; sl@0: } sl@0: *dst++ = '\r'; sl@0: newlineFound = 1; sl@0: } sl@0: *dst++ = *src++; sl@0: } sl@0: *srcLenPtr = src - srcStart; sl@0: *dstLenPtr = dst - dstStart; sl@0: break; sl@0: } sl@0: default: { sl@0: break; sl@0: } sl@0: } sl@0: return newlineFound; sl@0: } sl@0: sl@0: /* sl@0: *--------------------------------------------------------------------------- sl@0: * sl@0: * CheckFlush -- sl@0: * sl@0: * Helper function for WriteBytes() and WriteChars(). If the sl@0: * channel buffer is ready to be flushed, flush it. sl@0: * sl@0: * Results: sl@0: * The return value is -1 if there was a problem flushing the sl@0: * channel buffer, or 0 otherwise. sl@0: * sl@0: * Side effects: sl@0: * The buffer will be recycled if it is flushed. sl@0: * sl@0: *--------------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static int sl@0: CheckFlush(chanPtr, bufPtr, newlineFlag) sl@0: Channel *chanPtr; /* Channel being read, for buffering mode. */ sl@0: ChannelBuffer *bufPtr; /* Channel buffer to possibly flush. */ sl@0: int newlineFlag; /* Non-zero if a the channel buffer sl@0: * contains a newline. */ sl@0: { sl@0: ChannelState *statePtr = chanPtr->state; /* state info for channel */ sl@0: /* sl@0: * The current buffer is ready for output: sl@0: * 1. if it is full. sl@0: * 2. if it contains a newline and this channel is line-buffered. sl@0: * 3. if it contains any output and this channel is unbuffered. sl@0: */ sl@0: sl@0: if ((statePtr->flags & BUFFER_READY) == 0) { sl@0: if (bufPtr->nextAdded == bufPtr->bufLength) { sl@0: statePtr->flags |= BUFFER_READY; sl@0: } else if (statePtr->flags & CHANNEL_LINEBUFFERED) { sl@0: if (newlineFlag != 0) { sl@0: statePtr->flags |= BUFFER_READY; sl@0: } sl@0: } else if (statePtr->flags & CHANNEL_UNBUFFERED) { sl@0: statePtr->flags |= BUFFER_READY; sl@0: } sl@0: } sl@0: if (statePtr->flags & BUFFER_READY) { sl@0: if (FlushChannel(NULL, chanPtr, 0) != 0) { sl@0: return -1; sl@0: } sl@0: } sl@0: return 0; sl@0: } sl@0: sl@0: /* sl@0: *--------------------------------------------------------------------------- sl@0: * sl@0: * Tcl_Gets -- sl@0: * sl@0: * Reads a complete line of input from the channel into a Tcl_DString. sl@0: * sl@0: * Results: sl@0: * Length of line read (in characters) or -1 if error, EOF, or blocked. sl@0: * If -1, use Tcl_GetErrno() to retrieve the POSIX error code for the sl@0: * error or condition that occurred. sl@0: * sl@0: * Side effects: sl@0: * May flush output on the channel. May cause input to be consumed sl@0: * from the channel. sl@0: * sl@0: *--------------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C int sl@0: Tcl_Gets(chan, lineRead) sl@0: Tcl_Channel chan; /* Channel from which to read. */ sl@0: Tcl_DString *lineRead; /* The line read will be appended to this sl@0: * DString as UTF-8 characters. The caller sl@0: * must have initialized it and is responsible sl@0: * for managing the storage. */ sl@0: { sl@0: Tcl_Obj *objPtr; sl@0: int charsStored, length; sl@0: char *string; sl@0: sl@0: objPtr = Tcl_NewObj(); sl@0: charsStored = Tcl_GetsObj(chan, objPtr); sl@0: if (charsStored > 0) { sl@0: string = Tcl_GetStringFromObj(objPtr, &length); sl@0: Tcl_DStringAppend(lineRead, string, length); sl@0: } sl@0: Tcl_DecrRefCount(objPtr); sl@0: return charsStored; sl@0: } sl@0: sl@0: /* sl@0: *--------------------------------------------------------------------------- sl@0: * sl@0: * Tcl_GetsObj -- sl@0: * sl@0: * Accumulate input from the input channel until end-of-line or sl@0: * end-of-file has been seen. Bytes read from the input channel sl@0: * are converted to UTF-8 using the encoding specified by the sl@0: * channel. sl@0: * sl@0: * Results: sl@0: * Number of characters accumulated in the object or -1 if error, sl@0: * blocked, or EOF. If -1, use Tcl_GetErrno() to retrieve the sl@0: * POSIX error code for the error or condition that occurred. sl@0: * sl@0: * Side effects: sl@0: * Consumes input from the channel. sl@0: * sl@0: * On reading EOF, leave channel pointing at EOF char. sl@0: * On reading EOL, leave channel pointing after EOL, but don't sl@0: * return EOL in dst buffer. sl@0: * sl@0: *--------------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C int sl@0: Tcl_GetsObj(chan, objPtr) sl@0: Tcl_Channel chan; /* Channel from which to read. */ sl@0: Tcl_Obj *objPtr; /* The line read will be appended to this sl@0: * object as UTF-8 characters. */ sl@0: { sl@0: GetsState gs; sl@0: Channel *chanPtr = (Channel *) chan; sl@0: ChannelState *statePtr = chanPtr->state; /* state info for channel */ sl@0: ChannelBuffer *bufPtr; sl@0: int inEofChar, skip, copiedTotal, oldLength, oldFlags, oldRemoved; sl@0: Tcl_Encoding encoding; sl@0: char *dst, *dstEnd, *eol, *eof; sl@0: Tcl_EncodingState oldState; sl@0: sl@0: /* sl@0: * This operation should occur at the top of a channel stack. sl@0: */ sl@0: sl@0: chanPtr = statePtr->topChanPtr; sl@0: sl@0: if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) { sl@0: copiedTotal = -1; sl@0: goto done; sl@0: } sl@0: sl@0: bufPtr = statePtr->inQueueHead; sl@0: encoding = statePtr->encoding; sl@0: sl@0: /* sl@0: * Preserved so we can restore the channel's state in case we don't sl@0: * find a newline in the available input. sl@0: */ sl@0: sl@0: Tcl_GetStringFromObj(objPtr, &oldLength); sl@0: oldFlags = statePtr->inputEncodingFlags; sl@0: oldState = statePtr->inputEncodingState; sl@0: oldRemoved = BUFFER_PADDING; sl@0: if (bufPtr != NULL) { sl@0: oldRemoved = bufPtr->nextRemoved; sl@0: } sl@0: sl@0: /* sl@0: * If there is no encoding, use "iso8859-1" -- Tcl_GetsObj() doesn't sl@0: * produce ByteArray objects. To avoid circularity problems, sl@0: * "iso8859-1" is builtin to Tcl. sl@0: */ sl@0: sl@0: if (encoding == NULL) { sl@0: encoding = Tcl_GetEncoding(NULL, "iso8859-1"); sl@0: } sl@0: sl@0: /* sl@0: * Object used by FilterInputBytes to keep track of how much data has sl@0: * been consumed from the channel buffers. sl@0: */ sl@0: sl@0: gs.objPtr = objPtr; sl@0: gs.dstPtr = &dst; sl@0: gs.encoding = encoding; sl@0: gs.bufPtr = bufPtr; sl@0: gs.state = oldState; sl@0: gs.rawRead = 0; sl@0: gs.bytesWrote = 0; sl@0: gs.charsWrote = 0; sl@0: gs.totalChars = 0; sl@0: sl@0: dst = objPtr->bytes + oldLength; sl@0: dstEnd = dst; sl@0: sl@0: skip = 0; sl@0: eof = NULL; sl@0: inEofChar = statePtr->inEofChar; sl@0: sl@0: while (1) { sl@0: if (dst >= dstEnd) { sl@0: if (FilterInputBytes(chanPtr, &gs) != 0) { sl@0: goto restore; sl@0: } sl@0: dstEnd = dst + gs.bytesWrote; sl@0: } sl@0: sl@0: /* sl@0: * Remember if EOF char is seen, then look for EOL anyhow, because sl@0: * the EOL might be before the EOF char. sl@0: */ sl@0: sl@0: if (inEofChar != '\0') { sl@0: for (eol = dst; eol < dstEnd; eol++) { sl@0: if (*eol == inEofChar) { sl@0: dstEnd = eol; sl@0: eof = eol; sl@0: break; sl@0: } sl@0: } sl@0: } sl@0: sl@0: /* sl@0: * On EOL, leave current file position pointing after the EOL, but sl@0: * don't store the EOL in the output string. sl@0: */ sl@0: sl@0: switch (statePtr->inputTranslation) { sl@0: case TCL_TRANSLATE_LF: { sl@0: for (eol = dst; eol < dstEnd; eol++) { sl@0: if (*eol == '\n') { sl@0: skip = 1; sl@0: goto goteol; sl@0: } sl@0: } sl@0: break; sl@0: } sl@0: case TCL_TRANSLATE_CR: { sl@0: for (eol = dst; eol < dstEnd; eol++) { sl@0: if (*eol == '\r') { sl@0: skip = 1; sl@0: goto goteol; sl@0: } sl@0: } sl@0: break; sl@0: } sl@0: case TCL_TRANSLATE_CRLF: { sl@0: for (eol = dst; eol < dstEnd; eol++) { sl@0: if (*eol == '\r') { sl@0: eol++; sl@0: if (eol >= dstEnd) { sl@0: int offset; sl@0: sl@0: offset = eol - objPtr->bytes; sl@0: dst = dstEnd; sl@0: if (FilterInputBytes(chanPtr, &gs) != 0) { sl@0: goto restore; sl@0: } sl@0: dstEnd = dst + gs.bytesWrote; sl@0: eol = objPtr->bytes + offset; sl@0: if (eol >= dstEnd) { sl@0: skip = 0; sl@0: goto goteol; sl@0: } sl@0: } sl@0: if (*eol == '\n') { sl@0: eol--; sl@0: skip = 2; sl@0: goto goteol; sl@0: } sl@0: } sl@0: } sl@0: break; sl@0: } sl@0: case TCL_TRANSLATE_AUTO: { sl@0: eol = dst; sl@0: skip = 1; sl@0: if (statePtr->flags & INPUT_SAW_CR) { sl@0: statePtr->flags &= ~INPUT_SAW_CR; sl@0: if (*eol == '\n') { sl@0: /* sl@0: * Skip the raw bytes that make up the '\n'. sl@0: */ sl@0: sl@0: char tmp[1 + TCL_UTF_MAX]; sl@0: int rawRead; sl@0: sl@0: bufPtr = gs.bufPtr; sl@0: Tcl_ExternalToUtf(NULL, gs.encoding, sl@0: bufPtr->buf + bufPtr->nextRemoved, sl@0: gs.rawRead, statePtr->inputEncodingFlags, sl@0: &gs.state, tmp, 1 + TCL_UTF_MAX, &rawRead, sl@0: NULL, NULL); sl@0: bufPtr->nextRemoved += rawRead; sl@0: gs.rawRead -= rawRead; sl@0: gs.bytesWrote--; sl@0: gs.charsWrote--; sl@0: memmove(dst, dst + 1, (size_t) (dstEnd - dst)); sl@0: dstEnd--; sl@0: } sl@0: } sl@0: for (eol = dst; eol < dstEnd; eol++) { sl@0: if (*eol == '\r') { sl@0: eol++; sl@0: if (eol == dstEnd) { sl@0: /* sl@0: * If buffer ended on \r, peek ahead to see if a sl@0: * \n is available. sl@0: */ sl@0: sl@0: int offset; sl@0: sl@0: offset = eol - objPtr->bytes; sl@0: dst = dstEnd; sl@0: PeekAhead(chanPtr, &dstEnd, &gs); sl@0: eol = objPtr->bytes + offset; sl@0: if (eol >= dstEnd) { sl@0: eol--; sl@0: statePtr->flags |= INPUT_SAW_CR; sl@0: goto goteol; sl@0: } sl@0: } sl@0: if (*eol == '\n') { sl@0: skip++; sl@0: } sl@0: eol--; sl@0: goto goteol; sl@0: } else if (*eol == '\n') { sl@0: goto goteol; sl@0: } sl@0: } sl@0: } sl@0: } sl@0: if (eof != NULL) { sl@0: /* sl@0: * EOF character was seen. On EOF, leave current file position sl@0: * pointing at the EOF character, but don't store the EOF sl@0: * character in the output string. sl@0: */ sl@0: sl@0: dstEnd = eof; sl@0: statePtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF); sl@0: statePtr->inputEncodingFlags |= TCL_ENCODING_END; sl@0: } sl@0: if (statePtr->flags & CHANNEL_EOF) { sl@0: skip = 0; sl@0: eol = dstEnd; sl@0: if (eol == objPtr->bytes + oldLength) { sl@0: /* sl@0: * If we didn't append any bytes before encountering EOF, sl@0: * caller needs to see -1. sl@0: */ sl@0: sl@0: Tcl_SetObjLength(objPtr, oldLength); sl@0: CommonGetsCleanup(chanPtr, encoding); sl@0: copiedTotal = -1; sl@0: goto done; sl@0: } sl@0: goto goteol; sl@0: } sl@0: dst = dstEnd; sl@0: } sl@0: sl@0: /* sl@0: * Found EOL or EOF, but the output buffer may now contain too many sl@0: * UTF-8 characters. We need to know how many raw bytes correspond to sl@0: * the number of UTF-8 characters we want, plus how many raw bytes sl@0: * correspond to the character(s) making up EOL (if any), so we can sl@0: * remove the correct number of bytes from the channel buffer. sl@0: */ sl@0: sl@0: goteol: sl@0: bufPtr = gs.bufPtr; sl@0: statePtr->inputEncodingState = gs.state; sl@0: Tcl_ExternalToUtf(NULL, gs.encoding, bufPtr->buf + bufPtr->nextRemoved, sl@0: gs.rawRead, statePtr->inputEncodingFlags, sl@0: &statePtr->inputEncodingState, dst, sl@0: eol - dst + skip + TCL_UTF_MAX, &gs.rawRead, NULL, sl@0: &gs.charsWrote); sl@0: bufPtr->nextRemoved += gs.rawRead; sl@0: sl@0: /* sl@0: * Recycle all the emptied buffers. sl@0: */ sl@0: sl@0: Tcl_SetObjLength(objPtr, eol - objPtr->bytes); sl@0: CommonGetsCleanup(chanPtr, encoding); sl@0: statePtr->flags &= ~CHANNEL_BLOCKED; sl@0: copiedTotal = gs.totalChars + gs.charsWrote - skip; sl@0: goto done; sl@0: sl@0: /* sl@0: * Couldn't get a complete line. This only happens if we get a error sl@0: * reading from the channel or we are non-blocking and there wasn't sl@0: * an EOL or EOF in the data available. sl@0: */ sl@0: sl@0: restore: sl@0: bufPtr = statePtr->inQueueHead; sl@0: bufPtr->nextRemoved = oldRemoved; sl@0: sl@0: for (bufPtr = bufPtr->nextPtr; bufPtr != NULL; bufPtr = bufPtr->nextPtr) { sl@0: bufPtr->nextRemoved = BUFFER_PADDING; sl@0: } sl@0: CommonGetsCleanup(chanPtr, encoding); sl@0: sl@0: statePtr->inputEncodingState = oldState; sl@0: statePtr->inputEncodingFlags = oldFlags; sl@0: Tcl_SetObjLength(objPtr, oldLength); sl@0: sl@0: /* sl@0: * We didn't get a complete line so we need to indicate to UpdateInterest sl@0: * that the gets blocked. It will wait for more data instead of firing sl@0: * a timer, avoiding a busy wait. This is where we are assuming that the sl@0: * next operation is a gets. No more file events will be delivered on sl@0: * this channel until new data arrives or some operation is performed sl@0: * on the channel (e.g. gets, read, fconfigure) that changes the blocking sl@0: * state. Note that this means a file event will not be delivered even sl@0: * though a read would be able to consume the buffered data. sl@0: */ sl@0: sl@0: statePtr->flags |= CHANNEL_NEED_MORE_DATA; sl@0: copiedTotal = -1; sl@0: sl@0: done: sl@0: /* sl@0: * Update the notifier state so we don't block while there is still sl@0: * data in the buffers. sl@0: */ sl@0: sl@0: UpdateInterest(chanPtr); sl@0: return copiedTotal; sl@0: } sl@0: sl@0: /* sl@0: *--------------------------------------------------------------------------- sl@0: * sl@0: * FilterInputBytes -- sl@0: * sl@0: * Helper function for Tcl_GetsObj. Produces UTF-8 characters from sl@0: * raw bytes read from the channel. sl@0: * sl@0: * Consumes available bytes from channel buffers. When channel sl@0: * buffers are exhausted, reads more bytes from channel device into sl@0: * a new channel buffer. It is the caller's responsibility to sl@0: * free the channel buffers that have been exhausted. sl@0: * sl@0: * Results: sl@0: * The return value is -1 if there was an error reading from the sl@0: * channel, 0 otherwise. sl@0: * sl@0: * Side effects: sl@0: * Status object keeps track of how much data from channel buffers sl@0: * has been consumed and where UTF-8 bytes should be stored. sl@0: * sl@0: *--------------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static int sl@0: FilterInputBytes(chanPtr, gsPtr) sl@0: Channel *chanPtr; /* Channel to read. */ sl@0: GetsState *gsPtr; /* Current state of gets operation. */ sl@0: { sl@0: ChannelState *statePtr = chanPtr->state; /* state info for channel */ sl@0: ChannelBuffer *bufPtr; sl@0: char *raw, *rawStart, *rawEnd; sl@0: char *dst; sl@0: int offset, toRead, dstNeeded, spaceLeft, result, rawLen, length; sl@0: Tcl_Obj *objPtr; sl@0: #define ENCODING_LINESIZE 20 /* Lower bound on how many bytes to convert sl@0: * at a time. Since we don't know a priori sl@0: * how many bytes of storage this many source sl@0: * bytes will use, we actually need at least sl@0: * ENCODING_LINESIZE * TCL_MAX_UTF bytes of sl@0: * room. */ sl@0: sl@0: objPtr = gsPtr->objPtr; sl@0: sl@0: /* sl@0: * Subtract the number of bytes that were removed from channel buffer sl@0: * during last call. sl@0: */ sl@0: sl@0: bufPtr = gsPtr->bufPtr; sl@0: if (bufPtr != NULL) { sl@0: bufPtr->nextRemoved += gsPtr->rawRead; sl@0: if (bufPtr->nextRemoved >= bufPtr->nextAdded) { sl@0: bufPtr = bufPtr->nextPtr; sl@0: } sl@0: } sl@0: gsPtr->totalChars += gsPtr->charsWrote; sl@0: sl@0: if ((bufPtr == NULL) || (bufPtr->nextAdded == BUFFER_PADDING)) { sl@0: /* sl@0: * All channel buffers were exhausted and the caller still hasn't sl@0: * seen EOL. Need to read more bytes from the channel device. sl@0: * Side effect is to allocate another channel buffer. sl@0: */ sl@0: sl@0: read: sl@0: if (statePtr->flags & CHANNEL_BLOCKED) { sl@0: if (statePtr->flags & CHANNEL_NONBLOCKING) { sl@0: gsPtr->charsWrote = 0; sl@0: gsPtr->rawRead = 0; sl@0: return -1; sl@0: } sl@0: statePtr->flags &= ~CHANNEL_BLOCKED; sl@0: } sl@0: if (GetInput(chanPtr) != 0) { sl@0: gsPtr->charsWrote = 0; sl@0: gsPtr->rawRead = 0; sl@0: return -1; sl@0: } sl@0: bufPtr = statePtr->inQueueTail; sl@0: gsPtr->bufPtr = bufPtr; sl@0: } sl@0: sl@0: /* sl@0: * Convert some of the bytes from the channel buffer to UTF-8. Space in sl@0: * objPtr's string rep is used to hold the UTF-8 characters. Grow the sl@0: * string rep if we need more space. sl@0: */ sl@0: sl@0: rawStart = bufPtr->buf + bufPtr->nextRemoved; sl@0: raw = rawStart; sl@0: rawEnd = bufPtr->buf + bufPtr->nextAdded; sl@0: rawLen = rawEnd - rawStart; sl@0: sl@0: dst = *gsPtr->dstPtr; sl@0: offset = dst - objPtr->bytes; sl@0: toRead = ENCODING_LINESIZE; sl@0: if (toRead > rawLen) { sl@0: toRead = rawLen; sl@0: } sl@0: dstNeeded = toRead * TCL_UTF_MAX + 1; sl@0: spaceLeft = objPtr->length - offset - TCL_UTF_MAX - 1; sl@0: if (dstNeeded > spaceLeft) { sl@0: length = offset * 2; sl@0: if (offset < dstNeeded) { sl@0: length = offset + dstNeeded; sl@0: } sl@0: length += TCL_UTF_MAX + 1; sl@0: Tcl_SetObjLength(objPtr, length); sl@0: spaceLeft = length - offset; sl@0: dst = objPtr->bytes + offset; sl@0: *gsPtr->dstPtr = dst; sl@0: } sl@0: gsPtr->state = statePtr->inputEncodingState; sl@0: result = Tcl_ExternalToUtf(NULL, gsPtr->encoding, raw, rawLen, sl@0: statePtr->inputEncodingFlags, &statePtr->inputEncodingState, sl@0: dst, spaceLeft, &gsPtr->rawRead, &gsPtr->bytesWrote, sl@0: &gsPtr->charsWrote); sl@0: sl@0: /* sl@0: * Make sure that if we go through 'gets', that we reset the sl@0: * TCL_ENCODING_START flag still. [Bug #523988] sl@0: */ sl@0: statePtr->inputEncodingFlags &= ~TCL_ENCODING_START; sl@0: sl@0: if (result == TCL_CONVERT_MULTIBYTE) { sl@0: /* sl@0: * The last few bytes in this channel buffer were the start of a sl@0: * multibyte sequence. If this buffer was full, then move them to sl@0: * the next buffer so the bytes will be contiguous. sl@0: */ sl@0: sl@0: ChannelBuffer *nextPtr; sl@0: int extra; sl@0: sl@0: nextPtr = bufPtr->nextPtr; sl@0: if (bufPtr->nextAdded < bufPtr->bufLength) { sl@0: if (gsPtr->rawRead > 0) { sl@0: /* sl@0: * Some raw bytes were converted to UTF-8. Fall through, sl@0: * returning those UTF-8 characters because a EOL might be sl@0: * present in them. sl@0: */ sl@0: } else if (statePtr->flags & CHANNEL_EOF) { sl@0: /* sl@0: * There was a partial character followed by EOF on the sl@0: * device. Fall through, returning that nothing was found. sl@0: */ sl@0: sl@0: bufPtr->nextRemoved = bufPtr->nextAdded; sl@0: } else { sl@0: /* sl@0: * There are no more cached raw bytes left. See if we can sl@0: * get some more. sl@0: */ sl@0: sl@0: goto read; sl@0: } sl@0: } else { sl@0: if (nextPtr == NULL) { sl@0: nextPtr = AllocChannelBuffer(statePtr->bufSize); sl@0: bufPtr->nextPtr = nextPtr; sl@0: statePtr->inQueueTail = nextPtr; sl@0: } sl@0: extra = rawLen - gsPtr->rawRead; sl@0: memcpy((VOID *) (nextPtr->buf + BUFFER_PADDING - extra), sl@0: (VOID *) (raw + gsPtr->rawRead), (size_t) extra); sl@0: nextPtr->nextRemoved -= extra; sl@0: bufPtr->nextAdded -= extra; sl@0: } sl@0: } sl@0: sl@0: gsPtr->bufPtr = bufPtr; sl@0: return 0; sl@0: } sl@0: sl@0: /* sl@0: *--------------------------------------------------------------------------- sl@0: * sl@0: * PeekAhead -- sl@0: * sl@0: * Helper function used by Tcl_GetsObj(). Called when we've seen a sl@0: * \r at the end of the UTF-8 string and want to look ahead one sl@0: * character to see if it is a \n. sl@0: * sl@0: * Results: sl@0: * *gsPtr->dstPtr is filled with a pointer to the start of the range of sl@0: * UTF-8 characters that were found by peeking and *dstEndPtr is filled sl@0: * with a pointer to the bytes just after the end of the range. sl@0: * sl@0: * Side effects: sl@0: * If no more raw bytes were available in one of the channel buffers, sl@0: * tries to perform a non-blocking read to get more bytes from the sl@0: * channel device. sl@0: * sl@0: *--------------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static void sl@0: PeekAhead(chanPtr, dstEndPtr, gsPtr) sl@0: Channel *chanPtr; /* The channel to read. */ sl@0: char **dstEndPtr; /* Filled with pointer to end of new range sl@0: * of UTF-8 characters. */ sl@0: GetsState *gsPtr; /* Current state of gets operation. */ sl@0: { sl@0: ChannelState *statePtr = chanPtr->state; /* state info for channel */ sl@0: ChannelBuffer *bufPtr; sl@0: Tcl_DriverBlockModeProc *blockModeProc; sl@0: int bytesLeft; sl@0: sl@0: bufPtr = gsPtr->bufPtr; sl@0: sl@0: /* sl@0: * If there's any more raw input that's still buffered, we'll peek into sl@0: * that. Otherwise, only get more data from the channel driver if it sl@0: * looks like there might actually be more data. The assumption is that sl@0: * if the channel buffer is filled right up to the end, then there sl@0: * might be more data to read. sl@0: */ sl@0: sl@0: blockModeProc = NULL; sl@0: if (bufPtr->nextPtr == NULL) { sl@0: bytesLeft = bufPtr->nextAdded - (bufPtr->nextRemoved + gsPtr->rawRead); sl@0: if (bytesLeft == 0) { sl@0: if (bufPtr->nextAdded < bufPtr->bufLength) { sl@0: /* sl@0: * Don't peek ahead if last read was short read. sl@0: */ sl@0: sl@0: goto cleanup; sl@0: } sl@0: if ((statePtr->flags & CHANNEL_NONBLOCKING) == 0) { sl@0: blockModeProc = Tcl_ChannelBlockModeProc(chanPtr->typePtr); sl@0: if (blockModeProc == NULL) { sl@0: /* sl@0: * Don't peek ahead if cannot set non-blocking mode. sl@0: */ sl@0: sl@0: goto cleanup; sl@0: } sl@0: StackSetBlockMode(chanPtr, TCL_MODE_NONBLOCKING); sl@0: } sl@0: } sl@0: } sl@0: if (FilterInputBytes(chanPtr, gsPtr) == 0) { sl@0: *dstEndPtr = *gsPtr->dstPtr + gsPtr->bytesWrote; sl@0: } sl@0: if (blockModeProc != NULL) { sl@0: StackSetBlockMode(chanPtr, TCL_MODE_BLOCKING); sl@0: } sl@0: return; sl@0: sl@0: cleanup: sl@0: bufPtr->nextRemoved += gsPtr->rawRead; sl@0: gsPtr->rawRead = 0; sl@0: gsPtr->totalChars += gsPtr->charsWrote; sl@0: gsPtr->bytesWrote = 0; sl@0: gsPtr->charsWrote = 0; sl@0: } sl@0: sl@0: /* sl@0: *--------------------------------------------------------------------------- sl@0: * sl@0: * CommonGetsCleanup -- sl@0: * sl@0: * Helper function for Tcl_GetsObj() to restore the channel after sl@0: * a "gets" operation. sl@0: * sl@0: * Results: sl@0: * None. sl@0: * sl@0: * Side effects: sl@0: * Encoding may be freed. sl@0: * sl@0: *--------------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static void sl@0: CommonGetsCleanup(chanPtr, encoding) sl@0: Channel *chanPtr; sl@0: Tcl_Encoding encoding; sl@0: { sl@0: ChannelState *statePtr = chanPtr->state; /* state info for channel */ sl@0: ChannelBuffer *bufPtr, *nextPtr; sl@0: sl@0: bufPtr = statePtr->inQueueHead; sl@0: for ( ; bufPtr != NULL; bufPtr = nextPtr) { sl@0: nextPtr = bufPtr->nextPtr; sl@0: if (bufPtr->nextRemoved < bufPtr->nextAdded) { sl@0: break; sl@0: } sl@0: RecycleBuffer(statePtr, bufPtr, 0); sl@0: } sl@0: statePtr->inQueueHead = bufPtr; sl@0: if (bufPtr == NULL) { sl@0: statePtr->inQueueTail = NULL; sl@0: } else { sl@0: /* sl@0: * If any multi-byte characters were split across channel buffer sl@0: * boundaries, the split-up bytes were moved to the next channel sl@0: * buffer by FilterInputBytes(). Move the bytes back to their sl@0: * original buffer because the caller could change the channel's sl@0: * encoding which could change the interpretation of whether those sl@0: * bytes really made up multi-byte characters after all. sl@0: */ sl@0: sl@0: nextPtr = bufPtr->nextPtr; sl@0: for ( ; nextPtr != NULL; nextPtr = bufPtr->nextPtr) { sl@0: int extra; sl@0: sl@0: extra = bufPtr->bufLength - bufPtr->nextAdded; sl@0: if (extra > 0) { sl@0: memcpy((VOID *) (bufPtr->buf + bufPtr->nextAdded), sl@0: (VOID *) (nextPtr->buf + BUFFER_PADDING - extra), sl@0: (size_t) extra); sl@0: bufPtr->nextAdded += extra; sl@0: nextPtr->nextRemoved = BUFFER_PADDING; sl@0: } sl@0: bufPtr = nextPtr; sl@0: } sl@0: } sl@0: if (statePtr->encoding == NULL) { sl@0: Tcl_FreeEncoding(encoding); sl@0: } sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_Read -- sl@0: * sl@0: * Reads a given number of bytes from a channel. EOL and EOF sl@0: * translation is done on the bytes being read, so the the number sl@0: * of bytes consumed from the channel may not be equal to the sl@0: * number of bytes stored in the destination buffer. sl@0: * sl@0: * No encoding conversions are applied to the bytes being read. sl@0: * sl@0: * Results: sl@0: * The number of bytes read, or -1 on error. Use Tcl_GetErrno() sl@0: * to retrieve the error code for the error that occurred. sl@0: * sl@0: * Side effects: sl@0: * May cause input to be buffered. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C int sl@0: Tcl_Read(chan, dst, bytesToRead) sl@0: Tcl_Channel chan; /* The channel from which to read. */ sl@0: char *dst; /* Where to store input read. */ sl@0: int bytesToRead; /* Maximum number of bytes to read. */ sl@0: { sl@0: Channel *chanPtr = (Channel *) chan; sl@0: ChannelState *statePtr = chanPtr->state; /* state info for channel */ sl@0: sl@0: /* sl@0: * This operation should occur at the top of a channel stack. sl@0: */ sl@0: sl@0: chanPtr = statePtr->topChanPtr; sl@0: sl@0: if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) { sl@0: return -1; sl@0: } sl@0: sl@0: return DoRead(chanPtr, dst, bytesToRead); sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_ReadRaw -- sl@0: * sl@0: * Reads a given number of bytes from a channel. EOL and EOF sl@0: * translation is done on the bytes being read, so the the number sl@0: * of bytes consumed from the channel may not be equal to the sl@0: * number of bytes stored in the destination buffer. sl@0: * sl@0: * No encoding conversions are applied to the bytes being read. sl@0: * sl@0: * Results: sl@0: * The number of bytes read, or -1 on error. Use Tcl_GetErrno() sl@0: * to retrieve the error code for the error that occurred. sl@0: * sl@0: * Side effects: sl@0: * May cause input to be buffered. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C int sl@0: Tcl_ReadRaw(chan, bufPtr, bytesToRead) sl@0: Tcl_Channel chan; /* The channel from which to read. */ sl@0: char *bufPtr; /* Where to store input read. */ sl@0: int bytesToRead; /* Maximum number of bytes to read. */ sl@0: { sl@0: Channel *chanPtr = (Channel *) chan; sl@0: ChannelState *statePtr = chanPtr->state; /* state info for channel */ sl@0: int nread, result; sl@0: int copied, copiedNow; sl@0: sl@0: /* sl@0: * The check below does too much because it will reject a call to this sl@0: * function with a channel which is part of an 'fcopy'. But we have to sl@0: * allow this here or else the chaining in the transformation drivers sl@0: * will fail with 'file busy' error instead of retrieving and sl@0: * transforming the data to copy. sl@0: * sl@0: * We let the check procedure now believe that there is no fcopy in sl@0: * progress. A better solution than this might be an additional flag sl@0: * argument to switch off specific checks. sl@0: */ sl@0: sl@0: if (CheckChannelErrors(statePtr, TCL_READABLE | CHANNEL_RAW_MODE) != 0) { sl@0: return -1; sl@0: } sl@0: sl@0: /* sl@0: * Check for information in the push-back buffers. If there is sl@0: * some, use it. Go to the driver only if there is none (anymore) sl@0: * and the caller requests more bytes. sl@0: */ sl@0: sl@0: for (copied = 0; copied < bytesToRead; copied += copiedNow) { sl@0: copiedNow = CopyBuffer(chanPtr, bufPtr + copied, sl@0: bytesToRead - copied); sl@0: if (copiedNow == 0) { sl@0: if (statePtr->flags & CHANNEL_EOF) { sl@0: goto done; sl@0: } sl@0: if (statePtr->flags & CHANNEL_BLOCKED) { sl@0: if (statePtr->flags & CHANNEL_NONBLOCKING) { sl@0: goto done; sl@0: } sl@0: statePtr->flags &= (~(CHANNEL_BLOCKED)); sl@0: } sl@0: sl@0: #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING sl@0: /* [SF Tcl Bug 943274]. Better emulation of non-blocking sl@0: * channels for channels without BlockModeProc, by keeping sl@0: * track of true fileevents generated by the OS == Data sl@0: * waiting and reading if and only if we are sure to have sl@0: * data. sl@0: */ sl@0: sl@0: if ((statePtr->flags & CHANNEL_NONBLOCKING) && sl@0: (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) && sl@0: !(statePtr->flags & CHANNEL_HAS_MORE_DATA)) { sl@0: sl@0: /* We bypass the driver, it would block, as no data is available */ sl@0: nread = -1; sl@0: result = EWOULDBLOCK; sl@0: } else { sl@0: #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */ sl@0: /* sl@0: * Now go to the driver to get as much as is possible to sl@0: * fill the remaining request. Do all the error handling sl@0: * by ourselves. The code was stolen from 'GetInput' and sl@0: * slightly adapted (different return value here). sl@0: * sl@0: * The case of 'bytesToRead == 0' at this point cannot happen. sl@0: */ sl@0: sl@0: nread = (chanPtr->typePtr->inputProc)(chanPtr->instanceData, sl@0: bufPtr + copied, bytesToRead - copied, &result); sl@0: #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING sl@0: } sl@0: #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */ sl@0: if (nread > 0) { sl@0: /* sl@0: * If we get a short read, signal up that we may be sl@0: * BLOCKED. We should avoid calling the driver because sl@0: * on some platforms we will block in the low level sl@0: * reading code even though the channel is set into sl@0: * nonblocking mode. sl@0: */ sl@0: sl@0: if (nread < (bytesToRead - copied)) { sl@0: statePtr->flags |= CHANNEL_BLOCKED; sl@0: } sl@0: sl@0: #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING sl@0: if (nread <= (bytesToRead - copied)) { sl@0: /* [SF Tcl Bug 943274] We have read the available sl@0: * data, clear flag */ sl@0: statePtr->flags &= ~CHANNEL_HAS_MORE_DATA; sl@0: } sl@0: #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */ sl@0: } else if (nread == 0) { sl@0: statePtr->flags |= CHANNEL_EOF; sl@0: statePtr->inputEncodingFlags |= TCL_ENCODING_END; sl@0: } else if (nread < 0) { sl@0: if ((result == EWOULDBLOCK) || (result == EAGAIN)) { sl@0: if (copied > 0) { sl@0: /* sl@0: * Information that was copied earlier has precedence sl@0: * over EAGAIN/WOULDBLOCK handling. sl@0: */ sl@0: return copied; sl@0: } sl@0: sl@0: statePtr->flags |= CHANNEL_BLOCKED; sl@0: result = EAGAIN; sl@0: } sl@0: sl@0: Tcl_SetErrno(result); sl@0: return -1; sl@0: } sl@0: sl@0: return copied + nread; sl@0: } sl@0: } sl@0: sl@0: done: sl@0: return copied; sl@0: } sl@0: sl@0: /* sl@0: *--------------------------------------------------------------------------- sl@0: * sl@0: * Tcl_ReadChars -- sl@0: * sl@0: * Reads from the channel until the requested number of characters sl@0: * have been seen, EOF is seen, or the channel would block. EOL sl@0: * and EOF translation is done. If reading binary data, the raw sl@0: * bytes are wrapped in a Tcl byte array object. Otherwise, the raw sl@0: * bytes are converted to UTF-8 using the channel's current encoding sl@0: * and stored in a Tcl string object. sl@0: * sl@0: * Results: sl@0: * The number of characters read, or -1 on error. Use Tcl_GetErrno() sl@0: * to retrieve the error code for the error that occurred. sl@0: * sl@0: * Side effects: sl@0: * May cause input to be buffered. sl@0: * sl@0: *--------------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C int sl@0: Tcl_ReadChars(chan, objPtr, toRead, appendFlag) sl@0: Tcl_Channel chan; /* The channel to read. */ sl@0: Tcl_Obj *objPtr; /* Input data is stored in this object. */ sl@0: int toRead; /* Maximum number of characters to store, sl@0: * or -1 to read all available data (up to EOF sl@0: * or when channel blocks). */ sl@0: int appendFlag; /* If non-zero, data read from the channel sl@0: * will be appended to the object. Otherwise, sl@0: * the data will replace the existing contents sl@0: * of the object. */ sl@0: sl@0: { sl@0: Channel* chanPtr = (Channel *) chan; sl@0: ChannelState* statePtr = chanPtr->state; /* state info for channel */ sl@0: sl@0: /* sl@0: * This operation should occur at the top of a channel stack. sl@0: */ sl@0: sl@0: chanPtr = statePtr->topChanPtr; sl@0: sl@0: if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) { sl@0: /* sl@0: * Update the notifier state so we don't block while there is still sl@0: * data in the buffers. sl@0: */ sl@0: UpdateInterest(chanPtr); sl@0: return -1; sl@0: } sl@0: sl@0: return DoReadChars (chanPtr, objPtr, toRead, appendFlag); sl@0: } sl@0: /* sl@0: *--------------------------------------------------------------------------- sl@0: * sl@0: * DoReadChars -- sl@0: * sl@0: * Reads from the channel until the requested number of characters sl@0: * have been seen, EOF is seen, or the channel would block. EOL sl@0: * and EOF translation is done. If reading binary data, the raw sl@0: * bytes are wrapped in a Tcl byte array object. Otherwise, the raw sl@0: * bytes are converted to UTF-8 using the channel's current encoding sl@0: * and stored in a Tcl string object. sl@0: * sl@0: * Results: sl@0: * The number of characters read, or -1 on error. Use Tcl_GetErrno() sl@0: * to retrieve the error code for the error that occurred. sl@0: * sl@0: * Side effects: sl@0: * May cause input to be buffered. sl@0: * sl@0: *--------------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static int sl@0: DoReadChars(chanPtr, objPtr, toRead, appendFlag) sl@0: Channel* chanPtr; /* The channel to read. */ sl@0: Tcl_Obj *objPtr; /* Input data is stored in this object. */ sl@0: int toRead; /* Maximum number of characters to store, sl@0: * or -1 to read all available data (up to EOF sl@0: * or when channel blocks). */ sl@0: int appendFlag; /* If non-zero, data read from the channel sl@0: * will be appended to the object. Otherwise, sl@0: * the data will replace the existing contents sl@0: * of the object. */ sl@0: sl@0: { sl@0: ChannelState *statePtr = chanPtr->state; /* state info for channel */ sl@0: ChannelBuffer *bufPtr; sl@0: int offset, factor, copied, copiedNow, result; sl@0: Tcl_Encoding encoding; sl@0: #define UTF_EXPANSION_FACTOR 1024 sl@0: sl@0: /* sl@0: * This operation should occur at the top of a channel stack. sl@0: */ sl@0: sl@0: chanPtr = statePtr->topChanPtr; sl@0: encoding = statePtr->encoding; sl@0: factor = UTF_EXPANSION_FACTOR; sl@0: sl@0: if (appendFlag == 0) { sl@0: if (encoding == NULL) { sl@0: Tcl_SetByteArrayLength(objPtr, 0); sl@0: } else { sl@0: Tcl_SetObjLength(objPtr, 0); sl@0: /* sl@0: * We're going to access objPtr->bytes directly, so sl@0: * we must ensure that this is actually a string sl@0: * object (otherwise it might have been pure Unicode). sl@0: */ sl@0: Tcl_GetString(objPtr); sl@0: } sl@0: offset = 0; sl@0: } else { sl@0: if (encoding == NULL) { sl@0: Tcl_GetByteArrayFromObj(objPtr, &offset); sl@0: } else { sl@0: Tcl_GetStringFromObj(objPtr, &offset); sl@0: } sl@0: } sl@0: sl@0: for (copied = 0; (unsigned) toRead > 0; ) { sl@0: copiedNow = -1; sl@0: if (statePtr->inQueueHead != NULL) { sl@0: if (encoding == NULL) { sl@0: copiedNow = ReadBytes(statePtr, objPtr, toRead, &offset); sl@0: } else { sl@0: copiedNow = ReadChars(statePtr, objPtr, toRead, &offset, sl@0: &factor); sl@0: } sl@0: sl@0: /* sl@0: * If the current buffer is empty recycle it. sl@0: */ sl@0: sl@0: bufPtr = statePtr->inQueueHead; sl@0: if (bufPtr->nextRemoved == bufPtr->nextAdded) { sl@0: ChannelBuffer *nextPtr; sl@0: sl@0: nextPtr = bufPtr->nextPtr; sl@0: RecycleBuffer(statePtr, bufPtr, 0); sl@0: statePtr->inQueueHead = nextPtr; sl@0: if (nextPtr == NULL) { sl@0: statePtr->inQueueTail = NULL; sl@0: } sl@0: } sl@0: } sl@0: if (copiedNow < 0) { sl@0: if (statePtr->flags & CHANNEL_EOF) { sl@0: break; sl@0: } sl@0: if (statePtr->flags & CHANNEL_BLOCKED) { sl@0: if (statePtr->flags & CHANNEL_NONBLOCKING) { sl@0: break; sl@0: } sl@0: statePtr->flags &= ~CHANNEL_BLOCKED; sl@0: } sl@0: result = GetInput(chanPtr); sl@0: if (result != 0) { sl@0: if (result == EAGAIN) { sl@0: break; sl@0: } sl@0: copied = -1; sl@0: goto done; sl@0: } sl@0: } else { sl@0: copied += copiedNow; sl@0: toRead -= copiedNow; sl@0: } sl@0: } sl@0: statePtr->flags &= ~CHANNEL_BLOCKED; sl@0: if (encoding == NULL) { sl@0: Tcl_SetByteArrayLength(objPtr, offset); sl@0: } else { sl@0: Tcl_SetObjLength(objPtr, offset); sl@0: } sl@0: sl@0: done: sl@0: /* sl@0: * Update the notifier state so we don't block while there is still sl@0: * data in the buffers. sl@0: */ sl@0: sl@0: UpdateInterest(chanPtr); sl@0: return copied; sl@0: } sl@0: /* sl@0: *--------------------------------------------------------------------------- sl@0: * sl@0: * ReadBytes -- sl@0: * sl@0: * Reads from the channel until the requested number of bytes have sl@0: * been seen, EOF is seen, or the channel would block. Bytes from sl@0: * the channel are stored in objPtr as a ByteArray object. EOL sl@0: * and EOF translation are done. sl@0: * sl@0: * 'bytesToRead' can safely be a very large number because sl@0: * space is only allocated to hold data read from the channel sl@0: * as needed. sl@0: * sl@0: * Results: sl@0: * The return value is the number of bytes appended to the object sl@0: * and *offsetPtr is filled with the total number of bytes in the sl@0: * object (greater than the return value if there were already bytes sl@0: * in the object). sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *--------------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static int sl@0: ReadBytes(statePtr, objPtr, bytesToRead, offsetPtr) sl@0: ChannelState *statePtr; /* State of the channel to read. */ sl@0: Tcl_Obj *objPtr; /* Input data is appended to this ByteArray sl@0: * object. Its length is how much space sl@0: * has been allocated to hold data, not how sl@0: * many bytes of data have been stored in the sl@0: * object. */ sl@0: int bytesToRead; /* Maximum number of bytes to store, sl@0: * or < 0 to get all available bytes. sl@0: * Bytes are obtained from the first sl@0: * buffer in the queue -- even if this number sl@0: * is larger than the number of bytes sl@0: * available in the first buffer, only the sl@0: * bytes from the first buffer are sl@0: * returned. */ sl@0: int *offsetPtr; /* On input, contains how many bytes of sl@0: * objPtr have been used to hold data. On sl@0: * output, filled with how many bytes are now sl@0: * being used. */ sl@0: { sl@0: int toRead, srcLen, offset, length, srcRead, dstWrote; sl@0: ChannelBuffer *bufPtr; sl@0: char *src, *dst; sl@0: sl@0: offset = *offsetPtr; sl@0: sl@0: bufPtr = statePtr->inQueueHead; sl@0: src = bufPtr->buf + bufPtr->nextRemoved; sl@0: srcLen = bufPtr->nextAdded - bufPtr->nextRemoved; sl@0: sl@0: toRead = bytesToRead; sl@0: if ((unsigned) toRead > (unsigned) srcLen) { sl@0: toRead = srcLen; sl@0: } sl@0: sl@0: dst = (char *) Tcl_GetByteArrayFromObj(objPtr, &length); sl@0: if (toRead > length - offset - 1) { sl@0: /* sl@0: * Double the existing size of the object or make enough room to sl@0: * hold all the characters we may get from the source buffer, sl@0: * whichever is larger. sl@0: */ sl@0: sl@0: length = offset * 2; sl@0: if (offset < toRead) { sl@0: length = offset + toRead + 1; sl@0: } sl@0: dst = (char *) Tcl_SetByteArrayLength(objPtr, length); sl@0: } sl@0: dst += offset; sl@0: sl@0: if (statePtr->flags & INPUT_NEED_NL) { sl@0: statePtr->flags &= ~INPUT_NEED_NL; sl@0: if ((srcLen == 0) || (*src != '\n')) { sl@0: *dst = '\r'; sl@0: *offsetPtr += 1; sl@0: return 1; sl@0: } sl@0: *dst++ = '\n'; sl@0: src++; sl@0: srcLen--; sl@0: toRead--; sl@0: } sl@0: sl@0: srcRead = srcLen; sl@0: dstWrote = toRead; sl@0: if (TranslateInputEOL(statePtr, dst, src, &dstWrote, &srcRead) != 0) { sl@0: if (dstWrote == 0) { sl@0: return -1; sl@0: } sl@0: } sl@0: bufPtr->nextRemoved += srcRead; sl@0: *offsetPtr += dstWrote; sl@0: return dstWrote; sl@0: } sl@0: sl@0: /* sl@0: *--------------------------------------------------------------------------- sl@0: * sl@0: * ReadChars -- sl@0: * sl@0: * Reads from the channel until the requested number of UTF-8 sl@0: * characters have been seen, EOF is seen, or the channel would sl@0: * block. Raw bytes from the channel are converted to UTF-8 sl@0: * and stored in objPtr. EOL and EOF translation is done. sl@0: * sl@0: * 'charsToRead' can safely be a very large number because sl@0: * space is only allocated to hold data read from the channel sl@0: * as needed. sl@0: * sl@0: * Results: sl@0: * The return value is the number of characters appended to sl@0: * the object, *offsetPtr is filled with the number of bytes that sl@0: * were appended, and *factorPtr is filled with the expansion sl@0: * factor used to guess how many bytes of UTF-8 to allocate to sl@0: * hold N source bytes. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *--------------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static int sl@0: ReadChars(statePtr, objPtr, charsToRead, offsetPtr, factorPtr) sl@0: ChannelState *statePtr; /* State of channel to read. */ sl@0: Tcl_Obj *objPtr; /* Input data is appended to this object. sl@0: * objPtr->length is how much space has been sl@0: * allocated to hold data, not how many bytes sl@0: * of data have been stored in the object. */ sl@0: int charsToRead; /* Maximum number of characters to store, sl@0: * or -1 to get all available characters. sl@0: * Characters are obtained from the first sl@0: * buffer in the queue -- even if this number sl@0: * is larger than the number of characters sl@0: * available in the first buffer, only the sl@0: * characters from the first buffer are sl@0: * returned. */ sl@0: int *offsetPtr; /* On input, contains how many bytes of sl@0: * objPtr have been used to hold data. On sl@0: * output, filled with how many bytes are now sl@0: * being used. */ sl@0: int *factorPtr; /* On input, contains a guess of how many sl@0: * bytes need to be allocated to hold the sl@0: * result of converting N source bytes to sl@0: * UTF-8. On output, contains another guess sl@0: * based on the data seen so far. */ sl@0: { sl@0: int toRead, factor, offset, spaceLeft, length, srcLen, dstNeeded; sl@0: int srcRead, dstWrote, numChars, dstRead; sl@0: ChannelBuffer *bufPtr; sl@0: char *src, *dst; sl@0: Tcl_EncodingState oldState; sl@0: int encEndFlagSuppressed = 0; sl@0: sl@0: factor = *factorPtr; sl@0: offset = *offsetPtr; sl@0: sl@0: bufPtr = statePtr->inQueueHead; sl@0: src = bufPtr->buf + bufPtr->nextRemoved; sl@0: srcLen = bufPtr->nextAdded - bufPtr->nextRemoved; sl@0: sl@0: toRead = charsToRead; sl@0: if ((unsigned)toRead > (unsigned)srcLen) { sl@0: toRead = srcLen; sl@0: } sl@0: sl@0: /* sl@0: * 'factor' is how much we guess that the bytes in the source buffer sl@0: * will expand when converted to UTF-8 chars. This guess comes from sl@0: * analyzing how many characters were produced by the previous sl@0: * pass. sl@0: */ sl@0: sl@0: dstNeeded = toRead * factor / UTF_EXPANSION_FACTOR; sl@0: spaceLeft = objPtr->length - offset - TCL_UTF_MAX - 1; sl@0: sl@0: if (dstNeeded > spaceLeft) { sl@0: /* sl@0: * Double the existing size of the object or make enough room to sl@0: * hold all the characters we want from the source buffer, sl@0: * whichever is larger. sl@0: */ sl@0: sl@0: length = offset * 2; sl@0: if (offset < dstNeeded) { sl@0: length = offset + dstNeeded; sl@0: } sl@0: spaceLeft = length - offset; sl@0: length += TCL_UTF_MAX + 1; sl@0: Tcl_SetObjLength(objPtr, length); sl@0: } sl@0: if (toRead == srcLen) { sl@0: /* sl@0: * Want to convert the whole buffer in one pass. If we have sl@0: * enough space, convert it using all available space in object sl@0: * rather than using the factor. sl@0: */ sl@0: sl@0: dstNeeded = spaceLeft; sl@0: } sl@0: dst = objPtr->bytes + offset; sl@0: sl@0: /* sl@0: * SF Tcl Bug 1462248 sl@0: * The cause of the crash reported in the referenced bug is this: sl@0: * sl@0: * - ReadChars, called with a single buffer, with a incomplete sl@0: * multi-byte character at the end (only the first byte of it). sl@0: * - Encoding translation fails, asks for more data sl@0: * - Data is read, and eof is reached, TCL_ENCODING_END (TEE) is set. sl@0: * - ReadChar is called again, converts the first buffer, but due sl@0: * to TEE it does not check for incomplete multi-byte data, and the sl@0: * character just after the end of the first buffer is a valid sl@0: * completion of the multi-byte header in the actual buffer. The sl@0: * conversion reads more characters from the buffer then present. sl@0: * This causes nextRemoved to overshoot nextAdded and the next sl@0: * reads compute a negative srcLen, cause further translations to sl@0: * fail, causing copying of data into the next buffer using bad sl@0: * arguments, causing the mecpy for to eventually fail. sl@0: * sl@0: * In the end it is a memory access bug spiraling out of control sl@0: * if the conditions are _just so_. And ultimate cause is that TEE sl@0: * is given to a conversion where it should not. TEE signals that sl@0: * this is the last buffer. Except in our case it is not. sl@0: * sl@0: * My solution is to suppress TEE if the first buffer is not the sl@0: * last. We will eventually need it given that EOF has been sl@0: * reached, but not right now. This is what the new flag sl@0: * "endEncSuppressFlag" is for. sl@0: * sl@0: * The bug in 'Tcl_Utf2UtfProc' where it read from memory behind sl@0: * the actual buffer has been fixed as well, and fixes the problem sl@0: * with the crash too, but this would still allow the generic sl@0: * layer to accidentially break a multi-byte sequence if the sl@0: * conditions are just right, because again the ExternalToUtf sl@0: * would be successful where it should not. sl@0: */ sl@0: sl@0: if ((statePtr->inputEncodingFlags & TCL_ENCODING_END) && sl@0: (bufPtr->nextPtr != NULL)) { sl@0: sl@0: /* TEE is set for a buffer which is not the last. Squash it sl@0: * for now, and restore it later, before yielding control to sl@0: * our caller. sl@0: */ sl@0: sl@0: statePtr->inputEncodingFlags &= ~TCL_ENCODING_END; sl@0: encEndFlagSuppressed = 1; sl@0: } sl@0: sl@0: oldState = statePtr->inputEncodingState; sl@0: if (statePtr->flags & INPUT_NEED_NL) { sl@0: /* sl@0: * We want a '\n' because the last character we saw was '\r'. sl@0: */ sl@0: sl@0: statePtr->flags &= ~INPUT_NEED_NL; sl@0: Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen, sl@0: statePtr->inputEncodingFlags, &statePtr->inputEncodingState, sl@0: dst, TCL_UTF_MAX + 1, &srcRead, &dstWrote, &numChars); sl@0: if ((dstWrote > 0) && (*dst == '\n')) { sl@0: /* sl@0: * The next char was a '\n'. Consume it and produce a '\n'. sl@0: */ sl@0: sl@0: bufPtr->nextRemoved += srcRead; sl@0: } else { sl@0: /* sl@0: * The next char was not a '\n'. Produce a '\r'. sl@0: */ sl@0: sl@0: *dst = '\r'; sl@0: } sl@0: statePtr->inputEncodingFlags &= ~TCL_ENCODING_START; sl@0: *offsetPtr += 1; sl@0: sl@0: if (encEndFlagSuppressed) { sl@0: statePtr->inputEncodingFlags |= TCL_ENCODING_END; sl@0: } sl@0: return 1; sl@0: } sl@0: sl@0: Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen, sl@0: statePtr->inputEncodingFlags, &statePtr->inputEncodingState, dst, sl@0: dstNeeded + TCL_UTF_MAX, &srcRead, &dstWrote, &numChars); sl@0: sl@0: if (encEndFlagSuppressed) { sl@0: statePtr->inputEncodingFlags |= TCL_ENCODING_END; sl@0: } sl@0: sl@0: if (srcRead == 0) { sl@0: /* sl@0: * Not enough bytes in src buffer to make a complete char. Copy sl@0: * the bytes to the next buffer to make a new contiguous string, sl@0: * then tell the caller to fill the buffer with more bytes. sl@0: */ sl@0: sl@0: ChannelBuffer *nextPtr; sl@0: sl@0: nextPtr = bufPtr->nextPtr; sl@0: if (nextPtr == NULL) { sl@0: if (srcLen > 0) { sl@0: /* sl@0: * There isn't enough data in the buffers to complete the next sl@0: * character, so we need to wait for more data before the next sl@0: * file event can be delivered. sl@0: * sl@0: * SF #478856. sl@0: * sl@0: * The exception to this is if the input buffer was sl@0: * completely empty before we tried to convert its sl@0: * contents. Nothing in, nothing out, and no incomplete sl@0: * character data. The conversion before the current one sl@0: * was complete. sl@0: */ sl@0: sl@0: statePtr->flags |= CHANNEL_NEED_MORE_DATA; sl@0: } sl@0: return -1; sl@0: } sl@0: sl@0: /* Space is made at the beginning of the buffer to copy the sl@0: * previous unused bytes there. Check first if the buffer we sl@0: * are using actually has enough space at its beginning for sl@0: * the data we are copying. Because if not we will write over the sl@0: * buffer management information, especially the 'nextPtr'. sl@0: * sl@0: * Note that the BUFFER_PADDING (See AllocChannelBuffer) is sl@0: * used to prevent exactly this situation. I.e. it should sl@0: * never happen. Therefore it is ok to panic should it happen sl@0: * despite the precautions. sl@0: */ sl@0: sl@0: if (nextPtr->nextRemoved - srcLen < 0) { sl@0: Tcl_Panic ("Buffer Underflow, BUFFER_PADDING not enough"); sl@0: } sl@0: sl@0: nextPtr->nextRemoved -= srcLen; sl@0: memcpy((VOID *) (nextPtr->buf + nextPtr->nextRemoved), (VOID *) src, sl@0: (size_t) srcLen); sl@0: RecycleBuffer(statePtr, bufPtr, 0); sl@0: statePtr->inQueueHead = nextPtr; sl@0: return ReadChars(statePtr, objPtr, charsToRead, offsetPtr, factorPtr); sl@0: } sl@0: sl@0: dstRead = dstWrote; sl@0: if (TranslateInputEOL(statePtr, dst, dst, &dstWrote, &dstRead) != 0) { sl@0: /* sl@0: * Hit EOF char. How many bytes of src correspond to where the sl@0: * EOF was located in dst? Run the conversion again with an sl@0: * output buffer just big enough to hold the data so we can sl@0: * get the correct value for srcRead. sl@0: */ sl@0: sl@0: if (dstWrote == 0) { sl@0: return -1; sl@0: } sl@0: statePtr->inputEncodingState = oldState; sl@0: Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen, sl@0: statePtr->inputEncodingFlags, &statePtr->inputEncodingState, sl@0: dst, dstRead + TCL_UTF_MAX, &srcRead, &dstWrote, &numChars); sl@0: TranslateInputEOL(statePtr, dst, dst, &dstWrote, &dstRead); sl@0: } sl@0: sl@0: /* sl@0: * The number of characters that we got may be less than the number sl@0: * that we started with because "\r\n" sequences may have been sl@0: * turned into just '\n' in dst. sl@0: */ sl@0: sl@0: numChars -= (dstRead - dstWrote); sl@0: sl@0: if ((unsigned) numChars > (unsigned) toRead) { sl@0: /* sl@0: * Got too many chars. sl@0: */ sl@0: sl@0: CONST char *eof; sl@0: sl@0: eof = Tcl_UtfAtIndex(dst, toRead); sl@0: statePtr->inputEncodingState = oldState; sl@0: Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen, sl@0: statePtr->inputEncodingFlags, &statePtr->inputEncodingState, sl@0: dst, eof - dst + TCL_UTF_MAX, &srcRead, &dstWrote, &numChars); sl@0: dstRead = dstWrote; sl@0: TranslateInputEOL(statePtr, dst, dst, &dstWrote, &dstRead); sl@0: numChars -= (dstRead - dstWrote); sl@0: } sl@0: statePtr->inputEncodingFlags &= ~TCL_ENCODING_START; sl@0: sl@0: bufPtr->nextRemoved += srcRead; sl@0: if (dstWrote > srcRead + 1) { sl@0: *factorPtr = dstWrote * UTF_EXPANSION_FACTOR / srcRead; sl@0: } sl@0: *offsetPtr += dstWrote; sl@0: return numChars; sl@0: } sl@0: sl@0: /* sl@0: *--------------------------------------------------------------------------- sl@0: * sl@0: * TranslateInputEOL -- sl@0: * sl@0: * Perform input EOL and EOF translation on the source buffer, sl@0: * leaving the translated result in the destination buffer. sl@0: * sl@0: * Results: sl@0: * The return value is 1 if the EOF character was found when copying sl@0: * bytes to the destination buffer, 0 otherwise. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *--------------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static int sl@0: TranslateInputEOL(statePtr, dstStart, srcStart, dstLenPtr, srcLenPtr) sl@0: ChannelState *statePtr; /* Channel being read, for EOL translation sl@0: * and EOF character. */ sl@0: char *dstStart; /* Output buffer filled with chars by sl@0: * applying appropriate EOL translation to sl@0: * source characters. */ sl@0: CONST char *srcStart; /* Source characters. */ sl@0: int *dstLenPtr; /* On entry, the maximum length of output sl@0: * buffer in bytes; must be <= *srcLenPtr. On sl@0: * exit, the number of bytes actually used in sl@0: * output buffer. */ sl@0: int *srcLenPtr; /* On entry, the length of source buffer. sl@0: * On exit, the number of bytes read from sl@0: * the source buffer. */ sl@0: { sl@0: int dstLen, srcLen, inEofChar; sl@0: CONST char *eof; sl@0: sl@0: dstLen = *dstLenPtr; sl@0: sl@0: eof = NULL; sl@0: inEofChar = statePtr->inEofChar; sl@0: if (inEofChar != '\0') { sl@0: /* sl@0: * Find EOF in translated buffer then compress out the EOL. The sl@0: * source buffer may be much longer than the destination buffer -- sl@0: * we only want to return EOF if the EOF has been copied to the sl@0: * destination buffer. sl@0: */ sl@0: sl@0: CONST char *src, *srcMax; sl@0: sl@0: srcMax = srcStart + *srcLenPtr; sl@0: for (src = srcStart; src < srcMax; src++) { sl@0: if (*src == inEofChar) { sl@0: eof = src; sl@0: srcLen = src - srcStart; sl@0: if (srcLen < dstLen) { sl@0: dstLen = srcLen; sl@0: } sl@0: *srcLenPtr = srcLen; sl@0: break; sl@0: } sl@0: } sl@0: } sl@0: switch (statePtr->inputTranslation) { sl@0: case TCL_TRANSLATE_LF: { sl@0: if (dstStart != srcStart) { sl@0: memcpy((VOID *) dstStart, (VOID *) srcStart, (size_t) dstLen); sl@0: } sl@0: srcLen = dstLen; sl@0: break; sl@0: } sl@0: case TCL_TRANSLATE_CR: { sl@0: char *dst, *dstEnd; sl@0: sl@0: if (dstStart != srcStart) { sl@0: memcpy((VOID *) dstStart, (VOID *) srcStart, (size_t) dstLen); sl@0: } sl@0: dstEnd = dstStart + dstLen; sl@0: for (dst = dstStart; dst < dstEnd; dst++) { sl@0: if (*dst == '\r') { sl@0: *dst = '\n'; sl@0: } sl@0: } sl@0: srcLen = dstLen; sl@0: break; sl@0: } sl@0: case TCL_TRANSLATE_CRLF: { sl@0: char *dst; sl@0: CONST char *src, *srcEnd, *srcMax; sl@0: sl@0: dst = dstStart; sl@0: src = srcStart; sl@0: srcEnd = srcStart + dstLen; sl@0: srcMax = srcStart + *srcLenPtr; sl@0: sl@0: for ( ; src < srcEnd; ) { sl@0: if (*src == '\r') { sl@0: src++; sl@0: if (src >= srcMax) { sl@0: statePtr->flags |= INPUT_NEED_NL; sl@0: } else if (*src == '\n') { sl@0: *dst++ = *src++; sl@0: } else { sl@0: *dst++ = '\r'; sl@0: } sl@0: } else { sl@0: *dst++ = *src++; sl@0: } sl@0: } sl@0: srcLen = src - srcStart; sl@0: dstLen = dst - dstStart; sl@0: break; sl@0: } sl@0: case TCL_TRANSLATE_AUTO: { sl@0: char *dst; sl@0: CONST char *src, *srcEnd, *srcMax; sl@0: sl@0: dst = dstStart; sl@0: src = srcStart; sl@0: srcEnd = srcStart + dstLen; sl@0: srcMax = srcStart + *srcLenPtr; sl@0: sl@0: if ((statePtr->flags & INPUT_SAW_CR) && (src < srcMax)) { sl@0: if (*src == '\n') { sl@0: src++; sl@0: } sl@0: statePtr->flags &= ~INPUT_SAW_CR; sl@0: } sl@0: for ( ; src < srcEnd; ) { sl@0: if (*src == '\r') { sl@0: src++; sl@0: if (src >= srcMax) { sl@0: statePtr->flags |= INPUT_SAW_CR; sl@0: } else if (*src == '\n') { sl@0: if (srcEnd < srcMax) { sl@0: srcEnd++; sl@0: } sl@0: src++; sl@0: } sl@0: *dst++ = '\n'; sl@0: } else { sl@0: *dst++ = *src++; sl@0: } sl@0: } sl@0: srcLen = src - srcStart; sl@0: dstLen = dst - dstStart; sl@0: break; sl@0: } sl@0: default: { /* lint. */ sl@0: return 0; sl@0: } sl@0: } sl@0: *dstLenPtr = dstLen; sl@0: sl@0: if ((eof != NULL) && (srcStart + srcLen >= eof)) { sl@0: /* sl@0: * EOF character was seen in EOL translated range. Leave current sl@0: * file position pointing at the EOF character, but don't store the sl@0: * EOF character in the output string. sl@0: */ sl@0: sl@0: statePtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF); sl@0: statePtr->inputEncodingFlags |= TCL_ENCODING_END; sl@0: statePtr->flags &= ~(INPUT_SAW_CR | INPUT_NEED_NL); sl@0: return 1; sl@0: } sl@0: sl@0: *srcLenPtr = srcLen; sl@0: return 0; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_Ungets -- sl@0: * sl@0: * Causes the supplied string to be added to the input queue of sl@0: * the channel, at either the head or tail of the queue. sl@0: * sl@0: * Results: sl@0: * The number of bytes stored in the channel, or -1 on error. sl@0: * sl@0: * Side effects: sl@0: * Adds input to the input queue of a channel. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C int sl@0: Tcl_Ungets(chan, str, len, atEnd) sl@0: Tcl_Channel chan; /* The channel for which to add the input. */ sl@0: CONST char *str; /* The input itself. */ sl@0: int len; /* The length of the input. */ sl@0: int atEnd; /* If non-zero, add at end of queue; otherwise sl@0: * add at head of queue. */ sl@0: { sl@0: Channel *chanPtr; /* The real IO channel. */ sl@0: ChannelState *statePtr; /* State of actual channel. */ sl@0: ChannelBuffer *bufPtr; /* Buffer to contain the data. */ sl@0: int i, flags; sl@0: sl@0: chanPtr = (Channel *) chan; sl@0: statePtr = chanPtr->state; sl@0: sl@0: /* sl@0: * This operation should occur at the top of a channel stack. sl@0: */ sl@0: sl@0: chanPtr = statePtr->topChanPtr; sl@0: sl@0: /* sl@0: * CheckChannelErrors clears too many flag bits in this one case. sl@0: */ sl@0: sl@0: flags = statePtr->flags; sl@0: if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) { sl@0: len = -1; sl@0: goto done; sl@0: } sl@0: statePtr->flags = flags; sl@0: sl@0: /* sl@0: * If we have encountered a sticky EOF, just punt without storing. sl@0: * (sticky EOF is set if we have seen the input eofChar, to prevent sl@0: * reading beyond the eofChar). Otherwise, clear the EOF flags, and sl@0: * clear the BLOCKED bit. We want to discover these conditions anew sl@0: * in each operation. sl@0: */ sl@0: sl@0: if (statePtr->flags & CHANNEL_STICKY_EOF) { sl@0: goto done; sl@0: } sl@0: statePtr->flags &= (~(CHANNEL_BLOCKED | CHANNEL_EOF)); sl@0: sl@0: bufPtr = AllocChannelBuffer(len); sl@0: for (i = 0; i < len; i++) { sl@0: bufPtr->buf[bufPtr->nextAdded++] = str[i]; sl@0: } sl@0: sl@0: if (statePtr->inQueueHead == (ChannelBuffer *) NULL) { sl@0: bufPtr->nextPtr = (ChannelBuffer *) NULL; sl@0: statePtr->inQueueHead = bufPtr; sl@0: statePtr->inQueueTail = bufPtr; sl@0: } else if (atEnd) { sl@0: bufPtr->nextPtr = (ChannelBuffer *) NULL; sl@0: statePtr->inQueueTail->nextPtr = bufPtr; sl@0: statePtr->inQueueTail = bufPtr; sl@0: } else { sl@0: bufPtr->nextPtr = statePtr->inQueueHead; sl@0: statePtr->inQueueHead = bufPtr; sl@0: } sl@0: sl@0: done: sl@0: /* sl@0: * Update the notifier state so we don't block while there is still sl@0: * data in the buffers. sl@0: */ sl@0: sl@0: UpdateInterest(chanPtr); sl@0: return len; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_Flush -- sl@0: * sl@0: * Flushes output data on a channel. sl@0: * sl@0: * Results: sl@0: * A standard Tcl result. sl@0: * sl@0: * Side effects: sl@0: * May flush output queued on this channel. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C int sl@0: Tcl_Flush(chan) sl@0: Tcl_Channel chan; /* The Channel to flush. */ sl@0: { sl@0: int result; /* Of calling FlushChannel. */ sl@0: Channel *chanPtr = (Channel *) chan; /* The actual channel. */ sl@0: ChannelState *statePtr = chanPtr->state; /* State of actual channel. */ sl@0: sl@0: /* sl@0: * This operation should occur at the top of a channel stack. sl@0: */ sl@0: sl@0: chanPtr = statePtr->topChanPtr; sl@0: sl@0: if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) { sl@0: return -1; sl@0: } sl@0: sl@0: /* sl@0: * Force current output buffer to be output also. sl@0: */ sl@0: sl@0: if ((statePtr->curOutPtr != NULL) sl@0: && (statePtr->curOutPtr->nextAdded > 0)) { sl@0: statePtr->flags |= BUFFER_READY; sl@0: } sl@0: sl@0: result = FlushChannel(NULL, chanPtr, 0); sl@0: if (result != 0) { sl@0: return TCL_ERROR; sl@0: } sl@0: sl@0: return TCL_OK; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * DiscardInputQueued -- sl@0: * sl@0: * Discards any input read from the channel but not yet consumed sl@0: * by Tcl reading commands. sl@0: * sl@0: * Results: sl@0: * None. sl@0: * sl@0: * Side effects: sl@0: * May discard input from the channel. If discardLastBuffer is zero, sl@0: * leaves one buffer in place for back-filling. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static void sl@0: DiscardInputQueued(statePtr, discardSavedBuffers) sl@0: ChannelState *statePtr; /* Channel on which to discard sl@0: * the queued input. */ sl@0: int discardSavedBuffers; /* If non-zero, discard all buffers including sl@0: * last one. */ sl@0: { sl@0: ChannelBuffer *bufPtr, *nxtPtr; /* Loop variables. */ sl@0: sl@0: bufPtr = statePtr->inQueueHead; sl@0: statePtr->inQueueHead = (ChannelBuffer *) NULL; sl@0: statePtr->inQueueTail = (ChannelBuffer *) NULL; sl@0: for (; bufPtr != (ChannelBuffer *) NULL; bufPtr = nxtPtr) { sl@0: nxtPtr = bufPtr->nextPtr; sl@0: RecycleBuffer(statePtr, bufPtr, discardSavedBuffers); sl@0: } sl@0: sl@0: /* sl@0: * If discardSavedBuffers is nonzero, must also discard any previously sl@0: * saved buffer in the saveInBufPtr field. sl@0: */ sl@0: sl@0: if (discardSavedBuffers) { sl@0: if (statePtr->saveInBufPtr != (ChannelBuffer *) NULL) { sl@0: ckfree((char *) statePtr->saveInBufPtr); sl@0: statePtr->saveInBufPtr = (ChannelBuffer *) NULL; sl@0: } sl@0: } sl@0: } sl@0: sl@0: /* sl@0: *--------------------------------------------------------------------------- sl@0: * sl@0: * GetInput -- sl@0: * sl@0: * Reads input data from a device into a channel buffer. sl@0: * sl@0: * Results: sl@0: * The return value is the Posix error code if an error occurred while sl@0: * reading from the file, or 0 otherwise. sl@0: * sl@0: * Side effects: sl@0: * Reads from the underlying device. sl@0: * sl@0: *--------------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static int sl@0: GetInput(chanPtr) sl@0: Channel *chanPtr; /* Channel to read input from. */ sl@0: { sl@0: int toRead; /* How much to read? */ sl@0: int result; /* Of calling driver. */ sl@0: int nread; /* How much was read from channel? */ sl@0: ChannelBuffer *bufPtr; /* New buffer to add to input queue. */ sl@0: ChannelState *statePtr = chanPtr->state; /* state info for channel */ sl@0: sl@0: /* sl@0: * Prevent reading from a dead channel -- a channel that has been closed sl@0: * but not yet deallocated, which can happen if the exit handler for sl@0: * channel cleanup has run but the channel is still registered in some sl@0: * interpreter. sl@0: */ sl@0: sl@0: if (CheckForDeadChannel(NULL, statePtr)) { sl@0: return EINVAL; sl@0: } sl@0: sl@0: /* sl@0: * First check for more buffers in the pushback area of the sl@0: * topmost channel in the stack and use them. They can be the sl@0: * result of a transformation which went away without reading all sl@0: * the information placed in the area when it was stacked. sl@0: * sl@0: * Two possibilities for the state: No buffers in it, or a single sl@0: * empty buffer. In the latter case we can recycle it now. sl@0: */ sl@0: sl@0: if (chanPtr->inQueueHead != (ChannelBuffer*) NULL) { sl@0: if (statePtr->inQueueHead != (ChannelBuffer*) NULL) { sl@0: RecycleBuffer(statePtr, statePtr->inQueueHead, 0); sl@0: statePtr->inQueueHead = (ChannelBuffer*) NULL; sl@0: } sl@0: sl@0: statePtr->inQueueHead = chanPtr->inQueueHead; sl@0: statePtr->inQueueTail = chanPtr->inQueueTail; sl@0: chanPtr->inQueueHead = (ChannelBuffer*) NULL; sl@0: chanPtr->inQueueTail = (ChannelBuffer*) NULL; sl@0: return 0; sl@0: } sl@0: sl@0: /* sl@0: * Nothing in the pushback area, fall back to the usual handling sl@0: * (driver, etc.) sl@0: */ sl@0: sl@0: /* sl@0: * See if we can fill an existing buffer. If we can, read only sl@0: * as much as will fit in it. Otherwise allocate a new buffer, sl@0: * add it to the input queue and attempt to fill it to the max. sl@0: */ sl@0: sl@0: bufPtr = statePtr->inQueueTail; sl@0: if ((bufPtr != NULL) && (bufPtr->nextAdded < bufPtr->bufLength)) { sl@0: toRead = bufPtr->bufLength - bufPtr->nextAdded; sl@0: } else { sl@0: bufPtr = statePtr->saveInBufPtr; sl@0: statePtr->saveInBufPtr = NULL; sl@0: sl@0: /* sl@0: * Check the actual buffersize against the requested sl@0: * buffersize. Buffers which are smaller than requested are sl@0: * squashed. This is done to honor dynamic changes of the sl@0: * buffersize made by the user. sl@0: */ sl@0: sl@0: if ((bufPtr != NULL) && ((bufPtr->bufLength - BUFFER_PADDING) < statePtr->bufSize)) { sl@0: ckfree((char *) bufPtr); sl@0: bufPtr = NULL; sl@0: } sl@0: sl@0: if (bufPtr == NULL) { sl@0: bufPtr = AllocChannelBuffer(statePtr->bufSize); sl@0: } sl@0: bufPtr->nextPtr = (ChannelBuffer *) NULL; sl@0: sl@0: /* SF #427196: Use the actual size of the buffer to determine sl@0: * the number of bytes to read from the channel and not the sl@0: * size for new buffers. They can be different if the sl@0: * buffersize was changed between reads. sl@0: * sl@0: * Note: This affects performance negatively if the buffersize sl@0: * was extended but this small buffer is reused for all sl@0: * subsequent reads. The system never uses buffers with the sl@0: * requested bigger size in that case. An adjunct patch could sl@0: * try and delete all unused buffers it encounters and which sl@0: * are smaller than the formally requested buffersize. sl@0: */ sl@0: sl@0: toRead = bufPtr->bufLength - bufPtr->nextAdded; sl@0: sl@0: if (statePtr->inQueueTail == NULL) { sl@0: statePtr->inQueueHead = bufPtr; sl@0: } else { sl@0: statePtr->inQueueTail->nextPtr = bufPtr; sl@0: } sl@0: statePtr->inQueueTail = bufPtr; sl@0: } sl@0: sl@0: /* sl@0: * If EOF is set, we should avoid calling the driver because on some sl@0: * platforms it is impossible to read from a device after EOF. sl@0: */ sl@0: sl@0: if (statePtr->flags & CHANNEL_EOF) { sl@0: return 0; sl@0: } sl@0: sl@0: #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING sl@0: /* [SF Tcl Bug 943274]. Better emulation of non-blocking channels sl@0: * for channels without BlockModeProc, by keeping track of true sl@0: * fileevents generated by the OS == Data waiting and reading if sl@0: * and only if we are sure to have data. sl@0: */ sl@0: sl@0: if ((statePtr->flags & CHANNEL_NONBLOCKING) && sl@0: (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) && sl@0: !(statePtr->flags & CHANNEL_HAS_MORE_DATA)) { sl@0: sl@0: /* Bypass the driver, it would block, as no data is available */ sl@0: nread = -1; sl@0: result = EWOULDBLOCK; sl@0: } else { sl@0: #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */ sl@0: sl@0: nread = (chanPtr->typePtr->inputProc)(chanPtr->instanceData, sl@0: bufPtr->buf + bufPtr->nextAdded, toRead, &result); sl@0: sl@0: #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING sl@0: } sl@0: #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */ sl@0: sl@0: if (nread > 0) { sl@0: bufPtr->nextAdded += nread; sl@0: sl@0: /* sl@0: * If we get a short read, signal up that we may be BLOCKED. We sl@0: * should avoid calling the driver because on some platforms we sl@0: * will block in the low level reading code even though the sl@0: * channel is set into nonblocking mode. sl@0: */ sl@0: sl@0: if (nread < toRead) { sl@0: statePtr->flags |= CHANNEL_BLOCKED; sl@0: } sl@0: sl@0: #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING sl@0: if (nread <= toRead) { sl@0: /* [SF Tcl Bug 943274] We have read the available data, sl@0: * clear flag */ sl@0: statePtr->flags &= ~CHANNEL_HAS_MORE_DATA; sl@0: } sl@0: #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */ sl@0: sl@0: } else if (nread == 0) { sl@0: statePtr->flags |= CHANNEL_EOF; sl@0: statePtr->inputEncodingFlags |= TCL_ENCODING_END; sl@0: } else if (nread < 0) { sl@0: if ((result == EWOULDBLOCK) || (result == EAGAIN)) { sl@0: statePtr->flags |= CHANNEL_BLOCKED; sl@0: result = EAGAIN; sl@0: } sl@0: Tcl_SetErrno(result); sl@0: return result; sl@0: } sl@0: return 0; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_Seek -- sl@0: * sl@0: * Implements seeking on Tcl Channels. This is a public function sl@0: * so that other C facilities may be implemented on top of it. sl@0: * sl@0: * Results: sl@0: * The new access point or -1 on error. If error, use Tcl_GetErrno() sl@0: * to retrieve the POSIX error code for the error that occurred. sl@0: * sl@0: * Side effects: sl@0: * May flush output on the channel. May discard queued input. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C Tcl_WideInt sl@0: Tcl_Seek(chan, offset, mode) sl@0: Tcl_Channel chan; /* The channel on which to seek. */ sl@0: Tcl_WideInt offset; /* Offset to seek to. */ sl@0: int mode; /* Relative to which location to seek? */ sl@0: { sl@0: Channel *chanPtr = (Channel *) chan; /* The real IO channel. */ sl@0: ChannelState *statePtr = chanPtr->state; /* state info for channel */ sl@0: int inputBuffered, outputBuffered; sl@0: /* # bytes held in buffers. */ sl@0: int result; /* Of device driver operations. */ sl@0: Tcl_WideInt curPos; /* Position on the device. */ sl@0: int wasAsync; /* Was the channel nonblocking before the sl@0: * seek operation? If so, must restore to sl@0: * nonblocking mode after the seek. */ sl@0: sl@0: if (CheckChannelErrors(statePtr, TCL_WRITABLE | TCL_READABLE) != 0) { sl@0: return Tcl_LongAsWide(-1); sl@0: } sl@0: sl@0: /* sl@0: * Disallow seek on dead channels -- channels that have been closed but sl@0: * not yet been deallocated. Such channels can be found if the exit sl@0: * handler for channel cleanup has run but the channel is still sl@0: * registered in an interpreter. sl@0: */ sl@0: sl@0: if (CheckForDeadChannel(NULL, statePtr)) { sl@0: return Tcl_LongAsWide(-1); sl@0: } sl@0: sl@0: /* sl@0: * This operation should occur at the top of a channel stack. sl@0: */ sl@0: sl@0: chanPtr = statePtr->topChanPtr; sl@0: sl@0: /* sl@0: * Disallow seek on channels whose type does not have a seek procedure sl@0: * defined. This means that the channel does not support seeking. sl@0: */ sl@0: sl@0: if (chanPtr->typePtr->seekProc == (Tcl_DriverSeekProc *) NULL) { sl@0: Tcl_SetErrno(EINVAL); sl@0: return Tcl_LongAsWide(-1); sl@0: } sl@0: sl@0: /* sl@0: * Compute how much input and output is buffered. If both input and sl@0: * output is buffered, cannot compute the current position. sl@0: */ sl@0: sl@0: inputBuffered = Tcl_InputBuffered(chan); sl@0: outputBuffered = Tcl_OutputBuffered(chan); sl@0: sl@0: if ((inputBuffered != 0) && (outputBuffered != 0)) { sl@0: Tcl_SetErrno(EFAULT); sl@0: return Tcl_LongAsWide(-1); sl@0: } sl@0: sl@0: /* sl@0: * If we are seeking relative to the current position, compute the sl@0: * corrected offset taking into account the amount of unread input. sl@0: */ sl@0: sl@0: if (mode == SEEK_CUR) { sl@0: offset -= inputBuffered; sl@0: } sl@0: sl@0: /* sl@0: * Discard any queued input - this input should not be read after sl@0: * the seek. sl@0: */ sl@0: sl@0: DiscardInputQueued(statePtr, 0); sl@0: sl@0: /* sl@0: * Reset EOF and BLOCKED flags. We invalidate them by moving the sl@0: * access point. Also clear CR related flags. sl@0: */ sl@0: sl@0: statePtr->flags &= sl@0: (~(CHANNEL_EOF | CHANNEL_STICKY_EOF | CHANNEL_BLOCKED | INPUT_SAW_CR)); sl@0: sl@0: /* sl@0: * If the channel is in asynchronous output mode, switch it back sl@0: * to synchronous mode and cancel any async flush that may be sl@0: * scheduled. After the flush, the channel will be put back into sl@0: * asynchronous output mode. sl@0: */ sl@0: sl@0: wasAsync = 0; sl@0: if (statePtr->flags & CHANNEL_NONBLOCKING) { sl@0: wasAsync = 1; sl@0: result = StackSetBlockMode(chanPtr, TCL_MODE_BLOCKING); sl@0: if (result != 0) { sl@0: return Tcl_LongAsWide(-1); sl@0: } sl@0: statePtr->flags &= (~(CHANNEL_NONBLOCKING)); sl@0: if (statePtr->flags & BG_FLUSH_SCHEDULED) { sl@0: statePtr->flags &= (~(BG_FLUSH_SCHEDULED)); sl@0: } sl@0: } sl@0: sl@0: /* sl@0: * If the flush fails we cannot recover the original position. In sl@0: * that case the seek is not attempted because we do not know where sl@0: * the access position is - instead we return the error. FlushChannel sl@0: * has already called Tcl_SetErrno() to report the error upwards. sl@0: * If the flush succeeds we do the seek also. sl@0: */ sl@0: sl@0: if (FlushChannel(NULL, chanPtr, 0) != 0) { sl@0: curPos = -1; sl@0: } else { sl@0: sl@0: /* sl@0: * Now seek to the new position in the channel as requested by the sl@0: * caller. Note that we prefer the wideSeekProc if that is sl@0: * available and non-NULL... sl@0: */ sl@0: sl@0: if (HaveVersion(chanPtr->typePtr, TCL_CHANNEL_VERSION_3) && sl@0: chanPtr->typePtr->wideSeekProc != NULL) { sl@0: curPos = (chanPtr->typePtr->wideSeekProc) (chanPtr->instanceData, sl@0: offset, mode, &result); sl@0: } else if (offset < Tcl_LongAsWide(LONG_MIN) || sl@0: offset > Tcl_LongAsWide(LONG_MAX)) { sl@0: result = EOVERFLOW; sl@0: curPos = Tcl_LongAsWide(-1); sl@0: } else { sl@0: curPos = Tcl_LongAsWide((chanPtr->typePtr->seekProc) ( sl@0: chanPtr->instanceData, Tcl_WideAsLong(offset), mode, sl@0: &result)); sl@0: } sl@0: if (curPos == Tcl_LongAsWide(-1)) { sl@0: Tcl_SetErrno(result); sl@0: } sl@0: } sl@0: sl@0: /* sl@0: * Restore to nonblocking mode if that was the previous behavior. sl@0: * sl@0: * NOTE: Even if there was an async flush active we do not restore sl@0: * it now because we already flushed all the queued output, above. sl@0: */ sl@0: sl@0: if (wasAsync) { sl@0: statePtr->flags |= CHANNEL_NONBLOCKING; sl@0: result = StackSetBlockMode(chanPtr, TCL_MODE_NONBLOCKING); sl@0: if (result != 0) { sl@0: return Tcl_LongAsWide(-1); sl@0: } sl@0: } sl@0: sl@0: return curPos; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_Tell -- sl@0: * sl@0: * Returns the position of the next character to be read/written on sl@0: * this channel. sl@0: * sl@0: * Results: sl@0: * A nonnegative integer on success, -1 on failure. If failed, sl@0: * use Tcl_GetErrno() to retrieve the POSIX error code for the sl@0: * error that occurred. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C Tcl_WideInt sl@0: Tcl_Tell(chan) sl@0: Tcl_Channel chan; /* The channel to return pos for. */ sl@0: { sl@0: Channel *chanPtr = (Channel *) chan; /* The real IO channel. */ sl@0: ChannelState *statePtr = chanPtr->state; /* state info for channel */ sl@0: int inputBuffered, outputBuffered; /* # bytes held in buffers. */ sl@0: int result; /* Of calling device driver. */ sl@0: Tcl_WideInt curPos; /* Position on device. */ sl@0: sl@0: if (CheckChannelErrors(statePtr, TCL_WRITABLE | TCL_READABLE) != 0) { sl@0: return Tcl_LongAsWide(-1); sl@0: } sl@0: sl@0: /* sl@0: * Disallow tell on dead channels -- channels that have been closed but sl@0: * not yet been deallocated. Such channels can be found if the exit sl@0: * handler for channel cleanup has run but the channel is still sl@0: * registered in an interpreter. sl@0: */ sl@0: sl@0: if (CheckForDeadChannel(NULL, statePtr)) { sl@0: return Tcl_LongAsWide(-1); sl@0: } sl@0: sl@0: /* sl@0: * This operation should occur at the top of a channel stack. sl@0: */ sl@0: sl@0: chanPtr = statePtr->topChanPtr; sl@0: sl@0: /* sl@0: * Disallow tell on channels whose type does not have a seek procedure sl@0: * defined. This means that the channel does not support seeking. sl@0: */ sl@0: sl@0: if (chanPtr->typePtr->seekProc == (Tcl_DriverSeekProc *) NULL) { sl@0: Tcl_SetErrno(EINVAL); sl@0: return Tcl_LongAsWide(-1); sl@0: } sl@0: sl@0: /* sl@0: * Compute how much input and output is buffered. If both input and sl@0: * output is buffered, cannot compute the current position. sl@0: */ sl@0: sl@0: inputBuffered = Tcl_InputBuffered(chan); sl@0: outputBuffered = Tcl_OutputBuffered(chan); sl@0: sl@0: if ((inputBuffered != 0) && (outputBuffered != 0)) { sl@0: Tcl_SetErrno(EFAULT); sl@0: return Tcl_LongAsWide(-1); sl@0: } sl@0: sl@0: /* sl@0: * Get the current position in the device and compute the position sl@0: * where the next character will be read or written. Note that we sl@0: * prefer the wideSeekProc if that is available and non-NULL... sl@0: */ sl@0: sl@0: if (HaveVersion(chanPtr->typePtr, TCL_CHANNEL_VERSION_3) && sl@0: chanPtr->typePtr->wideSeekProc != NULL) { sl@0: curPos = (chanPtr->typePtr->wideSeekProc) (chanPtr->instanceData, sl@0: Tcl_LongAsWide(0), SEEK_CUR, &result); sl@0: } else { sl@0: curPos = Tcl_LongAsWide((chanPtr->typePtr->seekProc) ( sl@0: chanPtr->instanceData, 0, SEEK_CUR, &result)); sl@0: } sl@0: if (curPos == Tcl_LongAsWide(-1)) { sl@0: Tcl_SetErrno(result); sl@0: return Tcl_LongAsWide(-1); sl@0: } sl@0: if (inputBuffered != 0) { sl@0: return curPos - inputBuffered; sl@0: } sl@0: return curPos + outputBuffered; sl@0: } sl@0: sl@0: /* sl@0: *--------------------------------------------------------------------------- sl@0: * sl@0: * Tcl_SeekOld, Tcl_TellOld -- sl@0: * sl@0: * Backward-compatability versions of the seek/tell interface that sl@0: * do not support 64-bit offsets. This interface is not documented sl@0: * or expected to be supported indefinitely. sl@0: * sl@0: * Results: sl@0: * As for Tcl_Seek and Tcl_Tell respectively, except truncated to sl@0: * whatever value will fit in an 'int'. sl@0: * sl@0: * Side effects: sl@0: * As for Tcl_Seek and Tcl_Tell respectively. sl@0: * sl@0: *--------------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C int sl@0: Tcl_SeekOld(chan, offset, mode) sl@0: Tcl_Channel chan; /* The channel on which to seek. */ sl@0: int offset; /* Offset to seek to. */ sl@0: int mode; /* Relative to which location to seek? */ sl@0: { sl@0: Tcl_WideInt wOffset, wResult; sl@0: sl@0: wOffset = Tcl_LongAsWide((long)offset); sl@0: wResult = Tcl_Seek(chan, wOffset, mode); sl@0: return (int)Tcl_WideAsLong(wResult); sl@0: } sl@0: sl@0: EXPORT_C int sl@0: Tcl_TellOld(chan) sl@0: Tcl_Channel chan; /* The channel to return pos for. */ sl@0: { sl@0: Tcl_WideInt wResult; sl@0: sl@0: wResult = Tcl_Tell(chan); sl@0: return (int)Tcl_WideAsLong(wResult); sl@0: } sl@0: sl@0: /* sl@0: *--------------------------------------------------------------------------- sl@0: * sl@0: * CheckChannelErrors -- sl@0: * sl@0: * See if the channel is in an ready state and can perform the sl@0: * desired operation. sl@0: * sl@0: * Results: sl@0: * The return value is 0 if the channel is OK, otherwise the sl@0: * return value is -1 and errno is set to indicate the error. sl@0: * sl@0: * Side effects: sl@0: * May clear the EOF and/or BLOCKED bits if reading from channel. sl@0: * sl@0: *--------------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static int sl@0: CheckChannelErrors(statePtr, flags) sl@0: ChannelState *statePtr; /* Channel to check. */ sl@0: int flags; /* Test if channel supports desired operation: sl@0: * TCL_READABLE, TCL_WRITABLE. Also indicates sl@0: * Raw read or write for special close sl@0: * processing*/ sl@0: { sl@0: int direction = flags & (TCL_READABLE|TCL_WRITABLE); sl@0: sl@0: /* sl@0: * Check for unreported error. sl@0: */ sl@0: sl@0: if (statePtr->unreportedError != 0) { sl@0: Tcl_SetErrno(statePtr->unreportedError); sl@0: statePtr->unreportedError = 0; sl@0: return -1; sl@0: } sl@0: sl@0: /* sl@0: * Only the raw read and write operations are allowed during close sl@0: * in order to drain data from stacked channels. sl@0: */ sl@0: sl@0: if ((statePtr->flags & CHANNEL_CLOSED) && sl@0: ((flags & CHANNEL_RAW_MODE) == 0)) { sl@0: Tcl_SetErrno(EACCES); sl@0: return -1; sl@0: } sl@0: sl@0: /* sl@0: * Fail if the channel is not opened for desired operation. sl@0: */ sl@0: sl@0: if ((statePtr->flags & direction) == 0) { sl@0: Tcl_SetErrno(EACCES); sl@0: return -1; sl@0: } sl@0: sl@0: /* sl@0: * Fail if the channel is in the middle of a background copy. sl@0: * sl@0: * Don't do this tests for raw channels here or else the chaining in the sl@0: * transformation drivers will fail with 'file busy' error instead of sl@0: * retrieving and transforming the data to copy. sl@0: */ sl@0: sl@0: if ((statePtr->csPtr != NULL) && ((flags & CHANNEL_RAW_MODE) == 0)) { sl@0: Tcl_SetErrno(EBUSY); sl@0: return -1; sl@0: } sl@0: sl@0: if (direction == TCL_READABLE) { sl@0: /* sl@0: * If we have not encountered a sticky EOF, clear the EOF bit sl@0: * (sticky EOF is set if we have seen the input eofChar, to prevent sl@0: * reading beyond the eofChar). Also, always clear the BLOCKED bit. sl@0: * We want to discover these conditions anew in each operation. sl@0: */ sl@0: sl@0: if ((statePtr->flags & CHANNEL_STICKY_EOF) == 0) { sl@0: statePtr->flags &= ~CHANNEL_EOF; sl@0: } sl@0: statePtr->flags &= ~(CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA); sl@0: } sl@0: sl@0: return 0; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_Eof -- sl@0: * sl@0: * Returns 1 if the channel is at EOF, 0 otherwise. sl@0: * sl@0: * Results: sl@0: * 1 or 0, always. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C int sl@0: Tcl_Eof(chan) sl@0: Tcl_Channel chan; /* Does this channel have EOF? */ sl@0: { sl@0: ChannelState *statePtr = ((Channel *) chan)->state; sl@0: /* State of real channel structure. */ sl@0: sl@0: return ((statePtr->flags & CHANNEL_STICKY_EOF) || sl@0: ((statePtr->flags & CHANNEL_EOF) && sl@0: (Tcl_InputBuffered(chan) == 0))) ? 1 : 0; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_InputBlocked -- sl@0: * sl@0: * Returns 1 if input is blocked on this channel, 0 otherwise. sl@0: * sl@0: * Results: sl@0: * 0 or 1, always. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C int sl@0: Tcl_InputBlocked(chan) sl@0: Tcl_Channel chan; /* Is this channel blocked? */ sl@0: { sl@0: ChannelState *statePtr = ((Channel *) chan)->state; sl@0: /* State of real channel structure. */ sl@0: sl@0: return (statePtr->flags & CHANNEL_BLOCKED) ? 1 : 0; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_InputBuffered -- sl@0: * sl@0: * Returns the number of bytes of input currently buffered in the sl@0: * common internal buffer of a channel. sl@0: * sl@0: * Results: sl@0: * The number of input bytes buffered, or zero if the channel is not sl@0: * open for reading. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C int sl@0: Tcl_InputBuffered(chan) sl@0: Tcl_Channel chan; /* The channel to query. */ sl@0: { sl@0: ChannelState *statePtr = ((Channel *) chan)->state; sl@0: /* State of real channel structure. */ sl@0: ChannelBuffer *bufPtr; sl@0: int bytesBuffered; sl@0: sl@0: for (bytesBuffered = 0, bufPtr = statePtr->inQueueHead; sl@0: bufPtr != (ChannelBuffer *) NULL; sl@0: bufPtr = bufPtr->nextPtr) { sl@0: bytesBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved); sl@0: } sl@0: sl@0: /* sl@0: * Don't forget the bytes in the topmost pushback area. sl@0: */ sl@0: sl@0: for (bufPtr = statePtr->topChanPtr->inQueueHead; sl@0: bufPtr != (ChannelBuffer *) NULL; sl@0: bufPtr = bufPtr->nextPtr) { sl@0: bytesBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved); sl@0: } sl@0: sl@0: return bytesBuffered; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_OutputBuffered -- sl@0: * sl@0: * Returns the number of bytes of output currently buffered in the sl@0: * common internal buffer of a channel. sl@0: * sl@0: * Results: sl@0: * The number of output bytes buffered, or zero if the channel is not sl@0: * open for writing. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C int sl@0: Tcl_OutputBuffered(chan) sl@0: Tcl_Channel chan; /* The channel to query. */ sl@0: { sl@0: ChannelState *statePtr = ((Channel *) chan)->state; sl@0: /* State of real channel structure. */ sl@0: ChannelBuffer *bufPtr; sl@0: int bytesBuffered; sl@0: sl@0: for (bytesBuffered = 0, bufPtr = statePtr->outQueueHead; sl@0: bufPtr != (ChannelBuffer *) NULL; sl@0: bufPtr = bufPtr->nextPtr) { sl@0: bytesBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved); sl@0: } sl@0: if ((statePtr->curOutPtr != (ChannelBuffer *) NULL) && sl@0: (statePtr->curOutPtr->nextAdded > statePtr->curOutPtr->nextRemoved)) { sl@0: statePtr->flags |= BUFFER_READY; sl@0: bytesBuffered += sl@0: (statePtr->curOutPtr->nextAdded - statePtr->curOutPtr->nextRemoved); sl@0: } sl@0: sl@0: return bytesBuffered; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_ChannelBuffered -- sl@0: * sl@0: * Returns the number of bytes of input currently buffered in the sl@0: * internal buffer (push back area) of a channel. sl@0: * sl@0: * Results: sl@0: * The number of input bytes buffered, or zero if the channel is not sl@0: * open for reading. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C int sl@0: Tcl_ChannelBuffered(chan) sl@0: Tcl_Channel chan; /* The channel to query. */ sl@0: { sl@0: Channel *chanPtr = (Channel *) chan; sl@0: /* real channel structure. */ sl@0: ChannelBuffer *bufPtr; sl@0: int bytesBuffered; sl@0: sl@0: for (bytesBuffered = 0, bufPtr = chanPtr->inQueueHead; sl@0: bufPtr != (ChannelBuffer *) NULL; sl@0: bufPtr = bufPtr->nextPtr) { sl@0: bytesBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved); sl@0: } sl@0: sl@0: return bytesBuffered; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_SetChannelBufferSize -- sl@0: * sl@0: * Sets the size of buffers to allocate to store input or output sl@0: * in the channel. The size must be between 1 byte and 1 MByte. sl@0: * sl@0: * Results: sl@0: * None. sl@0: * sl@0: * Side effects: sl@0: * Sets the size of buffers subsequently allocated for this channel. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C void sl@0: Tcl_SetChannelBufferSize(chan, sz) sl@0: Tcl_Channel chan; /* The channel whose buffer size sl@0: * to set. */ sl@0: int sz; /* The size to set. */ sl@0: { sl@0: ChannelState *statePtr; /* State of real channel structure. */ sl@0: sl@0: /* sl@0: * If the buffer size is smaller than 1 byte or larger than one MByte, sl@0: * do not accept the requested size and leave the current buffer size. sl@0: */ sl@0: sl@0: if (sz < 1) { sl@0: return; sl@0: } sl@0: if (sz > (1024 * 1024)) { sl@0: return; sl@0: } sl@0: sl@0: statePtr = ((Channel *) chan)->state; sl@0: statePtr->bufSize = sz; sl@0: sl@0: if (statePtr->outputStage != NULL) { sl@0: ckfree((char *) statePtr->outputStage); sl@0: statePtr->outputStage = NULL; sl@0: } sl@0: if ((statePtr->encoding != NULL) && (statePtr->flags & TCL_WRITABLE)) { sl@0: statePtr->outputStage = (char *) sl@0: ckalloc((unsigned) (statePtr->bufSize + 2)); sl@0: } sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_GetChannelBufferSize -- sl@0: * sl@0: * Retrieves the size of buffers to allocate for this channel. sl@0: * sl@0: * Results: sl@0: * The size. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C int sl@0: Tcl_GetChannelBufferSize(chan) sl@0: Tcl_Channel chan; /* The channel for which to find the sl@0: * buffer size. */ sl@0: { sl@0: ChannelState *statePtr = ((Channel *) chan)->state; sl@0: /* State of real channel structure. */ sl@0: sl@0: return statePtr->bufSize; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_BadChannelOption -- sl@0: * sl@0: * This procedure generates a "bad option" error message in an sl@0: * (optional) interpreter. It is used by channel drivers when sl@0: * a invalid Set/Get option is requested. Its purpose is to concatenate sl@0: * the generic options list to the specific ones and factorize sl@0: * the generic options error message string. sl@0: * sl@0: * Results: sl@0: * TCL_ERROR. sl@0: * sl@0: * Side effects: sl@0: * An error message is generated in interp's result object to sl@0: * indicate that a command was invoked with the a bad option sl@0: * The message has the form sl@0: * bad option "blah": should be one of sl@0: * <...generic options...>+<...specific options...> sl@0: * "blah" is the optionName argument and "" sl@0: * is a space separated list of specific option words. sl@0: * The function takes good care of inserting minus signs before sl@0: * each option, commas after, and an "or" before the last option. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C int sl@0: Tcl_BadChannelOption(interp, optionName, optionList) sl@0: Tcl_Interp *interp; /* Current interpreter. (can be NULL)*/ sl@0: CONST char *optionName; /* 'bad option' name */ sl@0: CONST char *optionList; /* Specific options list to append sl@0: * to the standard generic options. sl@0: * can be NULL for generic options sl@0: * only. sl@0: */ sl@0: { sl@0: if (interp) { sl@0: CONST char *genericopt = sl@0: "blocking buffering buffersize encoding eofchar translation"; sl@0: CONST char **argv; sl@0: int argc, i; sl@0: Tcl_DString ds; sl@0: sl@0: Tcl_DStringInit(&ds); sl@0: Tcl_DStringAppend(&ds, genericopt, -1); sl@0: if (optionList && (*optionList)) { sl@0: Tcl_DStringAppend(&ds, " ", 1); sl@0: Tcl_DStringAppend(&ds, optionList, -1); sl@0: } sl@0: if (Tcl_SplitList(interp, Tcl_DStringValue(&ds), sl@0: &argc, &argv) != TCL_OK) { sl@0: panic("malformed option list in channel driver"); sl@0: } sl@0: Tcl_ResetResult(interp); sl@0: Tcl_AppendResult(interp, "bad option \"", optionName, sl@0: "\": should be one of ", (char *) NULL); sl@0: argc--; sl@0: for (i = 0; i < argc; i++) { sl@0: Tcl_AppendResult(interp, "-", argv[i], ", ", (char *) NULL); sl@0: } sl@0: Tcl_AppendResult(interp, "or -", argv[i], (char *) NULL); sl@0: Tcl_DStringFree(&ds); sl@0: ckfree((char *) argv); sl@0: } sl@0: Tcl_SetErrno(EINVAL); sl@0: return TCL_ERROR; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_GetChannelOption -- sl@0: * sl@0: * Gets a mode associated with an IO channel. If the optionName arg sl@0: * is non NULL, retrieves the value of that option. If the optionName sl@0: * arg is NULL, retrieves a list of alternating option names and sl@0: * values for the given channel. sl@0: * sl@0: * Results: sl@0: * A standard Tcl result. Also sets the supplied DString to the sl@0: * string value of the option(s) returned. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C int sl@0: Tcl_GetChannelOption(interp, chan, optionName, dsPtr) sl@0: Tcl_Interp *interp; /* For error reporting - can be NULL. */ sl@0: Tcl_Channel chan; /* Channel on which to get option. */ sl@0: CONST char *optionName; /* Option to get. */ sl@0: Tcl_DString *dsPtr; /* Where to store value(s). */ sl@0: { sl@0: size_t len; /* Length of optionName string. */ sl@0: char optionVal[128]; /* Buffer for sprintf. */ sl@0: Channel *chanPtr = (Channel *) chan; sl@0: ChannelState *statePtr = chanPtr->state; /* state info for channel */ sl@0: int flags; sl@0: sl@0: /* sl@0: * Disallow options on dead channels -- channels that have been closed but sl@0: * not yet been deallocated. Such channels can be found if the exit sl@0: * handler for channel cleanup has run but the channel is still sl@0: * registered in an interpreter. sl@0: */ sl@0: sl@0: if (CheckForDeadChannel(interp, statePtr)) { sl@0: return TCL_ERROR; sl@0: } sl@0: sl@0: /* sl@0: * This operation should occur at the top of a channel stack. sl@0: */ sl@0: sl@0: chanPtr = statePtr->topChanPtr; sl@0: sl@0: /* sl@0: * If we are in the middle of a background copy, use the saved flags. sl@0: */ sl@0: sl@0: if (statePtr->csPtr) { sl@0: if (chanPtr == statePtr->csPtr->readPtr) { sl@0: flags = statePtr->csPtr->readFlags; sl@0: } else { sl@0: flags = statePtr->csPtr->writeFlags; sl@0: } sl@0: } else { sl@0: flags = statePtr->flags; sl@0: } sl@0: sl@0: /* sl@0: * If the optionName is NULL it means that we want a list of all sl@0: * options and values. sl@0: */ sl@0: sl@0: if (optionName == (char *) NULL) { sl@0: len = 0; sl@0: } else { sl@0: len = strlen(optionName); sl@0: } sl@0: sl@0: if ((len == 0) || ((len > 2) && (optionName[1] == 'b') && sl@0: (strncmp(optionName, "-blocking", len) == 0))) { sl@0: if (len == 0) { sl@0: Tcl_DStringAppendElement(dsPtr, "-blocking"); sl@0: } sl@0: Tcl_DStringAppendElement(dsPtr, sl@0: (flags & CHANNEL_NONBLOCKING) ? "0" : "1"); sl@0: if (len > 0) { sl@0: return TCL_OK; sl@0: } sl@0: } sl@0: if ((len == 0) || ((len > 7) && (optionName[1] == 'b') && sl@0: (strncmp(optionName, "-buffering", len) == 0))) { sl@0: if (len == 0) { sl@0: Tcl_DStringAppendElement(dsPtr, "-buffering"); sl@0: } sl@0: if (flags & CHANNEL_LINEBUFFERED) { sl@0: Tcl_DStringAppendElement(dsPtr, "line"); sl@0: } else if (flags & CHANNEL_UNBUFFERED) { sl@0: Tcl_DStringAppendElement(dsPtr, "none"); sl@0: } else { sl@0: Tcl_DStringAppendElement(dsPtr, "full"); sl@0: } sl@0: if (len > 0) { sl@0: return TCL_OK; sl@0: } sl@0: } sl@0: if ((len == 0) || ((len > 7) && (optionName[1] == 'b') && sl@0: (strncmp(optionName, "-buffersize", len) == 0))) { sl@0: if (len == 0) { sl@0: Tcl_DStringAppendElement(dsPtr, "-buffersize"); sl@0: } sl@0: TclFormatInt(optionVal, statePtr->bufSize); sl@0: Tcl_DStringAppendElement(dsPtr, optionVal); sl@0: if (len > 0) { sl@0: return TCL_OK; sl@0: } sl@0: } sl@0: if ((len == 0) || sl@0: ((len > 2) && (optionName[1] == 'e') && sl@0: (strncmp(optionName, "-encoding", len) == 0))) { sl@0: if (len == 0) { sl@0: Tcl_DStringAppendElement(dsPtr, "-encoding"); sl@0: } sl@0: if (statePtr->encoding == NULL) { sl@0: Tcl_DStringAppendElement(dsPtr, "binary"); sl@0: } else { sl@0: Tcl_DStringAppendElement(dsPtr, sl@0: Tcl_GetEncodingName(statePtr->encoding)); sl@0: } sl@0: if (len > 0) { sl@0: return TCL_OK; sl@0: } sl@0: } sl@0: if ((len == 0) || sl@0: ((len > 2) && (optionName[1] == 'e') && sl@0: (strncmp(optionName, "-eofchar", len) == 0))) { sl@0: if (len == 0) { sl@0: Tcl_DStringAppendElement(dsPtr, "-eofchar"); sl@0: } sl@0: if (((flags & (TCL_READABLE|TCL_WRITABLE)) == sl@0: (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) { sl@0: Tcl_DStringStartSublist(dsPtr); sl@0: } sl@0: if (flags & TCL_READABLE) { sl@0: if (statePtr->inEofChar == 0) { sl@0: Tcl_DStringAppendElement(dsPtr, ""); sl@0: } else { sl@0: char buf[4]; sl@0: sl@0: sprintf(buf, "%c", statePtr->inEofChar); sl@0: Tcl_DStringAppendElement(dsPtr, buf); sl@0: } sl@0: } sl@0: if (flags & TCL_WRITABLE) { sl@0: if (statePtr->outEofChar == 0) { sl@0: Tcl_DStringAppendElement(dsPtr, ""); sl@0: } else { sl@0: char buf[4]; sl@0: sl@0: sprintf(buf, "%c", statePtr->outEofChar); sl@0: Tcl_DStringAppendElement(dsPtr, buf); sl@0: } sl@0: } sl@0: if ( !(flags & (TCL_READABLE|TCL_WRITABLE))) { sl@0: /* Not readable or writable (server socket) */ sl@0: Tcl_DStringAppendElement(dsPtr, ""); sl@0: } sl@0: if (((flags & (TCL_READABLE|TCL_WRITABLE)) == sl@0: (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) { sl@0: Tcl_DStringEndSublist(dsPtr); sl@0: } sl@0: if (len > 0) { sl@0: return TCL_OK; sl@0: } sl@0: } sl@0: if ((len == 0) || sl@0: ((len > 1) && (optionName[1] == 't') && sl@0: (strncmp(optionName, "-translation", len) == 0))) { sl@0: if (len == 0) { sl@0: Tcl_DStringAppendElement(dsPtr, "-translation"); sl@0: } sl@0: if (((flags & (TCL_READABLE|TCL_WRITABLE)) == sl@0: (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) { sl@0: Tcl_DStringStartSublist(dsPtr); sl@0: } sl@0: if (flags & TCL_READABLE) { sl@0: if (statePtr->inputTranslation == TCL_TRANSLATE_AUTO) { sl@0: Tcl_DStringAppendElement(dsPtr, "auto"); sl@0: } else if (statePtr->inputTranslation == TCL_TRANSLATE_CR) { sl@0: Tcl_DStringAppendElement(dsPtr, "cr"); sl@0: } else if (statePtr->inputTranslation == TCL_TRANSLATE_CRLF) { sl@0: Tcl_DStringAppendElement(dsPtr, "crlf"); sl@0: } else { sl@0: Tcl_DStringAppendElement(dsPtr, "lf"); sl@0: } sl@0: } sl@0: if (flags & TCL_WRITABLE) { sl@0: if (statePtr->outputTranslation == TCL_TRANSLATE_AUTO) { sl@0: Tcl_DStringAppendElement(dsPtr, "auto"); sl@0: } else if (statePtr->outputTranslation == TCL_TRANSLATE_CR) { sl@0: Tcl_DStringAppendElement(dsPtr, "cr"); sl@0: } else if (statePtr->outputTranslation == TCL_TRANSLATE_CRLF) { sl@0: Tcl_DStringAppendElement(dsPtr, "crlf"); sl@0: } else { sl@0: Tcl_DStringAppendElement(dsPtr, "lf"); sl@0: } sl@0: } sl@0: if ( !(flags & (TCL_READABLE|TCL_WRITABLE))) { sl@0: /* Not readable or writable (server socket) */ sl@0: Tcl_DStringAppendElement(dsPtr, "auto"); sl@0: } sl@0: if (((flags & (TCL_READABLE|TCL_WRITABLE)) == sl@0: (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) { sl@0: Tcl_DStringEndSublist(dsPtr); sl@0: } sl@0: if (len > 0) { sl@0: return TCL_OK; sl@0: } sl@0: } sl@0: if (chanPtr->typePtr->getOptionProc != (Tcl_DriverGetOptionProc *) NULL) { sl@0: /* sl@0: * let the driver specific handle additional options sl@0: * and result code and message. sl@0: */ sl@0: sl@0: return (chanPtr->typePtr->getOptionProc) (chanPtr->instanceData, sl@0: interp, optionName, dsPtr); sl@0: } else { sl@0: /* sl@0: * no driver specific options case. sl@0: */ sl@0: sl@0: if (len == 0) { sl@0: return TCL_OK; sl@0: } sl@0: return Tcl_BadChannelOption(interp, optionName, NULL); sl@0: } sl@0: } sl@0: sl@0: /* sl@0: *--------------------------------------------------------------------------- sl@0: * sl@0: * Tcl_SetChannelOption -- sl@0: * sl@0: * Sets an option on a channel. sl@0: * sl@0: * Results: sl@0: * A standard Tcl result. On error, sets interp's result object sl@0: * if interp is not NULL. sl@0: * sl@0: * Side effects: sl@0: * May modify an option on a device. sl@0: * sl@0: *--------------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C int sl@0: Tcl_SetChannelOption(interp, chan, optionName, newValue) sl@0: Tcl_Interp *interp; /* For error reporting - can be NULL. */ sl@0: Tcl_Channel chan; /* Channel on which to set mode. */ sl@0: CONST char *optionName; /* Which option to set? */ sl@0: CONST char *newValue; /* New value for option. */ sl@0: { sl@0: Channel *chanPtr = (Channel *) chan; /* The real IO channel. */ sl@0: ChannelState *statePtr = chanPtr->state; /* state info for channel */ sl@0: size_t len; /* Length of optionName string. */ sl@0: int argc; sl@0: CONST char **argv; sl@0: sl@0: /* sl@0: * If the channel is in the middle of a background copy, fail. sl@0: */ sl@0: sl@0: if (statePtr->csPtr) { sl@0: if (interp) { sl@0: Tcl_AppendResult(interp, sl@0: "unable to set channel options: background copy in progress", sl@0: (char *) NULL); sl@0: } sl@0: return TCL_ERROR; sl@0: } sl@0: sl@0: /* sl@0: * Disallow options on dead channels -- channels that have been closed but sl@0: * not yet been deallocated. Such channels can be found if the exit sl@0: * handler for channel cleanup has run but the channel is still sl@0: * registered in an interpreter. sl@0: */ sl@0: sl@0: if (CheckForDeadChannel(NULL, statePtr)) { sl@0: return TCL_ERROR; sl@0: } sl@0: sl@0: /* sl@0: * This operation should occur at the top of a channel stack. sl@0: */ sl@0: sl@0: chanPtr = statePtr->topChanPtr; sl@0: sl@0: len = strlen(optionName); sl@0: sl@0: if ((len > 2) && (optionName[1] == 'b') && sl@0: (strncmp(optionName, "-blocking", len) == 0)) { sl@0: int newMode; sl@0: if (Tcl_GetBoolean(interp, newValue, &newMode) == TCL_ERROR) { sl@0: return TCL_ERROR; sl@0: } sl@0: if (newMode) { sl@0: newMode = TCL_MODE_BLOCKING; sl@0: } else { sl@0: newMode = TCL_MODE_NONBLOCKING; sl@0: } sl@0: return SetBlockMode(interp, chanPtr, newMode); sl@0: } else if ((len > 7) && (optionName[1] == 'b') && sl@0: (strncmp(optionName, "-buffering", len) == 0)) { sl@0: len = strlen(newValue); sl@0: if ((newValue[0] == 'f') && (strncmp(newValue, "full", len) == 0)) { sl@0: statePtr->flags &= sl@0: (~(CHANNEL_UNBUFFERED|CHANNEL_LINEBUFFERED)); sl@0: } else if ((newValue[0] == 'l') && sl@0: (strncmp(newValue, "line", len) == 0)) { sl@0: statePtr->flags &= (~(CHANNEL_UNBUFFERED)); sl@0: statePtr->flags |= CHANNEL_LINEBUFFERED; sl@0: } else if ((newValue[0] == 'n') && sl@0: (strncmp(newValue, "none", len) == 0)) { sl@0: statePtr->flags &= (~(CHANNEL_LINEBUFFERED)); sl@0: statePtr->flags |= CHANNEL_UNBUFFERED; sl@0: } else { sl@0: if (interp) { sl@0: Tcl_AppendResult(interp, "bad value for -buffering: ", sl@0: "must be one of full, line, or none", sl@0: (char *) NULL); sl@0: return TCL_ERROR; sl@0: } sl@0: } sl@0: return TCL_OK; sl@0: } else if ((len > 7) && (optionName[1] == 'b') && sl@0: (strncmp(optionName, "-buffersize", len) == 0)) { sl@0: int newBufferSize; sl@0: if (Tcl_GetInt(interp, newValue, &newBufferSize) == TCL_ERROR) { sl@0: return TCL_ERROR; sl@0: } sl@0: Tcl_SetChannelBufferSize(chan, newBufferSize); sl@0: } else if ((len > 2) && (optionName[1] == 'e') && sl@0: (strncmp(optionName, "-encoding", len) == 0)) { sl@0: Tcl_Encoding encoding; sl@0: sl@0: if ((newValue[0] == '\0') || (strcmp(newValue, "binary") == 0)) { sl@0: encoding = NULL; sl@0: } else { sl@0: encoding = Tcl_GetEncoding(interp, newValue); sl@0: if (encoding == NULL) { sl@0: return TCL_ERROR; sl@0: } sl@0: } sl@0: /* sl@0: * When the channel has an escape sequence driven encoding such as sl@0: * iso2022, the terminated escape sequence must write to the buffer. sl@0: */ sl@0: if ((statePtr->encoding != NULL) && (statePtr->curOutPtr != NULL) sl@0: && (CheckChannelErrors(statePtr, TCL_WRITABLE) == 0)) { sl@0: statePtr->outputEncodingFlags |= TCL_ENCODING_END; sl@0: WriteChars(chanPtr, "", 0); sl@0: } sl@0: Tcl_FreeEncoding(statePtr->encoding); sl@0: statePtr->encoding = encoding; sl@0: statePtr->inputEncodingState = NULL; sl@0: statePtr->inputEncodingFlags = TCL_ENCODING_START; sl@0: statePtr->outputEncodingState = NULL; sl@0: statePtr->outputEncodingFlags = TCL_ENCODING_START; sl@0: statePtr->flags &= ~CHANNEL_NEED_MORE_DATA; sl@0: UpdateInterest(chanPtr); sl@0: } else if ((len > 2) && (optionName[1] == 'e') && sl@0: (strncmp(optionName, "-eofchar", len) == 0)) { sl@0: if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) { sl@0: return TCL_ERROR; sl@0: } sl@0: if (argc == 0) { sl@0: statePtr->inEofChar = 0; sl@0: statePtr->outEofChar = 0; sl@0: } else if (argc == 1) { sl@0: if (statePtr->flags & TCL_WRITABLE) { sl@0: statePtr->outEofChar = (int) argv[0][0]; sl@0: } sl@0: if (statePtr->flags & TCL_READABLE) { sl@0: statePtr->inEofChar = (int) argv[0][0]; sl@0: } sl@0: } else if (argc != 2) { sl@0: if (interp) { sl@0: Tcl_AppendResult(interp, sl@0: "bad value for -eofchar: should be a list of zero,", sl@0: " one, or two elements", (char *) NULL); sl@0: } sl@0: ckfree((char *) argv); sl@0: return TCL_ERROR; sl@0: } else { sl@0: if (statePtr->flags & TCL_READABLE) { sl@0: statePtr->inEofChar = (int) argv[0][0]; sl@0: } sl@0: if (statePtr->flags & TCL_WRITABLE) { sl@0: statePtr->outEofChar = (int) argv[1][0]; sl@0: } sl@0: } sl@0: if (argv != NULL) { sl@0: ckfree((char *) argv); sl@0: } sl@0: sl@0: /* sl@0: * [SF Tcl Bug 930851] Reset EOF and BLOCKED flags. Changing sl@0: * the character which signals eof can transform a current eof sl@0: * condition into a 'go ahead'. Ditto for blocked. sl@0: */ sl@0: sl@0: statePtr->flags &= (~(CHANNEL_EOF | CHANNEL_STICKY_EOF | CHANNEL_BLOCKED)); sl@0: sl@0: return TCL_OK; sl@0: } else if ((len > 1) && (optionName[1] == 't') && sl@0: (strncmp(optionName, "-translation", len) == 0)) { sl@0: CONST char *readMode, *writeMode; sl@0: sl@0: if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) { sl@0: return TCL_ERROR; sl@0: } sl@0: sl@0: if (argc == 1) { sl@0: readMode = (statePtr->flags & TCL_READABLE) ? argv[0] : NULL; sl@0: writeMode = (statePtr->flags & TCL_WRITABLE) ? argv[0] : NULL; sl@0: } else if (argc == 2) { sl@0: readMode = (statePtr->flags & TCL_READABLE) ? argv[0] : NULL; sl@0: writeMode = (statePtr->flags & TCL_WRITABLE) ? argv[1] : NULL; sl@0: } else { sl@0: if (interp) { sl@0: Tcl_AppendResult(interp, sl@0: "bad value for -translation: must be a one or two", sl@0: " element list", (char *) NULL); sl@0: } sl@0: ckfree((char *) argv); sl@0: return TCL_ERROR; sl@0: } sl@0: sl@0: if (readMode) { sl@0: TclEolTranslation translation; sl@0: if (*readMode == '\0') { sl@0: translation = statePtr->inputTranslation; sl@0: } else if (strcmp(readMode, "auto") == 0) { sl@0: translation = TCL_TRANSLATE_AUTO; sl@0: } else if (strcmp(readMode, "binary") == 0) { sl@0: translation = TCL_TRANSLATE_LF; sl@0: statePtr->inEofChar = 0; sl@0: Tcl_FreeEncoding(statePtr->encoding); sl@0: statePtr->encoding = NULL; sl@0: } else if (strcmp(readMode, "lf") == 0) { sl@0: translation = TCL_TRANSLATE_LF; sl@0: } else if (strcmp(readMode, "cr") == 0) { sl@0: translation = TCL_TRANSLATE_CR; sl@0: } else if (strcmp(readMode, "crlf") == 0) { sl@0: translation = TCL_TRANSLATE_CRLF; sl@0: } else if (strcmp(readMode, "platform") == 0) { sl@0: translation = TCL_PLATFORM_TRANSLATION; sl@0: } else { sl@0: if (interp) { sl@0: Tcl_AppendResult(interp, sl@0: "bad value for -translation: ", sl@0: "must be one of auto, binary, cr, lf, crlf,", sl@0: " or platform", (char *) NULL); sl@0: } sl@0: ckfree((char *) argv); sl@0: return TCL_ERROR; sl@0: } sl@0: sl@0: /* sl@0: * Reset the EOL flags since we need to look at any buffered sl@0: * data to see if the new translation mode allows us to sl@0: * complete the line. sl@0: */ sl@0: sl@0: if (translation != statePtr->inputTranslation) { sl@0: statePtr->inputTranslation = translation; sl@0: statePtr->flags &= ~(INPUT_SAW_CR); sl@0: statePtr->flags &= ~(CHANNEL_NEED_MORE_DATA); sl@0: UpdateInterest(chanPtr); sl@0: } sl@0: } sl@0: if (writeMode) { sl@0: if (*writeMode == '\0') { sl@0: /* Do nothing. */ sl@0: } else if (strcmp(writeMode, "auto") == 0) { sl@0: /* sl@0: * This is a hack to get TCP sockets to produce output sl@0: * in CRLF mode if they are being set into AUTO mode. sl@0: * A better solution for achieving this effect will be sl@0: * coded later. sl@0: */ sl@0: sl@0: if (strcmp(Tcl_ChannelName(chanPtr->typePtr), "tcp") == 0) { sl@0: statePtr->outputTranslation = TCL_TRANSLATE_CRLF; sl@0: } else { sl@0: statePtr->outputTranslation = TCL_PLATFORM_TRANSLATION; sl@0: } sl@0: } else if (strcmp(writeMode, "binary") == 0) { sl@0: statePtr->outEofChar = 0; sl@0: statePtr->outputTranslation = TCL_TRANSLATE_LF; sl@0: Tcl_FreeEncoding(statePtr->encoding); sl@0: statePtr->encoding = NULL; sl@0: } else if (strcmp(writeMode, "lf") == 0) { sl@0: statePtr->outputTranslation = TCL_TRANSLATE_LF; sl@0: } else if (strcmp(writeMode, "cr") == 0) { sl@0: statePtr->outputTranslation = TCL_TRANSLATE_CR; sl@0: } else if (strcmp(writeMode, "crlf") == 0) { sl@0: statePtr->outputTranslation = TCL_TRANSLATE_CRLF; sl@0: } else if (strcmp(writeMode, "platform") == 0) { sl@0: statePtr->outputTranslation = TCL_PLATFORM_TRANSLATION; sl@0: } else { sl@0: if (interp) { sl@0: Tcl_AppendResult(interp, sl@0: "bad value for -translation: ", sl@0: "must be one of auto, binary, cr, lf, crlf,", sl@0: " or platform", (char *) NULL); sl@0: } sl@0: ckfree((char *) argv); sl@0: return TCL_ERROR; sl@0: } sl@0: } sl@0: ckfree((char *) argv); sl@0: return TCL_OK; sl@0: } else if (chanPtr->typePtr->setOptionProc != NULL) { sl@0: return (*chanPtr->typePtr->setOptionProc)(chanPtr->instanceData, sl@0: interp, optionName, newValue); sl@0: } else { sl@0: return Tcl_BadChannelOption(interp, optionName, (char *) NULL); sl@0: } sl@0: sl@0: /* sl@0: * If bufsize changes, need to get rid of old utility buffer. sl@0: */ sl@0: sl@0: if (statePtr->saveInBufPtr != NULL) { sl@0: RecycleBuffer(statePtr, statePtr->saveInBufPtr, 1); sl@0: statePtr->saveInBufPtr = NULL; sl@0: } sl@0: if (statePtr->inQueueHead != NULL) { sl@0: if ((statePtr->inQueueHead->nextPtr == NULL) sl@0: && (statePtr->inQueueHead->nextAdded == sl@0: statePtr->inQueueHead->nextRemoved)) { sl@0: RecycleBuffer(statePtr, statePtr->inQueueHead, 1); sl@0: statePtr->inQueueHead = NULL; sl@0: statePtr->inQueueTail = NULL; sl@0: } sl@0: } sl@0: sl@0: /* sl@0: * If encoding or bufsize changes, need to update output staging buffer. sl@0: */ sl@0: sl@0: if (statePtr->outputStage != NULL) { sl@0: ckfree((char *) statePtr->outputStage); sl@0: statePtr->outputStage = NULL; sl@0: } sl@0: if ((statePtr->encoding != NULL) && (statePtr->flags & TCL_WRITABLE)) { sl@0: statePtr->outputStage = (char *) sl@0: ckalloc((unsigned) (statePtr->bufSize + 2)); sl@0: } sl@0: return TCL_OK; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * CleanupChannelHandlers -- sl@0: * sl@0: * Removes channel handlers that refer to the supplied interpreter, sl@0: * so that if the actual channel is not closed now, these handlers sl@0: * will not run on subsequent events on the channel. This would be sl@0: * erroneous, because the interpreter no longer has a reference to sl@0: * this channel. sl@0: * sl@0: * Results: sl@0: * None. sl@0: * sl@0: * Side effects: sl@0: * Removes channel handlers. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static void sl@0: CleanupChannelHandlers(interp, chanPtr) sl@0: Tcl_Interp *interp; sl@0: Channel *chanPtr; sl@0: { sl@0: ChannelState *statePtr = chanPtr->state; /* state info for channel */ sl@0: EventScriptRecord *sPtr, *prevPtr, *nextPtr; sl@0: sl@0: /* sl@0: * Remove fileevent records on this channel that refer to the sl@0: * given interpreter. sl@0: */ sl@0: sl@0: for (sPtr = statePtr->scriptRecordPtr, sl@0: prevPtr = (EventScriptRecord *) NULL; sl@0: sPtr != (EventScriptRecord *) NULL; sl@0: sPtr = nextPtr) { sl@0: nextPtr = sPtr->nextPtr; sl@0: if (sPtr->interp == interp) { sl@0: if (prevPtr == (EventScriptRecord *) NULL) { sl@0: statePtr->scriptRecordPtr = nextPtr; sl@0: } else { sl@0: prevPtr->nextPtr = nextPtr; sl@0: } sl@0: sl@0: Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr, sl@0: TclChannelEventScriptInvoker, (ClientData) sPtr); sl@0: sl@0: Tcl_DecrRefCount(sPtr->scriptPtr); sl@0: ckfree((char *) sPtr); sl@0: } else { sl@0: prevPtr = sPtr; sl@0: } sl@0: } sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_NotifyChannel -- sl@0: * sl@0: * This procedure is called by a channel driver when a driver sl@0: * detects an event on a channel. This procedure is responsible sl@0: * for actually handling the event by invoking any channel sl@0: * handler callbacks. sl@0: * sl@0: * Results: sl@0: * None. sl@0: * sl@0: * Side effects: sl@0: * Whatever the channel handler callback procedure does. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C void sl@0: Tcl_NotifyChannel(channel, mask) sl@0: Tcl_Channel channel; /* Channel that detected an event. */ sl@0: int mask; /* OR'ed combination of TCL_READABLE, sl@0: * TCL_WRITABLE, or TCL_EXCEPTION: indicates sl@0: * which events were detected. */ sl@0: { sl@0: Channel *chanPtr = (Channel *) channel; sl@0: ChannelState *statePtr = chanPtr->state; /* state info for channel */ sl@0: ChannelHandler *chPtr; sl@0: ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); sl@0: NextChannelHandler nh; sl@0: Channel* upChanPtr; sl@0: Tcl_ChannelType* upTypePtr; sl@0: sl@0: #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING sl@0: /* [SF Tcl Bug 943274] sl@0: * For a non-blocking channel without blockmodeproc we keep track sl@0: * of actual input coming from the OS so that we can do a credible sl@0: * imitation of non-blocking behaviour. sl@0: */ sl@0: sl@0: if ((mask & TCL_READABLE) && sl@0: (statePtr->flags & CHANNEL_NONBLOCKING) && sl@0: (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) && sl@0: !(statePtr->flags & CHANNEL_TIMER_FEV)) { sl@0: sl@0: statePtr->flags |= CHANNEL_HAS_MORE_DATA; sl@0: } sl@0: #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */ sl@0: sl@0: /* sl@0: * In contrast to the other API functions this procedure walks towards sl@0: * the top of a stack and not down from it. sl@0: * sl@0: * The channel calling this procedure is the one who generated the event, sl@0: * and thus does not take part in handling it. IOW, its HandlerProc is sl@0: * not called, instead we begin with the channel above it. sl@0: * sl@0: * This behaviour also allows the transformation channels to sl@0: * generate their own events and pass them upward. sl@0: */ sl@0: sl@0: while (mask && (chanPtr->upChanPtr != ((Channel*) NULL))) { sl@0: Tcl_DriverHandlerProc* upHandlerProc; sl@0: sl@0: upChanPtr = chanPtr->upChanPtr; sl@0: upTypePtr = upChanPtr->typePtr; sl@0: upHandlerProc = Tcl_ChannelHandlerProc(upTypePtr); sl@0: if (upHandlerProc != NULL) { sl@0: mask = (*upHandlerProc) (upChanPtr->instanceData, mask); sl@0: } sl@0: sl@0: /* ELSE: sl@0: * Ignore transformations which are unable to handle the event sl@0: * coming from below. Assume that they don't change the mask and sl@0: * pass it on. sl@0: */ sl@0: sl@0: chanPtr = upChanPtr; sl@0: } sl@0: sl@0: channel = (Tcl_Channel) chanPtr; sl@0: sl@0: /* sl@0: * Here we have either reached the top of the stack or the mask is sl@0: * empty. We break out of the procedure if it is the latter. sl@0: */ sl@0: sl@0: if (!mask) { sl@0: return; sl@0: } sl@0: sl@0: /* sl@0: * We are now above the topmost channel in a stack and have events sl@0: * left. Now call the channel handlers as usual. sl@0: * sl@0: * Preserve the channel struct in case the script closes it. sl@0: */ sl@0: sl@0: Tcl_Preserve((ClientData) channel); sl@0: Tcl_Preserve((ClientData) statePtr); sl@0: sl@0: /* sl@0: * If we are flushing in the background, be sure to call FlushChannel sl@0: * for writable events. Note that we have to discard the writable sl@0: * event so we don't call any write handlers before the flush is sl@0: * complete. sl@0: */ sl@0: sl@0: if ((statePtr->flags & BG_FLUSH_SCHEDULED) && (mask & TCL_WRITABLE)) { sl@0: FlushChannel(NULL, chanPtr, 1); sl@0: mask &= ~TCL_WRITABLE; sl@0: } sl@0: sl@0: /* sl@0: * Add this invocation to the list of recursive invocations of sl@0: * ChannelHandlerEventProc. sl@0: */ sl@0: sl@0: nh.nextHandlerPtr = (ChannelHandler *) NULL; sl@0: nh.nestedHandlerPtr = tsdPtr->nestedHandlerPtr; sl@0: tsdPtr->nestedHandlerPtr = &nh; sl@0: sl@0: for (chPtr = statePtr->chPtr; chPtr != (ChannelHandler *) NULL; ) { sl@0: /* sl@0: * If this channel handler is interested in any of the events that sl@0: * have occurred on the channel, invoke its procedure. sl@0: */ sl@0: sl@0: if ((chPtr->mask & mask) != 0) { sl@0: nh.nextHandlerPtr = chPtr->nextPtr; sl@0: (*(chPtr->proc))(chPtr->clientData, mask); sl@0: chPtr = nh.nextHandlerPtr; sl@0: } else { sl@0: chPtr = chPtr->nextPtr; sl@0: } sl@0: } sl@0: sl@0: /* sl@0: * Update the notifier interest, since it may have changed after sl@0: * invoking event handlers. Skip that if the channel was deleted sl@0: * in the call to the channel handler. sl@0: */ sl@0: sl@0: if (chanPtr->typePtr != NULL) { sl@0: UpdateInterest(chanPtr); sl@0: } sl@0: sl@0: Tcl_Release((ClientData) statePtr); sl@0: Tcl_Release((ClientData) channel); sl@0: sl@0: tsdPtr->nestedHandlerPtr = nh.nestedHandlerPtr; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * UpdateInterest -- sl@0: * sl@0: * Arrange for the notifier to call us back at appropriate times sl@0: * based on the current state of the channel. sl@0: * sl@0: * Results: sl@0: * None. sl@0: * sl@0: * Side effects: sl@0: * May schedule a timer or driver handler. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static void sl@0: UpdateInterest(chanPtr) sl@0: Channel *chanPtr; /* Channel to update. */ sl@0: { sl@0: ChannelState *statePtr = chanPtr->state; /* state info for channel */ sl@0: int mask = statePtr->interestMask; sl@0: sl@0: /* sl@0: * If there are flushed buffers waiting to be written, then sl@0: * we need to watch for the channel to become writable. sl@0: */ sl@0: sl@0: if (statePtr->flags & BG_FLUSH_SCHEDULED) { sl@0: mask |= TCL_WRITABLE; sl@0: } sl@0: sl@0: /* sl@0: * If there is data in the input queue, and we aren't waiting for more sl@0: * data, then we need to schedule a timer so we don't block in the sl@0: * notifier. Also, cancel the read interest so we don't get duplicate sl@0: * events. sl@0: */ sl@0: sl@0: if (mask & TCL_READABLE) { sl@0: if (!(statePtr->flags & CHANNEL_NEED_MORE_DATA) sl@0: && (statePtr->inQueueHead != (ChannelBuffer *) NULL) sl@0: && (statePtr->inQueueHead->nextRemoved < sl@0: statePtr->inQueueHead->nextAdded)) { sl@0: mask &= ~TCL_READABLE; sl@0: sl@0: /* sl@0: * Andreas Kupries, April 11, 2003 sl@0: * sl@0: * Some operating systems (Solaris 2.6 and higher (but not sl@0: * Solaris 2.5, go figure)) generate READABLE and sl@0: * EXCEPTION events when select()'ing [*] on a plain file, sl@0: * even if EOF was not yet reached. This is a problem in sl@0: * the following situation: sl@0: * sl@0: * - An extension asks to get both READABLE and EXCEPTION sl@0: * events. sl@0: * - It reads data into a buffer smaller than the buffer sl@0: * used by Tcl itself. sl@0: * - It does not process all events in the event queue, but sl@0: * only only one, at least in some situations. sl@0: * sl@0: * In that case we can get into a situation where sl@0: * sl@0: * - Tcl drops READABLE here, because it has data in its own sl@0: * buffers waiting to be read by the extension. sl@0: * - A READABLE event is syntesized via timer. sl@0: * - The OS still reports the EXCEPTION condition on the file. sl@0: * - And the extension gets the EXCPTION event first, and sl@0: * handles this as EOF. sl@0: * sl@0: * End result ==> Premature end of reading from a file. sl@0: * sl@0: * The concrete example is 'Expect', and its [expect] sl@0: * command (and at the C-level, deep in the bowels of sl@0: * Expect, 'exp_get_next_event'. See marker 'SunOS' for sl@0: * commentary in that function too). sl@0: * sl@0: * [*] As the Tcl notifier does. See also for marker sl@0: * 'SunOS' in file 'exp_event.c' of Expect. sl@0: * sl@0: * Our solution here is to drop the interest in the sl@0: * EXCEPTION events too. This compiles on all platforms, sl@0: * and also passes the testsuite on all of them. sl@0: */ sl@0: sl@0: mask &= ~TCL_EXCEPTION; sl@0: sl@0: if (!statePtr->timer) { sl@0: statePtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc, sl@0: (ClientData) chanPtr); sl@0: } sl@0: } sl@0: } sl@0: (chanPtr->typePtr->watchProc)(chanPtr->instanceData, mask); sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * ChannelTimerProc -- sl@0: * sl@0: * Timer handler scheduled by UpdateInterest to monitor the sl@0: * channel buffers until they are empty. sl@0: * sl@0: * Results: sl@0: * None. sl@0: * sl@0: * Side effects: sl@0: * May invoke channel handlers. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static void sl@0: ChannelTimerProc(clientData) sl@0: ClientData clientData; sl@0: { sl@0: Channel *chanPtr = (Channel *) clientData; sl@0: ChannelState *statePtr = chanPtr->state; /* state info for channel */ sl@0: sl@0: if (!(statePtr->flags & CHANNEL_NEED_MORE_DATA) sl@0: && (statePtr->interestMask & TCL_READABLE) sl@0: && (statePtr->inQueueHead != (ChannelBuffer *) NULL) sl@0: && (statePtr->inQueueHead->nextRemoved < sl@0: statePtr->inQueueHead->nextAdded)) { sl@0: /* sl@0: * Restart the timer in case a channel handler reenters the sl@0: * event loop before UpdateInterest gets called by Tcl_NotifyChannel. sl@0: */ sl@0: sl@0: statePtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc, sl@0: (ClientData) chanPtr); sl@0: sl@0: #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING sl@0: /* Set the TIMER flag to notify the higher levels that the sl@0: * driver might have no data for us. We do this only if we are sl@0: * in non-blocking mode and the driver has no BlockModeProc sl@0: * because only then we really don't know if the driver will sl@0: * block or not. A similar test is done in "PeekAhead". sl@0: */ sl@0: sl@0: if ((statePtr->flags & CHANNEL_NONBLOCKING) && sl@0: (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL)) { sl@0: statePtr->flags |= CHANNEL_TIMER_FEV; sl@0: } sl@0: #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */ sl@0: sl@0: Tcl_Preserve((ClientData) statePtr); sl@0: Tcl_NotifyChannel((Tcl_Channel)chanPtr, TCL_READABLE); sl@0: sl@0: #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING sl@0: statePtr->flags &= ~CHANNEL_TIMER_FEV; sl@0: #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */ sl@0: sl@0: Tcl_Release((ClientData) statePtr); sl@0: } else { sl@0: statePtr->timer = NULL; sl@0: UpdateInterest(chanPtr); sl@0: } sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_CreateChannelHandler -- sl@0: * sl@0: * Arrange for a given procedure to be invoked whenever the sl@0: * channel indicated by the chanPtr arg becomes readable or sl@0: * writable. sl@0: * sl@0: * Results: sl@0: * None. sl@0: * sl@0: * Side effects: sl@0: * From now on, whenever the I/O channel given by chanPtr becomes sl@0: * ready in the way indicated by mask, proc will be invoked. sl@0: * See the manual entry for details on the calling sequence sl@0: * to proc. If there is already an event handler for chan, proc sl@0: * and clientData, then the mask will be updated. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C void sl@0: Tcl_CreateChannelHandler(chan, mask, proc, clientData) sl@0: Tcl_Channel chan; /* The channel to create the handler for. */ sl@0: int mask; /* OR'ed combination of TCL_READABLE, sl@0: * TCL_WRITABLE, and TCL_EXCEPTION: sl@0: * indicates conditions under which sl@0: * proc should be called. Use 0 to sl@0: * disable a registered handler. */ sl@0: Tcl_ChannelProc *proc; /* Procedure to call for each sl@0: * selected event. */ sl@0: ClientData clientData; /* Arbitrary data to pass to proc. */ sl@0: { sl@0: ChannelHandler *chPtr; sl@0: Channel *chanPtr = (Channel *) chan; sl@0: ChannelState *statePtr = chanPtr->state; /* state info for channel */ sl@0: sl@0: /* sl@0: * Check whether this channel handler is not already registered. If sl@0: * it is not, create a new record, else reuse existing record (smash sl@0: * current values). sl@0: */ sl@0: sl@0: for (chPtr = statePtr->chPtr; sl@0: chPtr != (ChannelHandler *) NULL; sl@0: chPtr = chPtr->nextPtr) { sl@0: if ((chPtr->chanPtr == chanPtr) && (chPtr->proc == proc) && sl@0: (chPtr->clientData == clientData)) { sl@0: break; sl@0: } sl@0: } sl@0: if (chPtr == (ChannelHandler *) NULL) { sl@0: chPtr = (ChannelHandler *) ckalloc((unsigned) sizeof(ChannelHandler)); sl@0: chPtr->mask = 0; sl@0: chPtr->proc = proc; sl@0: chPtr->clientData = clientData; sl@0: chPtr->chanPtr = chanPtr; sl@0: chPtr->nextPtr = statePtr->chPtr; sl@0: statePtr->chPtr = chPtr; sl@0: } sl@0: sl@0: /* sl@0: * The remainder of the initialization below is done regardless of sl@0: * whether or not this is a new record or a modification of an old sl@0: * one. sl@0: */ sl@0: sl@0: chPtr->mask = mask; sl@0: sl@0: /* sl@0: * Recompute the interest mask for the channel - this call may actually sl@0: * be disabling an existing handler. sl@0: */ sl@0: sl@0: statePtr->interestMask = 0; sl@0: for (chPtr = statePtr->chPtr; sl@0: chPtr != (ChannelHandler *) NULL; sl@0: chPtr = chPtr->nextPtr) { sl@0: statePtr->interestMask |= chPtr->mask; sl@0: } sl@0: sl@0: UpdateInterest(statePtr->topChanPtr); sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_DeleteChannelHandler -- sl@0: * sl@0: * Cancel a previously arranged callback arrangement for an IO sl@0: * channel. sl@0: * sl@0: * Results: sl@0: * None. sl@0: * sl@0: * Side effects: sl@0: * If a callback was previously registered for this chan, proc and sl@0: * clientData , it is removed and the callback will no longer be called sl@0: * when the channel becomes ready for IO. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C void sl@0: Tcl_DeleteChannelHandler(chan, proc, clientData) sl@0: Tcl_Channel chan; /* The channel for which to remove the sl@0: * callback. */ sl@0: Tcl_ChannelProc *proc; /* The procedure in the callback to delete. */ sl@0: ClientData clientData; /* The client data in the callback sl@0: * to delete. */ sl@0: sl@0: { sl@0: ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); sl@0: ChannelHandler *chPtr, *prevChPtr; sl@0: Channel *chanPtr = (Channel *) chan; sl@0: ChannelState *statePtr = chanPtr->state; /* state info for channel */ sl@0: NextChannelHandler *nhPtr; sl@0: sl@0: /* sl@0: * Find the entry and the previous one in the list. sl@0: */ sl@0: sl@0: for (prevChPtr = (ChannelHandler *) NULL, chPtr = statePtr->chPtr; sl@0: chPtr != (ChannelHandler *) NULL; sl@0: chPtr = chPtr->nextPtr) { sl@0: if ((chPtr->chanPtr == chanPtr) && (chPtr->clientData == clientData) sl@0: && (chPtr->proc == proc)) { sl@0: break; sl@0: } sl@0: prevChPtr = chPtr; sl@0: } sl@0: sl@0: /* sl@0: * If not found, return without doing anything. sl@0: */ sl@0: sl@0: if (chPtr == (ChannelHandler *) NULL) { sl@0: return; sl@0: } sl@0: sl@0: /* sl@0: * If ChannelHandlerEventProc is about to process this handler, tell it to sl@0: * process the next one instead - we are going to delete *this* one. sl@0: */ sl@0: sl@0: for (nhPtr = tsdPtr->nestedHandlerPtr; sl@0: nhPtr != (NextChannelHandler *) NULL; sl@0: nhPtr = nhPtr->nestedHandlerPtr) { sl@0: if (nhPtr->nextHandlerPtr == chPtr) { sl@0: nhPtr->nextHandlerPtr = chPtr->nextPtr; sl@0: } sl@0: } sl@0: sl@0: /* sl@0: * Splice it out of the list of channel handlers. sl@0: */ sl@0: sl@0: if (prevChPtr == (ChannelHandler *) NULL) { sl@0: statePtr->chPtr = chPtr->nextPtr; sl@0: } else { sl@0: prevChPtr->nextPtr = chPtr->nextPtr; sl@0: } sl@0: ckfree((char *) chPtr); sl@0: sl@0: /* sl@0: * Recompute the interest list for the channel, so that infinite loops sl@0: * will not result if Tcl_DeleteChannelHandler is called inside an sl@0: * event. sl@0: */ sl@0: sl@0: statePtr->interestMask = 0; sl@0: for (chPtr = statePtr->chPtr; sl@0: chPtr != (ChannelHandler *) NULL; sl@0: chPtr = chPtr->nextPtr) { sl@0: statePtr->interestMask |= chPtr->mask; sl@0: } sl@0: sl@0: UpdateInterest(statePtr->topChanPtr); sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * DeleteScriptRecord -- sl@0: * sl@0: * Delete a script record for this combination of channel, interp sl@0: * and mask. sl@0: * sl@0: * Results: sl@0: * None. sl@0: * sl@0: * Side effects: sl@0: * Deletes a script record and cancels a channel event handler. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static void sl@0: DeleteScriptRecord(interp, chanPtr, mask) sl@0: Tcl_Interp *interp; /* Interpreter in which script was to be sl@0: * executed. */ sl@0: Channel *chanPtr; /* The channel for which to delete the sl@0: * script record (if any). */ sl@0: int mask; /* Events in mask must exactly match mask sl@0: * of script to delete. */ sl@0: { sl@0: ChannelState *statePtr = chanPtr->state; /* state info for channel */ sl@0: EventScriptRecord *esPtr, *prevEsPtr; sl@0: sl@0: for (esPtr = statePtr->scriptRecordPtr, sl@0: prevEsPtr = (EventScriptRecord *) NULL; sl@0: esPtr != (EventScriptRecord *) NULL; sl@0: prevEsPtr = esPtr, esPtr = esPtr->nextPtr) { sl@0: if ((esPtr->interp == interp) && (esPtr->mask == mask)) { sl@0: if (esPtr == statePtr->scriptRecordPtr) { sl@0: statePtr->scriptRecordPtr = esPtr->nextPtr; sl@0: } else { sl@0: prevEsPtr->nextPtr = esPtr->nextPtr; sl@0: } sl@0: sl@0: Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr, sl@0: TclChannelEventScriptInvoker, (ClientData) esPtr); sl@0: sl@0: Tcl_DecrRefCount(esPtr->scriptPtr); sl@0: ckfree((char *) esPtr); sl@0: sl@0: break; sl@0: } sl@0: } sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * CreateScriptRecord -- sl@0: * sl@0: * Creates a record to store a script to be executed when a specific sl@0: * event fires on a specific channel. sl@0: * sl@0: * Results: sl@0: * None. sl@0: * sl@0: * Side effects: sl@0: * Causes the script to be stored for later execution. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static void sl@0: CreateScriptRecord(interp, chanPtr, mask, scriptPtr) sl@0: Tcl_Interp *interp; /* Interpreter in which to execute sl@0: * the stored script. */ sl@0: Channel *chanPtr; /* Channel for which script is to sl@0: * be stored. */ sl@0: int mask; /* Set of events for which script sl@0: * will be invoked. */ sl@0: Tcl_Obj *scriptPtr; /* Pointer to script object. */ sl@0: { sl@0: ChannelState *statePtr = chanPtr->state; /* state info for channel */ sl@0: EventScriptRecord *esPtr; sl@0: sl@0: for (esPtr = statePtr->scriptRecordPtr; sl@0: esPtr != (EventScriptRecord *) NULL; sl@0: esPtr = esPtr->nextPtr) { sl@0: if ((esPtr->interp == interp) && (esPtr->mask == mask)) { sl@0: Tcl_DecrRefCount(esPtr->scriptPtr); sl@0: esPtr->scriptPtr = (Tcl_Obj *) NULL; sl@0: break; sl@0: } sl@0: } sl@0: if (esPtr == (EventScriptRecord *) NULL) { sl@0: esPtr = (EventScriptRecord *) ckalloc((unsigned) sl@0: sizeof(EventScriptRecord)); sl@0: Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask, sl@0: TclChannelEventScriptInvoker, (ClientData) esPtr); sl@0: esPtr->nextPtr = statePtr->scriptRecordPtr; sl@0: statePtr->scriptRecordPtr = esPtr; sl@0: } sl@0: esPtr->chanPtr = chanPtr; sl@0: esPtr->interp = interp; sl@0: esPtr->mask = mask; sl@0: Tcl_IncrRefCount(scriptPtr); sl@0: esPtr->scriptPtr = scriptPtr; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * TclChannelEventScriptInvoker -- sl@0: * sl@0: * Invokes a script scheduled by "fileevent" for when the channel sl@0: * becomes ready for IO. This function is invoked by the channel sl@0: * handler which was created by the Tcl "fileevent" command. sl@0: * sl@0: * Results: sl@0: * None. sl@0: * sl@0: * Side effects: sl@0: * Whatever the script does. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: void sl@0: TclChannelEventScriptInvoker(clientData, mask) sl@0: ClientData clientData; /* The script+interp record. */ sl@0: int mask; /* Not used. */ sl@0: { sl@0: Tcl_Interp *interp; /* Interpreter in which to eval the script. */ sl@0: Channel *chanPtr; /* The channel for which this handler is sl@0: * registered. */ sl@0: EventScriptRecord *esPtr; /* The event script + interpreter to eval it sl@0: * in. */ sl@0: int result; /* Result of call to eval script. */ sl@0: sl@0: esPtr = (EventScriptRecord *) clientData; sl@0: chanPtr = esPtr->chanPtr; sl@0: mask = esPtr->mask; sl@0: interp = esPtr->interp; sl@0: sl@0: /* sl@0: * We must preserve the interpreter so we can report errors on it sl@0: * later. Note that we do not need to preserve the channel because sl@0: * that is done by Tcl_NotifyChannel before calling channel handlers. sl@0: */ sl@0: sl@0: Tcl_Preserve((ClientData) interp); sl@0: result = Tcl_EvalObjEx(interp, esPtr->scriptPtr, TCL_EVAL_GLOBAL); sl@0: sl@0: /* sl@0: * On error, cause a background error and remove the channel handler sl@0: * and the script record. sl@0: * sl@0: * NOTE: Must delete channel handler before causing the background error sl@0: * because the background error may want to reinstall the handler. sl@0: */ sl@0: sl@0: if (result != TCL_OK) { sl@0: if (chanPtr->typePtr != NULL) { sl@0: DeleteScriptRecord(interp, chanPtr, mask); sl@0: } sl@0: Tcl_BackgroundError(interp); sl@0: } sl@0: Tcl_Release((ClientData) interp); sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_FileEventObjCmd -- sl@0: * sl@0: * This procedure implements the "fileevent" Tcl command. See the sl@0: * user documentation for details on what it does. This command is sl@0: * based on the Tk command "fileevent" which in turn is based on work sl@0: * contributed by Mark Diekhans. sl@0: * sl@0: * Results: sl@0: * A standard Tcl result. sl@0: * sl@0: * Side effects: sl@0: * May create a channel handler for the specified channel. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: /* ARGSUSED */ sl@0: int sl@0: Tcl_FileEventObjCmd(clientData, interp, objc, objv) sl@0: ClientData clientData; /* Not used. */ sl@0: Tcl_Interp *interp; /* Interpreter in which the channel sl@0: * for which to create the handler sl@0: * is found. */ sl@0: int objc; /* Number of arguments. */ sl@0: Tcl_Obj *CONST objv[]; /* Argument objects. */ sl@0: { sl@0: Channel *chanPtr; /* The channel to create sl@0: * the handler for. */ sl@0: ChannelState *statePtr; /* state info for channel */ sl@0: Tcl_Channel chan; /* The opaque type for the channel. */ sl@0: char *chanName; sl@0: int modeIndex; /* Index of mode argument. */ sl@0: int mask; sl@0: static CONST char *modeOptions[] = {"readable", "writable", NULL}; sl@0: static int maskArray[] = {TCL_READABLE, TCL_WRITABLE}; sl@0: sl@0: if ((objc != 3) && (objc != 4)) { sl@0: Tcl_WrongNumArgs(interp, 1, objv, "channelId event ?script?"); sl@0: return TCL_ERROR; sl@0: } sl@0: if (Tcl_GetIndexFromObj(interp, objv[2], modeOptions, "event name", 0, sl@0: &modeIndex) != TCL_OK) { sl@0: return TCL_ERROR; sl@0: } sl@0: mask = maskArray[modeIndex]; sl@0: sl@0: chanName = Tcl_GetString(objv[1]); sl@0: chan = Tcl_GetChannel(interp, chanName, NULL); sl@0: if (chan == (Tcl_Channel) NULL) { sl@0: return TCL_ERROR; sl@0: } sl@0: chanPtr = (Channel *) chan; sl@0: statePtr = chanPtr->state; sl@0: if ((statePtr->flags & mask) == 0) { sl@0: Tcl_AppendResult(interp, "channel is not ", sl@0: (mask == TCL_READABLE) ? "readable" : "writable", sl@0: (char *) NULL); sl@0: return TCL_ERROR; sl@0: } sl@0: sl@0: /* sl@0: * If we are supposed to return the script, do so. sl@0: */ sl@0: sl@0: if (objc == 3) { sl@0: EventScriptRecord *esPtr; sl@0: for (esPtr = statePtr->scriptRecordPtr; sl@0: esPtr != (EventScriptRecord *) NULL; sl@0: esPtr = esPtr->nextPtr) { sl@0: if ((esPtr->interp == interp) && (esPtr->mask == mask)) { sl@0: Tcl_SetObjResult(interp, esPtr->scriptPtr); sl@0: break; sl@0: } sl@0: } sl@0: return TCL_OK; sl@0: } sl@0: sl@0: /* sl@0: * If we are supposed to delete a stored script, do so. sl@0: */ sl@0: sl@0: if (*(Tcl_GetString(objv[3])) == '\0') { sl@0: DeleteScriptRecord(interp, chanPtr, mask); sl@0: return TCL_OK; sl@0: } sl@0: sl@0: /* sl@0: * Make the script record that will link between the event and the sl@0: * script to invoke. This also creates a channel event handler which sl@0: * will evaluate the script in the supplied interpreter. sl@0: */ sl@0: sl@0: CreateScriptRecord(interp, chanPtr, mask, objv[3]); sl@0: sl@0: return TCL_OK; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * TclCopyChannel -- sl@0: * sl@0: * This routine copies data from one channel to another, either sl@0: * synchronously or asynchronously. If a command script is sl@0: * supplied, the operation runs in the background. The script sl@0: * is invoked when the copy completes. Otherwise the function sl@0: * waits until the copy is completed before returning. sl@0: * sl@0: * Results: sl@0: * A standard Tcl result. sl@0: * sl@0: * Side effects: sl@0: * May schedule a background copy operation that causes both sl@0: * channels to be marked busy. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: int sl@0: TclCopyChannel(interp, inChan, outChan, toRead, cmdPtr) sl@0: Tcl_Interp *interp; /* Current interpreter. */ sl@0: Tcl_Channel inChan; /* Channel to read from. */ sl@0: Tcl_Channel outChan; /* Channel to write to. */ sl@0: int toRead; /* Amount of data to copy, or -1 for all. */ sl@0: Tcl_Obj *cmdPtr; /* Pointer to script to execute or NULL. */ sl@0: { sl@0: Channel *inPtr = (Channel *) inChan; sl@0: Channel *outPtr = (Channel *) outChan; sl@0: ChannelState *inStatePtr, *outStatePtr; sl@0: int readFlags, writeFlags; sl@0: CopyState *csPtr; sl@0: int nonBlocking = (cmdPtr) ? CHANNEL_NONBLOCKING : 0; sl@0: sl@0: inStatePtr = inPtr->state; sl@0: outStatePtr = outPtr->state; sl@0: sl@0: if (inStatePtr->csPtr) { sl@0: if (interp) { sl@0: Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"", sl@0: Tcl_GetChannelName(inChan), "\" is busy", NULL); sl@0: } sl@0: return TCL_ERROR; sl@0: } sl@0: if (outStatePtr->csPtr) { sl@0: if (interp) { sl@0: Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"", sl@0: Tcl_GetChannelName(outChan), "\" is busy", NULL); sl@0: } sl@0: return TCL_ERROR; sl@0: } sl@0: sl@0: readFlags = inStatePtr->flags; sl@0: writeFlags = outStatePtr->flags; sl@0: sl@0: /* sl@0: * Set up the blocking mode appropriately. Background copies need sl@0: * non-blocking channels. Foreground copies need blocking channels. sl@0: * If there is an error, restore the old blocking mode. sl@0: */ sl@0: sl@0: if (nonBlocking != (readFlags & CHANNEL_NONBLOCKING)) { sl@0: if (SetBlockMode(interp, inPtr, sl@0: nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING) sl@0: != TCL_OK) { sl@0: return TCL_ERROR; sl@0: } sl@0: } sl@0: if (inPtr != outPtr) { sl@0: if (nonBlocking != (writeFlags & CHANNEL_NONBLOCKING)) { sl@0: if (SetBlockMode(NULL, outPtr, sl@0: nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING) sl@0: != TCL_OK) { sl@0: if (nonBlocking != (readFlags & CHANNEL_NONBLOCKING)) { sl@0: SetBlockMode(NULL, inPtr, sl@0: (readFlags & CHANNEL_NONBLOCKING) sl@0: ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING); sl@0: return TCL_ERROR; sl@0: } sl@0: } sl@0: } sl@0: } sl@0: sl@0: /* sl@0: * Make sure the output side is unbuffered. sl@0: */ sl@0: sl@0: outStatePtr->flags = (outStatePtr->flags & ~(CHANNEL_LINEBUFFERED)) sl@0: | CHANNEL_UNBUFFERED; sl@0: sl@0: /* sl@0: * Allocate a new CopyState to maintain info about the current copy in sl@0: * progress. This structure will be deallocated when the copy is sl@0: * completed. sl@0: */ sl@0: sl@0: csPtr = (CopyState*) ckalloc(sizeof(CopyState) + inStatePtr->bufSize); sl@0: csPtr->bufSize = inStatePtr->bufSize; sl@0: csPtr->readPtr = inPtr; sl@0: csPtr->writePtr = outPtr; sl@0: csPtr->readFlags = readFlags; sl@0: csPtr->writeFlags = writeFlags; sl@0: csPtr->toRead = toRead; sl@0: csPtr->total = 0; sl@0: csPtr->interp = interp; sl@0: if (cmdPtr) { sl@0: Tcl_IncrRefCount(cmdPtr); sl@0: } sl@0: csPtr->cmdPtr = cmdPtr; sl@0: inStatePtr->csPtr = csPtr; sl@0: outStatePtr->csPtr = csPtr; sl@0: sl@0: /* sl@0: * Start copying data between the channels. sl@0: */ sl@0: sl@0: return CopyData(csPtr, 0); sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * CopyData -- sl@0: * sl@0: * This function implements the lowest level of the copying sl@0: * mechanism for TclCopyChannel. sl@0: * sl@0: * Results: sl@0: * Returns TCL_OK on success, else TCL_ERROR. sl@0: * sl@0: * Side effects: sl@0: * Moves data between channels, may create channel handlers. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static int sl@0: CopyData(csPtr, mask) sl@0: CopyState *csPtr; /* State of copy operation. */ sl@0: int mask; /* Current channel event flags. */ sl@0: { sl@0: Tcl_Interp *interp; sl@0: Tcl_Obj *cmdPtr, *errObj = NULL, *bufObj = NULL; sl@0: Tcl_Channel inChan, outChan; sl@0: ChannelState *inStatePtr, *outStatePtr; sl@0: int result = TCL_OK, size, total, sizeb; sl@0: char* buffer; sl@0: sl@0: int inBinary, outBinary, sameEncoding; /* Encoding control */ sl@0: int underflow; /* input underflow */ sl@0: sl@0: inChan = (Tcl_Channel) csPtr->readPtr; sl@0: outChan = (Tcl_Channel) csPtr->writePtr; sl@0: inStatePtr = csPtr->readPtr->state; sl@0: outStatePtr = csPtr->writePtr->state; sl@0: interp = csPtr->interp; sl@0: cmdPtr = csPtr->cmdPtr; sl@0: sl@0: /* sl@0: * Copy the data the slow way, using the translation mechanism. sl@0: * sl@0: * Note: We have make sure that we use the topmost channel in a stack sl@0: * for the copying. The caller uses Tcl_GetChannel to access it, and sl@0: * thus gets the bottom of the stack. sl@0: */ sl@0: sl@0: inBinary = (inStatePtr->encoding == NULL); sl@0: outBinary = (outStatePtr->encoding == NULL); sl@0: sameEncoding = (inStatePtr->encoding == outStatePtr->encoding); sl@0: sl@0: if (!(inBinary || sameEncoding)) { sl@0: bufObj = Tcl_NewObj (); sl@0: Tcl_IncrRefCount (bufObj); sl@0: } sl@0: sl@0: while (csPtr->toRead != 0) { sl@0: /* sl@0: * Check for unreported background errors. sl@0: */ sl@0: sl@0: if (inStatePtr->unreportedError != 0) { sl@0: Tcl_SetErrno(inStatePtr->unreportedError); sl@0: inStatePtr->unreportedError = 0; sl@0: goto readError; sl@0: } sl@0: if (outStatePtr->unreportedError != 0) { sl@0: Tcl_SetErrno(outStatePtr->unreportedError); sl@0: outStatePtr->unreportedError = 0; sl@0: goto writeError; sl@0: } sl@0: sl@0: /* sl@0: * Read up to bufSize bytes. sl@0: */ sl@0: sl@0: if ((csPtr->toRead == -1) || (csPtr->toRead > csPtr->bufSize)) { sl@0: sizeb = csPtr->bufSize; sl@0: } else { sl@0: sizeb = csPtr->toRead; sl@0: } sl@0: sl@0: if (inBinary || sameEncoding) { sl@0: size = DoRead(inStatePtr->topChanPtr, csPtr->buffer, sizeb); sl@0: } else { sl@0: size = DoReadChars(inStatePtr->topChanPtr, bufObj, sizeb, 0 /* No append */); sl@0: } sl@0: underflow = (size >= 0) && (size < sizeb); /* input underflow */ sl@0: sl@0: if (size < 0) { sl@0: readError: sl@0: errObj = Tcl_NewObj(); sl@0: Tcl_AppendStringsToObj(errObj, "error reading \"", sl@0: Tcl_GetChannelName(inChan), "\": ", sl@0: Tcl_PosixError(interp), (char *) NULL); sl@0: break; sl@0: } else if (underflow) { sl@0: /* sl@0: * We had an underflow on the read side. If we are at EOF, sl@0: * then the copying is done, otherwise set up a channel sl@0: * handler to detect when the channel becomes readable again. sl@0: */ sl@0: sl@0: if ((size == 0) && Tcl_Eof(inChan)) { sl@0: break; sl@0: } sl@0: if (! Tcl_Eof(inChan) && !(mask & TCL_READABLE)) { sl@0: if (mask & TCL_WRITABLE) { sl@0: Tcl_DeleteChannelHandler(outChan, CopyEventProc, sl@0: (ClientData) csPtr); sl@0: } sl@0: Tcl_CreateChannelHandler(inChan, TCL_READABLE, sl@0: CopyEventProc, (ClientData) csPtr); sl@0: } sl@0: if (size == 0) { sl@0: if (bufObj != (Tcl_Obj*) NULL) { sl@0: Tcl_DecrRefCount (bufObj); sl@0: bufObj = (Tcl_Obj*) NULL; sl@0: } sl@0: return TCL_OK; sl@0: } sl@0: } sl@0: sl@0: /* sl@0: * Now write the buffer out. sl@0: */ sl@0: sl@0: if (inBinary || sameEncoding) { sl@0: buffer = csPtr->buffer; sl@0: sizeb = size; sl@0: } else { sl@0: buffer = Tcl_GetStringFromObj (bufObj, &sizeb); sl@0: } sl@0: sl@0: if (outBinary || sameEncoding) { sl@0: sizeb = DoWrite(outStatePtr->topChanPtr, buffer, sizeb); sl@0: } else { sl@0: sizeb = DoWriteChars(outStatePtr->topChanPtr, buffer, sizeb); sl@0: } sl@0: sl@0: if (inBinary || sameEncoding) { sl@0: /* Both read and write counted bytes */ sl@0: size = sizeb; sl@0: } /* else : Read counted characters, write counted bytes, i.e. size != sizeb */ sl@0: sl@0: if (sizeb < 0) { sl@0: writeError: sl@0: errObj = Tcl_NewObj(); sl@0: Tcl_AppendStringsToObj(errObj, "error writing \"", sl@0: Tcl_GetChannelName(outChan), "\": ", sl@0: Tcl_PosixError(interp), (char *) NULL); sl@0: break; sl@0: } sl@0: sl@0: /* sl@0: * Update the current byte count. Do it now so the count is sl@0: * valid before a return or break takes us out of the loop. sl@0: * The invariant at the top of the loop should be that sl@0: * csPtr->toRead holds the number of bytes left to copy. sl@0: */ sl@0: sl@0: if (csPtr->toRead != -1) { sl@0: csPtr->toRead -= size; sl@0: } sl@0: csPtr->total += size; sl@0: sl@0: /* sl@0: * Break loop if EOF && (size>0) sl@0: */ sl@0: sl@0: if (Tcl_Eof(inChan)) { sl@0: break; sl@0: } sl@0: sl@0: /* sl@0: * Check to see if the write is happening in the background. If so, sl@0: * stop copying and wait for the channel to become writable again. sl@0: * After input underflow we already installed a readable handler sl@0: * therefore we don't need a writable handler. sl@0: */ sl@0: sl@0: if ( ! underflow && (outStatePtr->flags & BG_FLUSH_SCHEDULED) ) { sl@0: if (!(mask & TCL_WRITABLE)) { sl@0: if (mask & TCL_READABLE) { sl@0: Tcl_DeleteChannelHandler(inChan, CopyEventProc, sl@0: (ClientData) csPtr); sl@0: } sl@0: Tcl_CreateChannelHandler(outChan, TCL_WRITABLE, sl@0: CopyEventProc, (ClientData) csPtr); sl@0: } sl@0: if (bufObj != (Tcl_Obj*) NULL) { sl@0: Tcl_DecrRefCount (bufObj); sl@0: bufObj = (Tcl_Obj*) NULL; sl@0: } sl@0: return TCL_OK; sl@0: } sl@0: sl@0: /* sl@0: * For background copies, we only do one buffer per invocation so sl@0: * we don't starve the rest of the system. sl@0: */ sl@0: sl@0: if (cmdPtr) { sl@0: /* sl@0: * The first time we enter this code, there won't be a sl@0: * channel handler established yet, so do it here. sl@0: */ sl@0: sl@0: if (mask == 0) { sl@0: Tcl_CreateChannelHandler(outChan, TCL_WRITABLE, sl@0: CopyEventProc, (ClientData) csPtr); sl@0: } sl@0: if (bufObj != (Tcl_Obj*) NULL) { sl@0: Tcl_DecrRefCount (bufObj); sl@0: bufObj = (Tcl_Obj*) NULL; sl@0: } sl@0: return TCL_OK; sl@0: } sl@0: } /* while */ sl@0: sl@0: if (bufObj != (Tcl_Obj*) NULL) { sl@0: Tcl_DecrRefCount (bufObj); sl@0: bufObj = (Tcl_Obj*) NULL; sl@0: } sl@0: sl@0: /* sl@0: * Make the callback or return the number of bytes transferred. sl@0: * The local total is used because StopCopy frees csPtr. sl@0: */ sl@0: sl@0: total = csPtr->total; sl@0: if (cmdPtr && interp) { sl@0: /* sl@0: * Get a private copy of the command so we can mutate it sl@0: * by adding arguments. Note that StopCopy frees our saved sl@0: * reference to the original command obj. sl@0: */ sl@0: sl@0: cmdPtr = Tcl_DuplicateObj(cmdPtr); sl@0: Tcl_IncrRefCount(cmdPtr); sl@0: StopCopy(csPtr); sl@0: Tcl_Preserve((ClientData) interp); sl@0: sl@0: Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewIntObj(total)); sl@0: if (errObj) { sl@0: Tcl_ListObjAppendElement(interp, cmdPtr, errObj); sl@0: } sl@0: if (Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL) != TCL_OK) { sl@0: Tcl_BackgroundError(interp); sl@0: result = TCL_ERROR; sl@0: } sl@0: Tcl_DecrRefCount(cmdPtr); sl@0: Tcl_Release((ClientData) interp); sl@0: } else { sl@0: StopCopy(csPtr); sl@0: if (interp) { sl@0: if (errObj) { sl@0: Tcl_SetObjResult(interp, errObj); sl@0: result = TCL_ERROR; sl@0: } else { sl@0: Tcl_ResetResult(interp); sl@0: Tcl_SetIntObj(Tcl_GetObjResult(interp), total); sl@0: } sl@0: } sl@0: } sl@0: return result; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * DoRead -- sl@0: * sl@0: * Reads a given number of bytes from a channel. sl@0: * sl@0: * No encoding conversions are applied to the bytes being read. sl@0: * sl@0: * Results: sl@0: * The number of characters read, or -1 on error. Use Tcl_GetErrno() sl@0: * to retrieve the error code for the error that occurred. sl@0: * sl@0: * Side effects: sl@0: * May cause input to be buffered. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static int sl@0: DoRead(chanPtr, bufPtr, toRead) sl@0: Channel *chanPtr; /* The channel from which to read. */ sl@0: char *bufPtr; /* Where to store input read. */ sl@0: int toRead; /* Maximum number of bytes to read. */ sl@0: { sl@0: ChannelState *statePtr = chanPtr->state; /* state info for channel */ sl@0: int copied; /* How many characters were copied into sl@0: * the result string? */ sl@0: int copiedNow; /* How many characters were copied from sl@0: * the current input buffer? */ sl@0: int result; /* Of calling GetInput. */ sl@0: sl@0: /* sl@0: * If we have not encountered a sticky EOF, clear the EOF bit. Either sl@0: * way clear the BLOCKED bit. We want to discover these anew during sl@0: * each operation. sl@0: */ sl@0: sl@0: if (!(statePtr->flags & CHANNEL_STICKY_EOF)) { sl@0: statePtr->flags &= ~CHANNEL_EOF; sl@0: } sl@0: statePtr->flags &= ~(CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA); sl@0: sl@0: for (copied = 0; copied < toRead; copied += copiedNow) { sl@0: copiedNow = CopyAndTranslateBuffer(statePtr, bufPtr + copied, sl@0: toRead - copied); sl@0: if (copiedNow == 0) { sl@0: if (statePtr->flags & CHANNEL_EOF) { sl@0: goto done; sl@0: } sl@0: if (statePtr->flags & CHANNEL_BLOCKED) { sl@0: if (statePtr->flags & CHANNEL_NONBLOCKING) { sl@0: goto done; sl@0: } sl@0: statePtr->flags &= (~(CHANNEL_BLOCKED)); sl@0: } sl@0: result = GetInput(chanPtr); sl@0: if (result != 0) { sl@0: if (result != EAGAIN) { sl@0: copied = -1; sl@0: } sl@0: goto done; sl@0: } sl@0: } sl@0: } sl@0: sl@0: statePtr->flags &= (~(CHANNEL_BLOCKED)); sl@0: sl@0: done: sl@0: /* sl@0: * Update the notifier state so we don't block while there is still sl@0: * data in the buffers. sl@0: */ sl@0: sl@0: UpdateInterest(chanPtr); sl@0: return copied; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * CopyAndTranslateBuffer -- sl@0: * sl@0: * Copy at most one buffer of input to the result space, doing sl@0: * eol translations according to mode in effect currently. sl@0: * sl@0: * Results: sl@0: * Number of bytes stored in the result buffer (as opposed to the sl@0: * number of bytes read from the channel). May return sl@0: * zero if no input is available to be translated. sl@0: * sl@0: * Side effects: sl@0: * Consumes buffered input. May deallocate one buffer. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static int sl@0: CopyAndTranslateBuffer(statePtr, result, space) sl@0: ChannelState *statePtr; /* Channel state from which to read input. */ sl@0: char *result; /* Where to store the copied input. */ sl@0: int space; /* How many bytes are available in result sl@0: * to store the copied input? */ sl@0: { sl@0: ChannelBuffer *bufPtr; /* The buffer from which to copy bytes. */ sl@0: int bytesInBuffer; /* How many bytes are available to be sl@0: * copied in the current input buffer? */ sl@0: int copied; /* How many characters were already copied sl@0: * into the destination space? */ sl@0: int i; /* Iterates over the copied input looking sl@0: * for the input eofChar. */ sl@0: sl@0: /* sl@0: * If there is no input at all, return zero. The invariant is that either sl@0: * there is no buffer in the queue, or if the first buffer is empty, it sl@0: * is also the last buffer (and thus there is no input in the queue). sl@0: * Note also that if the buffer is empty, we leave it in the queue. sl@0: */ sl@0: sl@0: if (statePtr->inQueueHead == (ChannelBuffer *) NULL) { sl@0: return 0; sl@0: } sl@0: bufPtr = statePtr->inQueueHead; sl@0: bytesInBuffer = bufPtr->nextAdded - bufPtr->nextRemoved; sl@0: sl@0: copied = 0; sl@0: switch (statePtr->inputTranslation) { sl@0: case TCL_TRANSLATE_LF: { sl@0: if (bytesInBuffer == 0) { sl@0: return 0; sl@0: } sl@0: sl@0: /* sl@0: * Copy the current chunk into the result buffer. sl@0: */ sl@0: sl@0: if (bytesInBuffer < space) { sl@0: space = bytesInBuffer; sl@0: } sl@0: memcpy((VOID *) result, sl@0: (VOID *) (bufPtr->buf + bufPtr->nextRemoved), sl@0: (size_t) space); sl@0: bufPtr->nextRemoved += space; sl@0: copied = space; sl@0: break; sl@0: } sl@0: case TCL_TRANSLATE_CR: { sl@0: char *end; sl@0: sl@0: if (bytesInBuffer == 0) { sl@0: return 0; sl@0: } sl@0: sl@0: /* sl@0: * Copy the current chunk into the result buffer, then sl@0: * replace all \r with \n. sl@0: */ sl@0: sl@0: if (bytesInBuffer < space) { sl@0: space = bytesInBuffer; sl@0: } sl@0: memcpy((VOID *) result, sl@0: (VOID *) (bufPtr->buf + bufPtr->nextRemoved), sl@0: (size_t) space); sl@0: bufPtr->nextRemoved += space; sl@0: copied = space; sl@0: sl@0: for (end = result + copied; result < end; result++) { sl@0: if (*result == '\r') { sl@0: *result = '\n'; sl@0: } sl@0: } sl@0: break; sl@0: } sl@0: case TCL_TRANSLATE_CRLF: { sl@0: char *src, *end, *dst; sl@0: int curByte; sl@0: sl@0: /* sl@0: * If there is a held-back "\r" at EOF, produce it now. sl@0: */ sl@0: sl@0: if (bytesInBuffer == 0) { sl@0: if ((statePtr->flags & (INPUT_SAW_CR | CHANNEL_EOF)) == sl@0: (INPUT_SAW_CR | CHANNEL_EOF)) { sl@0: result[0] = '\r'; sl@0: statePtr->flags &= ~INPUT_SAW_CR; sl@0: return 1; sl@0: } sl@0: return 0; sl@0: } sl@0: sl@0: /* sl@0: * Copy the current chunk and replace "\r\n" with "\n" sl@0: * (but not standalone "\r"!). sl@0: */ sl@0: sl@0: if (bytesInBuffer < space) { sl@0: space = bytesInBuffer; sl@0: } sl@0: memcpy((VOID *) result, sl@0: (VOID *) (bufPtr->buf + bufPtr->nextRemoved), sl@0: (size_t) space); sl@0: bufPtr->nextRemoved += space; sl@0: copied = space; sl@0: sl@0: end = result + copied; sl@0: dst = result; sl@0: for (src = result; src < end; src++) { sl@0: curByte = *src; sl@0: if (curByte == '\n') { sl@0: statePtr->flags &= ~INPUT_SAW_CR; sl@0: } else if (statePtr->flags & INPUT_SAW_CR) { sl@0: statePtr->flags &= ~INPUT_SAW_CR; sl@0: *dst = '\r'; sl@0: dst++; sl@0: } sl@0: if (curByte == '\r') { sl@0: statePtr->flags |= INPUT_SAW_CR; sl@0: } else { sl@0: *dst = (char) curByte; sl@0: dst++; sl@0: } sl@0: } sl@0: copied = dst - result; sl@0: break; sl@0: } sl@0: case TCL_TRANSLATE_AUTO: { sl@0: char *src, *end, *dst; sl@0: int curByte; sl@0: sl@0: if (bytesInBuffer == 0) { sl@0: return 0; sl@0: } sl@0: sl@0: /* sl@0: * Loop over the current buffer, converting "\r" and "\r\n" sl@0: * to "\n". sl@0: */ sl@0: sl@0: if (bytesInBuffer < space) { sl@0: space = bytesInBuffer; sl@0: } sl@0: memcpy((VOID *) result, sl@0: (VOID *) (bufPtr->buf + bufPtr->nextRemoved), sl@0: (size_t) space); sl@0: bufPtr->nextRemoved += space; sl@0: copied = space; sl@0: sl@0: end = result + copied; sl@0: dst = result; sl@0: for (src = result; src < end; src++) { sl@0: curByte = *src; sl@0: if (curByte == '\r') { sl@0: statePtr->flags |= INPUT_SAW_CR; sl@0: *dst = '\n'; sl@0: dst++; sl@0: } else { sl@0: if ((curByte != '\n') || sl@0: !(statePtr->flags & INPUT_SAW_CR)) { sl@0: *dst = (char) curByte; sl@0: dst++; sl@0: } sl@0: statePtr->flags &= ~INPUT_SAW_CR; sl@0: } sl@0: } sl@0: copied = dst - result; sl@0: break; sl@0: } sl@0: default: { sl@0: panic("unknown eol translation mode"); sl@0: } sl@0: } sl@0: sl@0: /* sl@0: * If an in-stream EOF character is set for this channel, check that sl@0: * the input we copied so far does not contain the EOF char. If it does, sl@0: * copy only up to and excluding that character. sl@0: */ sl@0: sl@0: if (statePtr->inEofChar != 0) { sl@0: for (i = 0; i < copied; i++) { sl@0: if (result[i] == (char) statePtr->inEofChar) { sl@0: /* sl@0: * Set sticky EOF so that no further input is presented sl@0: * to the caller. sl@0: */ sl@0: sl@0: statePtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF); sl@0: statePtr->inputEncodingFlags |= TCL_ENCODING_END; sl@0: copied = i; sl@0: break; sl@0: } sl@0: } sl@0: } sl@0: sl@0: /* sl@0: * If the current buffer is empty recycle it. sl@0: */ sl@0: sl@0: if (bufPtr->nextRemoved == bufPtr->nextAdded) { sl@0: statePtr->inQueueHead = bufPtr->nextPtr; sl@0: if (statePtr->inQueueHead == (ChannelBuffer *) NULL) { sl@0: statePtr->inQueueTail = (ChannelBuffer *) NULL; sl@0: } sl@0: RecycleBuffer(statePtr, bufPtr, 0); sl@0: } sl@0: sl@0: /* sl@0: * Return the number of characters copied into the result buffer. sl@0: * This may be different from the number of bytes consumed, because sl@0: * of EOL translations. sl@0: */ sl@0: sl@0: return copied; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * CopyBuffer -- sl@0: * sl@0: * Copy at most one buffer of input to the result space. sl@0: * sl@0: * Results: sl@0: * Number of bytes stored in the result buffer. May return sl@0: * zero if no input is available. sl@0: * sl@0: * Side effects: sl@0: * Consumes buffered input. May deallocate one buffer. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static int sl@0: CopyBuffer(chanPtr, result, space) sl@0: Channel *chanPtr; /* Channel from which to read input. */ sl@0: char *result; /* Where to store the copied input. */ sl@0: int space; /* How many bytes are available in result sl@0: * to store the copied input? */ sl@0: { sl@0: ChannelBuffer *bufPtr; /* The buffer from which to copy bytes. */ sl@0: int bytesInBuffer; /* How many bytes are available to be sl@0: * copied in the current input buffer? */ sl@0: int copied; /* How many characters were already copied sl@0: * into the destination space? */ sl@0: sl@0: /* sl@0: * If there is no input at all, return zero. The invariant is that sl@0: * either there is no buffer in the queue, or if the first buffer sl@0: * is empty, it is also the last buffer (and thus there is no sl@0: * input in the queue). Note also that if the buffer is empty, we sl@0: * don't leave it in the queue, but recycle it. sl@0: */ sl@0: sl@0: if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) { sl@0: return 0; sl@0: } sl@0: bufPtr = chanPtr->inQueueHead; sl@0: bytesInBuffer = bufPtr->nextAdded - bufPtr->nextRemoved; sl@0: sl@0: copied = 0; sl@0: sl@0: if (bytesInBuffer == 0) { sl@0: RecycleBuffer(chanPtr->state, bufPtr, 0); sl@0: chanPtr->inQueueHead = (ChannelBuffer*) NULL; sl@0: chanPtr->inQueueTail = (ChannelBuffer*) NULL; sl@0: return 0; sl@0: } sl@0: sl@0: /* sl@0: * Copy the current chunk into the result buffer. sl@0: */ sl@0: sl@0: if (bytesInBuffer < space) { sl@0: space = bytesInBuffer; sl@0: } sl@0: sl@0: memcpy((VOID *) result, sl@0: (VOID *) (bufPtr->buf + bufPtr->nextRemoved), sl@0: (size_t) space); sl@0: bufPtr->nextRemoved += space; sl@0: copied = space; sl@0: sl@0: /* sl@0: * We don't care about in-stream EOF characters here as the data sl@0: * read here may still flow through one or more transformations, sl@0: * i.e. is not in its final state yet. sl@0: */ sl@0: sl@0: /* sl@0: * If the current buffer is empty recycle it. sl@0: */ sl@0: sl@0: if (bufPtr->nextRemoved == bufPtr->nextAdded) { sl@0: chanPtr->inQueueHead = bufPtr->nextPtr; sl@0: if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) { sl@0: chanPtr->inQueueTail = (ChannelBuffer *) NULL; sl@0: } sl@0: RecycleBuffer(chanPtr->state, bufPtr, 0); sl@0: } sl@0: sl@0: /* sl@0: * Return the number of characters copied into the result buffer. sl@0: */ sl@0: sl@0: return copied; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * DoWrite -- sl@0: * sl@0: * Puts a sequence of characters into an output buffer, may queue the sl@0: * buffer for output if it gets full, and also remembers whether the sl@0: * current buffer is ready e.g. if it contains a newline and we are in sl@0: * line buffering mode. sl@0: * sl@0: * Results: sl@0: * The number of bytes written or -1 in case of error. If -1, sl@0: * Tcl_GetErrno will return the error code. sl@0: * sl@0: * Side effects: sl@0: * May buffer up output and may cause output to be produced on the sl@0: * channel. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static int sl@0: DoWrite(chanPtr, src, srcLen) sl@0: Channel *chanPtr; /* The channel to buffer output for. */ sl@0: CONST char *src; /* Data to write. */ sl@0: int srcLen; /* Number of bytes to write. */ sl@0: { sl@0: ChannelState *statePtr = chanPtr->state; /* state info for channel */ sl@0: ChannelBuffer *outBufPtr; /* Current output buffer. */ sl@0: int foundNewline; /* Did we find a newline in output? */ sl@0: char *dPtr; sl@0: CONST char *sPtr; /* Search variables for newline. */ sl@0: int crsent; /* In CRLF eol translation mode, sl@0: * remember the fact that a CR was sl@0: * output to the channel without sl@0: * its following NL. */ sl@0: int i; /* Loop index for newline search. */ sl@0: int destCopied; /* How many bytes were used in this sl@0: * destination buffer to hold the sl@0: * output? */ sl@0: int totalDestCopied; /* How many bytes total were sl@0: * copied to the channel buffer? */ sl@0: int srcCopied; /* How many bytes were copied from sl@0: * the source string? */ sl@0: char *destPtr; /* Where in line to copy to? */ sl@0: sl@0: /* sl@0: * If we are in network (or windows) translation mode, record the fact sl@0: * that we have not yet sent a CR to the channel. sl@0: */ sl@0: sl@0: crsent = 0; sl@0: sl@0: /* sl@0: * Loop filling buffers and flushing them until all output has been sl@0: * consumed. sl@0: */ sl@0: sl@0: srcCopied = 0; sl@0: totalDestCopied = 0; sl@0: sl@0: while (srcLen > 0) { sl@0: sl@0: /* sl@0: * Make sure there is a current output buffer to accept output. sl@0: */ sl@0: sl@0: if (statePtr->curOutPtr == (ChannelBuffer *) NULL) { sl@0: statePtr->curOutPtr = AllocChannelBuffer(statePtr->bufSize); sl@0: } sl@0: sl@0: outBufPtr = statePtr->curOutPtr; sl@0: sl@0: destCopied = outBufPtr->bufLength - outBufPtr->nextAdded; sl@0: if (destCopied > srcLen) { sl@0: destCopied = srcLen; sl@0: } sl@0: sl@0: destPtr = outBufPtr->buf + outBufPtr->nextAdded; sl@0: switch (statePtr->outputTranslation) { sl@0: case TCL_TRANSLATE_LF: sl@0: srcCopied = destCopied; sl@0: memcpy((VOID *) destPtr, (VOID *) src, (size_t) destCopied); sl@0: break; sl@0: case TCL_TRANSLATE_CR: sl@0: srcCopied = destCopied; sl@0: memcpy((VOID *) destPtr, (VOID *) src, (size_t) destCopied); sl@0: for (dPtr = destPtr; dPtr < destPtr + destCopied; dPtr++) { sl@0: if (*dPtr == '\n') { sl@0: *dPtr = '\r'; sl@0: } sl@0: } sl@0: break; sl@0: case TCL_TRANSLATE_CRLF: sl@0: for (srcCopied = 0, dPtr = destPtr, sPtr = src; sl@0: dPtr < destPtr + destCopied; sl@0: dPtr++, sPtr++, srcCopied++) { sl@0: if (*sPtr == '\n') { sl@0: if (crsent) { sl@0: *dPtr = '\n'; sl@0: crsent = 0; sl@0: } else { sl@0: *dPtr = '\r'; sl@0: crsent = 1; sl@0: sPtr--, srcCopied--; sl@0: } sl@0: } else { sl@0: *dPtr = *sPtr; sl@0: } sl@0: } sl@0: break; sl@0: case TCL_TRANSLATE_AUTO: sl@0: panic("Tcl_Write: AUTO output translation mode not supported"); sl@0: default: sl@0: panic("Tcl_Write: unknown output translation mode"); sl@0: } sl@0: sl@0: /* sl@0: * The current buffer is ready for output if it is full, or if it sl@0: * contains a newline and this channel is line-buffered, or if it sl@0: * contains any output and this channel is unbuffered. sl@0: */ sl@0: sl@0: outBufPtr->nextAdded += destCopied; sl@0: if (!(statePtr->flags & BUFFER_READY)) { sl@0: if (outBufPtr->nextAdded == outBufPtr->bufLength) { sl@0: statePtr->flags |= BUFFER_READY; sl@0: } else if (statePtr->flags & CHANNEL_LINEBUFFERED) { sl@0: for (sPtr = src, i = 0, foundNewline = 0; sl@0: (i < srcCopied) && (!foundNewline); sl@0: i++, sPtr++) { sl@0: if (*sPtr == '\n') { sl@0: foundNewline = 1; sl@0: break; sl@0: } sl@0: } sl@0: if (foundNewline) { sl@0: statePtr->flags |= BUFFER_READY; sl@0: } sl@0: } else if (statePtr->flags & CHANNEL_UNBUFFERED) { sl@0: statePtr->flags |= BUFFER_READY; sl@0: } sl@0: } sl@0: sl@0: totalDestCopied += srcCopied; sl@0: src += srcCopied; sl@0: srcLen -= srcCopied; sl@0: sl@0: if (statePtr->flags & BUFFER_READY) { sl@0: if (FlushChannel(NULL, chanPtr, 0) != 0) { sl@0: return -1; sl@0: } sl@0: } sl@0: } /* Closes "while" */ sl@0: sl@0: return totalDestCopied; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * CopyEventProc -- sl@0: * sl@0: * This routine is invoked as a channel event handler for sl@0: * the background copy operation. It is just a trivial wrapper sl@0: * around the CopyData routine. sl@0: * sl@0: * Results: sl@0: * None. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static void sl@0: CopyEventProc(clientData, mask) sl@0: ClientData clientData; sl@0: int mask; sl@0: { sl@0: (void) CopyData((CopyState *)clientData, mask); sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * StopCopy -- sl@0: * sl@0: * This routine halts a copy that is in progress. sl@0: * sl@0: * Results: sl@0: * None. sl@0: * sl@0: * Side effects: sl@0: * Removes any pending channel handlers and restores the blocking sl@0: * and buffering modes of the channels. The CopyState is freed. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static void sl@0: StopCopy(csPtr) sl@0: CopyState *csPtr; /* State for bg copy to stop . */ sl@0: { sl@0: ChannelState *inStatePtr, *outStatePtr; sl@0: int nonBlocking; sl@0: sl@0: if (!csPtr) { sl@0: return; sl@0: } sl@0: sl@0: inStatePtr = csPtr->readPtr->state; sl@0: outStatePtr = csPtr->writePtr->state; sl@0: sl@0: /* sl@0: * Restore the old blocking mode and output buffering mode. sl@0: */ sl@0: sl@0: nonBlocking = (csPtr->readFlags & CHANNEL_NONBLOCKING); sl@0: if (nonBlocking != (inStatePtr->flags & CHANNEL_NONBLOCKING)) { sl@0: SetBlockMode(NULL, csPtr->readPtr, sl@0: nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING); sl@0: } sl@0: if (csPtr->readPtr != csPtr->writePtr) { sl@0: nonBlocking = (csPtr->writeFlags & CHANNEL_NONBLOCKING); sl@0: if (nonBlocking != (outStatePtr->flags & CHANNEL_NONBLOCKING)) { sl@0: SetBlockMode(NULL, csPtr->writePtr, sl@0: nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING); sl@0: } sl@0: } sl@0: outStatePtr->flags &= ~(CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED); sl@0: outStatePtr->flags |= sl@0: csPtr->writeFlags & (CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED); sl@0: sl@0: if (csPtr->cmdPtr) { sl@0: Tcl_DeleteChannelHandler((Tcl_Channel)csPtr->readPtr, CopyEventProc, sl@0: (ClientData)csPtr); sl@0: if (csPtr->readPtr != csPtr->writePtr) { sl@0: Tcl_DeleteChannelHandler((Tcl_Channel)csPtr->writePtr, sl@0: CopyEventProc, (ClientData)csPtr); sl@0: } sl@0: Tcl_DecrRefCount(csPtr->cmdPtr); sl@0: } sl@0: inStatePtr->csPtr = NULL; sl@0: outStatePtr->csPtr = NULL; sl@0: ckfree((char*) csPtr); sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * StackSetBlockMode -- sl@0: * sl@0: * This function sets the blocking mode for a channel, iterating sl@0: * through each channel in a stack and updates the state flags. sl@0: * sl@0: * Results: sl@0: * 0 if OK, result code from failed blockModeProc otherwise. sl@0: * sl@0: * Side effects: sl@0: * Modifies the blocking mode of the channel and possibly generates sl@0: * an error. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static int sl@0: StackSetBlockMode(chanPtr, mode) sl@0: Channel *chanPtr; /* Channel to modify. */ sl@0: int mode; /* One of TCL_MODE_BLOCKING or sl@0: * TCL_MODE_NONBLOCKING. */ sl@0: { sl@0: int result = 0; sl@0: Tcl_DriverBlockModeProc *blockModeProc; sl@0: sl@0: /* sl@0: * Start at the top of the channel stack sl@0: */ sl@0: sl@0: chanPtr = chanPtr->state->topChanPtr; sl@0: while (chanPtr != (Channel *) NULL) { sl@0: blockModeProc = Tcl_ChannelBlockModeProc(chanPtr->typePtr); sl@0: if (blockModeProc != NULL) { sl@0: result = (*blockModeProc) (chanPtr->instanceData, mode); sl@0: if (result != 0) { sl@0: Tcl_SetErrno(result); sl@0: return result; sl@0: } sl@0: } sl@0: chanPtr = chanPtr->downChanPtr; sl@0: } sl@0: return 0; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * SetBlockMode -- sl@0: * sl@0: * This function sets the blocking mode for a channel and updates sl@0: * the state flags. sl@0: * sl@0: * Results: sl@0: * A standard Tcl result. sl@0: * sl@0: * Side effects: sl@0: * Modifies the blocking mode of the channel and possibly generates sl@0: * an error. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static int sl@0: SetBlockMode(interp, chanPtr, mode) sl@0: Tcl_Interp *interp; /* Interp for error reporting. */ sl@0: Channel *chanPtr; /* Channel to modify. */ sl@0: int mode; /* One of TCL_MODE_BLOCKING or sl@0: * TCL_MODE_NONBLOCKING. */ sl@0: { sl@0: ChannelState *statePtr = chanPtr->state; /* state info for channel */ sl@0: int result = 0; sl@0: sl@0: result = StackSetBlockMode(chanPtr, mode); sl@0: if (result != 0) { sl@0: if (interp != (Tcl_Interp *) NULL) { sl@0: Tcl_AppendResult(interp, "error setting blocking mode: ", sl@0: Tcl_PosixError(interp), (char *) NULL); sl@0: } sl@0: return TCL_ERROR; sl@0: } sl@0: if (mode == TCL_MODE_BLOCKING) { sl@0: statePtr->flags &= (~(CHANNEL_NONBLOCKING | BG_FLUSH_SCHEDULED)); sl@0: } else { sl@0: statePtr->flags |= CHANNEL_NONBLOCKING; sl@0: } sl@0: return TCL_OK; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_GetChannelNames -- sl@0: * sl@0: * Return the names of all open channels in the interp. sl@0: * sl@0: * Results: sl@0: * TCL_OK or TCL_ERROR. sl@0: * sl@0: * Side effects: sl@0: * Interp result modified with list of channel names. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C int sl@0: Tcl_GetChannelNames(interp) sl@0: Tcl_Interp *interp; /* Interp for error reporting. */ sl@0: { sl@0: return Tcl_GetChannelNamesEx(interp, (char *) NULL); sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_GetChannelNamesEx -- sl@0: * sl@0: * Return the names of open channels in the interp filtered sl@0: * filtered through a pattern. If pattern is NULL, it returns sl@0: * all the open channels. sl@0: * sl@0: * Results: sl@0: * TCL_OK or TCL_ERROR. sl@0: * sl@0: * Side effects: sl@0: * Interp result modified with list of channel names. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C int sl@0: Tcl_GetChannelNamesEx(interp, pattern) sl@0: Tcl_Interp *interp; /* Interp for error reporting. */ sl@0: CONST char *pattern; /* pattern to filter on. */ sl@0: { sl@0: ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); sl@0: ChannelState *statePtr; sl@0: CONST char *name; /* name for channel */ sl@0: Tcl_Obj *resultPtr; /* pointer to result object */ sl@0: Tcl_HashTable *hTblPtr; /* Hash table of channels. */ sl@0: Tcl_HashEntry *hPtr; /* Search variable. */ sl@0: Tcl_HashSearch hSearch; /* Search variable. */ sl@0: sl@0: if (interp == (Tcl_Interp *) NULL) { sl@0: return TCL_OK; sl@0: } sl@0: sl@0: /* sl@0: * Get the channel table that stores the channels registered sl@0: * for this interpreter. sl@0: */ sl@0: hTblPtr = GetChannelTable(interp); sl@0: resultPtr = Tcl_GetObjResult(interp); sl@0: sl@0: for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch); sl@0: hPtr != (Tcl_HashEntry *) NULL; sl@0: hPtr = Tcl_NextHashEntry(&hSearch)) { sl@0: sl@0: statePtr = ((Channel *) Tcl_GetHashValue(hPtr))->state; sl@0: if (statePtr->topChanPtr == (Channel *) tsdPtr->stdinChannel) { sl@0: name = "stdin"; sl@0: } else if (statePtr->topChanPtr == (Channel *) tsdPtr->stdoutChannel) { sl@0: name = "stdout"; sl@0: } else if (statePtr->topChanPtr == (Channel *) tsdPtr->stderrChannel) { sl@0: name = "stderr"; sl@0: } else { sl@0: /* sl@0: * This is also stored in Tcl_GetHashKey(hTblPtr, hPtr), sl@0: * but it's simpler to just grab the name from the statePtr. sl@0: */ sl@0: name = statePtr->channelName; sl@0: } sl@0: sl@0: if (((pattern == NULL) || Tcl_StringMatch(name, pattern)) && sl@0: (Tcl_ListObjAppendElement(interp, resultPtr, sl@0: Tcl_NewStringObj(name, -1)) != TCL_OK)) { sl@0: return TCL_ERROR; sl@0: } sl@0: } sl@0: return TCL_OK; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_IsChannelRegistered -- sl@0: * sl@0: * Checks whether the channel is associated with the interp. sl@0: * See also Tcl_RegisterChannel and Tcl_UnregisterChannel. sl@0: * sl@0: * Results: sl@0: * 0 if the channel is not registered in the interpreter, 1 else. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C int sl@0: Tcl_IsChannelRegistered (interp, chan) sl@0: Tcl_Interp* interp; /* The interp to query of the channel */ sl@0: Tcl_Channel chan; /* The channel to check */ sl@0: { sl@0: Tcl_HashTable *hTblPtr; /* Hash table of channels. */ sl@0: Tcl_HashEntry *hPtr; /* Search variable. */ sl@0: Channel *chanPtr; /* The real IO channel. */ sl@0: ChannelState *statePtr; /* State of the real channel. */ sl@0: sl@0: /* sl@0: * Always check bottom-most channel in the stack. This is the one sl@0: * that gets registered. sl@0: */ sl@0: chanPtr = ((Channel *) chan)->state->bottomChanPtr; sl@0: statePtr = chanPtr->state; sl@0: sl@0: hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL); sl@0: if (hTblPtr == (Tcl_HashTable *) NULL) { sl@0: return 0; sl@0: } sl@0: hPtr = Tcl_FindHashEntry(hTblPtr, statePtr->channelName); sl@0: if (hPtr == (Tcl_HashEntry *) NULL) { sl@0: return 0; sl@0: } sl@0: if ((Channel *) Tcl_GetHashValue(hPtr) != chanPtr) { sl@0: return 0; sl@0: } sl@0: sl@0: return 1; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_IsChannelShared -- sl@0: * sl@0: * Checks whether the channel is shared by multiple interpreters. sl@0: * sl@0: * Results: sl@0: * A boolean value (0 = Not shared, 1 = Shared). sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C int sl@0: Tcl_IsChannelShared (chan) sl@0: Tcl_Channel chan; /* The channel to query */ sl@0: { sl@0: ChannelState *statePtr = ((Channel *) chan)->state; sl@0: /* State of real channel structure. */ sl@0: sl@0: return ((statePtr->refCount > 1) ? 1 : 0); sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_IsChannelExisting -- sl@0: * sl@0: * Checks whether a channel of the given name exists in the sl@0: * (thread)-global list of all channels. sl@0: * See Tcl_GetChannelNamesEx for function exposed at the Tcl level. sl@0: * sl@0: * Results: sl@0: * A boolean value (0 = Does not exist, 1 = Does exist). sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C int sl@0: Tcl_IsChannelExisting(chanName) sl@0: CONST char* chanName; /* The name of the channel to look for. */ sl@0: { sl@0: ChannelState *statePtr; sl@0: ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); sl@0: CONST char *name; sl@0: int chanNameLen; sl@0: sl@0: chanNameLen = strlen(chanName); sl@0: for (statePtr = tsdPtr->firstCSPtr; sl@0: statePtr != NULL; sl@0: statePtr = statePtr->nextCSPtr) { sl@0: if (statePtr->topChanPtr == (Channel *) tsdPtr->stdinChannel) { sl@0: name = "stdin"; sl@0: } else if (statePtr->topChanPtr == (Channel *) tsdPtr->stdoutChannel) { sl@0: name = "stdout"; sl@0: } else if (statePtr->topChanPtr == (Channel *) tsdPtr->stderrChannel) { sl@0: name = "stderr"; sl@0: } else { sl@0: name = statePtr->channelName; sl@0: } sl@0: sl@0: if ((*chanName == *name) && sl@0: (memcmp(name, chanName, (size_t) chanNameLen) == 0)) { sl@0: return 1; sl@0: } sl@0: } sl@0: sl@0: return 0; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_ChannelName -- sl@0: * sl@0: * Return the name of the channel type. sl@0: * sl@0: * Results: sl@0: * A pointer the name of the channel type. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C CONST char * sl@0: Tcl_ChannelName(chanTypePtr) sl@0: Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */ sl@0: { sl@0: return chanTypePtr->typeName; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_ChannelVersion -- sl@0: * sl@0: * Return the of version of the channel type. sl@0: * sl@0: * Results: sl@0: * One of the TCL_CHANNEL_VERSION_* constants from tcl.h sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C Tcl_ChannelTypeVersion sl@0: Tcl_ChannelVersion(chanTypePtr) sl@0: Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */ sl@0: { sl@0: if (chanTypePtr->version == TCL_CHANNEL_VERSION_2) { sl@0: return TCL_CHANNEL_VERSION_2; sl@0: } else if (chanTypePtr->version == TCL_CHANNEL_VERSION_3) { sl@0: return TCL_CHANNEL_VERSION_3; sl@0: } else if (chanTypePtr->version == TCL_CHANNEL_VERSION_4) { sl@0: return TCL_CHANNEL_VERSION_4; sl@0: } else { sl@0: /* sl@0: * In = ((int)minimumVersion); sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_ChannelBlockModeProc -- sl@0: * sl@0: * Return the Tcl_DriverBlockModeProc of the channel type. sl@0: * sl@0: * Results: sl@0: * A pointer to the proc. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- */ sl@0: sl@0: EXPORT_C Tcl_DriverBlockModeProc * sl@0: Tcl_ChannelBlockModeProc(chanTypePtr) sl@0: Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */ sl@0: { sl@0: if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) { sl@0: return chanTypePtr->blockModeProc; sl@0: } else { sl@0: /* sl@0: * The v1 structure had the blockModeProc in a different place. sl@0: */ sl@0: return (Tcl_DriverBlockModeProc *) (chanTypePtr->version); sl@0: } sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_ChannelCloseProc -- sl@0: * sl@0: * Return the Tcl_DriverCloseProc of the channel type. sl@0: * sl@0: * Results: sl@0: * A pointer to the proc. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C Tcl_DriverCloseProc * sl@0: Tcl_ChannelCloseProc(chanTypePtr) sl@0: Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */ sl@0: { sl@0: return chanTypePtr->closeProc; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_ChannelClose2Proc -- sl@0: * sl@0: * Return the Tcl_DriverClose2Proc of the channel type. sl@0: * sl@0: * Results: sl@0: * A pointer to the proc. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C Tcl_DriverClose2Proc * sl@0: Tcl_ChannelClose2Proc(chanTypePtr) sl@0: Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */ sl@0: { sl@0: return chanTypePtr->close2Proc; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_ChannelInputProc -- sl@0: * sl@0: * Return the Tcl_DriverInputProc of the channel type. sl@0: * sl@0: * Results: sl@0: * A pointer to the proc. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C Tcl_DriverInputProc * sl@0: Tcl_ChannelInputProc(chanTypePtr) sl@0: Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */ sl@0: { sl@0: return chanTypePtr->inputProc; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_ChannelOutputProc -- sl@0: * sl@0: * Return the Tcl_DriverOutputProc of the channel type. sl@0: * sl@0: * Results: sl@0: * A pointer to the proc. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C Tcl_DriverOutputProc * sl@0: Tcl_ChannelOutputProc(chanTypePtr) sl@0: Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */ sl@0: { sl@0: return chanTypePtr->outputProc; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_ChannelSeekProc -- sl@0: * sl@0: * Return the Tcl_DriverSeekProc of the channel type. sl@0: * sl@0: * Results: sl@0: * A pointer to the proc. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C Tcl_DriverSeekProc * sl@0: Tcl_ChannelSeekProc(chanTypePtr) sl@0: Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */ sl@0: { sl@0: return chanTypePtr->seekProc; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_ChannelSetOptionProc -- sl@0: * sl@0: * Return the Tcl_DriverSetOptionProc of the channel type. sl@0: * sl@0: * Results: sl@0: * A pointer to the proc. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C Tcl_DriverSetOptionProc * sl@0: Tcl_ChannelSetOptionProc(chanTypePtr) sl@0: Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */ sl@0: { sl@0: return chanTypePtr->setOptionProc; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_ChannelGetOptionProc -- sl@0: * sl@0: * Return the Tcl_DriverGetOptionProc of the channel type. sl@0: * sl@0: * Results: sl@0: * A pointer to the proc. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C Tcl_DriverGetOptionProc * sl@0: Tcl_ChannelGetOptionProc(chanTypePtr) sl@0: Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */ sl@0: { sl@0: return chanTypePtr->getOptionProc; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_ChannelWatchProc -- sl@0: * sl@0: * Return the Tcl_DriverWatchProc of the channel type. sl@0: * sl@0: * Results: sl@0: * A pointer to the proc. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C Tcl_DriverWatchProc * sl@0: Tcl_ChannelWatchProc(chanTypePtr) sl@0: Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */ sl@0: { sl@0: return chanTypePtr->watchProc; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_ChannelGetHandleProc -- sl@0: * sl@0: * Return the Tcl_DriverGetHandleProc of the channel type. sl@0: * sl@0: * Results: sl@0: * A pointer to the proc. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C Tcl_DriverGetHandleProc * sl@0: Tcl_ChannelGetHandleProc(chanTypePtr) sl@0: Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */ sl@0: { sl@0: return chanTypePtr->getHandleProc; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_ChannelFlushProc -- sl@0: * sl@0: * Return the Tcl_DriverFlushProc of the channel type. sl@0: * sl@0: * Results: sl@0: * A pointer to the proc. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C Tcl_DriverFlushProc * sl@0: Tcl_ChannelFlushProc(chanTypePtr) sl@0: Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */ sl@0: { sl@0: if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) { sl@0: return chanTypePtr->flushProc; sl@0: } else { sl@0: return NULL; sl@0: } sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_ChannelHandlerProc -- sl@0: * sl@0: * Return the Tcl_DriverHandlerProc of the channel type. sl@0: * sl@0: * Results: sl@0: * A pointer to the proc. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C Tcl_DriverHandlerProc * sl@0: Tcl_ChannelHandlerProc(chanTypePtr) sl@0: Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */ sl@0: { sl@0: if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) { sl@0: return chanTypePtr->handlerProc; sl@0: } else { sl@0: return NULL; sl@0: } sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_ChannelWideSeekProc -- sl@0: * sl@0: * Return the Tcl_DriverWideSeekProc of the channel type. sl@0: * sl@0: * Results: sl@0: * A pointer to the proc. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C Tcl_DriverWideSeekProc * sl@0: Tcl_ChannelWideSeekProc(chanTypePtr) sl@0: Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */ sl@0: { sl@0: if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_3)) { sl@0: return chanTypePtr->wideSeekProc; sl@0: } else { sl@0: return NULL; sl@0: } sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_ChannelThreadActionProc -- sl@0: * sl@0: * Return the Tcl_DriverThreadActionProc of the channel type. sl@0: * sl@0: * Results: sl@0: * A pointer to the proc. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C Tcl_DriverThreadActionProc * sl@0: Tcl_ChannelThreadActionProc(chanTypePtr) sl@0: Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */ sl@0: { sl@0: if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_4)) { sl@0: return chanTypePtr->threadActionProc; sl@0: } else { sl@0: return NULL; sl@0: } sl@0: } sl@0: sl@0: #if 0 sl@0: /* For future debugging work, a simple function to print the flags of sl@0: * a channel in semi-readable form. sl@0: */ sl@0: sl@0: static int sl@0: DumpFlags (str, flags) sl@0: char* str; sl@0: int flags; sl@0: { sl@0: char buf [20]; sl@0: int i = 0; sl@0: sl@0: if (flags & TCL_READABLE) {buf[i] = 'r';} else {buf [i]='_';}; i++; sl@0: if (flags & TCL_WRITABLE) {buf[i] = 'w';} else {buf [i]='_';}; i++; sl@0: if (flags & CHANNEL_NONBLOCKING) {buf[i] = 'n';} else {buf [i]='_';}; i++; sl@0: if (flags & CHANNEL_LINEBUFFERED) {buf[i] = 'l';} else {buf [i]='_';}; i++; sl@0: if (flags & CHANNEL_UNBUFFERED) {buf[i] = 'u';} else {buf [i]='_';}; i++; sl@0: if (flags & BUFFER_READY) {buf[i] = 'R';} else {buf [i]='_';}; i++; sl@0: if (flags & BG_FLUSH_SCHEDULED) {buf[i] = 'F';} else {buf [i]='_';}; i++; sl@0: if (flags & CHANNEL_CLOSED) {buf[i] = 'c';} else {buf [i]='_';}; i++; sl@0: if (flags & CHANNEL_EOF) {buf[i] = 'E';} else {buf [i]='_';}; i++; sl@0: if (flags & CHANNEL_STICKY_EOF) {buf[i] = 'S';} else {buf [i]='_';}; i++; sl@0: if (flags & CHANNEL_BLOCKED) {buf[i] = 'B';} else {buf [i]='_';}; i++; sl@0: if (flags & INPUT_SAW_CR) {buf[i] = '/';} else {buf [i]='_';}; i++; sl@0: if (flags & INPUT_NEED_NL) {buf[i] = '*';} else {buf [i]='_';}; i++; sl@0: if (flags & CHANNEL_DEAD) {buf[i] = 'D';} else {buf [i]='_';}; i++; sl@0: if (flags & CHANNEL_RAW_MODE) {buf[i] = 'R';} else {buf [i]='_';}; i++; sl@0: #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING sl@0: if (flags & CHANNEL_TIMER_FEV) {buf[i] = 'T';} else {buf [i]='_';}; i++; sl@0: if (flags & CHANNEL_HAS_MORE_DATA) {buf[i] = 'H';} else {buf [i]='_';}; i++; sl@0: #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */ sl@0: if (flags & CHANNEL_INCLOSE) {buf[i] = 'x';} else {buf [i]='_';}; i++; sl@0: buf [i] ='\0'; sl@0: sl@0: fprintf (stderr,"%s: %s\n", str, buf); fflush(stderr); sl@0: return 0; sl@0: } sl@0: #endif