diff options
Diffstat (limited to 'generic/tclIO.c')
| -rw-r--r-- | generic/tclIO.c | 1029 |
1 files changed, 661 insertions, 368 deletions
diff --git a/generic/tclIO.c b/generic/tclIO.c index 55b6bdc..6207f6e 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -4,8 +4,8 @@ * This file provides the generic portions (those that are the same on * all platforms and for all channel types) of Tcl's IO facilities. * - * Copyright (c) 1998-2000 Ajuba Solutions - * Copyright (c) 1995-1997 Sun Microsystems, Inc. + * Copyright © 1998-2000 Ajuba Solutions + * Copyright © 1995-1997 Sun Microsystems, Inc. * Contributions from Don Porter, NIST, 2014. (not subject to US copyright) * * See the file "license.terms" for information on usage and redistribution of @@ -28,7 +28,7 @@ typedef struct ChannelHandler { int mask; /* Mask of desired events. */ Tcl_ChannelProc *proc; /* Procedure to call in the type of * Tcl_CreateChannelHandler. */ - ClientData clientData; /* Argument to pass to procedure. */ + void *clientData; /* Argument to pass to procedure. */ struct ChannelHandler *nextPtr; /* Next one in list of registered handlers. */ } ChannelHandler; @@ -103,7 +103,7 @@ typedef struct CopyState { Tcl_Interp *interp; /* Interp that started the copy. */ Tcl_Obj *cmdPtr; /* Command to be invoked at completion. */ int bufSize; /* Size of appended buffer. */ - char buffer[1]; /* Copy buffer, this must be the last + char buffer[TCLFLEXARRAY]; /* Copy buffer, this must be the last * field. */ } CopyState; @@ -116,7 +116,7 @@ typedef struct CopyState { * The structure defined below is used in this file only. */ -typedef struct ThreadSpecificData { +typedef struct { NextChannelHandler *nestedHandlerPtr; /* This variable holds the list of nested * Tcl_NotifyChannel invocations. */ @@ -125,12 +125,12 @@ typedef struct ThreadSpecificData { * ChannelState exists per set of stacked * channels. */ Tcl_Channel stdinChannel; /* Static variable for the stdin channel. */ - int stdinInitialized; Tcl_Channel stdoutChannel; /* Static variable for the stdout channel. */ - int stdoutInitialized; Tcl_Channel stderrChannel; /* Static variable for the stderr channel. */ - int stderrInitialized; Tcl_Encoding binaryEncoding; + int stdinInitialized; + int stdoutInitialized; + int stderrInitialized; } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; @@ -142,7 +142,7 @@ static Tcl_ThreadDataKey dataKey; typedef struct CloseCallback { Tcl_CloseProc *proc; /* The procedure to call. */ - ClientData clientData; /* Arbitrary one-word data to pass + void *clientData; /* Arbitrary one-word data to pass * to the callback. */ struct CloseCallback *nextPtr; /* For chaining close callbacks. */ } CloseCallback; @@ -156,7 +156,7 @@ static void PreserveChannelBuffer(ChannelBuffer *bufPtr); static void ReleaseChannelBuffer(ChannelBuffer *bufPtr); static int IsShared(ChannelBuffer *bufPtr); static void ChannelFree(Channel *chanPtr); -static void ChannelTimerProc(ClientData clientData); +static void ChannelTimerProc(void *clientData); static int ChanRead(Channel *chanPtr, char *dst, int dstSize); static int CheckChannelErrors(ChannelState *statePtr, int direction); @@ -165,6 +165,7 @@ static int CheckForDeadChannel(Tcl_Interp *interp, static void CheckForStdChannelsBeingClosed(Tcl_Channel chan); static void CleanupChannelHandlers(Tcl_Interp *interp, Channel *chanPtr); +static void CleanupTimerHandler(ChannelState *statePtr); static int CloseChannel(Tcl_Interp *interp, Channel *chanPtr, int errorCode); static int CloseChannelPart(Tcl_Interp *interp, Channel *chanPtr, @@ -172,18 +173,19 @@ static int CloseChannelPart(Tcl_Interp *interp, Channel *chanPtr, static int CloseWrite(Tcl_Interp *interp, Channel *chanPtr); static void CommonGetsCleanup(Channel *chanPtr); static int CopyData(CopyState *csPtr, int mask); +static void DeleteTimerHandler(ChannelState *statePtr); static int MoveBytes(CopyState *csPtr); static void MBCallback(CopyState *csPtr, Tcl_Obj *errObj); static void MBError(CopyState *csPtr, int mask, int errorCode); static int MBRead(CopyState *csPtr); static int MBWrite(CopyState *csPtr); -static void MBEvent(ClientData clientData, int mask); +static void MBEvent(void *clientData, int mask); -static void CopyEventProc(ClientData clientData, int mask); +static void CopyEventProc(void *clientData, int mask); static void CreateScriptRecord(Tcl_Interp *interp, Channel *chanPtr, int mask, Tcl_Obj *scriptPtr); -static void DeleteChannelTable(ClientData clientData, +static void DeleteChannelTable(void *clientData, Tcl_Interp *interp); static void DeleteScriptRecord(Tcl_Interp *interp, Channel *chanPtr, int mask); @@ -201,7 +203,7 @@ static int FlushChannel(Tcl_Interp *interp, Channel *chanPtr, int calledFromAsyncFlush); static int TclGetsObjBinary(Tcl_Channel chan, Tcl_Obj *objPtr); static Tcl_Encoding GetBinaryEncoding(void); -static void FreeBinaryEncoding(ClientData clientData); +static Tcl_ExitProc FreeBinaryEncoding; static Tcl_HashTable * GetChannelTable(Tcl_Interp *interp); static int GetInput(Channel *chanPtr); static void PeekAhead(Channel *chanPtr, char **dstEndPtr, @@ -319,9 +321,9 @@ static int WillRead(Channel *chanPtr); typedef struct ResolvedChanName { ChannelState *statePtr; /* The saved lookup result */ Tcl_Interp *interp; /* The interp in which the lookup was done. */ - int epoch; /* The epoch of the channel when the lookup + size_t epoch; /* The epoch of the channel when the lookup * was done. Use to verify validity. */ - int refCount; /* Share this struct among many Tcl_Obj. */ + size_t refCount; /* Share this struct among many Tcl_Obj. */ } ResolvedChanName; static void DupChannelInternalRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr); @@ -335,6 +337,22 @@ static const Tcl_ObjType chanObjType = { NULL /* setFromAnyProc */ }; +#define ChanSetInternalRep(objPtr, resPtr) \ + do { \ + Tcl_ObjInternalRep ir; \ + (resPtr)->refCount++; \ + ir.twoPtrValue.ptr1 = (resPtr); \ + ir.twoPtrValue.ptr2 = NULL; \ + Tcl_StoreInternalRep((objPtr), &chanObjType, &ir); \ + } while (0) + +#define ChanGetInternalRep(objPtr, resPtr) \ + do { \ + const Tcl_ObjInternalRep *irPtr; \ + irPtr = TclFetchInternalRep((objPtr), &chanObjType); \ + (resPtr) = irPtr ? (ResolvedChanName *)irPtr->twoPtrValue.ptr1 : NULL; \ + } while (0) + #define BUSY_STATE(st, fl) \ ((((st)->csPtrR) && ((fl) & TCL_READABLE)) || \ (((st)->csPtrW) && ((fl) & TCL_WRITABLE))) @@ -358,11 +376,12 @@ ChanClose( Channel *chanPtr, Tcl_Interp *interp) { +#ifndef TCL_NO_DEPRECATED if ((chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) && (chanPtr->typePtr->closeProc != NULL)) { return chanPtr->typePtr->closeProc(chanPtr->instanceData, interp); - } else { - return chanPtr->typePtr->close2Proc(chanPtr->instanceData, interp, 0); } +#endif + return chanPtr->typePtr->close2Proc(chanPtr->instanceData, interp, 0); } /* @@ -376,13 +395,13 @@ ChanClose( * Results: * The return value of the driver inputProc, * - number of bytes stored at dst, ot - * - -1 on error, with a Posix error code available to the caller by + * - TCL_INDEX_NONE on error, with a Posix error code available to the caller by * calling Tcl_GetErrno(). * * Side effects: - * The CHANNEL_BLOCKED and CHANNEL_EOF flags of the channel state are set - * as appropriate. On EOF, the inputEncodingFlags are set to perform - * ending operations on decoding. + * The CHANNEL_ENCODING_ERROR, CHANNEL_BLOCKED and CHANNEL_EOF flags + * of the channel state are set as appropriate. On EOF, the + * inputEncodingFlags are set to perform ending operations on decoding. * * TODO - Is this really the right place for that? * @@ -414,7 +433,7 @@ ChanRead( ResetFlag(chanPtr->state, CHANNEL_BLOCKED | CHANNEL_EOF); chanPtr->state->inputEncodingFlags &= ~TCL_ENCODING_END; if (WillRead(chanPtr) < 0) { - return -1; + return TCL_INDEX_NONE; } bytesRead = chanPtr->typePtr->inputProc(chanPtr->instanceData, @@ -429,7 +448,16 @@ ChanRead( } ResetFlag(chanPtr->state, CHANNEL_BLOCKED | CHANNEL_EOF); chanPtr->state->inputEncodingFlags &= ~TCL_ENCODING_END; - if (bytesRead > 0) { + if (bytesRead < 0) { + if ((result == EWOULDBLOCK) || (result == EAGAIN)) { + SetFlag(chanPtr->state, CHANNEL_BLOCKED); + result = EAGAIN; + } + Tcl_SetErrno(result); + } else if (bytesRead == 0) { + SetFlag(chanPtr->state, CHANNEL_EOF); + chanPtr->state->inputEncodingFlags |= TCL_ENCODING_END; + } else { /* * If we get a short read, signal up that we may be BLOCKED. We should * avoid calling the driver because on some platforms we will block in @@ -440,15 +468,6 @@ ChanRead( if (bytesRead < dstSize) { SetFlag(chanPtr->state, CHANNEL_BLOCKED); } - } else if (bytesRead == 0) { - SetFlag(chanPtr->state, CHANNEL_EOF); - chanPtr->state->inputEncodingFlags |= TCL_ENCODING_END; - } else if (bytesRead < 0) { - if ((result == EWOULDBLOCK) || (result == EAGAIN)) { - SetFlag(chanPtr->state, CHANNEL_BLOCKED); - result = EAGAIN; - } - Tcl_SetErrno(result); } return bytesRead; } @@ -465,18 +484,23 @@ ChanSeek( * type and non-NULL. */ - if (Tcl_ChannelWideSeekProc(chanPtr->typePtr) != NULL) { - return Tcl_ChannelWideSeekProc(chanPtr->typePtr)(chanPtr->instanceData, - offset, mode, errnoPtr); - } + if (Tcl_ChannelWideSeekProc(chanPtr->typePtr) == NULL) { +#ifndef TCL_NO_DEPRECATED + if (offset<LONG_MIN || offset>LONG_MAX) { + *errnoPtr = EOVERFLOW; + return TCL_INDEX_NONE; + } - if (offset<Tcl_LongAsWide(LONG_MIN) || offset>Tcl_LongAsWide(LONG_MAX)) { - *errnoPtr = EOVERFLOW; - return Tcl_LongAsWide(-1); + return Tcl_ChannelSeekProc(chanPtr->typePtr)(chanPtr->instanceData, + offset, mode, errnoPtr); +#else + *errnoPtr = EINVAL; + return TCL_INDEX_NONE; +#endif } - return Tcl_LongAsWide(Tcl_ChannelSeekProc(chanPtr->typePtr)(chanPtr->instanceData, - Tcl_WideAsLong(offset), mode, errnoPtr)); + return Tcl_ChannelWideSeekProc(chanPtr->typePtr)(chanPtr->instanceData, + offset, mode, errnoPtr); } static inline void @@ -557,7 +581,6 @@ TclInitIOSubsystem(void) *------------------------------------------------------------------------- */ - /* ARGSUSED */ void TclFinalizeIOSubsystem(void) { @@ -826,7 +849,7 @@ Tcl_CreateCloseHandler( * callback. */ Tcl_CloseProc *proc, /* The callback routine to call when the * channel will be closed. */ - ClientData clientData) /* Arbitrary data to pass to the close + void *clientData) /* Arbitrary data to pass to the close * callback. */ { ChannelState *statePtr = ((Channel *) chan)->state; @@ -864,7 +887,7 @@ Tcl_DeleteCloseHandler( * callback. */ Tcl_CloseProc *proc, /* The procedure for the callback to * remove. */ - ClientData clientData) /* The callback data for the callback to + void *clientData) /* The callback data for the callback to * remove. */ { ChannelState *statePtr = ((Channel *) chan)->state; @@ -963,7 +986,7 @@ GetChannelTable( static void DeleteChannelTable( - ClientData clientData, /* The per-interpreter data structure. */ + void *clientData, /* The per-interpreter data structure. */ Tcl_Interp *interp) /* The interpreter being deleted. */ { Tcl_HashTable *hTblPtr; /* The hash table. */ @@ -1216,7 +1239,7 @@ Tcl_UnregisterChannel( if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "illegal recursive call to close through close-handler" - " of channel", -1)); + " of channel", TCL_INDEX_NONE)); } return TCL_ERROR; } @@ -1457,7 +1480,7 @@ Tcl_GetChannel( chanPtr = (Channel *)Tcl_GetHashValue(hPtr); chanPtr = chanPtr->state->bottomChanPtr; if (modePtr != NULL) { - *modePtr = chanPtr->state->flags & (TCL_READABLE|TCL_WRITABLE); + *modePtr = GotFlag(chanPtr->state, TCL_READABLE|TCL_WRITABLE); } return (Tcl_Channel) chanPtr; @@ -1493,23 +1516,22 @@ TclGetChannelFromObj( * channel was opened? Will contain an ORed * combination of TCL_READABLE and * TCL_WRITABLE, if non-NULL. */ - int flags) + TCL_UNUSED(int) /*flags*/) { ChannelState *statePtr; ResolvedChanName *resPtr = NULL; Tcl_Channel chan; - (void)flags; if (interp == NULL) { return TCL_ERROR; } - if (objPtr->typePtr == &chanObjType) { + ChanGetInternalRep(objPtr, resPtr); + if (resPtr) { /* * Confirm validity of saved lookup results. */ - resPtr = (ResolvedChanName *) objPtr->internalRep.twoPtrValue.ptr1; statePtr = resPtr->statePtr; if ((resPtr->interp == interp) /* Same interp context */ /* No epoch change in channel since lookup */ @@ -1526,26 +1548,25 @@ TclGetChannelFromObj( if (chan == NULL) { if (resPtr) { - FreeChannelInternalRep(objPtr); + Tcl_StoreInternalRep(objPtr, &chanObjType, NULL); } return TCL_ERROR; } if (resPtr && resPtr->refCount == 1) { - /* Re-use the ResolvedCmdName struct */ - Tcl_Release((ClientData) resPtr->statePtr); + /* + * Re-use the ResolvedCmdName struct. + */ + Tcl_Release((void *) resPtr->statePtr); } else { - TclFreeIntRep(objPtr); - resPtr = (ResolvedChanName *) ckalloc(sizeof(ResolvedChanName)); - resPtr->refCount = 1; - objPtr->internalRep.twoPtrValue.ptr1 = (ClientData) resPtr; - objPtr->typePtr = &chanObjType; + resPtr->refCount = 0; + ChanSetInternalRep(objPtr, resPtr); /* Overwrites, if needed */ } statePtr = ((Channel *)chan)->state; resPtr->statePtr = statePtr; - Tcl_Preserve((ClientData) statePtr); + Tcl_Preserve((void *) statePtr); resPtr->interp = interp; resPtr->epoch = statePtr->epoch; @@ -1553,7 +1574,7 @@ TclGetChannelFromObj( *channelPtr = (Tcl_Channel) statePtr->bottomChanPtr; if (modePtr != NULL) { - *modePtr = statePtr->flags & (TCL_READABLE|TCL_WRITABLE); + *modePtr = GotFlag(statePtr, TCL_READABLE|TCL_WRITABLE); } return TCL_OK; @@ -1579,7 +1600,7 @@ Tcl_Channel Tcl_CreateChannel( const Tcl_ChannelType *typePtr, /* The channel type record. */ const char *chanName, /* Name of channel to record. */ - ClientData instanceData, /* Instance specific data. */ + void *instanceData, /* Instance specific data. */ int mask) /* TCL_READABLE & TCL_WRITABLE to indicate if * the channel is readable, writable. */ { @@ -1602,9 +1623,18 @@ Tcl_CreateChannel( assert(sizeof(Tcl_ChannelTypeVersion) == sizeof(Tcl_DriverBlockModeProc *)); assert(typePtr->typeName != NULL); +#ifndef TCL_NO_DEPRECATED if (((NULL == typePtr->closeProc) || (TCL_CLOSE2PROC == typePtr->closeProc)) && (typePtr->close2Proc == NULL)) { Tcl_Panic("channel type %s must define closeProc or close2Proc", typePtr->typeName); } +#else + if (Tcl_ChannelVersion(typePtr) < TCL_CHANNEL_VERSION_5) { + Tcl_Panic("channel type %s must be version TCL_CHANNEL_VERSION_5", typePtr->typeName); + } + if (typePtr->close2Proc == NULL) { + Tcl_Panic("channel type %s must define close2Proc", typePtr->typeName); + } +#endif if ((TCL_READABLE & mask) && (NULL == typePtr->inputProc)) { Tcl_Panic("channel type %s must define inputProc when used for reader channel", typePtr->typeName); } @@ -1614,9 +1644,11 @@ Tcl_CreateChannel( if (NULL == typePtr->watchProc) { Tcl_Panic("channel type %s must define watchProc", typePtr->typeName); } - if ((NULL!=typePtr->wideSeekProc) && (NULL == typePtr->seekProc)) { +#ifndef TCL_NO_DEPRECATED + if ((NULL != typePtr->wideSeekProc) && (NULL == typePtr->seekProc)) { Tcl_Panic("channel type %s must define seekProc if defining wideSeekProc", typePtr->typeName); } +#endif /* * JH: We could subsequently memset these to 0 to avoid the numerous @@ -1651,6 +1683,7 @@ Tcl_CreateChannel( } statePtr->channelName = tmp; statePtr->flags = mask; + statePtr->maxPerms = mask; /* Save max privileges for close callback */ /* * Set the channel to system default encoding. @@ -1669,8 +1702,12 @@ Tcl_CreateChannel( } statePtr->inputEncodingState = NULL; statePtr->inputEncodingFlags = TCL_ENCODING_START; + CHANNEL_PROFILE_SET(statePtr->inputEncodingFlags, + TCL_ENCODING_PROFILE_TCL8); statePtr->outputEncodingState = NULL; statePtr->outputEncodingFlags = TCL_ENCODING_START; + CHANNEL_PROFILE_SET(statePtr->outputEncodingFlags, + TCL_ENCODING_PROFILE_TCL8); /* * Set the channel up initially in AUTO input translation mode to accept @@ -1801,7 +1838,7 @@ Tcl_StackChannel( const Tcl_ChannelType *typePtr, /* The channel type record for the new * channel. */ - ClientData instanceData, /* Instance specific data for the new + void *instanceData, /* Instance specific data for the new * channel. */ int mask, /* TCL_READABLE & TCL_WRITABLE to indicate if * the channel is readable, writable. */ @@ -1847,7 +1884,7 @@ Tcl_StackChannel( * --+---+---+---+----+ */ - if ((mask & (statePtr->flags & (TCL_READABLE | TCL_WRITABLE))) == 0) { + if ((mask & GotFlag(statePtr, TCL_READABLE|TCL_WRITABLE)) == 0) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "reading and writing both disallowed for channel \"%s\"", @@ -2137,8 +2174,11 @@ Tcl_UnstackChannel( /* * Close and free the channel driver state. + * TIP #220: This is done with maximum privileges (as created). */ + ResetFlag(statePtr, TCL_READABLE|TCL_WRITABLE); + SetFlag(statePtr, statePtr->maxPerms); result = ChanClose(chanPtr, interp); ChannelFree(chanPtr); @@ -2257,7 +2297,7 @@ Tcl_GetTopChannel( *---------------------------------------------------------------------- */ -ClientData +void * Tcl_GetChannelInstanceData( Tcl_Channel chan) /* Channel for which to return client data. */ { @@ -2345,7 +2385,7 @@ Tcl_GetChannelMode( ChannelState *statePtr = ((Channel *) chan)->state; /* State of actual channel. */ - return (statePtr->flags & (TCL_READABLE | TCL_WRITABLE)); + return GotFlag(statePtr, TCL_READABLE|TCL_WRITABLE); } /* @@ -2396,10 +2436,10 @@ int Tcl_GetChannelHandle( Tcl_Channel chan, /* The channel to get file from. */ int direction, /* TCL_WRITABLE or TCL_READABLE. */ - ClientData *handlePtr) /* Where to store handle */ + void **handlePtr) /* Where to store handle */ { Channel *chanPtr; /* The actual channel. */ - ClientData handle; + void *handle; int result; chanPtr = ((Channel *) chan)->state->bottomChanPtr; @@ -2418,6 +2458,54 @@ Tcl_GetChannelHandle( } /* + *---------------------------------------------------------------------- + * + * Tcl_RemoveChannelMode -- + * + * Remove either read or write privileges from the channel. + * + * Results: + * A standard Tcl result code. + * + * Side effects: + * May change the access mode of the channel. + * May leave an error message in the interp. + * + *---------------------------------------------------------------------- + */ + +int +Tcl_RemoveChannelMode( + Tcl_Interp* interp, /* The interp for an error message. Allowed to be NULL. */ + Tcl_Channel chan, /* The channel which is modified. */ + int mode) /* The access mode to drop from the channel */ +{ + const char* emsg; + ChannelState *statePtr = ((Channel *) chan)->state; + /* State of actual channel. */ + + if ((mode != TCL_READABLE) && (mode != TCL_WRITABLE)) { + emsg = "Illegal mode value."; + goto error; + } + if (0 == (GotFlag(statePtr, TCL_READABLE|TCL_WRITABLE) & ~mode)) { + emsg = "Bad mode, would make channel inacessible"; + goto error; + } + + ResetFlag(statePtr, mode); + return TCL_OK; + + error: + if (interp != NULL) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Tcl_RemoveChannelMode error: %s. Channel: \"%s\"", + emsg, Tcl_GetChannelName((Tcl_Channel) chan))); + } + return TCL_ERROR; +} + +/* *--------------------------------------------------------------------------- * * AllocChannelBuffer -- @@ -2462,7 +2550,7 @@ static void PreserveChannelBuffer( ChannelBuffer *bufPtr) { - if (bufPtr->refCount == 0) { + if (!bufPtr->refCount) { Tcl_Panic("Reuse of ChannelBuffer! %p", bufPtr); } bufPtr->refCount++; @@ -2529,7 +2617,7 @@ RecycleBuffer( * This is to honor dynamic changes of the buffersize made by the user. */ - if ((bufPtr->bufLength - BUFFER_PADDING) != statePtr->bufSize) { + if ((bufPtr->bufLength) != statePtr->bufSize + BUFFER_PADDING) { ReleaseChannelBuffer(bufPtr); return; } @@ -2639,7 +2727,7 @@ CheckForDeadChannel( Tcl_SetErrno(EINVAL); if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "unable to access channel: invalid channel", -1)); + "unable to access channel: invalid channel", TCL_INDEX_NONE)); } return 1; } @@ -2682,6 +2770,7 @@ FlushChannel( int wroteSome = 0; /* Set to one if any data was written to the * driver. */ + int bufExists; /* * Prevent writing on a dead channel -- a channel that has been closed but * not yet deallocated. This can occur if the exit handler for the channel @@ -2836,7 +2925,7 @@ FlushChannel( if (interp != NULL && !TclChanCaughtErrorBypass(interp, (Tcl_Channel) chanPtr)) { Tcl_SetObjResult(interp, - Tcl_NewStringObj(Tcl_PosixError(interp), -1)); + Tcl_NewStringObj(Tcl_PosixError(interp), TCL_INDEX_NONE)); } /* @@ -2850,8 +2939,8 @@ FlushChannel( * queued. */ - DiscardOutputQueued(statePtr); ReleaseChannelBuffer(bufPtr); + DiscardOutputQueued(statePtr); break; } else { /* @@ -2862,20 +2951,32 @@ FlushChannel( wroteSome = 1; } - bufPtr->nextRemoved += written; + bufExists = bufPtr->refCount > 1; + ReleaseChannelBuffer(bufPtr); + if (bufExists) { + /* There is still a reference to this buffer other than the one + * this routine just released, meaning that final cleanup of the + * buffer hasn't been ordered by, e.g. by a reflected channel + * closing the channel from within one of its handler scripts (not + * something one would expecte, but it must be considered). Normal + * operations on the buffer can proceed. + */ - /* - * If this buffer is now empty, recycle it. - */ + bufPtr->nextRemoved += written; - if (IsBufferEmpty(bufPtr)) { - statePtr->outQueueHead = bufPtr->nextPtr; - if (statePtr->outQueueHead == NULL) { - statePtr->outQueueTail = NULL; + /* + * If this buffer is now empty, recycle it. + */ + + if (IsBufferEmpty(bufPtr)) { + statePtr->outQueueHead = bufPtr->nextPtr; + if (statePtr->outQueueHead == NULL) { + statePtr->outQueueTail = NULL; + } + RecycleBuffer(statePtr, bufPtr, 0); } - RecycleBuffer(statePtr, bufPtr, 0); } - ReleaseChannelBuffer(bufPtr); + } /* Closes "while". */ /* @@ -3093,13 +3194,7 @@ CloseChannel( /* * Cancel any outstanding timer. */ - - if (statePtr->timer != NULL) { - Tcl_DeleteTimerHandler(statePtr->timer); - statePtr->timer = NULL; - TclChannelRelease((Tcl_Channel)statePtr->timerChanPtr); - statePtr->timerChanPtr = NULL; - } + DeleteTimerHandler(statePtr); /* @@ -3360,12 +3455,12 @@ Tcl_SpliceChannel( *---------------------------------------------------------------------- */ - /* ARGSUSED */ int Tcl_Close( Tcl_Interp *interp, /* Interpreter for errors. */ Tcl_Channel chan) /* The channel being closed. Must not be - * referenced in any interpreter. */ + * referenced in any interpreter. May be NULL, + * in which case this is a no-op. */ { CloseCallback *cbPtr; /* Iterate over close callbacks for this * channel. */ @@ -3405,7 +3500,7 @@ Tcl_Close( if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "illegal recursive call to close through close-handler" - " of channel", -1)); + " of channel", TCL_INDEX_NONE)); } return TCL_ERROR; } @@ -3450,6 +3545,11 @@ Tcl_Close( Tcl_ClearChannelHandlers(chan); /* + * Cancel any outstanding timer. + */ + DeleteTimerHandler(statePtr); + + /* * Invoke the registered close callbacks and delete their records. */ @@ -3467,6 +3567,7 @@ Tcl_Close( * it anymore and this will help avoid deadlocks on some channel types. */ +#ifndef TCL_NO_DEPRECATED if ((chanPtr->typePtr->closeProc == TCL_CLOSE2PROC) || (chanPtr->typePtr->closeProc == NULL)) { /* If this half-close gives a EINVAL or ENOTCONN, just continue the full close */ result = chanPtr->typePtr->close2Proc(chanPtr->instanceData, interp, TCL_CLOSE_READ); @@ -3474,6 +3575,12 @@ Tcl_Close( result = 0; } } +#else + result = chanPtr->typePtr->close2Proc(chanPtr->instanceData, interp, TCL_CLOSE_READ); + if ((result == EINVAL) || result == ENOTCONN) { + result = 0; + } +#endif /* * The call to FlushChannel will flush any queued output and invoke the @@ -3506,7 +3613,7 @@ Tcl_Close( Tcl_SetErrno(stickyError); if (interp != NULL) { Tcl_SetObjResult(interp, - Tcl_NewStringObj(Tcl_PosixError(interp), -1)); + Tcl_NewStringObj(Tcl_PosixError(interp), TCL_INDEX_NONE)); } return TCL_ERROR; } @@ -3521,10 +3628,10 @@ Tcl_Close( result = flushcode; } if ((result != 0) && (result != TCL_ERROR) && (interp != NULL) - && 0 == Tcl_GetCharLength(Tcl_GetObjResult(interp))) { + && 0 == TclGetCharLength(Tcl_GetObjResult(interp))) { Tcl_SetErrno(result); Tcl_SetObjResult(interp, - Tcl_NewStringObj(Tcl_PosixError(interp), -1)); + Tcl_NewStringObj(Tcl_PosixError(interp), TCL_INDEX_NONE)); } if (result != 0) { return TCL_ERROR; @@ -3537,24 +3644,21 @@ Tcl_Close( * * Tcl_CloseEx -- * - * Closes one side of a channel, read or write. + * Closes one side of a channel, read or write, close all. * * Results: * A standard Tcl result. * * Side effects: - * Closes one direction of the channel. + * Closes one direction of the channel, or do a full close. * * NOTE: * Tcl_CloseEx closes the specified direction of the channel as far as - * the user is concerned. The channel keeps existing however. You cannot - * call this function to close the last possible direction of the - * channel. Use Tcl_Close for that. + * the user is concerned. If flags = 0, this is equivalent to Tcl_Close. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ int Tcl_CloseEx( Tcl_Interp *interp, /* Interpreter for errors. */ @@ -3599,7 +3703,7 @@ Tcl_CloseEx( if (chanPtr != statePtr->topChanPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "half-close not applicable to stack of transformations", -1)); + "half-close not applicable to stack of transformations", TCL_INDEX_NONE)); return TCL_ERROR; } @@ -3609,7 +3713,7 @@ Tcl_CloseEx( * opened for that direction). */ - if (!(statePtr->flags & (TCL_READABLE | TCL_WRITABLE) & flags)) { + if (!(GotFlag(statePtr, TCL_READABLE|TCL_WRITABLE) & flags)) { const char *msg; if (flags & TCL_CLOSE_READ) { @@ -3628,11 +3732,11 @@ Tcl_CloseEx( * That won't do. */ - if (statePtr->flags & CHANNEL_INCLOSE) { + if (GotFlag(statePtr, CHANNEL_INCLOSE)) { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "illegal recursive call to close through close-handler" - " of channel", -1)); + " of channel", TCL_INDEX_NONE)); } return TCL_ERROR; } @@ -3918,13 +4022,7 @@ Tcl_ClearChannelHandlers( /* * Cancel any outstanding timer. */ - - if (statePtr->timer != NULL) { - Tcl_DeleteTimerHandler(statePtr->timer); - statePtr->timer = NULL; - TclChannelRelease((Tcl_Channel)statePtr->timerChanPtr); - statePtr->timerChanPtr = NULL; - } + DeleteTimerHandler(statePtr); /* * Remove any references to channel handlers for this channel that may be @@ -3991,8 +4089,8 @@ Tcl_ClearChannelHandlers( * No encoding conversions are applied to the bytes being read. * * Results: - * The number of bytes written or -1 in case of error. If -1, - * Tcl_GetErrno will return the error code. + * The number of bytes written or TCL_INDEX_NONE in case of error. If + * TCL_INDEX_NONE, Tcl_GetErrno will return the error code. * * Side effects: * May buffer up output and may cause output to be produced on the @@ -4019,14 +4117,14 @@ Tcl_Write( chanPtr = statePtr->topChanPtr; if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) { - return -1; + return TCL_INDEX_NONE; } if (srcLen < 0) { srcLen = strlen(src); } if (WriteBytes(chanPtr, src, srcLen) < 0) { - return -1; + return TCL_INDEX_NONE; } return srcLen; } @@ -4045,8 +4143,8 @@ Tcl_Write( * No encoding conversions are applied to the bytes being read. * * Results: - * The number of bytes written or -1 in case of error. If -1, - * Tcl_GetErrno will return the error code. + * The number of bytes written or TCL_INDEX_NONE in case of error. If + * TCL_INDEX_NONE, Tcl_GetErrno will return the error code. * * Side effects: * May buffer up output and may cause output to be produced on the @@ -4068,7 +4166,7 @@ Tcl_WriteRaw( int errorCode, written; if (CheckChannelErrors(statePtr, TCL_WRITABLE | CHANNEL_RAW_MODE) != 0) { - return -1; + return TCL_INDEX_NONE; } if (srcLen < 0) { @@ -4101,8 +4199,8 @@ Tcl_WriteRaw( * specified channel to the topmost channel in a stack. * * Results: - * The number of bytes written or -1 in case of error. If -1, - * Tcl_GetErrno will return the error code. + * The number of bytes written or TCL_INDEX_NONE in case of error. If + * TCL_INDEX_NONE, Tcl_GetErrno will return the error code. * * Side effects: * May buffer up output and may cause output to be produced on the @@ -4116,7 +4214,7 @@ Tcl_WriteChars( Tcl_Channel chan, /* The channel to buffer output for. */ const char *src, /* UTF-8 characters to queue in output * buffer. */ - int len) /* Length of string in bytes, or < 0 for + int len) /* Length of string in bytes, or TCL_INDEX_NONE for * strlen(). */ { Channel *chanPtr = (Channel *) chan; @@ -4125,7 +4223,7 @@ Tcl_WriteChars( Tcl_Obj *objPtr; if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) { - return -1; + return TCL_INDEX_NONE; } chanPtr = statePtr->topChanPtr; @@ -4170,8 +4268,8 @@ Tcl_WriteChars( * line buffering mode. * * Results: - * The number of bytes written or -1 in case of error. If -1, - * Tcl_GetErrno() will return the error code. + * The number of bytes written or TCL_INDEX_NONE in case of error. If + * TCL_INDEX_NONE, Tcl_GetErrno() will return the error code. * * Side effects: * May buffer up output and may cause output to be produced on the @@ -4198,7 +4296,7 @@ Tcl_WriteObj( chanPtr = statePtr->topChanPtr; if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) { - return -1; + return TCL_INDEX_NONE; } if (statePtr->encoding == NULL) { src = (char *) Tcl_GetByteArrayFromObj(objPtr, &srcLen); @@ -4215,8 +4313,11 @@ WillWrite( { int inputBuffered; - if ((Tcl_ChannelSeekProc(chanPtr->typePtr) != NULL) && - ((inputBuffered = Tcl_InputBuffered((Tcl_Channel) chanPtr)) > 0)){ + if (((Tcl_ChannelWideSeekProc(chanPtr->typePtr) != NULL) +#ifndef TCL_NO_DEPRECATED + || (Tcl_ChannelSeekProc(chanPtr->typePtr) != NULL) +#endif + ) && ((inputBuffered = Tcl_InputBuffered((Tcl_Channel) chanPtr)) > 0)){ int ignore; DiscardInputQueued(chanPtr->state, 0); @@ -4235,11 +4336,13 @@ WillRead( DiscardInputQueued(chanPtr->state, 0); Tcl_SetErrno(EINVAL); - return -1; + return TCL_INDEX_NONE; } - if ((Tcl_ChannelSeekProc(chanPtr->typePtr) != NULL) - && (Tcl_OutputBuffered((Tcl_Channel) chanPtr) > 0)) { - + if (((Tcl_ChannelWideSeekProc(chanPtr->typePtr) != NULL) +#ifndef TCL_NO_DEPRECATED + || (Tcl_ChannelSeekProc(chanPtr->typePtr) != NULL) +#endif + ) && (Tcl_OutputBuffered((Tcl_Channel) chanPtr) > 0)) { /* * CAVEAT - The assumption here is that FlushChannel() will push out * the bytes of any writes that are in progress. Since this is a @@ -4251,7 +4354,7 @@ WillRead( */ if (FlushChannel(NULL, chanPtr, 0) != 0) { - return -1; + return TCL_INDEX_NONE; } } return 0; @@ -4268,7 +4371,7 @@ WillRead( * ready e.g. if it contains a newline and we are in line buffering mode. * * Results: - * The number of bytes written or -1 in case of error. If -1, + * The number of bytes written or TCL_INDEX_NONE in case of error. If TCL_INDEX_NONE, * Tcl_GetErrno will return the error code. * * Side effects: @@ -4332,7 +4435,6 @@ Write( bufPtr->nextAdded += saved; saved = 0; } - PreserveChannelBuffer(bufPtr); dst = InsertPoint(bufPtr); dstLen = SpaceLeft(bufPtr); @@ -4347,7 +4449,24 @@ Write( statePtr->outputEncodingFlags &= ~TCL_ENCODING_START; + /* + * See io-75.2, TCL bug 6978c01b65. + * Check, if an encoding error occured and should be reported to the + * script level. + * This happens, if a written character may not be represented by the + * current output encoding and strict encoding is active. + */ + + if (result == TCL_CONVERT_UNKNOWN || result == TCL_CONVERT_SYNTAX) { + encodingError = 1; + result = TCL_OK; + } + if ((result != TCL_OK) && (srcRead + dstWrote == 0)) { + /* + * We're reading from invalid/incomplete UTF-8. + */ + encodingError = 1; result = TCL_OK; } @@ -4418,8 +4537,7 @@ Write( if (IsBufferFull(bufPtr)) { if (FlushChannel(NULL, chanPtr, 0) != 0) { - ReleaseChannelBuffer(bufPtr); - return -1; + return TCL_INDEX_NONE; } flushed += statePtr->bufSize; @@ -4438,18 +4556,19 @@ Write( needNlFlush = 0; } } - ReleaseChannelBuffer(bufPtr); } if (((flushed < total) && GotFlag(statePtr, CHANNEL_UNBUFFERED)) || (needNlFlush && GotFlag(statePtr, CHANNEL_LINEBUFFERED))) { if (FlushChannel(NULL, chanPtr, 0) != 0) { - return -1; + return TCL_INDEX_NONE; } } + UpdateInterest(chanPtr); + if (encodingError) { - Tcl_SetErrno(EINVAL); - return -1; + Tcl_SetErrno(EILSEQ); + return TCL_INDEX_NONE; } return total; } @@ -4462,8 +4581,8 @@ Write( * Reads a complete line of input from the channel into a Tcl_DString. * * Results: - * Length of line read (in characters) or -1 if error, EOF, or blocked. - * If -1, use Tcl_GetErrno() to retrieve the POSIX error code for the + * Length of line read (in characters) or TCL_INDEX_NONE if error, EOF, or blocked. + * If TCL_INDEX_NONE, use Tcl_GetErrno() to retrieve the POSIX error code for the * error or condition that occurred. * * Side effects: @@ -4503,8 +4622,8 @@ Tcl_Gets( * converted to UTF-8 using the encoding specified by the channel. * * Results: - * Number of characters accumulated in the object or -1 if error, - * blocked, or EOF. If -1, use Tcl_GetErrno() to retrieve the POSIX error + * Number of characters accumulated in the object or TCL_INDEX_NONE if error, + * blocked, or EOF. If TCL_INDEX_NONE, use Tcl_GetErrno() to retrieve the POSIX error * code for the error or condition that occurred. * * Side effects: @@ -4527,13 +4646,20 @@ Tcl_GetsObj( ChannelState *statePtr = chanPtr->state; /* State info for channel */ ChannelBuffer *bufPtr; - int inEofChar, skip, copiedTotal, oldLength, oldFlags, oldRemoved; + int inEofChar, skip, copiedTotal, oldFlags, oldRemoved; + int oldLength; Tcl_Encoding encoding; char *dst, *dstEnd, *eol, *eof; Tcl_EncodingState oldState; + if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR)) { + UpdateInterest(chanPtr); + Tcl_SetErrno(EILSEQ); + return TCL_INDEX_NONE; + } + if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) { - return -1; + return TCL_INDEX_NONE; } /* @@ -4548,7 +4674,7 @@ Tcl_GetsObj( /* TODO: Do we need this? */ UpdateInterest(chanPtr); - return -1; + return TCL_INDEX_NONE; } /* @@ -4788,6 +4914,19 @@ Tcl_GetsObj( goto done; } goto gotEOL; + } else if (gs.bytesWrote == 0 + && GotFlag(statePtr, CHANNEL_ENCODING_ERROR) + && !GotFlag(statePtr, CHANNEL_NONBLOCKING)) { + /* Set eol to the position that caused the encoding error, and then + * coninue to gotEOL, which stores the data that was decoded + * without error to objPtr. This allows the caller to do something + * useful with the data decoded so far, and also results in the + * position of the file being the first byte that was not + * succesfully decoded, allowing further processing at exactly that + * point, if desired. + */ + eol = dstEnd; + goto gotEOL; } dst = dstEnd; } @@ -4887,6 +5026,7 @@ Tcl_GetsObj( done: assert(!GotFlag(statePtr, CHANNEL_EOF) || GotFlag(statePtr, CHANNEL_STICKY_EOF) + || GotFlag(statePtr, CHANNEL_ENCODING_ERROR) || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0); assert(!(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED) == (CHANNEL_EOF|CHANNEL_BLOCKED))); @@ -4903,6 +5043,11 @@ Tcl_GetsObj( } UpdateInterest(chanPtr); TclChannelRelease((Tcl_Channel)chanPtr); + if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR) && + (copiedTotal == 0 || !GotFlag(statePtr, CHANNEL_NONBLOCKING))) { + Tcl_SetErrno(EILSEQ); + copiedTotal = -1; + } return copiedTotal; } @@ -4920,8 +5065,8 @@ Tcl_GetsObj( * may be called when an -eofchar is set on the channel. * * Results: - * Number of characters accumulated in the object or -1 if error, - * blocked, or EOF. If -1, use Tcl_GetErrno() to retrieve the POSIX error + * Number of characters accumulated in the object or TCL_INDEX_NONE if error, + * blocked, or EOF. If TCL_INDEX_NONE, use Tcl_GetErrno() to retrieve the POSIX error * code for the error or condition that occurred. * * Side effects: @@ -4943,8 +5088,9 @@ TclGetsObjBinary( ChannelState *statePtr = chanPtr->state; /* State info for channel */ ChannelBuffer *bufPtr; - int inEofChar, skip, copiedTotal, oldLength, oldFlags, oldRemoved; - int rawLen, byteLen, eolChar; + int inEofChar, skip, copiedTotal, oldFlags, oldRemoved; + int rawLen, byteLen, oldLength; + int eolChar; unsigned char *dst, *dstEnd, *eol, *eof, *byteArray; /* @@ -5068,12 +5214,12 @@ TclGetsObjBinary( if ((dst == dstEnd) && (byteLen == oldLength)) { /* * If we didn't append any bytes before encountering EOF, - * caller needs to see -1. + * caller needs to see TCL_INDEX_NONE. */ byteArray = Tcl_SetByteArrayLength(objPtr, oldLength); CommonGetsCleanup(chanPtr); - copiedTotal = -1; + copiedTotal = TCL_INDEX_NONE; ResetFlag(statePtr, CHANNEL_BLOCKED); goto done; } @@ -5162,7 +5308,7 @@ TclGetsObjBinary( */ SetFlag(statePtr, CHANNEL_NEED_MORE_DATA); - copiedTotal = -1; + copiedTotal = TCL_INDEX_NONE; /* * Update the notifier state so we don't block while there is still data @@ -5196,10 +5342,9 @@ TclGetsObjBinary( static void FreeBinaryEncoding( - ClientData dummy) /* Not used */ + TCL_UNUSED(void *)) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - (void)dummy; if (tsdPtr->binaryEncoding != NULL) { Tcl_FreeEncoding(tsdPtr->binaryEncoding); @@ -5208,7 +5353,7 @@ FreeBinaryEncoding( } static Tcl_Encoding -GetBinaryEncoding() +GetBinaryEncoding(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -5352,11 +5497,17 @@ FilterInputBytes( *gsPtr->dstPtr = dst; } gsPtr->state = statePtr->inputEncodingState; + result = Tcl_ExternalToUtf(NULL, gsPtr->encoding, raw, rawLen, statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE, &statePtr->inputEncodingState, dst, spaceLeft, &gsPtr->rawRead, &gsPtr->bytesWrote, &gsPtr->charsWrote); + if (result == TCL_CONVERT_UNKNOWN || result == TCL_CONVERT_SYNTAX) { + SetFlag(statePtr, CHANNEL_ENCODING_ERROR); + result = TCL_OK; + } + /* * Make sure that if we go through 'gets', that we reset the * TCL_ENCODING_START flag still. [Bug #523988] @@ -5576,7 +5727,7 @@ CommonGetsCleanup( * No encoding conversions are applied to the bytes being read. * * Results: - * The number of bytes read, or -1 on error. Use Tcl_GetErrno() to + * The number of bytes read, or TCL_INDEX_NONE on error. Use Tcl_GetErrno() to * retrieve the error code for the error that occurred. * * Side effects: @@ -5602,7 +5753,7 @@ Tcl_Read( chanPtr = statePtr->topChanPtr; if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) { - return -1; + return TCL_INDEX_NONE; } return DoRead(chanPtr, dst, bytesToRead, 0); @@ -5621,7 +5772,7 @@ Tcl_Read( * No encoding conversions are applied to the bytes being read. * * Results: - * The number of bytes read, or -1 on error. Use Tcl_GetErrno() to + * The number of bytes read, or TCL_INDEX_NONE on error. Use Tcl_GetErrno() to * retrieve the error code for the error that occurred. * * Side effects: @@ -5643,7 +5794,7 @@ Tcl_ReadRaw( assert(bytesToRead > 0); if (CheckChannelErrors(statePtr, TCL_READABLE | CHANNEL_RAW_MODE) != 0) { - return -1; + return TCL_INDEX_NONE; } /* @@ -5697,13 +5848,7 @@ Tcl_ReadRaw( if (bytesToRead > 0) { int nread = ChanRead(chanPtr, readBuf, bytesToRead); - if (nread > 0) { - /* - * Successful read (short is OK) - add to bytes copied. - */ - - copied += nread; - } else if (nread < 0) { + if (nread < 0) { /* * An error signaled. If CHANNEL_BLOCKED, then the error is not * real, but an indication of blocked state. In that case, retain @@ -5715,8 +5860,14 @@ Tcl_ReadRaw( */ if (!GotFlag(statePtr, CHANNEL_BLOCKED) || copied == 0) { - copied = -1; + copied = TCL_INDEX_NONE; } + } else if (nread > 0) { + /* + * Successful read (short is OK) - add to bytes copied. + */ + + copied += nread; } else { /* * nread == 0. Driver is at EOF. Let that state filter up. @@ -5739,7 +5890,7 @@ Tcl_ReadRaw( * object. * * Results: - * The number of characters read, or -1 on error. Use Tcl_GetErrno() to + * The number of characters read, or TCL_INDEX_NONE on error. Use Tcl_GetErrno() to * retrieve the error code for the error that occurred. * * Side effects: @@ -5753,7 +5904,7 @@ Tcl_ReadChars( Tcl_Channel chan, /* The channel to read. */ Tcl_Obj *objPtr, /* Input data is stored in this object. */ int toRead, /* Maximum number of characters to store, or - * -1 to read all available data (up to EOF or + * TCL_INDEX_NONE to read all available data (up to EOF or * when channel blocks). */ int appendFlag) /* If non-zero, data read from the channel * will be appended to the object. Otherwise, @@ -5777,7 +5928,7 @@ Tcl_ReadChars( */ UpdateInterest(chanPtr); - return -1; + return TCL_INDEX_NONE; } return DoReadChars(chanPtr, objPtr, toRead, appendFlag); @@ -5795,7 +5946,7 @@ Tcl_ReadChars( * object. * * Results: - * The number of characters read, or -1 on error. Use Tcl_GetErrno() to + * The number of characters read, or TCL_INDEX_NONE on error. Use Tcl_GetErrno() to * retrieve the error code for the error that occurred. * * Side effects: @@ -5809,7 +5960,7 @@ DoReadChars( Channel *chanPtr, /* The channel to read. */ Tcl_Obj *objPtr, /* Input data is stored in this object. */ int toRead, /* Maximum number of characters to store, or - * -1 to read all available data (up to EOF or + * TCL_INDEX_NONE to read all available data (up to EOF or * when channel blocks). */ int appendFlag) /* If non-zero, data read from the channel * will be appended to the object. Otherwise, @@ -5829,7 +5980,11 @@ DoReadChars( && (statePtr->inputTranslation == TCL_TRANSLATE_LF) && (statePtr->inEofChar == '\0'); - if (appendFlag == 0) { + if (appendFlag) { + if (binaryMode && (NULL == TclGetBytesFromObj(NULL, objPtr, NULL))) { + binaryMode = 0; + } + } else { if (binaryMode) { Tcl_SetByteArrayLength(objPtr, 0); } else { @@ -5847,6 +6002,12 @@ DoReadChars( } } + if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR)) { + /* TODO: We don't need this call? */ + UpdateInterest(chanPtr); + Tcl_SetErrno(EILSEQ); + return -1; + } /* * Early out when next read will see eofchar. * @@ -5895,7 +6056,7 @@ DoReadChars( ResetFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_EOF); statePtr->inputEncodingFlags &= ~TCL_ENCODING_END; for (copied = 0; (unsigned) toRead > 0; ) { - copiedNow = -1; + copiedNow = TCL_INDEX_NONE; if (statePtr->inQueueHead != NULL) { if (binaryMode) { copiedNow = ReadBytes(statePtr, objPtr, toRead); @@ -5917,6 +6078,23 @@ DoReadChars( statePtr->inQueueTail = NULL; } } + + /* + * If CHANNEL_ENCODING_ERROR and CHANNEL_STICKY_EOF are both set, + * then CHANNEL_ENCODING_ERROR was caused by data that occurred + * after the EOF character was encountered, so it doesn't count as + * a real error. + */ + + if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR) + && !GotFlag(statePtr, CHANNEL_STICKY_EOF) + && !GotFlag(statePtr, CHANNEL_NONBLOCKING)) { + /* Channel is blocking. Return an error so that callers + * like [read] can return an error. + */ + Tcl_SetErrno(EILSEQ); + goto finish; + } } if (copiedNow < 0) { @@ -5935,7 +6113,7 @@ DoReadChars( } if (result != 0) { if (!GotFlag(statePtr, CHANNEL_BLOCKED)) { - copied = -1; + copied = TCL_INDEX_NONE; } break; } @@ -5945,6 +6123,7 @@ DoReadChars( } } +finish: /* * Failure to fill a channel buffer may have left channel reporting a * "blocked" state, but so long as we fulfilled the request here, the @@ -5973,10 +6152,16 @@ DoReadChars( assert(!GotFlag(statePtr, CHANNEL_EOF) || GotFlag(statePtr, CHANNEL_STICKY_EOF) + || GotFlag(statePtr, CHANNEL_ENCODING_ERROR) || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0); assert(!(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED) == (CHANNEL_EOF|CHANNEL_BLOCKED))); UpdateInterest(chanPtr); + if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR) + && (!copied || !GotFlag(statePtr, CHANNEL_NONBLOCKING))) { + Tcl_SetErrno(EILSEQ); + copied = -1; + } TclChannelRelease((Tcl_Channel)chanPtr); return copied; } @@ -5996,7 +6181,7 @@ DoReadChars( * * Results: * The return value is the number of bytes appended to the object, or - * -1 to indicate that zero bytes were read due to an EOF. + * TCL_INDEX_NONE to indicate that zero bytes were read due to an EOF. * * Side effects: * The storage of bytes in objPtr can cause (re-)allocation of memory. @@ -6065,7 +6250,7 @@ ReadChars( * allocated to hold data, not how many bytes * of data have been stored in the object. */ int charsToRead, /* Maximum number of characters to store, or - * -1 to get all available characters. + * TCL_INDEX_NONE to get all available characters. * Characters are obtained from the first * buffer in the queue -- even if this number * is larger than the number of characters @@ -6089,7 +6274,8 @@ ReadChars( int savedIEFlags = statePtr->inputEncodingFlags; int savedFlags = statePtr->flags; char *dst, *src = RemovePoint(bufPtr); - int numBytes, srcLen = BytesLeft(bufPtr); + int numBytes; + int srcLen = BytesLeft(bufPtr); /* * One src byte can yield at most one character. So when the number of @@ -6165,6 +6351,11 @@ ReadChars( flags, &statePtr->inputEncodingState, dst, dstLimit, &srcRead, &dstDecoded, &numChars); + if (code == TCL_CONVERT_UNKNOWN || code == TCL_CONVERT_SYNTAX) { + SetFlag(statePtr, CHANNEL_ENCODING_ERROR); + code = TCL_OK; + } + /* * Perform the translation transformation in place. Read no more than * the dstDecoded bytes the encoding transformation actually produced. @@ -6192,12 +6383,12 @@ ReadChars( * the stopping, but the value of dstRead does not include it. * * Also rather bizarre, our caller can only notice an EOF - * condition if we return the value -1 as the number of chars + * condition if we return the value TCL_INDEX_NONE as the number of chars * read. This forces us to perform a 2-call dance where the * first call can read all the chars up to the eof char, and * the second call is solely for consuming the encoded eof * char then pointed at by src so that we can return that - * magic -1 value. This seems really wasteful, especially + * magic TCL_INDEX_NONE value. This seems really wasteful, especially * since the first decoding pass of each call is likely to * decode many bytes beyond that eof char that's all we care * about. @@ -6212,7 +6403,7 @@ ReadChars( */ Tcl_SetObjLength(objPtr, numBytes); - return -1; + return TCL_INDEX_NONE; } { @@ -6300,7 +6491,7 @@ ReadChars( return 1; } - } else if (statePtr->flags & CHANNEL_EOF) { + } else if (GotFlag(statePtr, CHANNEL_EOF)) { /* * The bare \r is the only char and we will never read a * subsequent char to make the determination. @@ -6340,7 +6531,7 @@ ReadChars( * bytes demanded by the Tcl_ExternalToUtf() call! */ - dstLimit = Tcl_UtfAtIndex(dst, charsToRead) - dst + (TCL_UTF_MAX - 1); + dstLimit = TclUtfAtIndex(dst, charsToRead) - dst + (TCL_UTF_MAX - 1); statePtr->flags = savedFlags; statePtr->inputEncodingFlags = savedIEFlags; statePtr->inputEncodingState = savedState; @@ -6387,7 +6578,7 @@ ReadChars( SetFlag(statePtr, CHANNEL_NEED_MORE_DATA); } Tcl_SetObjLength(objPtr, numBytes); - return -1; + return TCL_INDEX_NONE; } /* @@ -6566,7 +6757,7 @@ TranslateInputEOL( char *dst = dstStart; int lesser; - if ((statePtr->flags & INPUT_SAW_CR) && srcLen) { + if (GotFlag(statePtr, INPUT_SAW_CR) && srcLen) { if (*src == '\n') { src++; srcLen--; } ResetFlag(statePtr, INPUT_SAW_CR); } @@ -6601,11 +6792,14 @@ TranslateInputEOL( * EOF character was seen in EOL translated range. Leave current file * position pointing at the EOF character, but don't store the EOF * character in the output string. + * + * If CHANNEL_ENCODING_ERROR is set, it can only be because of data + * encountered after the EOF character, so it is nonsense. Unset it. */ SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF); statePtr->inputEncodingFlags |= TCL_ENCODING_END; - ResetFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR); + ResetFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR|CHANNEL_ENCODING_ERROR); } } @@ -6618,7 +6812,7 @@ TranslateInputEOL( * channel, at either the head or tail of the queue. * * Results: - * The number of bytes stored in the channel, or -1 on error. + * The number of bytes stored in the channel, or TCL_INDEX_NONE on error. * * Side effects: * Adds input to the input queue of a channel. @@ -6654,7 +6848,7 @@ Tcl_Ungets( flags = statePtr->flags; if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) { - len = -1; + len = TCL_INDEX_NONE; goto done; } statePtr->flags = flags; @@ -6839,24 +7033,21 @@ GetInput( } /* - * WARNING: There was once a comment here claiming that it was - * a bad idea to make another call to the inputproc of a channel - * driver when EOF has already been detected on the channel. Through - * much of Tcl's history, this warning was then completely negated - * by having all (most?) read paths clear the EOF setting before - * reaching here. So we had a guard that was never triggered. + * WARNING: There was once a comment here claiming that it was a bad idea + * to make another call to the inputproc of a channel driver when EOF has + * already been detected on the channel. Through much of Tcl's history, + * this warning was then completely negated by having all (most?) read + * paths clear the EOF setting before reaching here. So we had a guard + * that was never triggered. + * + * Don't be tempted to restore the guard. Even if EOF is set on the + * channel, continue through and call the inputproc again. This is the + * way to enable the ability to [read] again beyond the EOF, which seems a + * strange thing to do, but for which use cases exist [Tcl Bug 5adc350683] + * and which may even be essential for channels representing things like + * ttys or other devices where the stream might take the logical form of a + * series of 'files' separated by an EOF condition. * - * Don't be tempted to restore the guard. Even if EOF is set on - * the channel, continue through and call the inputproc again. This - * is the way to enable the ability to [read] again beyond the EOF, - * which seems a strange thing to do, but for which use cases exist - * [Tcl Bug 5adc350683] and which may even be essential for channels - * representing things like ttys or other devices where the stream - * might take the logical form of a series of 'files' separated by - * an EOF condition. - */ - - /* * First check for more buffers in the pushback area of the topmost * channel in the stack and use them. They can be the result of a * transformation which went away without reading all the information @@ -6900,7 +7091,7 @@ GetInput( */ if ((bufPtr != NULL) - && (bufPtr->bufLength - BUFFER_PADDING != statePtr->bufSize)) { + && (bufPtr->bufLength != statePtr->bufSize + BUFFER_PADDING)) { ReleaseChannelBuffer(bufPtr); bufPtr = NULL; } @@ -6925,15 +7116,17 @@ GetInput( PreserveChannelBuffer(bufPtr); nread = ChanRead(chanPtr, InsertPoint(bufPtr), toRead); + ReleaseChannelBuffer(bufPtr); if (nread < 0) { result = Tcl_GetErrno(); } else { result = 0; - bufPtr->nextAdded += nread; + if (statePtr->inQueueTail != NULL) { + statePtr->inQueueTail->nextAdded += nread; + } } - ReleaseChannelBuffer(bufPtr); return result; } @@ -6955,10 +7148,10 @@ GetInput( *---------------------------------------------------------------------- */ -Tcl_WideInt +long long Tcl_Seek( Tcl_Channel chan, /* The channel on which to seek. */ - Tcl_WideInt offset, /* Offset to seek to. */ + long long offset, /* Offset to seek to. */ int mode) /* Relative to which location to seek? */ { Channel *chanPtr = (Channel *) chan; @@ -6968,7 +7161,7 @@ Tcl_Seek( int inputBuffered, outputBuffered; /* # bytes held in buffers. */ int result; /* Of device driver operations. */ - Tcl_WideInt curPos; /* Position on the device. */ + long long curPos; /* Position on the device. */ int wasAsync; /* Was the channel nonblocking before the seek * operation? If so, must restore to * non-blocking mode after the seek. */ @@ -6999,7 +7192,11 @@ Tcl_Seek( * defined. This means that the channel does not support seeking. */ - if (Tcl_ChannelSeekProc(chanPtr->typePtr) == NULL) { + if ((Tcl_ChannelWideSeekProc(chanPtr->typePtr) == NULL) +#ifndef TCL_NO_DEPRECATED + && (Tcl_ChannelSeekProc(chanPtr->typePtr) == NULL) +#endif + ) { Tcl_SetErrno(EINVAL); return -1; } @@ -7124,7 +7321,7 @@ Tcl_Seek( *---------------------------------------------------------------------- */ -Tcl_WideInt +long long Tcl_Tell( Tcl_Channel chan) /* The channel to return pos for. */ { @@ -7135,7 +7332,7 @@ Tcl_Tell( int inputBuffered, outputBuffered; /* # bytes held in buffers. */ int result; /* Of calling device driver. */ - Tcl_WideInt curPos; /* Position on device. */ + long long curPos; /* Position on device. */ if (CheckChannelErrors(statePtr, TCL_WRITABLE | TCL_READABLE) != 0) { return -1; @@ -7163,7 +7360,11 @@ Tcl_Tell( * defined. This means that the channel does not support seeking. */ - if (Tcl_ChannelSeekProc(chanPtr->typePtr) == NULL) { + if ((Tcl_ChannelWideSeekProc(chanPtr->typePtr) == NULL) +#ifndef TCL_NO_DEPRECATED + && (Tcl_ChannelSeekProc(chanPtr->typePtr) == NULL) +#endif + ) { Tcl_SetErrno(EINVAL); return -1; } @@ -7197,47 +7398,6 @@ Tcl_Tell( /* *--------------------------------------------------------------------------- * - * Tcl_SeekOld, Tcl_TellOld -- - * - * Backward-compatibility versions of the seek/tell interface that do not - * support 64-bit offsets. This interface is not documented or expected - * to be supported indefinitely. - * - * Results: - * As for Tcl_Seek and Tcl_Tell respectively, except truncated to - * whatever value will fit in an 'int'. - * - * Side effects: - * As for Tcl_Seek and Tcl_Tell respectively. - * - *--------------------------------------------------------------------------- - */ - -int -Tcl_SeekOld( - Tcl_Channel chan, /* The channel on which to seek. */ - int offset, /* Offset to seek to. */ - int mode) /* Relative to which location to seek? */ -{ - Tcl_WideInt wOffset, wResult; - - wOffset = Tcl_LongAsWide((long) offset); - wResult = Tcl_Seek(chan, wOffset, mode); - return (int) Tcl_WideAsLong(wResult); -} - -int -Tcl_TellOld( - Tcl_Channel chan) /* The channel to return pos for. */ -{ - Tcl_WideInt wResult = Tcl_Tell(chan); - - return (int) Tcl_WideAsLong(wResult); -} - -/* - *--------------------------------------------------------------------------- - * * Tcl_TruncateChannel -- * * Truncate a channel to the given length. @@ -7256,7 +7416,7 @@ Tcl_TellOld( int Tcl_TruncateChannel( Tcl_Channel chan, /* Channel to truncate. */ - Tcl_WideInt length) /* Length to truncate it to. */ + long long length) /* Length to truncate it to. */ { Channel *chanPtr = (Channel *) chan; Tcl_DriverTruncateProc *truncateProc = @@ -7370,7 +7530,7 @@ CheckChannelErrors( * Fail if the channel is not opened for desired operation. */ - if ((statePtr->flags & direction) == 0) { + if (GotFlag(statePtr, direction) == 0) { Tcl_SetErrno(EACCES); return -1; } @@ -7418,6 +7578,9 @@ Tcl_Eof( ChannelState *statePtr = ((Channel *) chan)->state; /* State of real channel structure. */ + if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR)) { + return 0; + } return GotFlag(statePtr, CHANNEL_EOF) ? 1 : 0; } @@ -7692,17 +7855,17 @@ Tcl_BadChannelOption( { if (interp != NULL) { const char *genericopt = - "blocking buffering buffersize encoding eofchar translation"; + "blocking buffering buffersize encoding eofchar profile translation"; const char **argv; int argc, i; Tcl_DString ds; Tcl_Obj *errObj; Tcl_DStringInit(&ds); - Tcl_DStringAppend(&ds, genericopt, -1); + Tcl_DStringAppend(&ds, genericopt, TCL_INDEX_NONE); if (optionList && (*optionList)) { TclDStringAppendLiteral(&ds, " "); - Tcl_DStringAppend(&ds, optionList, -1); + Tcl_DStringAppend(&ds, optionList, TCL_INDEX_NONE); } if (Tcl_SplitList(interp, Tcl_DStringValue(&ds), &argc, &argv) != TCL_OK) { @@ -7890,6 +8053,23 @@ Tcl_GetChannelOption( return TCL_OK; } } + if (len == 0 || HaveOpt(1, "-profile")) { + int profile; + const char *profileName; + if (len == 0) { + Tcl_DStringAppendElement(dsPtr, "-profile"); + } + /* Note currently input and output profiles are same */ + profile = CHANNEL_PROFILE_GET(statePtr->inputEncodingFlags); + profileName = TclEncodingProfileIdToName(interp, profile); + if (profileName == NULL) { + return TCL_ERROR; + } + Tcl_DStringAppendElement(dsPtr, profileName); + if (len > 0) { + return TCL_OK; + } + } if (len == 0 || HaveOpt(1, "-translation")) { if (len == 0) { Tcl_DStringAppendElement(dsPtr, "-translation"); @@ -7986,7 +8166,7 @@ Tcl_SetChannelOption( /* State info for channel */ size_t len; /* Length of optionName string. */ int argc; - const char **argv; + const char **argv = NULL; /* * If the channel is in the middle of a background copy, fail. @@ -7996,7 +8176,7 @@ Tcl_SetChannelOption( if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "unable to set channel options: background copy in" - " progress", -1)); + " progress", TCL_INDEX_NONE)); } return TCL_ERROR; } @@ -8047,7 +8227,7 @@ Tcl_SetChannelOption( } else if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "bad value for -buffering: must be one of" - " full, line, or none", -1)); + " full, line, or none", TCL_INDEX_NONE)); return TCL_ERROR; } return TCL_OK; @@ -8061,6 +8241,7 @@ Tcl_SetChannelOption( return TCL_OK; } else if (HaveOpt(2, "-encoding")) { Tcl_Encoding encoding; + int profile; if ((newValue[0] == '\0') || (strcmp(newValue, "binary") == 0)) { encoding = NULL; @@ -8085,29 +8266,35 @@ Tcl_SetChannelOption( Tcl_FreeEncoding(statePtr->encoding); statePtr->encoding = encoding; statePtr->inputEncodingState = NULL; + profile = CHANNEL_PROFILE_GET(statePtr->inputEncodingFlags); statePtr->inputEncodingFlags = TCL_ENCODING_START; + CHANNEL_PROFILE_SET(statePtr->inputEncodingFlags, profile); statePtr->outputEncodingState = NULL; statePtr->outputEncodingFlags = TCL_ENCODING_START; - ResetFlag(statePtr, CHANNEL_NEED_MORE_DATA); + CHANNEL_PROFILE_SET(statePtr->outputEncodingFlags, profile); /* Same as input */ + ResetFlag(statePtr, CHANNEL_NEED_MORE_DATA|CHANNEL_ENCODING_ERROR); UpdateInterest(chanPtr); return TCL_OK; } else if (HaveOpt(2, "-eofchar")) { - if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) { + if (!newValue[0] || (!(newValue[0] & 0x80) && !newValue[1])) { + if (GotFlag(statePtr, TCL_READABLE)) { + statePtr->inEofChar = newValue[0]; + } + statePtr->outEofChar = 0; + } else if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) { return TCL_ERROR; - } - if (argc == 0) { + } else if (argc == 0) { statePtr->inEofChar = 0; statePtr->outEofChar = 0; } else if (argc == 1 || argc == 2) { - int outIndex = (argc - 1); int inValue = (int) argv[0][0]; - int outValue = (int) argv[outIndex][0]; + int outValue = (argc == 2) ? (int) argv[1][0] : 0; if (inValue & 0x80 || outValue & 0x80) { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "bad value for -eofchar: must be non-NUL ASCII" - " character", -1)); + " character", TCL_INDEX_NONE)); } ckfree(argv); return TCL_ERROR; @@ -8122,7 +8309,7 @@ Tcl_SetChannelOption( if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "bad value for -eofchar: should be a list of zero," - " one, or two elements", -1)); + " one, or two elements", TCL_INDEX_NONE)); } ckfree(argv); return TCL_ERROR; @@ -8143,6 +8330,15 @@ Tcl_SetChannelOption( ResetFlag(statePtr, CHANNEL_EOF|CHANNEL_STICKY_EOF|CHANNEL_BLOCKED); statePtr->inputEncodingFlags &= ~TCL_ENCODING_END; return TCL_OK; + } else if (HaveOpt(1, "-profile")) { + int profile; + if (TclEncodingProfileNameToId(interp, newValue, &profile) != TCL_OK) { + return TCL_ERROR; + } + CHANNEL_PROFILE_SET(statePtr->inputEncodingFlags, profile); + CHANNEL_PROFILE_SET(statePtr->outputEncodingFlags, profile); + ResetFlag(statePtr, CHANNEL_NEED_MORE_DATA|CHANNEL_ENCODING_ERROR); + return TCL_OK; } else if (HaveOpt(1, "-translation")) { const char *readMode, *writeMode; @@ -8160,7 +8356,7 @@ Tcl_SetChannelOption( if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "bad value for -translation: must be a one or two" - " element list", -1)); + " element list", TCL_INDEX_NONE)); } ckfree(argv); return TCL_ERROR; @@ -8190,7 +8386,7 @@ Tcl_SetChannelOption( if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "bad value for -translation: must be one of " - "auto, binary, cr, lf, crlf, or platform", -1)); + "auto, binary, cr, lf, crlf, or platform", TCL_INDEX_NONE)); } ckfree(argv); return TCL_ERROR; @@ -8240,7 +8436,7 @@ Tcl_SetChannelOption( if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "bad value for -translation: must be one of " - "auto, binary, cr, lf, crlf, or platform", -1)); + "auto, binary, cr, lf, crlf, or platform", TCL_INDEX_NONE)); } ckfree(argv); return TCL_ERROR; @@ -8570,6 +8766,18 @@ UpdateInterest( } } } + + if (!statePtr->timer + && mask & TCL_WRITABLE + && GotFlag(statePtr, CHANNEL_NONBLOCKING)) { + + TclChannelPreserve((Tcl_Channel)chanPtr); + statePtr->timerChanPtr = chanPtr; + statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, + ChannelTimerProc,chanPtr); + } + + ChanWatch(chanPtr, mask); } @@ -8592,40 +8800,80 @@ UpdateInterest( static void ChannelTimerProc( - ClientData clientData) + void *clientData) { Channel *chanPtr = (Channel *)clientData; /* State info for channel */ ChannelState *statePtr = chanPtr->state; + /* TclChannelPreserve() must be called before the current function was + * scheduled, is already in effect. In this function it guards against + * deallocation in Tcl_NotifyChannel and also keps the channel preserved + * until ChannelTimerProc is later called again. + */ + if (chanPtr->typePtr == NULL) { - statePtr->timer = NULL; - TclChannelRelease((Tcl_Channel)statePtr->timerChanPtr); - statePtr->timerChanPtr = NULL; + CleanupTimerHandler(statePtr); } else { - if (!GotFlag(statePtr, CHANNEL_NEED_MORE_DATA) - && (statePtr->interestMask & TCL_READABLE) - && (statePtr->inQueueHead != NULL) - && IsBufferReady(statePtr->inQueueHead)) { + Tcl_Preserve(statePtr); + statePtr->timer = NULL; + if (statePtr->interestMask & TCL_WRITABLE + && GotFlag(statePtr, CHANNEL_NONBLOCKING) + && !GotFlag(statePtr, BG_FLUSH_SCHEDULED) + ) { /* * Restart the timer in case a channel handler reenters the event loop * before UpdateInterest gets called by Tcl_NotifyChannel. */ - statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, ChannelTimerProc,chanPtr); - Tcl_Preserve(statePtr); - Tcl_NotifyChannel((Tcl_Channel) chanPtr, TCL_READABLE); - Tcl_Release(statePtr); + Tcl_NotifyChannel((Tcl_Channel) chanPtr, TCL_WRITABLE); } else { - statePtr->timer = NULL; - UpdateInterest(chanPtr); - TclChannelRelease((Tcl_Channel)statePtr->timerChanPtr); - statePtr->timerChanPtr = NULL; + /* The channel may have just been closed from within Tcl_NotifyChannel */ + if (!GotFlag(statePtr, CHANNEL_INCLOSE)) { + if (!GotFlag(statePtr, CHANNEL_NEED_MORE_DATA) + && (statePtr->interestMask & TCL_READABLE) + && (statePtr->inQueueHead != NULL) + && IsBufferReady(statePtr->inQueueHead)) { + /* + * Restart the timer in case a channel handler reenters the event loop + * before UpdateInterest gets called by Tcl_NotifyChannel. + */ + + statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, + ChannelTimerProc,chanPtr); + Tcl_NotifyChannel((Tcl_Channel) chanPtr, TCL_READABLE); + } else { + CleanupTimerHandler(statePtr); + UpdateInterest(chanPtr); + } + } else { + CleanupTimerHandler(statePtr); + } } + Tcl_Release(statePtr); } } +static void +DeleteTimerHandler( + ChannelState *statePtr +) +{ + if (statePtr->timer != NULL) { + Tcl_DeleteTimerHandler(statePtr->timer); + CleanupTimerHandler(statePtr); + } +} +static void +CleanupTimerHandler( + ChannelState *statePtr +){ + TclChannelRelease((Tcl_Channel)statePtr->timerChanPtr); + statePtr->timer = NULL; + statePtr->timerChanPtr = NULL; +} + /* *---------------------------------------------------------------------- * @@ -8657,7 +8905,7 @@ Tcl_CreateChannelHandler( * handler. */ Tcl_ChannelProc *proc, /* Procedure to call for each selected * event. */ - ClientData clientData) /* Arbitrary data to pass to proc. */ + void *clientData) /* Arbitrary data to pass to proc. */ { ChannelHandler *chPtr; Channel *chanPtr = (Channel *) chan; @@ -8688,7 +8936,7 @@ Tcl_CreateChannelHandler( /* * The remainder of the initialization below is done regardless of whether - * or not this is a new record or a modification of an old one. + * this is a new record or a modification of an old one. */ chPtr->mask = mask; @@ -8729,7 +8977,7 @@ Tcl_DeleteChannelHandler( Tcl_Channel chan, /* The channel for which to remove the * callback. */ Tcl_ChannelProc *proc, /* The procedure in the callback to delete. */ - ClientData clientData) /* The client data in the callback to + void *clientData) /* The client data in the callback to * delete. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -8935,21 +9183,20 @@ CreateScriptRecord( void TclChannelEventScriptInvoker( - ClientData clientData, /* The script+interp record. */ - int mask) /* Not used. */ + void *clientData, /* The script+interp record. */ + TCL_UNUSED(int) /*mask*/) { - Tcl_Interp *interp; /* Interpreter in which to eval the script. */ - Channel *chanPtr; /* The channel for which this handler is - * registered. */ - EventScriptRecord *esPtr; /* The event script + interpreter to eval it + EventScriptRecord *esPtr = (EventScriptRecord *)clientData; + /* The event script + interpreter to eval it * in. */ + Channel *chanPtr = esPtr->chanPtr; + /* The channel for which this handler is + * registered. */ + Tcl_Interp *interp = esPtr->interp; + /* Interpreter in which to eval the script. */ + int mask = esPtr->mask; int result; /* Result of call to eval script. */ - esPtr = (EventScriptRecord *)clientData; - chanPtr = esPtr->chanPtr; - mask = esPtr->mask; - interp = esPtr->interp; - /* * Be sure event executed in managed channel (covering bugs similar [f583715154]). */ @@ -9002,10 +9249,9 @@ TclChannelEventScriptInvoker( *---------------------------------------------------------------------- */ - /* ARGSUSED */ int Tcl_FileEventObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(void *), Tcl_Interp *interp, /* Interpreter in which the channel for which * to create the handler is found. */ int objc, /* Number of arguments. */ @@ -9019,7 +9265,6 @@ Tcl_FileEventObjCmd( int mask; static const char *const modeOptions[] = {"readable", "writable", NULL}; static const int maskArray[] = {TCL_READABLE, TCL_WRITABLE}; - (void)dummy; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 1, objv, "channelId event ?script?"); @@ -9038,7 +9283,7 @@ Tcl_FileEventObjCmd( } chanPtr = (Channel *) chan; statePtr = chanPtr->state; - if ((statePtr->flags & mask) == 0) { + if (GotFlag(statePtr, mask) == 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf("channel is not %s", (mask == TCL_READABLE) ? "readable" : "writable")); return TCL_ERROR; @@ -9100,7 +9345,7 @@ Tcl_FileEventObjCmd( static void ZeroTransferTimerProc( - ClientData clientData) + void *clientData) { /* calling CopyData with mask==0 still implies immediate invocation of the * -command callback, and completion of the fcopy. @@ -9129,6 +9374,7 @@ ZeroTransferTimerProc( *---------------------------------------------------------------------- */ +#if !defined(TCL_NO_DEPRECATED) int TclCopyChannelOld( Tcl_Interp *interp, /* Current interpreter. */ @@ -9140,13 +9386,14 @@ TclCopyChannelOld( return TclCopyChannel(interp, inChan, outChan, (Tcl_WideInt) toRead, cmdPtr); } +#endif int TclCopyChannel( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Channel inChan, /* Channel to read from. */ Tcl_Channel outChan, /* Channel to write to. */ - Tcl_WideInt toRead, /* Amount of data to copy, or -1 for all. */ + long long toRead, /* Amount of data to copy, or -1 for all. */ Tcl_Obj *cmdPtr) /* Pointer to script to execute or NULL. */ { Channel *inPtr = (Channel *) inChan; @@ -9203,8 +9450,8 @@ TclCopyChannel( * Make sure the output side is unbuffered. */ - outStatePtr->flags = (outStatePtr->flags & ~CHANNEL_LINEBUFFERED) - | CHANNEL_UNBUFFERED; + ResetFlag(outStatePtr, CHANNEL_LINEBUFFERED); + SetFlag(outStatePtr, CHANNEL_UNBUFFERED); /* * Test for conditions where we know we can just move bytes from input @@ -9212,10 +9459,17 @@ TclCopyChannel( * of the bytes themselves. */ + /* + * TODO - should really only allow lossless profiles. Below reflects + * Tcl 8.7 alphas prior to encoding profiles + */ + moveBytes = inStatePtr->inEofChar == '\0' /* No eofChar to stop input */ && inStatePtr->inputTranslation == TCL_TRANSLATE_LF && outStatePtr->outputTranslation == TCL_TRANSLATE_LF - && inStatePtr->encoding == outStatePtr->encoding; + && inStatePtr->encoding == outStatePtr->encoding + && CHANNEL_PROFILE_GET(inStatePtr->flags) != TCL_ENCODING_PROFILE_STRICT + && CHANNEL_PROFILE_GET(outStatePtr->flags) == TCL_ENCODING_PROFILE_TCL8; /* * Allocate a new CopyState to maintain info about the current copy in @@ -9223,7 +9477,7 @@ TclCopyChannel( * completed. */ - csPtr = (CopyState *)ckalloc(sizeof(CopyState) + !moveBytes * inStatePtr->bufSize); + csPtr = (CopyState *)ckalloc(offsetof(CopyState, buffer) + 1U + !moveBytes * inStatePtr->bufSize); csPtr->bufSize = !moveBytes * inStatePtr->bufSize; csPtr->readPtr = inPtr; csPtr->writePtr = outPtr; @@ -9334,7 +9588,7 @@ MBError( static void MBEvent( - ClientData clientData, + void *clientData, int mask) { CopyState *csPtr = (CopyState *) clientData; @@ -9413,13 +9667,13 @@ MBWrite( if (bufPtr) { /* Split the overflowing buffer in two */ int extra = (int) (inBytes - csPtr->toRead); - /* Note that going with int for extra assumes that inBytes is not too - * much over toRead to require a wide itself. If that gets violated - * then the calculations involving extra must be made wide too. - * - * Noted with Win32/MSVC debug build treating the warning (possible of - * data in __int64 to int conversion) as error. - */ + /* Note that going with int for extra assumes that inBytes is not too + * much over toRead to require a wide itself. If that gets violated + * then the calculations involving extra must be made wide too. + * + * Noted with Win32/MSVC debug build treating the warning (possible of + * data in long long to int conversion) as error. + */ bufPtr = AllocChannelBuffer(extra); @@ -9517,7 +9771,8 @@ CopyData( Tcl_Obj *cmdPtr, *errObj = NULL, *bufObj = NULL, *msg = NULL; Tcl_Channel inChan, outChan; ChannelState *inStatePtr, *outStatePtr; - int result = TCL_OK, size, sizeb; + int result = TCL_OK, size; + int sizeb; Tcl_WideInt total; const char *buffer; int inBinary, outBinary, sameEncoding; @@ -9541,7 +9796,9 @@ CopyData( inBinary = (inStatePtr->encoding == NULL); outBinary = (outStatePtr->encoding == NULL); - sameEncoding = (inStatePtr->encoding == outStatePtr->encoding); + sameEncoding = inStatePtr->encoding == outStatePtr->encoding + && CHANNEL_PROFILE_GET(inStatePtr->flags) != TCL_ENCODING_PROFILE_STRICT + && CHANNEL_PROFILE_GET(outStatePtr->flags) == TCL_ENCODING_PROFILE_TCL8; if (!(inBinary || sameEncoding)) { TclNewObj(bufObj); @@ -9558,12 +9815,20 @@ CopyData( Tcl_SetErrno(inStatePtr->unreportedError); inStatePtr->unreportedError = 0; goto readError; + } else if (inStatePtr->flags & CHANNEL_ENCODING_ERROR) { + Tcl_SetErrno(EILSEQ); + inStatePtr->flags &= ~CHANNEL_ENCODING_ERROR; + goto readError; } Tcl_GetChannelError(outChan, &msg); if ((outStatePtr->unreportedError != 0) || (msg != NULL)) { Tcl_SetErrno(outStatePtr->unreportedError); outStatePtr->unreportedError = 0; goto writeError; + } else if (outStatePtr->flags & CHANNEL_ENCODING_ERROR) { + Tcl_SetErrno(EILSEQ); + outStatePtr->flags &= ~CHANNEL_ENCODING_ERROR; + goto writeError; } if (cmdPtr && (mask == 0)) { @@ -9824,7 +10089,7 @@ CopyData( * * Results: * The number of bytes actually stored (<= bytesToRead), - * or -1 if there is an error in reading the channel. Use + * or TCL_INDEX_NONE if there is an error in reading the channel. Use * Tcl_GetErrno() to retrieve the error code for the error * that occurred. * @@ -9833,7 +10098,7 @@ CopyData( * - EOF is reached on the channel; or * - the channel is non-blocking, and we've read all we can * without blocking. - * - a channel reading error occurs (and we return -1) + * - a channel reading error occurs (and we return TCL_INDEX_NONE) * * Side effects: * May cause input to be buffered. @@ -9865,6 +10130,11 @@ DoRead( * too. Keep on keeping on for now. */ + if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR)) { + UpdateInterest(chanPtr); + Tcl_SetErrno(EILSEQ); + return -1; + } if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) { SetFlag(statePtr, CHANNEL_EOF); assert(statePtr->inputEncodingFlags & TCL_ENCODING_END); @@ -9932,7 +10202,7 @@ DoRead( UpdateInterest(chanPtr); TclChannelRelease((Tcl_Channel)chanPtr); - return -1; + return TCL_INDEX_NONE; } assert(IsBufferFull(bufPtr)); @@ -9962,10 +10232,10 @@ DoRead( } /* - * 1) We're @EOF because we saw eof char. + * 1) We're @EOF because we saw eof char, or there was an encoding error. */ - if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) { + if (GotFlag(statePtr, CHANNEL_STICKY_EOF|CHANNEL_ENCODING_ERROR)) { break; } @@ -9983,7 +10253,7 @@ DoRead( * There's no more buffered data... */ - if (statePtr->flags & CHANNEL_EOF) { + if (GotFlag(statePtr, CHANNEL_EOF)) { /* * ...and there never will be. */ @@ -9991,7 +10261,7 @@ DoRead( *p++ = '\r'; bytesToRead--; bufPtr->nextRemoved++; - } else if (statePtr->flags & CHANNEL_BLOCKED) { + } else if (GotFlag(statePtr, CHANNEL_BLOCKED)) { /* * ...and we cannot get more now. */ @@ -10050,6 +10320,7 @@ DoRead( assert(!GotFlag(statePtr, CHANNEL_EOF) || GotFlag(statePtr, CHANNEL_STICKY_EOF) + || GotFlag(statePtr, CHANNEL_ENCODING_ERROR) || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0); assert(!(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED) == (CHANNEL_EOF|CHANNEL_BLOCKED))); @@ -10078,7 +10349,7 @@ DoRead( static void CopyEventProc( - ClientData clientData, + void *clientData, int mask) { (void) CopyData((CopyState *)clientData, mask); @@ -10124,20 +10395,20 @@ StopCopy( */ nonBlocking = csPtr->readFlags & CHANNEL_NONBLOCKING; - if (nonBlocking != (inStatePtr->flags & CHANNEL_NONBLOCKING)) { + if (nonBlocking != GotFlag(inStatePtr, CHANNEL_NONBLOCKING)) { SetBlockMode(NULL, csPtr->readPtr, nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING); } if (csPtr->readPtr != csPtr->writePtr) { nonBlocking = csPtr->writeFlags & CHANNEL_NONBLOCKING; - if (nonBlocking != (outStatePtr->flags & CHANNEL_NONBLOCKING)) { + if (nonBlocking != GotFlag(outStatePtr, CHANNEL_NONBLOCKING)) { SetBlockMode(NULL, csPtr->writePtr, nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING); } } ResetFlag(outStatePtr, CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED); - outStatePtr->flags |= - csPtr->writeFlags & (CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED); + SetFlag(outStatePtr, + csPtr->writeFlags & (CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED)); if (csPtr->cmdPtr) { Tcl_DeleteChannelHandler(inChan, CopyEventProc, csPtr); @@ -10340,7 +10611,7 @@ Tcl_GetChannelNamesEx( && (pattern[2] == 'd'))) { if ((Tcl_FindHashEntry(hTblPtr, pattern) != NULL) && (Tcl_ListObjAppendElement(interp, resultPtr, - Tcl_NewStringObj(pattern, -1)) != TCL_OK)) { + Tcl_NewStringObj(pattern, TCL_INDEX_NONE)) != TCL_OK)) { goto error; } goto done; @@ -10367,7 +10638,7 @@ Tcl_GetChannelNamesEx( if (((pattern == NULL) || Tcl_StringMatch(name, pattern)) && (Tcl_ListObjAppendElement(interp, resultPtr, - Tcl_NewStringObj(name, -1)) != TCL_OK)) { + Tcl_NewStringObj(name, TCL_INDEX_NONE)) != TCL_OK)) { error: TclDecrRefCount(resultPtr); return TCL_ERROR; @@ -10548,6 +10819,7 @@ Tcl_ChannelVersion( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { +#ifndef TCL_NO_DEPRECATED if ((chanTypePtr->version < TCL_CHANNEL_VERSION_2) || (chanTypePtr->version > TCL_CHANNEL_VERSION_5)) { /* @@ -10556,6 +10828,7 @@ Tcl_ChannelVersion( */ return TCL_CHANNEL_VERSION_1; } +#endif return chanTypePtr->version; } @@ -10579,13 +10852,14 @@ Tcl_ChannelBlockModeProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { +#ifndef TCL_NO_DEPRECATED if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_2) { /* * The v1 structure had the blockModeProc in a different place. */ return (Tcl_DriverBlockModeProc *) chanTypePtr->version; } - +#endif return chanTypePtr->blockModeProc; } @@ -10605,6 +10879,7 @@ Tcl_ChannelBlockModeProc( *---------------------------------------------------------------------- */ +#ifndef TCL_NO_DEPRECATED Tcl_DriverCloseProc * Tcl_ChannelCloseProc( const Tcl_ChannelType *chanTypePtr) @@ -10612,6 +10887,7 @@ Tcl_ChannelCloseProc( { return chanTypePtr->closeProc; } +#endif /* *---------------------------------------------------------------------- @@ -10701,6 +10977,7 @@ Tcl_ChannelOutputProc( *---------------------------------------------------------------------- */ +#ifndef TCL_NO_DEPRECATED Tcl_DriverSeekProc * Tcl_ChannelSeekProc( const Tcl_ChannelType *chanTypePtr) @@ -10708,6 +10985,7 @@ Tcl_ChannelSeekProc( { return chanTypePtr->seekProc; } +#endif /* *---------------------------------------------------------------------- @@ -10826,9 +11104,11 @@ Tcl_ChannelFlushProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { +#ifndef TCL_NO_DEPRECATED if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_2) { return NULL; } +#endif return chanTypePtr->flushProc; } @@ -10853,9 +11133,11 @@ Tcl_ChannelHandlerProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { +#ifndef TCL_NO_DEPRECATED if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_2) { return NULL; } +#endif return chanTypePtr->handlerProc; } @@ -10880,9 +11162,11 @@ Tcl_ChannelWideSeekProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { +#ifndef TCL_NO_DEPRECATED if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_3) { return NULL; } +#endif return chanTypePtr->wideSeekProc; } @@ -10908,9 +11192,11 @@ Tcl_ChannelThreadActionProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { +#ifndef TCL_NO_DEPRECATED if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_4) { return NULL; } +#endif return chanTypePtr->threadActionProc; } @@ -10937,15 +11223,17 @@ Tcl_SetChannelErrorInterp( Tcl_Obj *msg) /* Error message to store. */ { Interp *iPtr = (Interp *) interp; - - if (iPtr->chanMsg != NULL) { - TclDecrRefCount(iPtr->chanMsg); - iPtr->chanMsg = NULL; - } + Tcl_Obj *disposePtr = iPtr->chanMsg; if (msg != NULL) { iPtr->chanMsg = FixLevelCode(msg); Tcl_IncrRefCount(iPtr->chanMsg); + } else { + iPtr->chanMsg = NULL; + } + + if (disposePtr != NULL) { + TclDecrRefCount(disposePtr); } return; } @@ -10973,15 +11261,17 @@ Tcl_SetChannelError( Tcl_Obj *msg) /* Error message to store. */ { ChannelState *statePtr = ((Channel *) chan)->state; - - if (statePtr->chanMsg != NULL) { - TclDecrRefCount(statePtr->chanMsg); - statePtr->chanMsg = NULL; - } + Tcl_Obj *disposePtr = statePtr->chanMsg; if (msg != NULL) { statePtr->chanMsg = FixLevelCode(msg); Tcl_IncrRefCount(statePtr->chanMsg); + } else { + statePtr->chanMsg = NULL; + } + + if (disposePtr != NULL) { + TclDecrRefCount(disposePtr); } return; } @@ -11009,7 +11299,8 @@ static Tcl_Obj * FixLevelCode( Tcl_Obj *msg) { - int explicitResult, numOptions, lc, lcn; + int explicitResult, numOptions, lcn; + int lc; Tcl_Obj **lv, **lvn; int res, i, j, val, lignore, cignore; int newlevel = -1, newcode = -1; @@ -11026,7 +11317,7 @@ FixLevelCode( * information. Hence an error means that we've got serious breakage. */ - res = TclListObjGetElements(NULL, msg, &lc, &lv); + res = TclListObjGetElementsM(NULL, msg, &lc, &lv); if (res != TCL_OK) { Tcl_Panic("Tcl_SetChannelError: bad syntax of message"); } @@ -11102,7 +11393,7 @@ FixLevelCode( if (0 == strcmp(TclGetString(lv[i]), "-level")) { if (newlevel >= 0) { lvn[j++] = lv[i]; - lvn[j++] = Tcl_NewIntObj(newlevel); + lvn[j++] = Tcl_NewWideIntObj(newlevel); newlevel = -1; lignore = 1; continue; @@ -11112,7 +11403,7 @@ FixLevelCode( } else if (0 == strcmp(TclGetString(lv[i]), "-code")) { if (newcode >= 0) { lvn[j++] = lv[i]; - lvn[j++] = Tcl_NewIntObj(newcode); + lvn[j++] = Tcl_NewWideIntObj(newcode); newcode = -1; cignore = 1; continue; @@ -11254,11 +11545,11 @@ DupChannelInternalRep( Tcl_Obj *copyPtr) /* Object with internal rep to set. Must not * currently have an internal rep.*/ { - ResolvedChanName *resPtr = srcPtr->internalRep.twoPtrValue.ptr1; + ResolvedChanName *resPtr; - resPtr->refCount++; - copyPtr->internalRep.twoPtrValue.ptr1 = resPtr; - copyPtr->typePtr = srcPtr->typePtr; + ChanGetInternalRep(srcPtr, resPtr); + assert(resPtr); + ChanSetInternalRep(copyPtr, resPtr); } /* @@ -11281,10 +11572,11 @@ static void FreeChannelInternalRep( Tcl_Obj *objPtr) /* Object with internal rep to free. */ { - ResolvedChanName *resPtr = objPtr->internalRep.twoPtrValue.ptr1; + ResolvedChanName *resPtr; - objPtr->typePtr = NULL; - if (--resPtr->refCount) { + ChanGetInternalRep(objPtr, resPtr); + assert(resPtr); + if (resPtr->refCount-- > 1) { return; } Tcl_Release(resPtr->statePtr); @@ -11302,8 +11594,8 @@ DumpFlags( char *str, int flags) { - char buf[20]; int i = 0; + char buf[24]; #define ChanFlag(chr, bit) (buf[i++] = ((flags & (bit)) ? (chr) : '_')) @@ -11316,6 +11608,7 @@ DumpFlags( ChanFlag('c', CHANNEL_CLOSED); ChanFlag('E', CHANNEL_EOF); ChanFlag('S', CHANNEL_STICKY_EOF); + ChanFlag('U', CHANNEL_ENCODING_ERROR); ChanFlag('B', CHANNEL_BLOCKED); ChanFlag('/', INPUT_SAW_CR); ChanFlag('D', CHANNEL_DEAD); |