/[dtapublic]/projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclio.c
ViewVC logotype

Annotation of /projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclio.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 71 - (hide annotations) (download)
Sat Nov 5 11:07:06 2016 UTC (7 years, 6 months ago) by dashley
File MIME type: text/plain
File size: 253590 byte(s)
Set EOL properties appropriately to facilitate simultaneous Linux and Windows development.
1 dashley 71 /* $Header$ */
2     /*
3     * tclIO.c --
4     *
5     * This file provides the generic portions (those that are the same on
6     * all platforms and for all channel types) of Tcl's IO facilities.
7     *
8     * Copyright (c) 1998 Scriptics Corporation
9     * Copyright (c) 1995-1997 Sun Microsystems, Inc.
10     *
11     * See the file "license.terms" for information on usage and redistribution
12     * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
13     *
14     * RCS: @(#) $Id: tclio.c,v 1.1.1.1 2001/06/13 04:42:01 dtashley Exp $
15     */
16    
17     #include "tclInt.h"
18     #include "tclPort.h"
19    
20     /*
21     * Make sure that both EAGAIN and EWOULDBLOCK are defined. This does not
22     * compile on systems where neither is defined. We want both defined so
23     * that we can test safely for both. In the code we still have to test for
24     * both because there may be systems on which both are defined and have
25     * different values.
26     */
27    
28     #if ((!defined(EWOULDBLOCK)) && (defined(EAGAIN)))
29     # define EWOULDBLOCK EAGAIN
30     #endif
31     #if ((!defined(EAGAIN)) && (defined(EWOULDBLOCK)))
32     # define EAGAIN EWOULDBLOCK
33     #endif
34     #if ((!defined(EAGAIN)) && (!defined(EWOULDBLOCK)))
35     error one of EWOULDBLOCK or EAGAIN must be defined
36     #endif
37    
38     /*
39     * The following structure encapsulates the state for a background channel
40     * copy. Note that the data buffer for the copy will be appended to this
41     * structure.
42     */
43    
44     typedef struct CopyState {
45     struct Channel *readPtr; /* Pointer to input channel. */
46     struct Channel *writePtr; /* Pointer to output channel. */
47     int readFlags; /* Original read channel flags. */
48     int writeFlags; /* Original write channel flags. */
49     int toRead; /* Number of bytes to copy, or -1. */
50     int total; /* Total bytes transferred (written). */
51     Tcl_Interp *interp; /* Interp that started the copy. */
52     Tcl_Obj *cmdPtr; /* Command to be invoked at completion. */
53     int bufSize; /* Size of appended buffer. */
54     char buffer[1]; /* Copy buffer, this must be the last
55     * field. */
56     } CopyState;
57    
58     /*
59     * struct ChannelBuffer:
60     *
61     * Buffers data being sent to or from a channel.
62     */
63    
64     typedef struct ChannelBuffer {
65     int nextAdded; /* The next position into which a character
66     * will be put in the buffer. */
67     int nextRemoved; /* Position of next byte to be removed
68     * from the buffer. */
69     int bufLength; /* How big is the buffer? */
70     struct ChannelBuffer *nextPtr;
71     /* Next buffer in chain. */
72     char buf[4]; /* Placeholder for real buffer. The real
73     * buffer occuppies this space + bufSize-4
74     * bytes. This must be the last field in
75     * the structure. */
76     } ChannelBuffer;
77    
78     #define CHANNELBUFFER_HEADER_SIZE (sizeof(ChannelBuffer) - 4)
79    
80     /*
81     * How much extra space to allocate in buffer to hold bytes from previous
82     * buffer (when converting to UTF-8) or to hold bytes that will go to
83     * next buffer (when converting from UTF-8).
84     */
85    
86     #define BUFFER_PADDING 16
87    
88     /*
89     * The following defines the *default* buffer size for channels.
90     */
91    
92     #define CHANNELBUFFER_DEFAULT_SIZE (1024 * 4)
93    
94     /*
95     * Structure to record a close callback. One such record exists for
96     * each close callback registered for a channel.
97     */
98    
99     typedef struct CloseCallback {
100     Tcl_CloseProc *proc; /* The procedure to call. */
101     ClientData clientData; /* Arbitrary one-word data to pass
102     * to the callback. */
103     struct CloseCallback *nextPtr; /* For chaining close callbacks. */
104     } CloseCallback;
105    
106     /*
107     * The following structure describes the information saved from a call to
108     * "fileevent". This is used later when the event being waited for to
109     * invoke the saved script in the interpreter designed in this record.
110     */
111    
112     typedef struct EventScriptRecord {
113     struct Channel *chanPtr; /* The channel for which this script is
114     * registered. This is used only when an
115     * error occurs during evaluation of the
116     * script, to delete the handler. */
117     Tcl_Obj *scriptPtr; /* Script to invoke. */
118     Tcl_Interp *interp; /* In what interpreter to invoke script? */
119     int mask; /* Events must overlap current mask for the
120     * stored script to be invoked. */
121     struct EventScriptRecord *nextPtr;
122     /* Next in chain of records. */
123     } EventScriptRecord;
124    
125     /*
126     * struct Channel:
127     *
128     * One of these structures is allocated for each open channel. It contains data
129     * specific to the channel but which belongs to the generic part of the Tcl
130     * channel mechanism, and it points at an instance specific (and type
131     * specific) * instance data, and at a channel type structure.
132     */
133    
134     typedef struct Channel {
135     char *channelName; /* The name of the channel instance in Tcl
136     * commands. Storage is owned by the generic IO
137     * code, is dynamically allocated. */
138     int flags; /* ORed combination of the flags defined
139     * below. */
140     Tcl_Encoding encoding; /* Encoding to apply when reading or writing
141     * data on this channel. NULL means no
142     * encoding is applied to data. */
143     Tcl_EncodingState inputEncodingState;
144     /* Current encoding state, used when converting
145     * input data bytes to UTF-8. */
146     int inputEncodingFlags; /* Encoding flags to pass to conversion
147     * routine when converting input data bytes to
148     * UTF-8. May be TCL_ENCODING_START before
149     * converting first byte and TCL_ENCODING_END
150     * when EOF is seen. */
151     Tcl_EncodingState outputEncodingState;
152     /* Current encoding state, used when converting
153     * UTF-8 to output data bytes. */
154     int outputEncodingFlags; /* Encoding flags to pass to conversion
155     * routine when converting UTF-8 to output
156     * data bytes. May be TCL_ENCODING_START
157     * before converting first byte and
158     * TCL_ENCODING_END when EOF is seen. */
159     Tcl_EolTranslation inputTranslation;
160     /* What translation to apply for end of line
161     * sequences on input? */
162     Tcl_EolTranslation outputTranslation;
163     /* What translation to use for generating
164     * end of line sequences in output? */
165     int inEofChar; /* If nonzero, use this as a signal of EOF
166     * on input. */
167     int outEofChar; /* If nonzero, append this to the channel
168     * when it is closed if it is open for
169     * writing. */
170     int unreportedError; /* Non-zero if an error report was deferred
171     * because it happened in the background. The
172     * value is the POSIX error code. */
173     ClientData instanceData; /* Instance-specific data provided by
174     * creator of channel. */
175    
176     Tcl_ChannelType *typePtr; /* Pointer to channel type structure. */
177     int refCount; /* How many interpreters hold references to
178     * this IO channel? */
179     CloseCallback *closeCbPtr; /* Callbacks registered to be called when the
180     * channel is closed. */
181     char *outputStage; /* Temporary staging buffer used when
182     * translating EOL before converting from
183     * UTF-8 to external form. */
184     ChannelBuffer *curOutPtr; /* Current output buffer being filled. */
185     ChannelBuffer *outQueueHead;/* Points at first buffer in output queue. */
186     ChannelBuffer *outQueueTail;/* Points at last buffer in output queue. */
187    
188     ChannelBuffer *saveInBufPtr;/* Buffer saved for input queue - eliminates
189     * need to allocate a new buffer for "gets"
190     * that crosses buffer boundaries. */
191     ChannelBuffer *inQueueHead; /* Points at first buffer in input queue. */
192     ChannelBuffer *inQueueTail; /* Points at last buffer in input queue. */
193    
194     struct ChannelHandler *chPtr;/* List of channel handlers registered
195     * for this channel. */
196     int interestMask; /* Mask of all events this channel has
197     * handlers for. */
198     struct Channel *nextChanPtr;/* Next in list of channels currently open. */
199     EventScriptRecord *scriptRecordPtr;
200     /* Chain of all scripts registered for
201     * event handlers ("fileevent") on this
202     * channel. */
203     int bufSize; /* What size buffers to allocate? */
204     Tcl_TimerToken timer; /* Handle to wakeup timer for this channel. */
205     CopyState *csPtr; /* State of background copy, or NULL. */
206     struct Channel* supercedes; /* Refers to channel this one was stacked upon.
207     This reference is NULL for normal channels.
208     See Tcl_StackChannel. */
209    
210     } Channel;
211    
212     /*
213     * Values for the flags field in Channel. Any ORed combination of the
214     * following flags can be stored in the field. These flags record various
215     * options and state bits about the channel. In addition to the flags below,
216     * the channel can also have TCL_READABLE (1<<1) and TCL_WRITABLE (1<<2) set.
217     */
218    
219     #define CHANNEL_NONBLOCKING (1<<3) /* Channel is currently in
220     * nonblocking mode. */
221     #define CHANNEL_LINEBUFFERED (1<<4) /* Output to the channel must be
222     * flushed after every newline. */
223     #define CHANNEL_UNBUFFERED (1<<5) /* Output to the channel must always
224     * be flushed immediately. */
225     #define BUFFER_READY (1<<6) /* Current output buffer (the
226     * curOutPtr field in the
227     * channel structure) should be
228     * output as soon as possible even
229     * though it may not be full. */
230     #define BG_FLUSH_SCHEDULED (1<<7) /* A background flush of the
231     * queued output buffers has been
232     * scheduled. */
233     #define CHANNEL_CLOSED (1<<8) /* Channel has been closed. No
234     * further Tcl-level IO on the
235     * channel is allowed. */
236     #define CHANNEL_EOF (1<<9) /* EOF occurred on this channel.
237     * This bit is cleared before every
238     * input operation. */
239     #define CHANNEL_STICKY_EOF (1<<10) /* EOF occurred on this channel because
240     * we saw the input eofChar. This bit
241     * prevents clearing of the EOF bit
242     * before every input operation. */
243     #define CHANNEL_BLOCKED (1<<11) /* EWOULDBLOCK or EAGAIN occurred
244     * on this channel. This bit is
245     * cleared before every input or
246     * output operation. */
247     #define INPUT_SAW_CR (1<<12) /* Channel is in CRLF eol input
248     * translation mode and the last
249     * byte seen was a "\r". */
250     #define INPUT_NEED_NL (1<<15) /* Saw a '\r' at end of last buffer,
251     * and there should be a '\n' at
252     * beginning of next buffer. */
253     #define CHANNEL_DEAD (1<<13) /* The channel has been closed by
254     * the exit handler (on exit) but
255     * not deallocated. When any IO
256     * operation sees this flag on a
257     * channel, it does not call driver
258     * level functions to avoid referring
259     * to deallocated data. */
260     #define CHANNEL_NEED_MORE_DATA (1<<14) /* The last input operation failed
261     * because there was not enough data
262     * to complete the operation. This
263     * flag is set when gets fails to
264     * get a complete line or when read
265     * fails to get a complete character.
266     * When set, file events will not be
267     * delivered for buffered data until
268     * the state of the channel changes. */
269    
270     /*
271     * For each channel handler registered in a call to Tcl_CreateChannelHandler,
272     * there is one record of the following type. All of records for a specific
273     * channel are chained together in a singly linked list which is stored in
274     * the channel structure.
275     */
276    
277     typedef struct ChannelHandler {
278     Channel *chanPtr; /* The channel structure for this channel. */
279     int mask; /* Mask of desired events. */
280     Tcl_ChannelProc *proc; /* Procedure to call in the type of
281     * Tcl_CreateChannelHandler. */
282     ClientData clientData; /* Argument to pass to procedure. */
283     struct ChannelHandler *nextPtr;
284     /* Next one in list of registered handlers. */
285     } ChannelHandler;
286    
287     /*
288     * This structure keeps track of the current ChannelHandler being invoked in
289     * the current invocation of ChannelHandlerEventProc. There is a potential
290     * problem if a ChannelHandler is deleted while it is the current one, since
291     * ChannelHandlerEventProc needs to look at the nextPtr field. To handle this
292     * problem, structures of the type below indicate the next handler to be
293     * processed for any (recursively nested) dispatches in progress. The
294     * nextHandlerPtr field is updated if the handler being pointed to is deleted.
295     * The nextPtr field is used to chain together all recursive invocations, so
296     * that Tcl_DeleteChannelHandler can find all the recursively nested
297     * invocations of ChannelHandlerEventProc and compare the handler being
298     * deleted against the NEXT handler to be invoked in that invocation; when it
299     * finds such a situation, Tcl_DeleteChannelHandler updates the nextHandlerPtr
300     * field of the structure to the next handler.
301     */
302    
303     typedef struct NextChannelHandler {
304     ChannelHandler *nextHandlerPtr; /* The next handler to be invoked in
305     * this invocation. */
306     struct NextChannelHandler *nestedHandlerPtr;
307     /* Next nested invocation of
308     * ChannelHandlerEventProc. */
309     } NextChannelHandler;
310    
311    
312     /*
313     * The following structure describes the event that is added to the Tcl
314     * event queue by the channel handler check procedure.
315     */
316    
317     typedef struct ChannelHandlerEvent {
318     Tcl_Event header; /* Standard header for all events. */
319     Channel *chanPtr; /* The channel that is ready. */
320     int readyMask; /* Events that have occurred. */
321     } ChannelHandlerEvent;
322    
323     /*
324     * The following structure is used by Tcl_GetsObj() to encapsulates the
325     * state for a "gets" operation.
326     */
327    
328     typedef struct GetsState {
329     Tcl_Obj *objPtr; /* The object to which UTF-8 characters
330     * will be appended. */
331     char **dstPtr; /* Pointer into objPtr's string rep where
332     * next character should be stored. */
333     Tcl_Encoding encoding; /* The encoding to use to convert raw bytes
334     * to UTF-8. */
335     ChannelBuffer *bufPtr; /* The current buffer of raw bytes being
336     * emptied. */
337     Tcl_EncodingState state; /* The encoding state just before the last
338     * external to UTF-8 conversion in
339     * FilterInputBytes(). */
340     int rawRead; /* The number of bytes removed from bufPtr
341     * in the last call to FilterInputBytes(). */
342     int bytesWrote; /* The number of bytes of UTF-8 data
343     * appended to objPtr during the last call to
344     * FilterInputBytes(). */
345     int charsWrote; /* The corresponding number of UTF-8
346     * characters appended to objPtr during the
347     * last call to FilterInputBytes(). */
348     int totalChars; /* The total number of UTF-8 characters
349     * appended to objPtr so far, just before the
350     * last call to FilterInputBytes(). */
351     } GetsState;
352    
353     /*
354     * All static variables used in this file are collected into a single
355     * instance of the following structure. For multi-threaded implementations,
356     * there is one instance of this structure for each thread.
357     *
358     * Notice that different structures with the same name appear in other
359     * files. The structure defined below is used in this file only.
360     */
361    
362     typedef struct ThreadSpecificData {
363    
364     /*
365     * This variable holds the list of nested ChannelHandlerEventProc
366     * invocations.
367     */
368     NextChannelHandler *nestedHandlerPtr;
369    
370     /*
371     * List of all channels currently open.
372     */
373     Channel *firstChanPtr;
374     #ifdef oldcode
375     /*
376     * Has a channel exit handler been created yet?
377     */
378     int channelExitHandlerCreated;
379    
380     /*
381     * Has the channel event source been created and registered with the
382     * notifier?
383     */
384     int channelEventSourceCreated;
385     #endif
386     /*
387     * Static variables to hold channels for stdin, stdout and stderr.
388     */
389     Tcl_Channel stdinChannel;
390     int stdinInitialized;
391     Tcl_Channel stdoutChannel;
392     int stdoutInitialized;
393     Tcl_Channel stderrChannel;
394     int stderrInitialized;
395    
396     } ThreadSpecificData;
397    
398     static Tcl_ThreadDataKey dataKey;
399    
400    
401     /*
402     * Static functions in this file:
403     */
404    
405     static ChannelBuffer * AllocChannelBuffer _ANSI_ARGS_((int length));
406     static void ChannelEventScriptInvoker _ANSI_ARGS_((
407     ClientData clientData, int flags));
408     static void ChannelTimerProc _ANSI_ARGS_((
409     ClientData clientData));
410     static int CheckChannelErrors _ANSI_ARGS_((Channel *chanPtr,
411     int direction));
412     static int CheckFlush _ANSI_ARGS_((Channel *chanPtr,
413     ChannelBuffer *bufPtr, int newlineFlag));
414     static int CheckForDeadChannel _ANSI_ARGS_((Tcl_Interp *interp,
415     Channel *chan));
416     static void CheckForStdChannelsBeingClosed _ANSI_ARGS_((
417     Tcl_Channel chan));
418     static void CleanupChannelHandlers _ANSI_ARGS_((
419     Tcl_Interp *interp, Channel *chanPtr));
420     static int CloseChannel _ANSI_ARGS_((Tcl_Interp *interp,
421     Channel *chanPtr, int errorCode));
422     static void CommonGetsCleanup _ANSI_ARGS_((Channel *chanPtr,
423     Tcl_Encoding encoding));
424     static int CopyAndTranslateBuffer _ANSI_ARGS_((
425     Channel *chanPtr, char *result, int space));
426     static int CopyData _ANSI_ARGS_((CopyState *csPtr, int mask));
427     static void CopyEventProc _ANSI_ARGS_((ClientData clientData,
428     int mask));
429     static void CreateScriptRecord _ANSI_ARGS_((
430     Tcl_Interp *interp, Channel *chanPtr,
431     int mask, Tcl_Obj *scriptPtr));
432     static void DeleteChannelTable _ANSI_ARGS_((
433     ClientData clientData, Tcl_Interp *interp));
434     static void DeleteScriptRecord _ANSI_ARGS_((Tcl_Interp *interp,
435     Channel *chanPtr, int mask));
436     static void DiscardInputQueued _ANSI_ARGS_((
437     Channel *chanPtr, int discardSavedBuffers));
438     static void DiscardOutputQueued _ANSI_ARGS_((
439     Channel *chanPtr));
440     static int DoRead _ANSI_ARGS_((Channel *chanPtr, char *srcPtr,
441     int slen));
442     static int DoWrite _ANSI_ARGS_((Channel *chanPtr, char *src,
443     int srcLen));
444     static int FilterInputBytes _ANSI_ARGS_((Channel *chanPtr,
445     GetsState *statePtr));
446     static int FlushChannel _ANSI_ARGS_((Tcl_Interp *interp,
447     Channel *chanPtr, int calledFromAsyncFlush));
448     static Tcl_HashTable * GetChannelTable _ANSI_ARGS_((Tcl_Interp *interp));
449     static int GetInput _ANSI_ARGS_((Channel *chanPtr));
450     static void PeekAhead _ANSI_ARGS_((Channel *chanPtr,
451     char **dstEndPtr, GetsState *gsPtr));
452     static int ReadBytes _ANSI_ARGS_((Channel *chanPtr,
453     Tcl_Obj *objPtr, int charsLeft, int *offsetPtr));
454     static int ReadChars _ANSI_ARGS_((Channel *chanPtr,
455     Tcl_Obj *objPtr, int charsLeft, int *offsetPtr,
456     int *factorPtr));
457     static void RecycleBuffer _ANSI_ARGS_((Channel *chanPtr,
458     ChannelBuffer *bufPtr, int mustDiscard));
459     static int SetBlockMode _ANSI_ARGS_((Tcl_Interp *interp,
460     Channel *chanPtr, int mode));
461     static void StopCopy _ANSI_ARGS_((CopyState *csPtr));
462     static int TranslateInputEOL _ANSI_ARGS_((Channel *chanPtr,
463     char *dst, CONST char *src, int *dstLenPtr,
464     int *srcLenPtr));
465     static int TranslateOutputEOL _ANSI_ARGS_((Channel *chanPtr,
466     char *dst, CONST char *src, int *dstLenPtr,
467     int *srcLenPtr));
468     static void UpdateInterest _ANSI_ARGS_((Channel *chanPtr));
469     static int WriteBytes _ANSI_ARGS_((Channel *chanPtr,
470     CONST char *src, int srcLen));
471     static int WriteChars _ANSI_ARGS_((Channel *chanPtr,
472     CONST char *src, int srcLen));
473    
474    
475     /*
476     *---------------------------------------------------------------------------
477     *
478     * TclInitIOSubsystem --
479     *
480     * Initialize all resources used by this subsystem on a per-process
481     * basis.
482     *
483     * Results:
484     * None.
485     *
486     * Side effects:
487     * Depends on the memory subsystems.
488     *
489     *---------------------------------------------------------------------------
490     */
491    
492     void
493     TclInitIOSubsystem()
494     {
495     /*
496     * By fetching thread local storage we take care of
497     * allocating it for each thread.
498     */
499     (void) TCL_TSD_INIT(&dataKey);
500     }
501    
502     /*
503     *-------------------------------------------------------------------------
504     *
505     * TclFinalizeIOSubsystem --
506     *
507     * Releases all resources used by this subsystem on a per-process
508     * basis. Closes all extant channels that have not already been
509     * closed because they were not owned by any interp.
510     *
511     * Results:
512     * None.
513     *
514     * Side effects:
515     * Depends on encoding and memory subsystems.
516     *
517     *-------------------------------------------------------------------------
518     */
519    
520     /* ARGSUSED */
521     void
522     TclFinalizeIOSubsystem()
523     {
524     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
525     Channel *chanPtr; /* Iterates over open channels. */
526     Channel *nextChanPtr; /* Iterates over open channels. */
527    
528    
529     for (chanPtr = tsdPtr->firstChanPtr; chanPtr != (Channel *) NULL;
530     chanPtr = nextChanPtr) {
531     nextChanPtr = chanPtr->nextChanPtr;
532    
533     /*
534     * Set the channel back into blocking mode to ensure that we wait
535     * for all data to flush out.
536     */
537    
538     (void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr,
539     "-blocking", "on");
540    
541     if ((chanPtr == (Channel *) tsdPtr->stdinChannel) ||
542     (chanPtr == (Channel *) tsdPtr->stdoutChannel) ||
543     (chanPtr == (Channel *) tsdPtr->stderrChannel)) {
544    
545     /*
546     * Decrement the refcount which was earlier artificially bumped
547     * up to keep the channel from being closed.
548     */
549    
550     chanPtr->refCount--;
551     }
552    
553     if (chanPtr->refCount <= 0) {
554    
555     /*
556     * Close it only if the refcount indicates that the channel is not
557     * referenced from any interpreter. If it is, that interpreter will
558     * close the channel when it gets destroyed.
559     */
560    
561     (void) Tcl_Close((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
562    
563     } else {
564    
565     /*
566     * The refcount is greater than zero, so flush the channel.
567     */
568    
569     Tcl_Flush((Tcl_Channel) chanPtr);
570    
571     /*
572     * Call the device driver to actually close the underlying
573     * device for this channel.
574     */
575    
576     if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {
577     (chanPtr->typePtr->closeProc)(chanPtr->instanceData,
578     (Tcl_Interp *) NULL);
579     } else {
580     (chanPtr->typePtr->close2Proc)(chanPtr->instanceData,
581     (Tcl_Interp *) NULL, 0);
582     }
583    
584     /*
585     * Finally, we clean up the fields in the channel data structure
586     * since all of them have been deleted already. We mark the
587     * channel with CHANNEL_DEAD to prevent any further IO operations
588     * on it.
589     */
590    
591     chanPtr->instanceData = (ClientData) NULL;
592     chanPtr->flags |= CHANNEL_DEAD;
593     }
594     }
595     }
596    
597    
598     /*
599     *----------------------------------------------------------------------
600     *
601     * Tcl_SetStdChannel --
602     *
603     * This function is used to change the channels that are used
604     * for stdin/stdout/stderr in new interpreters.
605     *
606     * Results:
607     * None
608     *
609     * Side effects:
610     * None.
611     *
612     *----------------------------------------------------------------------
613     */
614    
615     void
616     Tcl_SetStdChannel(channel, type)
617     Tcl_Channel channel;
618     int type; /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
619     {
620     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
621     switch (type) {
622     case TCL_STDIN:
623     tsdPtr->stdinInitialized = 1;
624     tsdPtr->stdinChannel = channel;
625     break;
626     case TCL_STDOUT:
627     tsdPtr->stdoutInitialized = 1;
628     tsdPtr->stdoutChannel = channel;
629     break;
630     case TCL_STDERR:
631     tsdPtr->stderrInitialized = 1;
632     tsdPtr->stderrChannel = channel;
633     break;
634     }
635     }
636    
637     /*
638     *----------------------------------------------------------------------
639     *
640     * Tcl_GetStdChannel --
641     *
642     * Returns the specified standard channel.
643     *
644     * Results:
645     * Returns the specified standard channel, or NULL.
646     *
647     * Side effects:
648     * May cause the creation of a standard channel and the underlying
649     * file.
650     *
651     *----------------------------------------------------------------------
652     */
653     Tcl_Channel
654     Tcl_GetStdChannel(type)
655     int type; /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
656     {
657     Tcl_Channel channel = NULL;
658     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
659    
660     /*
661     * If the channels were not created yet, create them now and
662     * store them in the static variables.
663     */
664    
665     switch (type) {
666     case TCL_STDIN:
667     if (!tsdPtr->stdinInitialized) {
668     tsdPtr->stdinChannel = TclpGetDefaultStdChannel(TCL_STDIN);
669     tsdPtr->stdinInitialized = 1;
670    
671     /*
672     * Artificially bump the refcount to ensure that the channel
673     * is only closed on exit.
674     *
675     * NOTE: Must only do this if stdinChannel is not NULL. It
676     * can be NULL in situations where Tcl is unable to connect
677     * to the standard input.
678     */
679    
680     if (tsdPtr->stdinChannel != (Tcl_Channel) NULL) {
681     (void) Tcl_RegisterChannel((Tcl_Interp *) NULL,
682     tsdPtr->stdinChannel);
683     }
684     }
685     channel = tsdPtr->stdinChannel;
686     break;
687     case TCL_STDOUT:
688     if (!tsdPtr->stdoutInitialized) {
689     tsdPtr->stdoutChannel = TclpGetDefaultStdChannel(TCL_STDOUT);
690     tsdPtr->stdoutInitialized = 1;
691     if (tsdPtr->stdoutChannel != (Tcl_Channel) NULL) {
692     (void) Tcl_RegisterChannel((Tcl_Interp *) NULL,
693     tsdPtr->stdoutChannel);
694     }
695     }
696     channel = tsdPtr->stdoutChannel;
697     break;
698     case TCL_STDERR:
699     if (!tsdPtr->stderrInitialized) {
700     tsdPtr->stderrChannel = TclpGetDefaultStdChannel(TCL_STDERR);
701     tsdPtr->stderrInitialized = 1;
702     if (tsdPtr->stderrChannel != (Tcl_Channel) NULL) {
703     (void) Tcl_RegisterChannel((Tcl_Interp *) NULL,
704     tsdPtr->stderrChannel);
705     }
706     }
707     channel = tsdPtr->stderrChannel;
708     break;
709     }
710     return channel;
711     }
712    
713    
714     /*
715     *----------------------------------------------------------------------
716     *
717     * Tcl_CreateCloseHandler
718     *
719     * Creates a close callback which will be called when the channel is
720     * closed.
721     *
722     * Results:
723     * None.
724     *
725     * Side effects:
726     * Causes the callback to be called in the future when the channel
727     * will be closed.
728     *
729     *----------------------------------------------------------------------
730     */
731    
732     void
733     Tcl_CreateCloseHandler(chan, proc, clientData)
734     Tcl_Channel chan; /* The channel for which to create the
735     * close callback. */
736     Tcl_CloseProc *proc; /* The callback routine to call when the
737     * channel will be closed. */
738     ClientData clientData; /* Arbitrary data to pass to the
739     * close callback. */
740     {
741     Channel *chanPtr;
742     CloseCallback *cbPtr;
743    
744     chanPtr = (Channel *) chan;
745    
746     cbPtr = (CloseCallback *) ckalloc((unsigned) sizeof(CloseCallback));
747     cbPtr->proc = proc;
748     cbPtr->clientData = clientData;
749    
750     cbPtr->nextPtr = chanPtr->closeCbPtr;
751     chanPtr->closeCbPtr = cbPtr;
752     }
753    
754     /*
755     *----------------------------------------------------------------------
756     *
757     * Tcl_DeleteCloseHandler --
758     *
759     * Removes a callback that would have been called on closing
760     * the channel. If there is no matching callback then this
761     * function has no effect.
762     *
763     * Results:
764     * None.
765     *
766     * Side effects:
767     * The callback will not be called in the future when the channel
768     * is eventually closed.
769     *
770     *----------------------------------------------------------------------
771     */
772    
773     void
774     Tcl_DeleteCloseHandler(chan, proc, clientData)
775     Tcl_Channel chan; /* The channel for which to cancel the
776     * close callback. */
777     Tcl_CloseProc *proc; /* The procedure for the callback to
778     * remove. */
779     ClientData clientData; /* The callback data for the callback
780     * to remove. */
781     {
782     Channel *chanPtr;
783     CloseCallback *cbPtr, *cbPrevPtr;
784    
785     chanPtr = (Channel *) chan;
786     for (cbPtr = chanPtr->closeCbPtr, cbPrevPtr = (CloseCallback *) NULL;
787     cbPtr != (CloseCallback *) NULL;
788     cbPtr = cbPtr->nextPtr) {
789     if ((cbPtr->proc == proc) && (cbPtr->clientData == clientData)) {
790     if (cbPrevPtr == (CloseCallback *) NULL) {
791     chanPtr->closeCbPtr = cbPtr->nextPtr;
792     }
793     ckfree((char *) cbPtr);
794     break;
795     } else {
796     cbPrevPtr = cbPtr;
797     }
798     }
799     }
800    
801     /*
802     *----------------------------------------------------------------------
803     *
804     * GetChannelTable --
805     *
806     * Gets and potentially initializes the channel table for an
807     * interpreter. If it is initializing the table it also inserts
808     * channels for stdin, stdout and stderr if the interpreter is
809     * trusted.
810     *
811     * Results:
812     * A pointer to the hash table created, for use by the caller.
813     *
814     * Side effects:
815     * Initializes the channel table for an interpreter. May create
816     * channels for stdin, stdout and stderr.
817     *
818     *----------------------------------------------------------------------
819     */
820    
821     static Tcl_HashTable *
822     GetChannelTable(interp)
823     Tcl_Interp *interp;
824     {
825     Tcl_HashTable *hTblPtr; /* Hash table of channels. */
826     Tcl_Channel stdinChan, stdoutChan, stderrChan;
827    
828     hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
829     if (hTblPtr == (Tcl_HashTable *) NULL) {
830     hTblPtr = (Tcl_HashTable *) ckalloc((unsigned) sizeof(Tcl_HashTable));
831     Tcl_InitHashTable(hTblPtr, TCL_STRING_KEYS);
832    
833     (void) Tcl_SetAssocData(interp, "tclIO",
834     (Tcl_InterpDeleteProc *) DeleteChannelTable,
835     (ClientData) hTblPtr);
836    
837     /*
838     * If the interpreter is trusted (not "safe"), insert channels
839     * for stdin, stdout and stderr (possibly creating them in the
840     * process).
841     */
842    
843     if (Tcl_IsSafe(interp) == 0) {
844     stdinChan = Tcl_GetStdChannel(TCL_STDIN);
845     if (stdinChan != NULL) {
846     Tcl_RegisterChannel(interp, stdinChan);
847     }
848     stdoutChan = Tcl_GetStdChannel(TCL_STDOUT);
849     if (stdoutChan != NULL) {
850     Tcl_RegisterChannel(interp, stdoutChan);
851     }
852     stderrChan = Tcl_GetStdChannel(TCL_STDERR);
853     if (stderrChan != NULL) {
854     Tcl_RegisterChannel(interp, stderrChan);
855     }
856     }
857    
858     }
859     return hTblPtr;
860     }
861    
862     /*
863     *----------------------------------------------------------------------
864     *
865     * DeleteChannelTable --
866     *
867     * Deletes the channel table for an interpreter, closing any open
868     * channels whose refcount reaches zero. This procedure is invoked
869     * when an interpreter is deleted, via the AssocData cleanup
870     * mechanism.
871     *
872     * Results:
873     * None.
874     *
875     * Side effects:
876     * Deletes the hash table of channels. May close channels. May flush
877     * output on closed channels. Removes any channeEvent handlers that were
878     * registered in this interpreter.
879     *
880     *----------------------------------------------------------------------
881     */
882    
883     static void
884     DeleteChannelTable(clientData, interp)
885     ClientData clientData; /* The per-interpreter data structure. */
886     Tcl_Interp *interp; /* The interpreter being deleted. */
887     {
888     Tcl_HashTable *hTblPtr; /* The hash table. */
889     Tcl_HashSearch hSearch; /* Search variable. */
890     Tcl_HashEntry *hPtr; /* Search variable. */
891     Channel *chanPtr; /* Channel being deleted. */
892     EventScriptRecord *sPtr, *prevPtr, *nextPtr;
893     /* Variables to loop over all channel events
894     * registered, to delete the ones that refer
895     * to the interpreter being deleted. */
896    
897     /*
898     * Delete all the registered channels - this will close channels whose
899     * refcount reaches zero.
900     */
901    
902     hTblPtr = (Tcl_HashTable *) clientData;
903     for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
904     hPtr != (Tcl_HashEntry *) NULL;
905     hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch)) {
906    
907     chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
908    
909     /*
910     * Remove any fileevents registered in this interpreter.
911     */
912    
913     for (sPtr = chanPtr->scriptRecordPtr,
914     prevPtr = (EventScriptRecord *) NULL;
915     sPtr != (EventScriptRecord *) NULL;
916     sPtr = nextPtr) {
917     nextPtr = sPtr->nextPtr;
918     if (sPtr->interp == interp) {
919     if (prevPtr == (EventScriptRecord *) NULL) {
920     chanPtr->scriptRecordPtr = nextPtr;
921     } else {
922     prevPtr->nextPtr = nextPtr;
923     }
924    
925     Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
926     ChannelEventScriptInvoker, (ClientData) sPtr);
927    
928     Tcl_DecrRefCount(sPtr->scriptPtr);
929     ckfree((char *) sPtr);
930     } else {
931     prevPtr = sPtr;
932     }
933     }
934    
935     /*
936     * Cannot call Tcl_UnregisterChannel because that procedure calls
937     * Tcl_GetAssocData to get the channel table, which might already
938     * be inaccessible from the interpreter structure. Instead, we
939     * emulate the behavior of Tcl_UnregisterChannel directly here.
940     */
941    
942     Tcl_DeleteHashEntry(hPtr);
943     chanPtr->refCount--;
944     if (chanPtr->refCount <= 0) {
945     if (!(chanPtr->flags & BG_FLUSH_SCHEDULED)) {
946     (void) Tcl_Close(interp, (Tcl_Channel) chanPtr);
947     }
948     }
949     }
950     Tcl_DeleteHashTable(hTblPtr);
951     ckfree((char *) hTblPtr);
952     }
953    
954     /*
955     *----------------------------------------------------------------------
956     *
957     * CheckForStdChannelsBeingClosed --
958     *
959     * Perform special handling for standard channels being closed. When
960     * given a standard channel, if the refcount is now 1, it means that
961     * the last reference to the standard channel is being explicitly
962     * closed. Now bump the refcount artificially down to 0, to ensure the
963     * normal handling of channels being closed will occur. Also reset the
964     * static pointer to the channel to NULL, to avoid dangling references.
965     *
966     * Results:
967     * None.
968     *
969     * Side effects:
970     * Manipulates the refcount on standard channels. May smash the global
971     * static pointer to a standard channel.
972     *
973     *----------------------------------------------------------------------
974     */
975    
976     static void
977     CheckForStdChannelsBeingClosed(chan)
978     Tcl_Channel chan;
979     {
980     Channel *chanPtr = (Channel *) chan;
981     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
982    
983     if ((chan == tsdPtr->stdinChannel) && (tsdPtr->stdinInitialized)) {
984     if (chanPtr->refCount < 2) {
985     chanPtr->refCount = 0;
986     tsdPtr->stdinChannel = NULL;
987     return;
988     }
989     } else if ((chan == tsdPtr->stdoutChannel) && (tsdPtr->stdoutInitialized)) {
990     if (chanPtr->refCount < 2) {
991     chanPtr->refCount = 0;
992     tsdPtr->stdoutChannel = NULL;
993     return;
994     }
995     } else if ((chan == tsdPtr->stderrChannel) && (tsdPtr->stderrInitialized)) {
996     if (chanPtr->refCount < 2) {
997     chanPtr->refCount = 0;
998     tsdPtr->stderrChannel = NULL;
999     return;
1000     }
1001     }
1002     }
1003    
1004     /*
1005     *----------------------------------------------------------------------
1006     *
1007     * Tcl_RegisterChannel --
1008     *
1009     * Adds an already-open channel to the channel table of an interpreter.
1010     * If the interpreter passed as argument is NULL, it only increments
1011     * the channel refCount.
1012     *
1013     * Results:
1014     * None.
1015     *
1016     * Side effects:
1017     * May increment the reference count of a channel.
1018     *
1019     *----------------------------------------------------------------------
1020     */
1021    
1022     void
1023     Tcl_RegisterChannel(interp, chan)
1024     Tcl_Interp *interp; /* Interpreter in which to add the channel. */
1025     Tcl_Channel chan; /* The channel to add to this interpreter
1026     * channel table. */
1027     {
1028     Tcl_HashTable *hTblPtr; /* Hash table of channels. */
1029     Tcl_HashEntry *hPtr; /* Search variable. */
1030     int new; /* Is the hash entry new or does it exist? */
1031     Channel *chanPtr; /* The actual channel. */
1032    
1033     chanPtr = (Channel *) chan;
1034    
1035     if (chanPtr->channelName == (char *) NULL) {
1036     panic("Tcl_RegisterChannel: channel without name");
1037     }
1038     if (interp != (Tcl_Interp *) NULL) {
1039     hTblPtr = GetChannelTable(interp);
1040     hPtr = Tcl_CreateHashEntry(hTblPtr, chanPtr->channelName, &new);
1041     if (new == 0) {
1042     if (chan == (Tcl_Channel) Tcl_GetHashValue(hPtr)) {
1043     return;
1044     }
1045    
1046     /* Andreas Kupries <a.kupries@westend.com>, 12/13/1998
1047     * "Trf-Patch for filtering channels"
1048     *
1049     * This is the change to 'Tcl_RegisterChannel'.
1050     *
1051     * Explanation:
1052     * The moment a channel is stacked upon another he
1053     * takes the identity of the channel he supercedes,
1054     * i.e. he gets the *same* name. Because of this we
1055     * cannot check for duplicate names anymore, they
1056     * have to be allowed now.
1057     */
1058    
1059     /* panic("Tcl_RegisterChannel: duplicate channel names"); */
1060     }
1061     Tcl_SetHashValue(hPtr, (ClientData) chanPtr);
1062     }
1063     chanPtr->refCount++;
1064     }
1065    
1066     /*
1067     *----------------------------------------------------------------------
1068     *
1069     * Tcl_UnregisterChannel --
1070     *
1071     * Deletes the hash entry for a channel associated with an interpreter.
1072     * If the interpreter given as argument is NULL, it only decrements the
1073     * reference count.
1074     *
1075     * Results:
1076     * A standard Tcl result.
1077     *
1078     * Side effects:
1079     * Deletes the hash entry for a channel associated with an interpreter.
1080     *
1081     *----------------------------------------------------------------------
1082     */
1083    
1084     int
1085     Tcl_UnregisterChannel(interp, chan)
1086     Tcl_Interp *interp; /* Interpreter in which channel is defined. */
1087     Tcl_Channel chan; /* Channel to delete. */
1088     {
1089     Tcl_HashTable *hTblPtr; /* Hash table of channels. */
1090     Tcl_HashEntry *hPtr; /* Search variable. */
1091     Channel *chanPtr; /* The real IO channel. */
1092    
1093     chanPtr = (Channel *) chan;
1094    
1095     if (interp != (Tcl_Interp *) NULL) {
1096     hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
1097     if (hTblPtr == (Tcl_HashTable *) NULL) {
1098     return TCL_OK;
1099     }
1100     hPtr = Tcl_FindHashEntry(hTblPtr, chanPtr->channelName);
1101     if (hPtr == (Tcl_HashEntry *) NULL) {
1102     return TCL_OK;
1103     }
1104     if ((Channel *) Tcl_GetHashValue(hPtr) != chanPtr) {
1105     return TCL_OK;
1106     }
1107     Tcl_DeleteHashEntry(hPtr);
1108    
1109     /*
1110     * Remove channel handlers that refer to this interpreter, so that they
1111     * will not be present if the actual close is delayed and more events
1112     * happen on the channel. This may occur if the channel is shared
1113     * between several interpreters, or if the channel has async
1114     * flushing active.
1115     */
1116    
1117     CleanupChannelHandlers(interp, chanPtr);
1118     }
1119    
1120     chanPtr->refCount--;
1121    
1122     /*
1123     * Perform special handling for standard channels being closed. If the
1124     * refCount is now 1 it means that the last reference to the standard
1125     * channel is being explicitly closed, so bump the refCount down
1126     * artificially to 0. This will ensure that the channel is actually
1127     * closed, below. Also set the static pointer to NULL for the channel.
1128     */
1129    
1130     CheckForStdChannelsBeingClosed(chan);
1131    
1132     /*
1133     * If the refCount reached zero, close the actual channel.
1134     */
1135    
1136     if (chanPtr->refCount <= 0) {
1137    
1138     /*
1139     * Ensure that if there is another buffer, it gets flushed
1140     * whether or not we are doing a background flush.
1141     */
1142    
1143     if ((chanPtr->curOutPtr != NULL) &&
1144     (chanPtr->curOutPtr->nextAdded >
1145     chanPtr->curOutPtr->nextRemoved)) {
1146     chanPtr->flags |= BUFFER_READY;
1147     }
1148     chanPtr->flags |= CHANNEL_CLOSED;
1149     if (!(chanPtr->flags & BG_FLUSH_SCHEDULED)) {
1150     if (Tcl_Close(interp, chan) != TCL_OK) {
1151     return TCL_ERROR;
1152     }
1153     }
1154     }
1155     return TCL_OK;
1156     }
1157    
1158     /*
1159     *---------------------------------------------------------------------------
1160     *
1161     * Tcl_GetChannel --
1162     *
1163     * Finds an existing Tcl_Channel structure by name in a given
1164     * interpreter. This function is public because it is used by
1165     * channel-type-specific functions.
1166     *
1167     * Results:
1168     * A Tcl_Channel or NULL on failure. If failed, interp's result
1169     * object contains an error message. *modePtr is filled with the
1170     * modes in which the channel was opened.
1171     *
1172     * Side effects:
1173     * None.
1174     *
1175     *---------------------------------------------------------------------------
1176     */
1177    
1178     Tcl_Channel
1179     Tcl_GetChannel(interp, chanName, modePtr)
1180     Tcl_Interp *interp; /* Interpreter in which to find or create
1181     * the channel. */
1182     char *chanName; /* The name of the channel. */
1183     int *modePtr; /* Where to store the mode in which the
1184     * channel was opened? Will contain an ORed
1185     * combination of TCL_READABLE and
1186     * TCL_WRITABLE, if non-NULL. */
1187     {
1188     Channel *chanPtr; /* The actual channel. */
1189     Tcl_HashTable *hTblPtr; /* Hash table of channels. */
1190     Tcl_HashEntry *hPtr; /* Search variable. */
1191     char *name; /* Translated name. */
1192    
1193     /*
1194     * Substitute "stdin", etc. Note that even though we immediately
1195     * find the channel using Tcl_GetStdChannel, we still need to look
1196     * it up in the specified interpreter to ensure that it is present
1197     * in the channel table. Otherwise, safe interpreters would always
1198     * have access to the standard channels.
1199     */
1200    
1201     name = chanName;
1202     if ((chanName[0] == 's') && (chanName[1] == 't')) {
1203     chanPtr = NULL;
1204     if (strcmp(chanName, "stdin") == 0) {
1205     chanPtr = (Channel *)Tcl_GetStdChannel(TCL_STDIN);
1206     } else if (strcmp(chanName, "stdout") == 0) {
1207     chanPtr = (Channel *)Tcl_GetStdChannel(TCL_STDOUT);
1208     } else if (strcmp(chanName, "stderr") == 0) {
1209     chanPtr = (Channel *)Tcl_GetStdChannel(TCL_STDERR);
1210     }
1211     if (chanPtr != NULL) {
1212     name = chanPtr->channelName;
1213     }
1214     }
1215    
1216     hTblPtr = GetChannelTable(interp);
1217     hPtr = Tcl_FindHashEntry(hTblPtr, name);
1218     if (hPtr == (Tcl_HashEntry *) NULL) {
1219     Tcl_AppendResult(interp, "can not find channel named \"",
1220     chanName, "\"", (char *) NULL);
1221     return NULL;
1222     }
1223    
1224     chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
1225     if (modePtr != NULL) {
1226     *modePtr = (chanPtr->flags & (TCL_READABLE|TCL_WRITABLE));
1227     }
1228    
1229     return (Tcl_Channel) chanPtr;
1230     }
1231    
1232     /*
1233     *----------------------------------------------------------------------
1234     *
1235     * Tcl_CreateChannel --
1236     *
1237     * Creates a new entry in the hash table for a Tcl_Channel
1238     * record.
1239     *
1240     * Results:
1241     * Returns the new Tcl_Channel.
1242     *
1243     * Side effects:
1244     * Creates a new Tcl_Channel instance and inserts it into the
1245     * hash table.
1246     *
1247     *----------------------------------------------------------------------
1248     */
1249    
1250     Tcl_Channel
1251     Tcl_CreateChannel(typePtr, chanName, instanceData, mask)
1252     Tcl_ChannelType *typePtr; /* The channel type record. */
1253     char *chanName; /* Name of channel to record. */
1254     ClientData instanceData; /* Instance specific data. */
1255     int mask; /* TCL_READABLE & TCL_WRITABLE to indicate
1256     * if the channel is readable, writable. */
1257     {
1258     Channel *chanPtr; /* The channel structure newly created. */
1259     CONST char *name;
1260     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
1261    
1262     chanPtr = (Channel *) ckalloc((unsigned) sizeof(Channel));
1263    
1264     if (chanName != (char *) NULL) {
1265     chanPtr->channelName = ckalloc((unsigned) (strlen(chanName) + 1));
1266     strcpy(chanPtr->channelName, chanName);
1267     } else {
1268     panic("Tcl_CreateChannel: NULL channel name");
1269     }
1270    
1271     chanPtr->flags = mask;
1272    
1273     /*
1274     * Set the channel to system default encoding.
1275     */
1276    
1277     chanPtr->encoding = NULL;
1278     name = Tcl_GetEncodingName(NULL);
1279     if (strcmp(name, "binary") != 0) {
1280     chanPtr->encoding = Tcl_GetEncoding(NULL, name);
1281     }
1282     chanPtr->inputEncodingState = NULL;
1283     chanPtr->inputEncodingFlags = TCL_ENCODING_START;
1284     chanPtr->outputEncodingState = NULL;
1285     chanPtr->outputEncodingFlags = TCL_ENCODING_START;
1286    
1287     /*
1288     * Set the channel up initially in AUTO input translation mode to
1289     * accept "\n", "\r" and "\r\n". Output translation mode is set to
1290     * a platform specific default value. The eofChar is set to 0 for both
1291     * input and output, so that Tcl does not look for an in-file EOF
1292     * indicator (e.g. ^Z) and does not append an EOF indicator to files.
1293     */
1294    
1295     chanPtr->inputTranslation = TCL_TRANSLATE_AUTO;
1296     chanPtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
1297     chanPtr->inEofChar = 0;
1298     chanPtr->outEofChar = 0;
1299    
1300     chanPtr->unreportedError = 0;
1301     chanPtr->instanceData = instanceData;
1302     chanPtr->typePtr = typePtr;
1303     chanPtr->refCount = 0;
1304     chanPtr->closeCbPtr = (CloseCallback *) NULL;
1305     chanPtr->curOutPtr = (ChannelBuffer *) NULL;
1306     chanPtr->outQueueHead = (ChannelBuffer *) NULL;
1307     chanPtr->outQueueTail = (ChannelBuffer *) NULL;
1308     chanPtr->saveInBufPtr = (ChannelBuffer *) NULL;
1309     chanPtr->inQueueHead = (ChannelBuffer *) NULL;
1310     chanPtr->inQueueTail = (ChannelBuffer *) NULL;
1311     chanPtr->chPtr = (ChannelHandler *) NULL;
1312     chanPtr->interestMask = 0;
1313     chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL;
1314     chanPtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE;
1315     chanPtr->timer = NULL;
1316     chanPtr->csPtr = NULL;
1317     chanPtr->supercedes = (Channel*) NULL;
1318    
1319     chanPtr->outputStage = NULL;
1320     if ((chanPtr->encoding != NULL) && (chanPtr->flags & TCL_WRITABLE)) {
1321     chanPtr->outputStage = (char *)
1322     ckalloc((unsigned) (chanPtr->bufSize + 2));
1323     }
1324    
1325     /*
1326     * Link the channel into the list of all channels; create an on-exit
1327     * handler if there is not one already, to close off all the channels
1328     * in the list on exit.
1329     */
1330    
1331     chanPtr->nextChanPtr = tsdPtr->firstChanPtr;
1332     tsdPtr->firstChanPtr = chanPtr;
1333    
1334     /*
1335     * Install this channel in the first empty standard channel slot, if
1336     * the channel was previously closed explicitly.
1337     */
1338    
1339     if ((tsdPtr->stdinChannel == NULL) && (tsdPtr->stdinInitialized == 1)) {
1340     Tcl_SetStdChannel((Tcl_Channel)chanPtr, TCL_STDIN);
1341     Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
1342     } else if ((tsdPtr->stdoutChannel == NULL) && (tsdPtr->stdoutInitialized == 1)) {
1343     Tcl_SetStdChannel((Tcl_Channel)chanPtr, TCL_STDOUT);
1344     Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
1345     } else if ((tsdPtr->stderrChannel == NULL) && (tsdPtr->stderrInitialized == 1)) {
1346     Tcl_SetStdChannel((Tcl_Channel)chanPtr, TCL_STDERR);
1347     Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
1348     }
1349     return (Tcl_Channel) chanPtr;
1350     }
1351    
1352     /*
1353     *----------------------------------------------------------------------
1354     *
1355     * Tcl_StackChannel --
1356     *
1357     * Replaces an entry in the hash table for a Tcl_Channel
1358     * record. The replacement is a new channel with same name,
1359     * it supercedes the replaced channel. Input and output of
1360     * the superceded channel is now going through the newly
1361     * created channel and allows the arbitrary filtering/manipulation
1362     * of the dataflow.
1363     *
1364     * Andreas Kupries <a.kupries@westend.com>, 12/13/1998
1365     * "Trf-Patch for filtering channels"
1366     *
1367     * Results:
1368     * Returns the new Tcl_Channel, which actually contains the
1369     * saved information about prevChan.
1370     *
1371     * Side effects:
1372     * A new channel structure is allocated and linked below
1373     * the existing channel. The channel operations and client
1374     * data of the existing channel are copied down to the newly
1375     * created channel, and the current channel has its operations
1376     * replaced by the new typePtr.
1377     *
1378     *----------------------------------------------------------------------
1379     */
1380    
1381     Tcl_Channel
1382     Tcl_StackChannel(interp, typePtr, instanceData, mask, prevChan)
1383     Tcl_Interp* interp; /* The interpreter we are working in */
1384     Tcl_ChannelType *typePtr; /* The channel type record for the new
1385     * channel. */
1386     ClientData instanceData; /* Instance specific data for the new
1387     * channel. */
1388     int mask; /* TCL_READABLE & TCL_WRITABLE to indicate
1389     * if the channel is readable, writable. */
1390     Tcl_Channel prevChan; /* The channel structure to replace */
1391     {
1392     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
1393     Channel *chanPtr, *pt;
1394     int interest = 0;
1395    
1396     /*
1397     * AK, 06/30/1999
1398     *
1399     * Tcl_StackChannel differs from Tcl_ReplaceChannel of the
1400     * original "Trf" patch. Instead of seeing the
1401     * newly created structure as the *new* channel to cover the specified
1402     * one use it to *save* the current state of the specified channel and
1403     * then reinitialize the current structure for the given transformation.
1404     *
1405     * Advantages:
1406     * - No splicing into the (thread-)global list of channels (or the per-
1407     * interp hash-tables).
1408     * - Users of the C-API still have valid channel references even after
1409     * the call to this procedure.
1410     *
1411     * Disadvantages:
1412     * - Untested code.
1413     */
1414    
1415     /*
1416     * Find the given channel in the list of all channels.
1417     */
1418    
1419     pt = (Channel*) tsdPtr->firstChanPtr;
1420    
1421     while (pt != (Channel *) prevChan) {
1422     pt = pt->nextChanPtr;
1423     }
1424    
1425     /*
1426     * 'pt == prevChan' now (or NULL, if not found).
1427     */
1428    
1429     if (!pt) {
1430     return (Tcl_Channel) NULL;
1431     }
1432    
1433     /*
1434     * Here we check if the given "mask" matches the "flags"
1435     * of the already existing channel.
1436     *
1437     * | - | R | W | RW |
1438     * --+---+---+---+----+ <=> 0 != (chan->mask & prevChan->mask)
1439     * - | | | | |
1440     * R | | + | | + | The superceding channel is allowed to
1441     * W | | | + | + | restrict the capabilities of the
1442     * RW| | + | + | + | superceded one !
1443     * --+---+---+---+----+
1444     */
1445    
1446     if ((mask & Tcl_GetChannelMode (prevChan)) == 0) {
1447     return (Tcl_Channel) NULL;
1448     }
1449    
1450     chanPtr = (Channel *) ckalloc((unsigned) sizeof(Channel));
1451    
1452     /*
1453     * If there is some interest in the channel, remove it, break
1454     * down the whole chain. It will be reconstructed later.
1455     */
1456    
1457     interest = pt->interestMask;
1458    
1459     pt->interestMask = 0;
1460    
1461     if (interest) {
1462     (pt->typePtr->watchProc) (pt->instanceData, 0);
1463     }
1464    
1465     /*
1466     * Save some of the current state into the new structure,
1467     * reinitialize the parts which will stay with the transformation.
1468     *
1469     * Remarks:
1470     * - We cannot discard the buffers, and they cannot be used from the
1471     * transformation placed later into the 'pt' structure. Save them,
1472     * and believe that Tcl_SetChannelOption (buffering, none) will do
1473     * the right thing.
1474     * - encoding and EOL-translation control information is initialized
1475     * to values for 'binary'. This is later reinforced via
1476     * Tcl_SetChanneloption to get the handling of flags and the event
1477     * system right.
1478     * - The 'interestMask' of the saved channel is cleared, but the
1479     * transformations WatchProc is used to establish the connection
1480     * between transformation and underlying channel. This should
1481     * reestablish the correct mask.
1482     * - TTO = Transform Takes Over. The hidden channel no longer
1483     * needs to perform this function.
1484     */
1485    
1486     chanPtr->channelName = (char *) ckalloc (strlen(pt->channelName)+1);
1487     strcpy (chanPtr->channelName, pt->channelName);
1488    
1489     chanPtr->flags = pt->flags; /* Save */
1490    
1491     chanPtr->encoding = (Tcl_Encoding) NULL; /* == 'binary' */
1492     chanPtr->inputEncodingState = (Tcl_EncodingState) NULL;
1493     chanPtr->inputEncodingFlags = TCL_ENCODING_START;
1494     chanPtr->outputEncodingState = (Tcl_EncodingState) NULL;
1495     chanPtr->outputEncodingFlags = TCL_ENCODING_START;
1496    
1497     chanPtr->inputTranslation = TCL_TRANSLATE_LF; /* == 'binary' */
1498     chanPtr->outputTranslation = TCL_TRANSLATE_LF; /* == 'binary' */
1499     chanPtr->inEofChar = pt->inEofChar; /* Save */
1500     chanPtr->outEofChar = pt->outEofChar; /* Save */
1501    
1502     chanPtr->unreportedError = pt->unreportedError; /* Save */
1503     chanPtr->instanceData = pt->instanceData; /* Save */
1504     chanPtr->typePtr = pt->typePtr; /* Save */
1505     chanPtr->refCount = 0; /* None, as the structure is covered */
1506     chanPtr->closeCbPtr = (CloseCallback*) NULL; /* TTO */
1507    
1508     chanPtr->outputStage = (char*) NULL;
1509     chanPtr->curOutPtr = pt->curOutPtr; /* Save */
1510     chanPtr->outQueueHead = pt->outQueueHead; /* Save */
1511     chanPtr->outQueueTail = pt->outQueueTail; /* Save */
1512     chanPtr->saveInBufPtr = pt->saveInBufPtr; /* Save */
1513     chanPtr->inQueueHead = pt->inQueueHead; /* Save */
1514     chanPtr->inQueueTail = pt->inQueueTail; /* Save */
1515    
1516     chanPtr->chPtr = (ChannelHandler *) NULL; /* TTO */
1517     chanPtr->interestMask = 0;
1518     chanPtr->nextChanPtr = (Channel*) NULL; /* Is not in list! */
1519     chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL; /* TTO */
1520     chanPtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE;
1521     chanPtr->timer = (Tcl_TimerToken) NULL; /* TTO */
1522     chanPtr->csPtr = (CopyState*) NULL; /* TTO */
1523    
1524     /*
1525     * Place new block at the head of a possibly existing list of previously
1526     * stacked channels, then do the missing initializations of translation
1527     * and buffer system.
1528     */
1529    
1530     chanPtr->supercedes = pt->supercedes;
1531    
1532     Tcl_SetChannelOption (interp, (Tcl_Channel) chanPtr,
1533     "-translation", "binary");
1534     Tcl_SetChannelOption (interp, (Tcl_Channel) chanPtr,
1535     "-buffering", "none");
1536    
1537     /*
1538     * Save accomplished, now reinitialize the (old) structure for the
1539     * transformation.
1540     *
1541     * - The information about encoding and eol-translation is taken
1542     * without change. There is no need to fiddle with
1543     * refCount et. al.
1544     *
1545     * Don't forget to use the same blocking mode as the old channel.
1546     */
1547    
1548     pt->flags = mask | (chanPtr->flags & CHANNEL_NONBLOCKING);
1549    
1550     /*
1551     * EDITORS NOTE: all the lines with "take it as is" should get
1552     * deleted once this code has been debugged.
1553     */
1554    
1555     /* pt->encoding, take it as is */
1556     /* pt->inputEncodingState, take it as is */
1557     /* pt->inputEncodingFlags, take it as is */
1558     /* pt->outputEncodingState, take it as is */
1559     /* pt->outputEncodingFlags, take it as is */
1560    
1561     /* pt->inputTranslation, take it as is */
1562     /* pt->outputTranslation, take it as is */
1563    
1564     /*
1565     * No special EOF character, that condition is determined by the
1566     * old channel
1567     */
1568    
1569     pt->inEofChar = 0;
1570     pt->outEofChar = 0;
1571    
1572     pt->unreportedError = 0; /* No errors yet */
1573     pt->instanceData = instanceData; /* Transformation state */
1574     pt->typePtr = typePtr; /* Transformation type */
1575     /* pt->refCount, take it as it is */
1576     /* pt->closeCbPtr, take it as it is */
1577    
1578     /* pt->outputStage, take it as it is */
1579     pt->curOutPtr = (ChannelBuffer *) NULL;
1580     pt->outQueueHead = (ChannelBuffer *) NULL;
1581     pt->outQueueTail = (ChannelBuffer *) NULL;
1582     pt->saveInBufPtr = (ChannelBuffer *) NULL;
1583     pt->inQueueHead = (ChannelBuffer *) NULL;
1584     pt->inQueueTail = (ChannelBuffer *) NULL;
1585    
1586     /* pt->chPtr, take it as it is */
1587     /* pt->interestMask, take it as it is */
1588     /* pt->nextChanPtr, take it as it is */
1589     /* pt->scriptRecordPtr, take it as it is */
1590     pt->bufSize = CHANNELBUFFER_DEFAULT_SIZE;
1591     /* pt->timer, take it as it is */
1592     /* pt->csPtr, take it as it is */
1593    
1594     /*
1595     * Have the transformation reference the new structure containing
1596     * the saved channel.
1597     */
1598    
1599     pt->supercedes = chanPtr;
1600    
1601     /*
1602     * Don't forget to reinitialize the output buffer used for encodings.
1603     */
1604    
1605     if ((chanPtr->encoding != NULL) && (chanPtr->flags & TCL_WRITABLE)) {
1606     chanPtr->outputStage = (char *)
1607     ckalloc((unsigned) (chanPtr->bufSize + 2));
1608     }
1609    
1610     /*
1611     * Event handling: If the information in the old channel shows
1612     * that there was interest in some events call the 'WatchProc'
1613     * of the transformation to establish the proper connection
1614     * between them.
1615     */
1616    
1617     if (interest) {
1618     (pt->typePtr->watchProc) (pt->instanceData, interest);
1619     }
1620    
1621     /*
1622     * The superceded channel is effectively unregistered
1623     * We cannot decrement its reference count because that
1624     * can cause it to get garbage collected out from under us.
1625     * Don't add the following code:
1626     *
1627     * chanPtr->supercedes->refCount --;
1628     */
1629    
1630     return (Tcl_Channel) chanPtr;
1631     }
1632    
1633     /*
1634     *----------------------------------------------------------------------
1635     *
1636     * Tcl_UnstackChannel --
1637     *
1638     * Unstacks an entry in the hash table for a Tcl_Channel
1639     * record. This is the reverse to 'Tcl_StackChannel'.
1640     * The old, superceded channel is uncovered and re-registered
1641     * in the appropriate data structures.
1642     *
1643     * Results:
1644     * Returns the old Tcl_Channel, i.e. the one which was stacked over.
1645     *
1646     * Side effects:
1647     * See above.
1648     *
1649     *----------------------------------------------------------------------
1650     */
1651    
1652     void
1653     Tcl_UnstackChannel (interp, chan)
1654     Tcl_Interp* interp; /* The interpreter we are working in */
1655     Tcl_Channel chan; /* The channel to unstack */
1656     {
1657     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
1658     Channel* chanPtr = (Channel*) chan;
1659    
1660     if (chanPtr->supercedes != (Channel*) NULL) {
1661     /*
1662     * Instead of manipulating the per-thread / per-interp list/hashtable
1663     * of registered channels we wind down the state of the transformation,
1664     * and then restore the state of underlying channel into the old
1665     * structure.
1666     */
1667    
1668     Tcl_DString dsTrans; /* storage to save option information */
1669     Tcl_DString dsBuf; /* storage to save option information */
1670     Channel top; /* Save area for current transformation */
1671     Channel* chanDownPtr = chanPtr->supercedes;
1672     int interest; /* interest mask of transformation
1673     * before destruct. */
1674     int saveInputEncodingFlags; /* Save area for encoding */
1675     int saveOutputEncodingFlags; /* related information */
1676     Tcl_EncodingState saveInputEncodingState;
1677     Tcl_EncodingState saveOutputEncodingState;
1678     Tcl_Encoding saveEncoding;
1679    
1680     /*
1681     * Event handling: Disallow the delivery of events from the
1682     * old, now uncovered channel to the transformation.
1683     *
1684     * This is done before everything else to avoid problems
1685     * after our heavy-duty shuffling of pointers around.
1686     */
1687    
1688     interest = chanPtr->interestMask;
1689     (chanPtr->typePtr->watchProc) (chanPtr->instanceData, 0);
1690    
1691     /* 1. Swap the information in the top channel (the transformation)
1692     * and the channel below, with some exceptions. This additionally
1693     * cuts the top channel out of the chain. Without the latter
1694     * a Tcl_Close on the transformation would be impossible, as that
1695     * procedure will free the structure, making 'top' unusable.
1696     *
1697     * chanPtr -> top channel, transformation.
1698     * chanDownPtr -> channel immediately below the transformation.
1699     */
1700    
1701     memcpy ((void*) &top, (void*) chanPtr, sizeof (Channel));
1702     memcpy ((void*) chanPtr, (void*) chanDownPtr, sizeof (Channel));
1703     top.supercedes = (Channel*) NULL;
1704     memcpy ((void*) chanDownPtr, (void*) &top, sizeof (Channel));
1705    
1706     /* Now:
1707     * chanPtr -> channel immediately below the transformation, now top
1708     * chanDownPtr -> transformation, cut loose.
1709     *
1710     * Handle the exceptions mentioned above, i.e. move the information
1711     * from the transformation into the new top, and reinitialize it to
1712     * safe values in the transformation.
1713     */
1714    
1715     chanPtr->refCount = chanDownPtr->refCount;
1716     chanPtr->closeCbPtr = chanDownPtr->closeCbPtr;
1717     chanPtr->chPtr = chanDownPtr->chPtr;
1718     chanPtr->nextChanPtr = chanDownPtr->nextChanPtr;
1719     chanPtr->scriptRecordPtr = chanDownPtr->scriptRecordPtr;
1720     chanPtr->timer = chanDownPtr->timer;
1721     chanPtr->csPtr = chanDownPtr->csPtr;
1722    
1723     chanDownPtr->refCount = 0;
1724     chanDownPtr->closeCbPtr = (CloseCallback*) NULL;
1725     chanDownPtr->chPtr = (ChannelHandler*) NULL;
1726     chanDownPtr->nextChanPtr = (Channel*) NULL;
1727     chanDownPtr->scriptRecordPtr = (EventScriptRecord*) NULL;
1728     chanDownPtr->timer = (Tcl_TimerToken) NULL;
1729     chanDownPtr->csPtr = (CopyState*) NULL;
1730    
1731     /* The now uncovered channel still has encoding and eol-translation
1732     * deactivated, i.e. switched to 'binary'. *Don't* touch this until
1733     * after the transformation is closed for good, as it may write
1734     * information into it during that (-> flushing of data waiting in
1735     * internal buffers!) and rely on these settings. Thanks to Matt
1736     * Newman <matt@sensus.org> for finding this goof.
1737     *
1738     * But we also have to protect the state of the encoding from removal
1739     * during the close. So we save it in some local variables.
1740     * Additionally the current value of the options is lost after we
1741     * close, we have to save them now.
1742     */
1743    
1744     saveEncoding = chanDownPtr->encoding;
1745     saveInputEncodingState = chanDownPtr->inputEncodingState;
1746     saveInputEncodingFlags = chanDownPtr->inputEncodingFlags;
1747     saveOutputEncodingState = chanDownPtr->outputEncodingState;
1748     saveOutputEncodingFlags = chanDownPtr->outputEncodingFlags;
1749    
1750     Tcl_DStringInit (&dsTrans);
1751     Tcl_GetChannelOption (interp, (Tcl_Channel) chanDownPtr,
1752     "-translation", &dsTrans);
1753    
1754     Tcl_DStringInit (&dsBuf);
1755     Tcl_GetChannelOption (interp, (Tcl_Channel) chanDownPtr,
1756     "-buffering", &dsBuf);
1757    
1758     /*
1759     * Prevent the accidential removal of the encoding during
1760     * the destruction of the transformation channel.
1761     */
1762    
1763     chanDownPtr->encoding = (Tcl_Encoding) NULL;
1764     chanDownPtr->inputEncodingState = (Tcl_EncodingState) NULL;
1765     chanDownPtr->inputEncodingFlags = TCL_ENCODING_START;
1766     chanDownPtr->outputEncodingState = (Tcl_EncodingState) NULL;
1767     chanDownPtr->outputEncodingFlags = TCL_ENCODING_START;
1768    
1769     /*
1770     * A little trick: Add the transformation structure to the
1771     * per-thread list of existing channels (which it never were
1772     * part of so far), or Tcl_Close/FlushChannel will panic
1773     * ("damaged channel list").
1774     *
1775     * Afterward do a regular close upon the transformation.
1776     * This may cause flushing of data into the old channel (if the
1777     * transformation remembered its own channel in itself).
1778     *
1779     * We know that its refCount dropped to 0.
1780     */
1781    
1782     chanDownPtr->nextChanPtr = tsdPtr->firstChanPtr;
1783     tsdPtr->firstChanPtr = chanDownPtr;
1784    
1785     Tcl_Close (interp, (Tcl_Channel)chanDownPtr);
1786    
1787     /*
1788     * Now it is possible to wind down the transformation (in 'top'),
1789     * especially to copy the current encoding and translation control
1790     * information down.
1791     */
1792    
1793     /*
1794     * Move the currently active encoding from the save area
1795     * to the now uncovered channel. We assume here that this
1796     * channel uses 'encoding binary' (==> encoding == NULL, etc.
1797     * This allows us to simply copy the pointers without having to
1798     * think about refcounts and deallocation of the old encoding.
1799     *
1800     * And don't forget to reenable the EOL-translation used by the
1801     * transformation. Using a DString to do this *is* a bit awkward,
1802     * but still the best way to handle the complexities here, like
1803     * flag manipulation and event system.
1804     */
1805    
1806     chanPtr->encoding = saveEncoding;
1807     chanPtr->inputEncodingState = saveInputEncodingState;
1808     chanPtr->inputEncodingFlags = saveInputEncodingFlags;
1809     chanPtr->outputEncodingState = saveOutputEncodingState;
1810     chanPtr->outputEncodingFlags = saveOutputEncodingFlags;
1811    
1812     Tcl_SetChannelOption (interp, (Tcl_Channel) chanPtr,
1813     "-translation", dsTrans.string);
1814    
1815     Tcl_SetChannelOption (interp, (Tcl_Channel) chanPtr,
1816     "-buffering", dsBuf.string);
1817    
1818     Tcl_DStringFree (&dsTrans);
1819     Tcl_DStringFree (&dsBuf);
1820    
1821     /*
1822     * Event handling: If the information from the now destroyed
1823     * transformation shows that there was interest in some events
1824     * call the 'WatchProc' of the now uncovered channel to renew
1825     * that interest with underlying channels or the driver.
1826     */
1827    
1828     if (interest) {
1829     chanPtr->interestMask = 0;
1830     (chanPtr->typePtr->watchProc) (chanPtr->instanceData,
1831     interest);
1832     chanPtr->interestMask = interest;
1833     }
1834    
1835     } else {
1836     /* This channel does not cover another one.
1837     * Simply do a close, if necessary.
1838     */
1839    
1840     if (chanPtr->refCount == 0) {
1841     Tcl_Close (interp, chan);
1842     }
1843     }
1844     }
1845    
1846     /*
1847     *----------------------------------------------------------------------
1848     *
1849     * Tcl_GetStackedChannel --
1850     *
1851     * Determines wether the specified channel is stacked upon another.
1852     *
1853     * Results:
1854     * NULL if the channel is not stacked upon another one, or a reference
1855     * to the channel it is stacked upon. This reference can be used in
1856     * queries, but modification is not allowed.
1857     *
1858     * Side effects:
1859     * None.
1860     *
1861     *----------------------------------------------------------------------
1862     */
1863    
1864     Tcl_Channel
1865     Tcl_GetStackedChannel(chan)
1866     Tcl_Channel chan;
1867     {
1868     Channel* chanPtr = (Channel*) chan;
1869     return (Tcl_Channel) chanPtr->supercedes;
1870     }
1871    
1872     /*
1873     *----------------------------------------------------------------------
1874     *
1875     * Tcl_GetChannelMode --
1876     *
1877     * Computes a mask indicating whether the channel is open for
1878     * reading and writing.
1879     *
1880     * Results:
1881     * An OR-ed combination of TCL_READABLE and TCL_WRITABLE.
1882     *
1883     * Side effects:
1884     * None.
1885     *
1886     *----------------------------------------------------------------------
1887     */
1888    
1889     int
1890     Tcl_GetChannelMode(chan)
1891     Tcl_Channel chan; /* The channel for which the mode is
1892     * being computed. */
1893     {
1894     Channel *chanPtr; /* The actual channel. */
1895    
1896     chanPtr = (Channel *) chan;
1897     return (chanPtr->flags & (TCL_READABLE | TCL_WRITABLE));
1898     }
1899    
1900     /*
1901     *----------------------------------------------------------------------
1902     *
1903     * Tcl_GetChannelName --
1904     *
1905     * Returns the string identifying the channel name.
1906     *
1907     * Results:
1908     * The string containing the channel name. This memory is
1909     * owned by the generic layer and should not be modified by
1910     * the caller.
1911     *
1912     * Side effects:
1913     * None.
1914     *
1915     *----------------------------------------------------------------------
1916     */
1917    
1918     char *
1919     Tcl_GetChannelName(chan)
1920     Tcl_Channel chan; /* The channel for which to return the name. */
1921     {
1922     Channel *chanPtr; /* The actual channel. */
1923    
1924     chanPtr = (Channel *) chan;
1925     return chanPtr->channelName;
1926     }
1927    
1928     /*
1929     *----------------------------------------------------------------------
1930     *
1931     * Tcl_GetChannelType --
1932     *
1933     * Given a channel structure, returns the channel type structure.
1934     *
1935     * Results:
1936     * Returns a pointer to the channel type structure.
1937     *
1938     * Side effects:
1939     * None.
1940     *
1941     *----------------------------------------------------------------------
1942     */
1943    
1944     Tcl_ChannelType *
1945     Tcl_GetChannelType(chan)
1946     Tcl_Channel chan; /* The channel to return type for. */
1947     {
1948     Channel *chanPtr; /* The actual channel. */
1949    
1950     chanPtr = (Channel *) chan;
1951     return chanPtr->typePtr;
1952     }
1953    
1954     /*
1955     *----------------------------------------------------------------------
1956     *
1957     * Tcl_GetChannelHandle --
1958     *
1959     * Returns an OS handle associated with a channel.
1960     *
1961     * Results:
1962     * Returns TCL_OK and places the handle in handlePtr, or returns
1963     * TCL_ERROR on failure.
1964     *
1965     * Side effects:
1966     * None.
1967     *
1968     *----------------------------------------------------------------------
1969     */
1970    
1971     int
1972     Tcl_GetChannelHandle(chan, direction, handlePtr)
1973     Tcl_Channel chan; /* The channel to get file from. */
1974     int direction; /* TCL_WRITABLE or TCL_READABLE. */
1975     ClientData *handlePtr; /* Where to store handle */
1976     {
1977     Channel *chanPtr; /* The actual channel. */
1978     ClientData handle;
1979     int result;
1980    
1981     chanPtr = (Channel *) chan;
1982     result = (chanPtr->typePtr->getHandleProc)(chanPtr->instanceData,
1983     direction, &handle);
1984     if (handlePtr) {
1985     *handlePtr = handle;
1986     }
1987     return result;
1988     }
1989    
1990     /*
1991     *----------------------------------------------------------------------
1992     *
1993     * Tcl_GetChannelInstanceData --
1994     *
1995     * Returns the client data associated with a channel.
1996     *
1997     * Results:
1998     * The client data.
1999     *
2000     * Side effects:
2001     * None.
2002     *
2003     *----------------------------------------------------------------------
2004     */
2005    
2006     ClientData
2007     Tcl_GetChannelInstanceData(chan)
2008     Tcl_Channel chan; /* Channel for which to return client data. */
2009     {
2010     Channel *chanPtr; /* The actual channel. */
2011    
2012     chanPtr = (Channel *) chan;
2013     return chanPtr->instanceData;
2014     }
2015    
2016     /*
2017     *---------------------------------------------------------------------------
2018     *
2019     * AllocChannelBuffer --
2020     *
2021     * A channel buffer has BUFFER_PADDING bytes extra at beginning to
2022     * hold any bytes of a native-encoding character that got split by
2023     * the end of the previous buffer and need to be moved to the
2024     * beginning of the next buffer to make a contiguous string so it
2025     * can be converted to UTF-8.
2026     *
2027     * A channel buffer has BUFFER_PADDING bytes extra at the end to
2028     * hold any bytes of a native-encoding character (generated from a
2029     * UTF-8 character) that overflow past the end of the buffer and
2030     * need to be moved to the next buffer.
2031     *
2032     * Results:
2033     * A newly allocated channel buffer.
2034     *
2035     * Side effects:
2036     * None.
2037     *
2038     *---------------------------------------------------------------------------
2039     */
2040    
2041     static ChannelBuffer *
2042     AllocChannelBuffer(length)
2043     int length; /* Desired length of channel buffer. */
2044     {
2045     ChannelBuffer *bufPtr;
2046     int n;
2047    
2048     n = length + CHANNELBUFFER_HEADER_SIZE + BUFFER_PADDING + BUFFER_PADDING;
2049     bufPtr = (ChannelBuffer *) ckalloc((unsigned) n);
2050     bufPtr->nextAdded = BUFFER_PADDING;
2051     bufPtr->nextRemoved = BUFFER_PADDING;
2052     bufPtr->bufLength = length + BUFFER_PADDING;
2053     bufPtr->nextPtr = (ChannelBuffer *) NULL;
2054     return bufPtr;
2055     }
2056    
2057     /*
2058     *----------------------------------------------------------------------
2059     *
2060     * RecycleBuffer --
2061     *
2062     * Helper function to recycle input and output buffers. Ensures
2063     * that two input buffers are saved (one in the input queue and
2064     * another in the saveInBufPtr field) and that curOutPtr is set
2065     * to a buffer. Only if these conditions are met is the buffer
2066     * freed to the OS.
2067     *
2068     * Results:
2069     * None.
2070     *
2071     * Side effects:
2072     * May free a buffer to the OS.
2073     *
2074     *----------------------------------------------------------------------
2075     */
2076    
2077     static void
2078     RecycleBuffer(chanPtr, bufPtr, mustDiscard)
2079     Channel *chanPtr; /* Channel for which to recycle buffers. */
2080     ChannelBuffer *bufPtr; /* The buffer to recycle. */
2081     int mustDiscard; /* If nonzero, free the buffer to the
2082     * OS, always. */
2083     {
2084     /*
2085     * Do we have to free the buffer to the OS?
2086     */
2087    
2088     if (mustDiscard) {
2089     ckfree((char *) bufPtr);
2090     return;
2091     }
2092    
2093     /*
2094     * Only save buffers for the input queue if the channel is readable.
2095     */
2096    
2097     if (chanPtr->flags & TCL_READABLE) {
2098     if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
2099     chanPtr->inQueueHead = bufPtr;
2100     chanPtr->inQueueTail = bufPtr;
2101     goto keepit;
2102     }
2103     if (chanPtr->saveInBufPtr == (ChannelBuffer *) NULL) {
2104     chanPtr->saveInBufPtr = bufPtr;
2105     goto keepit;
2106     }
2107     }
2108    
2109     /*
2110     * Only save buffers for the output queue if the channel is writable.
2111     */
2112    
2113     if (chanPtr->flags & TCL_WRITABLE) {
2114     if (chanPtr->curOutPtr == (ChannelBuffer *) NULL) {
2115     chanPtr->curOutPtr = bufPtr;
2116     goto keepit;
2117     }
2118     }
2119    
2120     /*
2121     * If we reached this code we return the buffer to the OS.
2122     */
2123    
2124     ckfree((char *) bufPtr);
2125     return;
2126    
2127     keepit:
2128     bufPtr->nextRemoved = BUFFER_PADDING;
2129     bufPtr->nextAdded = BUFFER_PADDING;
2130     bufPtr->nextPtr = (ChannelBuffer *) NULL;
2131     }
2132    
2133     /*
2134     *----------------------------------------------------------------------
2135     *
2136     * DiscardOutputQueued --
2137     *
2138     * Discards all output queued in the output queue of a channel.
2139     *
2140     * Results:
2141     * None.
2142     *
2143     * Side effects:
2144     * Recycles buffers.
2145     *
2146     *----------------------------------------------------------------------
2147     */
2148    
2149     static void
2150     DiscardOutputQueued(chanPtr)
2151     Channel *chanPtr; /* The channel for which to discard output. */
2152     {
2153     ChannelBuffer *bufPtr;
2154    
2155     while (chanPtr->outQueueHead != (ChannelBuffer *) NULL) {
2156     bufPtr = chanPtr->outQueueHead;
2157     chanPtr->outQueueHead = bufPtr->nextPtr;
2158     RecycleBuffer(chanPtr, bufPtr, 0);
2159     }
2160     chanPtr->outQueueHead = (ChannelBuffer *) NULL;
2161     chanPtr->outQueueTail = (ChannelBuffer *) NULL;
2162     }
2163    
2164     /*
2165     *----------------------------------------------------------------------
2166     *
2167     * CheckForDeadChannel --
2168     *
2169     * This function checks is a given channel is Dead.
2170     * (A channel that has been closed but not yet deallocated.)
2171     *
2172     * Results:
2173     * True (1) if channel is Dead, False (0) if channel is Ok
2174     *
2175     * Side effects:
2176     * None
2177     *
2178     *----------------------------------------------------------------------
2179     */
2180    
2181     static int
2182     CheckForDeadChannel(interp, chanPtr)
2183     Tcl_Interp *interp; /* For error reporting (can be NULL) */
2184     Channel *chanPtr; /* The channel to check. */
2185     {
2186     if (chanPtr->flags & CHANNEL_DEAD) {
2187     Tcl_SetErrno(EINVAL);
2188     if (interp) {
2189     Tcl_AppendResult(interp,
2190     "unable to access channel: invalid channel",
2191     (char *) NULL);
2192     }
2193     return 1;
2194     }
2195     return 0;
2196     }
2197    
2198     /*
2199     *----------------------------------------------------------------------
2200     *
2201     * FlushChannel --
2202     *
2203     * This function flushes as much of the queued output as is possible
2204     * now. If calledFromAsyncFlush is nonzero, it is being called in an
2205     * event handler to flush channel output asynchronously.
2206     *
2207     * Results:
2208     * 0 if successful, else the error code that was returned by the
2209     * channel type operation.
2210     *
2211     * Side effects:
2212     * May produce output on a channel. May block indefinitely if the
2213     * channel is synchronous. May schedule an async flush on the channel.
2214     * May recycle memory for buffers in the output queue.
2215     *
2216     *----------------------------------------------------------------------
2217     */
2218    
2219     static int
2220     FlushChannel(interp, chanPtr, calledFromAsyncFlush)
2221     Tcl_Interp *interp; /* For error reporting during close. */
2222     Channel *chanPtr; /* The channel to flush on. */
2223     int calledFromAsyncFlush; /* If nonzero then we are being
2224     * called from an asynchronous
2225     * flush callback. */
2226     {
2227     ChannelBuffer *bufPtr; /* Iterates over buffered output
2228     * queue. */
2229     int toWrite; /* Amount of output data in current
2230     * buffer available to be written. */
2231     int written; /* Amount of output data actually
2232     * written in current round. */
2233     int errorCode = 0; /* Stores POSIX error codes from
2234     * channel driver operations. */
2235     int wroteSome = 0; /* Set to one if any data was
2236     * written to the driver. */
2237    
2238     /*
2239     * Prevent writing on a dead channel -- a channel that has been closed
2240     * but not yet deallocated. This can occur if the exit handler for the
2241     * channel deallocation runs before all channels are deregistered in
2242     * all interpreters.
2243     */
2244    
2245     if (CheckForDeadChannel(interp,chanPtr)) return -1;
2246    
2247     /*
2248     * Loop over the queued buffers and attempt to flush as
2249     * much as possible of the queued output to the channel.
2250     */
2251    
2252     while (1) {
2253    
2254     /*
2255     * If the queue is empty and there is a ready current buffer, OR if
2256     * the current buffer is full, then move the current buffer to the
2257     * queue.
2258     */
2259    
2260     if (((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&
2261     (chanPtr->curOutPtr->nextAdded == chanPtr->curOutPtr->bufLength))
2262     || ((chanPtr->flags & BUFFER_READY) &&
2263     (chanPtr->outQueueHead == (ChannelBuffer *) NULL))) {
2264     chanPtr->flags &= (~(BUFFER_READY));
2265     chanPtr->curOutPtr->nextPtr = (ChannelBuffer *) NULL;
2266     if (chanPtr->outQueueHead == (ChannelBuffer *) NULL) {
2267     chanPtr->outQueueHead = chanPtr->curOutPtr;
2268     } else {
2269     chanPtr->outQueueTail->nextPtr = chanPtr->curOutPtr;
2270     }
2271     chanPtr->outQueueTail = chanPtr->curOutPtr;
2272     chanPtr->curOutPtr = (ChannelBuffer *) NULL;
2273     }
2274     bufPtr = chanPtr->outQueueHead;
2275    
2276     /*
2277     * If we are not being called from an async flush and an async
2278     * flush is active, we just return without producing any output.
2279     */
2280    
2281     if ((!calledFromAsyncFlush) &&
2282     (chanPtr->flags & BG_FLUSH_SCHEDULED)) {
2283     return 0;
2284     }
2285    
2286     /*
2287     * If the output queue is still empty, break out of the while loop.
2288     */
2289    
2290     if (bufPtr == (ChannelBuffer *) NULL) {
2291     break; /* Out of the "while (1)". */
2292     }
2293    
2294     /*
2295     * Produce the output on the channel.
2296     */
2297    
2298     toWrite = bufPtr->nextAdded - bufPtr->nextRemoved;
2299     written = (chanPtr->typePtr->outputProc) (chanPtr->instanceData,
2300     (char *) bufPtr->buf + bufPtr->nextRemoved, toWrite,
2301     &errorCode);
2302    
2303     /*
2304     * If the write failed completely attempt to start the asynchronous
2305     * flush mechanism and break out of this loop - do not attempt to
2306     * write any more output at this time.
2307     */
2308    
2309     if (written < 0) {
2310    
2311     /*
2312     * If the last attempt to write was interrupted, simply retry.
2313     */
2314    
2315     if (errorCode == EINTR) {
2316     errorCode = 0;
2317     continue;
2318     }
2319    
2320     /*
2321     * If the channel is non-blocking and we would have blocked,
2322     * start a background flushing handler and break out of the loop.
2323     */
2324    
2325     if ((errorCode == EWOULDBLOCK) || (errorCode == EAGAIN)) {
2326     /*
2327     * This used to check for CHANNEL_NONBLOCKING, and panic
2328     * if the channel was blocking. However, it appears
2329     * that setting stdin to -blocking 0 has some effect on
2330     * the stdout when it's a tty channel (dup'ed underneath)
2331     */
2332     if (!(chanPtr->flags & BG_FLUSH_SCHEDULED)) {
2333     chanPtr->flags |= BG_FLUSH_SCHEDULED;
2334     UpdateInterest(chanPtr);
2335     }
2336     errorCode = 0;
2337     break;
2338     }
2339    
2340     /*
2341     * Decide whether to report the error upwards or defer it.
2342     */
2343    
2344     if (calledFromAsyncFlush) {
2345     if (chanPtr->unreportedError == 0) {
2346     chanPtr->unreportedError = errorCode;
2347     }
2348     } else {
2349     Tcl_SetErrno(errorCode);
2350     if (interp != NULL) {
2351     Tcl_SetResult(interp,
2352     Tcl_PosixError(interp), TCL_VOLATILE);
2353     }
2354     }
2355    
2356     /*
2357     * When we get an error we throw away all the output
2358     * currently queued.
2359     */
2360    
2361     DiscardOutputQueued(chanPtr);
2362     continue;
2363     } else {
2364     wroteSome = 1;
2365     }
2366    
2367     bufPtr->nextRemoved += written;
2368    
2369     /*
2370     * If this buffer is now empty, recycle it.
2371     */
2372    
2373     if (bufPtr->nextRemoved == bufPtr->nextAdded) {
2374     chanPtr->outQueueHead = bufPtr->nextPtr;
2375     if (chanPtr->outQueueHead == (ChannelBuffer *) NULL) {
2376     chanPtr->outQueueTail = (ChannelBuffer *) NULL;
2377     }
2378     RecycleBuffer(chanPtr, bufPtr, 0);
2379     }
2380     } /* Closes "while (1)". */
2381    
2382     /*
2383     * If we wrote some data while flushing in the background, we are done.
2384     * We can't finish the background flush until we run out of data and
2385     * the channel becomes writable again. This ensures that all of the
2386     * pending data has been flushed at the system level.
2387     */
2388    
2389     if (chanPtr->flags & BG_FLUSH_SCHEDULED) {
2390     if (wroteSome) {
2391     return errorCode;
2392     } else if (chanPtr->outQueueHead == (ChannelBuffer *) NULL) {
2393     chanPtr->flags &= (~(BG_FLUSH_SCHEDULED));
2394     (chanPtr->typePtr->watchProc)(chanPtr->instanceData,
2395     chanPtr->interestMask);
2396     }
2397     }
2398    
2399     /*
2400     * If the channel is flagged as closed, delete it when the refCount
2401     * drops to zero, the output queue is empty and there is no output
2402     * in the current output buffer.
2403     */
2404    
2405     if ((chanPtr->flags & CHANNEL_CLOSED) && (chanPtr->refCount <= 0) &&
2406     (chanPtr->outQueueHead == (ChannelBuffer *) NULL) &&
2407     ((chanPtr->curOutPtr == (ChannelBuffer *) NULL) ||
2408     (chanPtr->curOutPtr->nextAdded ==
2409     chanPtr->curOutPtr->nextRemoved))) {
2410     return CloseChannel(interp, chanPtr, errorCode);
2411     }
2412     return errorCode;
2413     }
2414    
2415     /*
2416     *----------------------------------------------------------------------
2417     *
2418     * CloseChannel --
2419     *
2420     * Utility procedure to close a channel and free its associated
2421     * resources.
2422     *
2423     * Results:
2424     * 0 on success or a POSIX error code if the operation failed.
2425     *
2426     * Side effects:
2427     * May close the actual channel; may free memory.
2428     *
2429     *----------------------------------------------------------------------
2430     */
2431    
2432     static int
2433     CloseChannel(interp, chanPtr, errorCode)
2434     Tcl_Interp *interp; /* For error reporting. */
2435     Channel *chanPtr; /* The channel to close. */
2436     int errorCode; /* Status of operation so far. */
2437     {
2438     int result = 0; /* Of calling driver close
2439     * operation. */
2440     Channel *prevChanPtr; /* Preceding channel in list of
2441     * all channels - used to splice a
2442     * channel out of the list on close. */
2443     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
2444    
2445     if (chanPtr == NULL) {
2446     return result;
2447     }
2448    
2449     /*
2450     * No more input can be consumed so discard any leftover input.
2451     */
2452    
2453     DiscardInputQueued(chanPtr, 1);
2454    
2455     /*
2456     * Discard a leftover buffer in the current output buffer field.
2457     */
2458    
2459     if (chanPtr->curOutPtr != (ChannelBuffer *) NULL) {
2460     ckfree((char *) chanPtr->curOutPtr);
2461     chanPtr->curOutPtr = (ChannelBuffer *) NULL;
2462     }
2463    
2464     /*
2465     * The caller guarantees that there are no more buffers
2466     * queued for output.
2467     */
2468    
2469     if (chanPtr->outQueueHead != (ChannelBuffer *) NULL) {
2470     panic("TclFlush, closed channel: queued output left");
2471     }
2472    
2473     /*
2474     * If the EOF character is set in the channel, append that to the
2475     * output device.
2476     */
2477    
2478     if ((chanPtr->outEofChar != 0) && (chanPtr->flags & TCL_WRITABLE)) {
2479     int dummy;
2480     char c;
2481    
2482     c = (char) chanPtr->outEofChar;
2483     (chanPtr->typePtr->outputProc) (chanPtr->instanceData, &c, 1, &dummy);
2484     }
2485    
2486     /*
2487     * Remove TCL_READABLE and TCL_WRITABLE from chanPtr->flags, so
2488     * that close callbacks can not do input or output (assuming they
2489     * squirreled the channel away in their clientData). This also
2490     * prevents infinite loops if the callback calls any C API that
2491     * could call FlushChannel.
2492     */
2493    
2494     chanPtr->flags &= (~(TCL_READABLE|TCL_WRITABLE));
2495    
2496     /*
2497     * Splice this channel out of the list of all channels.
2498     */
2499    
2500     if (chanPtr == tsdPtr->firstChanPtr) {
2501     tsdPtr->firstChanPtr = chanPtr->nextChanPtr;
2502     } else {
2503     for (prevChanPtr = tsdPtr->firstChanPtr;
2504     (prevChanPtr != (Channel *) NULL) &&
2505     (prevChanPtr->nextChanPtr != chanPtr);
2506     prevChanPtr = prevChanPtr->nextChanPtr) {
2507     /* Empty loop body. */
2508     }
2509     if (prevChanPtr == (Channel *) NULL) {
2510     panic("FlushChannel: damaged channel list");
2511     }
2512     prevChanPtr->nextChanPtr = chanPtr->nextChanPtr;
2513     }
2514    
2515     /*
2516     * Close and free the channel driver state.
2517     */
2518    
2519     if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {
2520     result = (chanPtr->typePtr->closeProc)(chanPtr->instanceData, interp);
2521     } else {
2522     result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData, interp,
2523     0);
2524     }
2525    
2526     if (chanPtr->channelName != (char *) NULL) {
2527     ckfree(chanPtr->channelName);
2528     }
2529     Tcl_FreeEncoding(chanPtr->encoding);
2530     if (chanPtr->outputStage != NULL) {
2531     ckfree((char *) chanPtr->outputStage);
2532     }
2533    
2534     /*
2535     * If we are being called synchronously, report either
2536     * any latent error on the channel or the current error.
2537     */
2538    
2539     if (chanPtr->unreportedError != 0) {
2540     errorCode = chanPtr->unreportedError;
2541     }
2542     if (errorCode == 0) {
2543     errorCode = result;
2544     if (errorCode != 0) {
2545     Tcl_SetErrno(errorCode);
2546     }
2547     }
2548    
2549     /* Andreas Kupries <a.kupries@westend.com>, 12/13/1998
2550     * "Trf-Patch for filtering channels"
2551     *
2552     * This is the change to 'CloseChannel'.
2553     *
2554     * Explanation
2555     * Closing a filtering channel closes the one it
2556     * superceded too. This basically ripples through
2557     * the whole chain of filters until it reaches
2558     * the underlying normal channel.
2559     *
2560     * This is done by reintegrating the superceded
2561     * channel into the (thread) global list of open
2562     * channels and then invoking a regular close.
2563     * There is no need to handle the complexities of
2564     * this process by ourselves.
2565     *
2566     * *Note*
2567     * This has to be done after the call to the
2568     * 'closeProc' of the filtering channel to allow
2569     * that one to flush internal buffers into
2570     * the underlying channel.
2571     */
2572    
2573     if (chanPtr->supercedes != (Channel*) NULL) {
2574     /*
2575     * Insert the channel we were stacked upon back into
2576     * the list of open channels, then do a regular close.
2577     */
2578    
2579     chanPtr->supercedes->nextChanPtr = tsdPtr->firstChanPtr;
2580     tsdPtr->firstChanPtr = chanPtr->supercedes;
2581     chanPtr->supercedes->refCount --; /* is deregistered */
2582     Tcl_Close (interp, (Tcl_Channel) chanPtr->supercedes);
2583     }
2584    
2585     /*
2586     * Cancel any outstanding timer.
2587     */
2588    
2589     Tcl_DeleteTimerHandler(chanPtr->timer);
2590    
2591     /*
2592     * Mark the channel as deleted by clearing the type structure.
2593     */
2594    
2595     chanPtr->typePtr = NULL;
2596    
2597     Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC);
2598    
2599     return errorCode;
2600     }
2601    
2602     /*
2603     *----------------------------------------------------------------------
2604     *
2605     * Tcl_Close --
2606     *
2607     * Closes a channel.
2608     *
2609     * Results:
2610     * A standard Tcl result.
2611     *
2612     * Side effects:
2613     * Closes the channel if this is the last reference.
2614     *
2615     * NOTE:
2616     * Tcl_Close removes the channel as far as the user is concerned.
2617     * However, it may continue to exist for a while longer if it has
2618     * a background flush scheduled. The device itself is eventually
2619     * closed and the channel record removed, in CloseChannel, above.
2620     *
2621     *----------------------------------------------------------------------
2622     */
2623    
2624     /* ARGSUSED */
2625     int
2626     Tcl_Close(interp, chan)
2627     Tcl_Interp *interp; /* Interpreter for errors. */
2628     Tcl_Channel chan; /* The channel being closed. Must
2629     * not be referenced in any
2630     * interpreter. */
2631     {
2632     ChannelHandler *chPtr, *chNext; /* Iterate over channel handlers. */
2633     CloseCallback *cbPtr; /* Iterate over close callbacks
2634     * for this channel. */
2635     EventScriptRecord *ePtr, *eNextPtr; /* Iterate over eventscript records. */
2636     Channel *chanPtr; /* The real IO channel. */
2637     int result; /* Of calling FlushChannel. */
2638     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
2639     NextChannelHandler *nhPtr;
2640    
2641     if (chan == (Tcl_Channel) NULL) {
2642     return TCL_OK;
2643     }
2644    
2645     /*
2646     * Perform special handling for standard channels being closed. If the
2647     * refCount is now 1 it means that the last reference to the standard
2648     * channel is being explicitly closed, so bump the refCount down
2649     * artificially to 0. This will ensure that the channel is actually
2650     * closed, below. Also set the static pointer to NULL for the channel.
2651     */
2652    
2653     CheckForStdChannelsBeingClosed(chan);
2654    
2655     chanPtr = (Channel *) chan;
2656     if (chanPtr->refCount > 0) {
2657     panic("called Tcl_Close on channel with refCount > 0");
2658     }
2659    
2660     /*
2661     * Remove any references to channel handlers for this channel that
2662     * may be about to be invoked.
2663     */
2664    
2665     for (nhPtr = tsdPtr->nestedHandlerPtr;
2666     nhPtr != (NextChannelHandler *) NULL;
2667     nhPtr = nhPtr->nestedHandlerPtr) {
2668     if (nhPtr->nextHandlerPtr &&
2669     (nhPtr->nextHandlerPtr->chanPtr == chanPtr)) {
2670     nhPtr->nextHandlerPtr = NULL;
2671     }
2672     }
2673    
2674     /*
2675     * Remove all the channel handler records attached to the channel
2676     * itself.
2677     */
2678    
2679     for (chPtr = chanPtr->chPtr;
2680     chPtr != (ChannelHandler *) NULL;
2681     chPtr = chNext) {
2682     chNext = chPtr->nextPtr;
2683     ckfree((char *) chPtr);
2684     }
2685     chanPtr->chPtr = (ChannelHandler *) NULL;
2686    
2687    
2688     /*
2689     * Cancel any pending copy operation.
2690     */
2691    
2692     StopCopy(chanPtr->csPtr);
2693    
2694     /*
2695     * Must set the interest mask now to 0, otherwise infinite loops
2696     * will occur if Tcl_DoOneEvent is called before the channel is
2697     * finally deleted in FlushChannel. This can happen if the channel
2698     * has a background flush active.
2699     */
2700    
2701     chanPtr->interestMask = 0;
2702    
2703     /*
2704     * Remove any EventScript records for this channel.
2705     */
2706    
2707     for (ePtr = chanPtr->scriptRecordPtr;
2708     ePtr != (EventScriptRecord *) NULL;
2709     ePtr = eNextPtr) {
2710     eNextPtr = ePtr->nextPtr;
2711     Tcl_DecrRefCount(ePtr->scriptPtr);
2712     ckfree((char *) ePtr);
2713     }
2714     chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL;
2715    
2716     /*
2717     * Invoke the registered close callbacks and delete their records.
2718     */
2719    
2720     while (chanPtr->closeCbPtr != (CloseCallback *) NULL) {
2721     cbPtr = chanPtr->closeCbPtr;
2722     chanPtr->closeCbPtr = cbPtr->nextPtr;
2723     (cbPtr->proc) (cbPtr->clientData);
2724     ckfree((char *) cbPtr);
2725     }
2726    
2727     /*
2728     * Ensure that the last output buffer will be flushed.
2729     */
2730    
2731     if ((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&
2732     (chanPtr->curOutPtr->nextAdded > chanPtr->curOutPtr->nextRemoved)) {
2733     chanPtr->flags |= BUFFER_READY;
2734     }
2735    
2736     /*
2737     * If this channel supports it, close the read side, since we don't need it
2738     * anymore and this will help avoid deadlocks on some channel types.
2739     */
2740    
2741     if (chanPtr->typePtr->closeProc == TCL_CLOSE2PROC) {
2742     result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData, interp,
2743     TCL_CLOSE_READ);
2744     } else {
2745     result = 0;
2746     }
2747    
2748     /*
2749     * The call to FlushChannel will flush any queued output and invoke
2750     * the close function of the channel driver, or it will set up the
2751     * channel to be flushed and closed asynchronously.
2752     */
2753    
2754     chanPtr->flags |= CHANNEL_CLOSED;
2755     if ((FlushChannel(interp, chanPtr, 0) != 0) || (result != 0)) {
2756     return TCL_ERROR;
2757     }
2758     return TCL_OK;
2759     }
2760    
2761     /*
2762     *----------------------------------------------------------------------
2763     *
2764     * Tcl_Write --
2765     *
2766     * Puts a sequence of bytes into an output buffer, may queue the
2767     * buffer for output if it gets full, and also remembers whether the
2768     * current buffer is ready e.g. if it contains a newline and we are in
2769     * line buffering mode.
2770     *
2771     * Results:
2772     * The number of bytes written or -1 in case of error. If -1,
2773     * Tcl_GetErrno will return the error code.
2774     *
2775     * Side effects:
2776     * May buffer up output and may cause output to be produced on the
2777     * channel.
2778     *
2779     *----------------------------------------------------------------------
2780     */
2781    
2782     int
2783     Tcl_Write(chan, src, srcLen)
2784     Tcl_Channel chan; /* The channel to buffer output for. */
2785     char *src; /* Data to queue in output buffer. */
2786     int srcLen; /* Length of data in bytes, or < 0 for
2787     * strlen(). */
2788     {
2789     Channel *chanPtr;
2790    
2791     chanPtr = (Channel *) chan;
2792     if (CheckChannelErrors(chanPtr, TCL_WRITABLE) != 0) {
2793     return -1;
2794     }
2795     if (srcLen < 0) {
2796     srcLen = strlen(src);
2797     }
2798     return DoWrite(chanPtr, src, srcLen);
2799     }
2800    
2801     /*
2802     *---------------------------------------------------------------------------
2803     *
2804     * Tcl_WriteChars --
2805     *
2806     * Takes a sequence of UTF-8 characters and converts them for output
2807     * using the channel's current encoding, may queue the buffer for
2808     * output if it gets full, and also remembers whether the current
2809     * buffer is ready e.g. if it contains a newline and we are in
2810     * line buffering mode.
2811     *
2812     * Results:
2813     * The number of bytes written or -1 in case of error. If -1,
2814     * Tcl_GetErrno will return the error code.
2815     *
2816     * Side effects:
2817     * May buffer up output and may cause output to be produced on the
2818     * channel.
2819     *
2820     *----------------------------------------------------------------------
2821     */
2822    
2823     int
2824     Tcl_WriteChars(chan, src, len)
2825     Tcl_Channel chan; /* The channel to buffer output for. */
2826     CONST char *src; /* UTF-8 characters to queue in output buffer. */
2827     int len; /* Length of string in bytes, or < 0 for
2828     * strlen(). */
2829     {
2830     Channel *chanPtr;
2831    
2832     chanPtr = (Channel *) chan;
2833     if (CheckChannelErrors(chanPtr, TCL_WRITABLE) != 0) {
2834     return -1;
2835     }
2836     if (len < 0) {
2837     len = strlen(src);
2838     }
2839     if (chanPtr->encoding == NULL) {
2840     /*
2841     * Inefficient way to convert UTF-8 to byte-array, but the
2842     * code parallels the way it is done for objects.
2843     */
2844    
2845     Tcl_Obj *objPtr;
2846     int result;
2847    
2848     objPtr = Tcl_NewStringObj(src, len);
2849     src = (char *) Tcl_GetByteArrayFromObj(objPtr, &len);
2850     result = WriteBytes(chanPtr, src, len);
2851     Tcl_DecrRefCount(objPtr);
2852     return result;
2853     }
2854     return WriteChars(chanPtr, src, len);
2855     }
2856    
2857     /*
2858     *---------------------------------------------------------------------------
2859     *
2860     * Tcl_WriteObj --
2861     *
2862     * Takes the Tcl object and queues its contents for output. If the
2863     * encoding of the channel is NULL, takes the byte-array representation
2864     * of the object and queues those bytes for output. Otherwise, takes
2865     * the characters in the UTF-8 (string) representation of the object
2866     * and converts them for output using the channel's current encoding.
2867     * May flush internal buffers to output if one becomes full or is ready
2868     * for some other reason, e.g. if it contains a newline and the channel
2869     * is in line buffering mode.
2870     *
2871     * Results:
2872     * The number of bytes written or -1 in case of error. If -1,
2873     * Tcl_GetErrno() will return the error code.
2874     *
2875     * Side effects:
2876     * May buffer up output and may cause output to be produced on the
2877     * channel.
2878     *
2879     *----------------------------------------------------------------------
2880     */
2881    
2882     int
2883     Tcl_WriteObj(chan, objPtr)
2884     Tcl_Channel chan; /* The channel to buffer output for. */
2885     Tcl_Obj *objPtr; /* The object to write. */
2886     {
2887     Channel *chanPtr;
2888     char *src;
2889     int srcLen;
2890    
2891     chanPtr = (Channel *) chan;
2892     if (CheckChannelErrors(chanPtr, TCL_WRITABLE) != 0) {
2893     return -1;
2894     }
2895     if (chanPtr->encoding == NULL) {
2896     src = (char *) Tcl_GetByteArrayFromObj(objPtr, &srcLen);
2897     return WriteBytes(chanPtr, src, srcLen);
2898     } else {
2899     src = Tcl_GetStringFromObj(objPtr, &srcLen);
2900     return WriteChars(chanPtr, src, srcLen);
2901     }
2902     }
2903    
2904     /*
2905     *----------------------------------------------------------------------
2906     *
2907     * WriteBytes --
2908     *
2909     * Write a sequence of bytes into an output buffer, may queue the
2910     * buffer for output if it gets full, and also remembers whether the
2911     * current buffer is ready e.g. if it contains a newline and we are in
2912     * line buffering mode.
2913     *
2914     * Results:
2915     * The number of bytes written or -1 in case of error. If -1,
2916     * Tcl_GetErrno will return the error code.
2917     *
2918     * Side effects:
2919     * May buffer up output and may cause output to be produced on the
2920     * channel.
2921     *
2922     *----------------------------------------------------------------------
2923     */
2924    
2925     static int
2926     WriteBytes(chanPtr, src, srcLen)
2927     Channel *chanPtr; /* The channel to buffer output for. */
2928     CONST char *src; /* Bytes to write. */
2929     int srcLen; /* Number of bytes to write. */
2930     {
2931     ChannelBuffer *bufPtr;
2932     char *dst;
2933     int dstLen, dstMax, sawLF, savedLF, total, toWrite;
2934    
2935     total = 0;
2936     sawLF = 0;
2937     savedLF = 0;
2938    
2939     /*
2940     * Loop over all bytes in src, storing them in output buffer with
2941     * proper EOL translation.
2942     */
2943    
2944     while (srcLen + savedLF > 0) {
2945     bufPtr = chanPtr->curOutPtr;
2946     if (bufPtr == NULL) {
2947     bufPtr = AllocChannelBuffer(chanPtr->bufSize);
2948     chanPtr->curOutPtr = bufPtr;
2949     }
2950     dst = bufPtr->buf + bufPtr->nextAdded;
2951     dstMax = bufPtr->bufLength - bufPtr->nextAdded;
2952     dstLen = dstMax;
2953    
2954     toWrite = dstLen;
2955     if (toWrite > srcLen) {
2956     toWrite = srcLen;
2957     }
2958    
2959     if (savedLF) {
2960     /*
2961     * A '\n' was left over from last call to TranslateOutputEOL()
2962     * and we need to store it in this buffer. If the channel is
2963     * line-based, we will need to flush it.
2964     */
2965    
2966     *dst++ = '\n';
2967     dstLen--;
2968     sawLF++;
2969     }
2970     sawLF += TranslateOutputEOL(chanPtr, dst, src, &dstLen, &toWrite);
2971     dstLen += savedLF;
2972     savedLF = 0;
2973    
2974     if (dstLen > dstMax) {
2975     savedLF = 1;
2976     dstLen = dstMax;
2977     }
2978     bufPtr->nextAdded += dstLen;
2979     if (CheckFlush(chanPtr, bufPtr, sawLF) != 0) {
2980     return -1;
2981     }
2982     total += dstLen;
2983     src += toWrite;
2984     srcLen -= toWrite;
2985     sawLF = 0;
2986     }
2987     return total;
2988     }
2989    
2990     /*
2991     *----------------------------------------------------------------------
2992     *
2993     * WriteChars --
2994     *
2995     * Convert UTF-8 bytes to the channel's external encoding and
2996     * write the produced bytes into an output buffer, may queue the
2997     * buffer for output if it gets full, and also remembers whether the
2998     * current buffer is ready e.g. if it contains a newline and we are in
2999     * line buffering mode.
3000     *
3001     * Results:
3002     * The number of bytes written or -1 in case of error. If -1,
3003     * Tcl_GetErrno will return the error code.
3004     *
3005     * Side effects:
3006     * May buffer up output and may cause output to be produced on the
3007     * channel.
3008     *
3009     *----------------------------------------------------------------------
3010     */
3011    
3012     static int
3013     WriteChars(chanPtr, src, srcLen)
3014     Channel *chanPtr; /* The channel to buffer output for. */
3015     CONST char *src; /* UTF-8 string to write. */
3016     int srcLen; /* Length of UTF-8 string in bytes. */
3017     {
3018     ChannelBuffer *bufPtr;
3019     char *dst, *stage;
3020     int saved, savedLF, sawLF, total, toWrite, flags;
3021     int dstWrote, dstLen, stageLen, stageMax, stageRead;
3022     Tcl_Encoding encoding;
3023     char safe[BUFFER_PADDING];
3024    
3025     total = 0;
3026     sawLF = 0;
3027     savedLF = 0;
3028     saved = 0;
3029     encoding = chanPtr->encoding;
3030    
3031     /*
3032     * Loop over all UTF-8 characters in src, storing them in staging buffer
3033     * with proper EOL translation.
3034     */
3035    
3036     while (srcLen + savedLF > 0) {
3037     stage = chanPtr->outputStage;
3038     stageMax = chanPtr->bufSize;
3039     stageLen = stageMax;
3040    
3041     toWrite = stageLen;
3042     if (toWrite > srcLen) {
3043     toWrite = srcLen;
3044     }
3045    
3046     if (savedLF) {
3047     /*
3048     * A '\n' was left over from last call to TranslateOutputEOL()
3049     * and we need to store it in the staging buffer. If the
3050     * channel is line-based, we will need to flush the output
3051     * buffer (after translating the staging buffer).
3052     */
3053    
3054     *stage++ = '\n';
3055     stageLen--;
3056     sawLF++;
3057     }
3058     sawLF += TranslateOutputEOL(chanPtr, stage, src, &stageLen, &toWrite);
3059    
3060     stage -= savedLF;
3061     stageLen += savedLF;
3062     savedLF = 0;
3063    
3064     if (stageLen > stageMax) {
3065     savedLF = 1;
3066     stageLen = stageMax;
3067     }
3068     src += toWrite;
3069     srcLen -= toWrite;
3070    
3071     flags = chanPtr->outputEncodingFlags;
3072     if (srcLen == 0) {
3073     flags |= TCL_ENCODING_END;
3074     }
3075    
3076     /*
3077     * Loop over all UTF-8 characters in staging buffer, converting them
3078     * to external encoding, storing them in output buffer.
3079     */
3080    
3081     while (stageLen + saved > 0) {
3082     bufPtr = chanPtr->curOutPtr;
3083     if (bufPtr == NULL) {
3084     bufPtr = AllocChannelBuffer(chanPtr->bufSize);
3085     chanPtr->curOutPtr = bufPtr;
3086     }
3087     dst = bufPtr->buf + bufPtr->nextAdded;
3088     dstLen = bufPtr->bufLength - bufPtr->nextAdded;
3089    
3090     if (saved != 0) {
3091     /*
3092     * Here's some translated bytes left over from the last
3093     * buffer that we need to stick at the beginning of this
3094     * buffer.
3095     */
3096    
3097     memcpy((VOID *) dst, (VOID *) safe, (size_t) saved);
3098     bufPtr->nextAdded += saved;
3099     dst += saved;
3100     dstLen -= saved;
3101     saved = 0;
3102     }
3103    
3104     Tcl_UtfToExternal(NULL, encoding, stage, stageLen, flags,
3105     &chanPtr->outputEncodingState, dst,
3106     dstLen + BUFFER_PADDING, &stageRead, &dstWrote, NULL);
3107     if (stageRead + dstWrote == 0) {
3108     /*
3109     * We have an incomplete UTF-8 character at the end of the
3110     * staging buffer. It will get moved to the beginning of the
3111     * staging buffer followed by more bytes from src.
3112     */
3113    
3114     src -= stageLen;
3115     srcLen += stageLen;
3116     stageLen = 0;
3117     savedLF = 0;
3118     break;
3119     }
3120     bufPtr->nextAdded += dstWrote;
3121     if (bufPtr->nextAdded > bufPtr->bufLength) {
3122     /*
3123     * When translating from UTF-8 to external encoding, we
3124     * allowed the translation to produce a character that
3125     * crossed the end of the output buffer, so that we would
3126     * get a completely full buffer before flushing it. The
3127     * extra bytes will be moved to the beginning of the next
3128     * buffer.
3129     */
3130    
3131     saved = bufPtr->nextAdded - bufPtr->bufLength;
3132     memcpy((VOID *) safe, (VOID *) (dst + dstLen), (size_t) saved);
3133     bufPtr->nextAdded = bufPtr->bufLength;
3134     }
3135     if (CheckFlush(chanPtr, bufPtr, sawLF) != 0) {
3136     return -1;
3137     }
3138    
3139     total += dstWrote;
3140     stage += stageRead;
3141     stageLen -= stageRead;
3142     sawLF = 0;
3143     }
3144     }
3145     return total;
3146     }
3147    
3148     /*
3149     *---------------------------------------------------------------------------
3150     *
3151     * TranslateOutputEOL --
3152     *
3153     * Helper function for WriteBytes() and WriteChars(). Converts the
3154     * '\n' characters in the source buffer into the appropriate EOL
3155     * form specified by the output translation mode.
3156     *
3157     * EOL translation stops either when the source buffer is empty
3158     * or the output buffer is full.
3159     *
3160     * When converting to CRLF mode and there is only 1 byte left in
3161     * the output buffer, this routine stores the '\r' in the last
3162     * byte and then stores the '\n' in the byte just past the end of the
3163     * buffer. The caller is responsible for passing in a buffer that
3164     * is large enough to hold the extra byte.
3165     *
3166     * Results:
3167     * The return value is 1 if a '\n' was translated from the source
3168     * buffer, or 0 otherwise -- this can be used by the caller to
3169     * decide to flush a line-based channel even though the channel
3170     * buffer is not full.
3171     *
3172     * *dstLenPtr is filled with how many bytes of the output buffer
3173     * were used. As mentioned above, this can be one more that
3174     * the output buffer's specified length if a CRLF was stored.
3175     *
3176     * *srcLenPtr is filled with how many bytes of the source buffer
3177     * were consumed.
3178     *
3179     * Side effects:
3180     * It may be obvious, but bears mentioning that when converting
3181     * in CRLF mode (which requires two bytes of storage in the output
3182     * buffer), the number of bytes consumed from the source buffer
3183     * will be less than the number of bytes stored in the output buffer.
3184     *
3185     *---------------------------------------------------------------------------
3186     */
3187    
3188     static int
3189     TranslateOutputEOL(chanPtr, dst, src, dstLenPtr, srcLenPtr)
3190     Channel *chanPtr; /* Channel being read, for translation and
3191     * buffering modes. */
3192     char *dst; /* Output buffer filled with UTF-8 chars by
3193     * applying appropriate EOL translation to
3194     * source characters. */
3195     CONST char *src; /* Source UTF-8 characters. */
3196     int *dstLenPtr; /* On entry, the maximum length of output
3197     * buffer in bytes. On exit, the number of
3198     * bytes actually used in output buffer. */
3199     int *srcLenPtr; /* On entry, the length of source buffer.
3200     * On exit, the number of bytes read from
3201     * the source buffer. */
3202     {
3203     char *dstEnd;
3204     int srcLen, newlineFound;
3205    
3206     newlineFound = 0;
3207     srcLen = *srcLenPtr;
3208    
3209     switch (chanPtr->outputTranslation) {
3210     case TCL_TRANSLATE_LF: {
3211     for (dstEnd = dst + srcLen; dst < dstEnd; ) {
3212     if (*src == '\n') {
3213     newlineFound = 1;
3214     }
3215     *dst++ = *src++;
3216     }
3217     *dstLenPtr = srcLen;
3218     break;
3219     }
3220     case TCL_TRANSLATE_CR: {
3221     for (dstEnd = dst + srcLen; dst < dstEnd;) {
3222     if (*src == '\n') {
3223     *dst++ = '\r';
3224     newlineFound = 1;
3225     src++;
3226     } else {
3227     *dst++ = *src++;
3228     }
3229     }
3230     *dstLenPtr = srcLen;
3231     break;
3232     }
3233     case TCL_TRANSLATE_CRLF: {
3234     /*
3235     * Since this causes the number of bytes to grow, we
3236     * start off trying to put 'srcLen' bytes into the
3237     * output buffer, but allow it to store more bytes, as
3238     * long as there's still source bytes and room in the
3239     * output buffer.
3240     */
3241    
3242     char *dstStart, *dstMax;
3243     CONST char *srcStart;
3244    
3245     dstStart = dst;
3246     dstMax = dst + *dstLenPtr;
3247    
3248     srcStart = src;
3249    
3250     if (srcLen < *dstLenPtr) {
3251     dstEnd = dst + srcLen;
3252     } else {
3253     dstEnd = dst + *dstLenPtr;
3254     }
3255     while (dst < dstEnd) {
3256     if (*src == '\n') {
3257     if (dstEnd < dstMax) {
3258     dstEnd++;
3259     }
3260     *dst++ = '\r';
3261     newlineFound = 1;
3262     }
3263     *dst++ = *src++;
3264     }
3265     *srcLenPtr = src - srcStart;
3266     *dstLenPtr = dst - dstStart;
3267     break;
3268     }
3269     default: {
3270     break;
3271     }
3272     }
3273     return newlineFound;
3274     }
3275    
3276     /*
3277     *---------------------------------------------------------------------------
3278     *
3279     * CheckFlush --
3280     *
3281     * Helper function for WriteBytes() and WriteChars(). If the
3282     * channel buffer is ready to be flushed, flush it.
3283     *
3284     * Results:
3285     * The return value is -1 if there was a problem flushing the
3286     * channel buffer, or 0 otherwise.
3287     *
3288     * Side effects:
3289     * The buffer will be recycled if it is flushed.
3290     *
3291     *---------------------------------------------------------------------------
3292     */
3293    
3294     static int
3295     CheckFlush(chanPtr, bufPtr, newlineFlag)
3296     Channel *chanPtr; /* Channel being read, for buffering mode. */
3297     ChannelBuffer *bufPtr; /* Channel buffer to possibly flush. */
3298     int newlineFlag; /* Non-zero if a the channel buffer
3299     * contains a newline. */
3300     {
3301     /*
3302     * The current buffer is ready for output:
3303     * 1. if it is full.
3304     * 2. if it contains a newline and this channel is line-buffered.
3305     * 3. if it contains any output and this channel is unbuffered.
3306     */
3307    
3308     if ((chanPtr->flags & BUFFER_READY) == 0) {
3309     if (bufPtr->nextAdded == bufPtr->bufLength) {
3310     chanPtr->flags |= BUFFER_READY;
3311     } else if (chanPtr->flags & CHANNEL_LINEBUFFERED) {
3312     if (newlineFlag != 0) {
3313     chanPtr->flags |= BUFFER_READY;
3314     }
3315     } else if (chanPtr->flags & CHANNEL_UNBUFFERED) {
3316     chanPtr->flags |= BUFFER_READY;
3317     }
3318     }
3319     if (chanPtr->flags & BUFFER_READY) {
3320     if (FlushChannel(NULL, chanPtr, 0) != 0) {
3321     return -1;
3322     }
3323     }
3324     return 0;
3325     }
3326    
3327     /*
3328     *---------------------------------------------------------------------------
3329     *
3330     * Tcl_Gets --
3331     *
3332     * Reads a complete line of input from the channel into a Tcl_DString.
3333     *
3334     * Results:
3335     * Length of line read (in characters) or -1 if error, EOF, or blocked.
3336     * If -1, use Tcl_GetErrno() to retrieve the POSIX error code for the
3337     * error or condition that occurred.
3338     *
3339     * Side effects:
3340     * May flush output on the channel. May cause input to be consumed
3341     * from the channel.
3342     *
3343     *---------------------------------------------------------------------------
3344     */
3345    
3346     int
3347     Tcl_Gets(chan, lineRead)
3348     Tcl_Channel chan; /* Channel from which to read. */
3349     Tcl_DString *lineRead; /* The line read will be appended to this
3350     * DString as UTF-8 characters. The caller
3351     * must have initialized it and is responsible
3352     * for managing the storage. */
3353     {
3354     Tcl_Obj *objPtr;
3355     int charsStored, length;
3356     char *string;
3357    
3358     objPtr = Tcl_NewObj();
3359     charsStored = Tcl_GetsObj(chan, objPtr);
3360     if (charsStored > 0) {
3361     string = Tcl_GetStringFromObj(objPtr, &length);
3362     Tcl_DStringAppend(lineRead, string, length);
3363     }
3364     Tcl_DecrRefCount(objPtr);
3365     return charsStored;
3366     }
3367    
3368     /*
3369     *---------------------------------------------------------------------------
3370     *
3371     * Tcl_GetsObj --
3372     *
3373     * Accumulate input from the input channel until end-of-line or
3374     * end-of-file has been seen. Bytes read from the input channel
3375     * are converted to UTF-8 using the encoding specified by the
3376     * channel.
3377     *
3378     * Results:
3379     * Number of characters accumulated in the object or -1 if error,
3380     * blocked, or EOF. If -1, use Tcl_GetErrno() to retrieve the
3381     * POSIX error code for the error or condition that occurred.
3382     *
3383     * Side effects:
3384     * Consumes input from the channel.
3385     *
3386     * On reading EOF, leave channel pointing at EOF char.
3387     * On reading EOL, leave channel pointing after EOL, but don't
3388     * return EOL in dst buffer.
3389     *
3390     *---------------------------------------------------------------------------
3391     */
3392    
3393     int
3394     Tcl_GetsObj(chan, objPtr)
3395     Tcl_Channel chan; /* Channel from which to read. */
3396     Tcl_Obj *objPtr; /* The line read will be appended to this
3397     * object as UTF-8 characters. */
3398     {
3399     GetsState gs;
3400     Channel *chanPtr;
3401     int inEofChar, skip, copiedTotal;
3402     ChannelBuffer *bufPtr;
3403     Tcl_Encoding encoding;
3404     char *dst, *dstEnd, *eol, *eof;
3405     Tcl_EncodingState oldState;
3406     int oldLength, oldFlags, oldRemoved;
3407    
3408     chanPtr = (Channel *) chan;
3409     if (CheckChannelErrors(chanPtr, TCL_READABLE) != 0) {
3410     copiedTotal = -1;
3411     goto done;
3412     }
3413    
3414     bufPtr = chanPtr->inQueueHead;
3415     encoding = chanPtr->encoding;
3416    
3417     /*
3418     * Preserved so we can restore the channel's state in case we don't
3419     * find a newline in the available input.
3420     */
3421    
3422     Tcl_GetStringFromObj(objPtr, &oldLength);
3423     oldFlags = chanPtr->inputEncodingFlags;
3424     oldState = chanPtr->inputEncodingState;
3425     oldRemoved = BUFFER_PADDING;
3426     if (bufPtr != NULL) {
3427     oldRemoved = bufPtr->nextRemoved;
3428     }
3429    
3430     /*
3431     * If there is no encoding, use "iso8859-1" -- Tcl_GetsObj() doesn't
3432     * produce ByteArray objects. To avoid circularity problems,
3433     * "iso8859-1" is builtin to Tcl.
3434     */
3435    
3436     if (encoding == NULL) {
3437     encoding = Tcl_GetEncoding(NULL, "iso8859-1");
3438     }
3439    
3440     /*
3441     * Object used by FilterInputBytes to keep track of how much data has
3442     * been consumed from the channel buffers.
3443     */
3444    
3445     gs.objPtr = objPtr;
3446     gs.dstPtr = &dst;
3447     gs.encoding = encoding;
3448     gs.bufPtr = bufPtr;
3449     gs.state = oldState;
3450     gs.rawRead = 0;
3451     gs.bytesWrote = 0;
3452     gs.charsWrote = 0;
3453     gs.totalChars = 0;
3454    
3455     dst = objPtr->bytes + oldLength;
3456     dstEnd = dst;
3457    
3458     skip = 0;
3459     eof = NULL;
3460     inEofChar = chanPtr->inEofChar;
3461    
3462     while (1) {
3463     if (dst >= dstEnd) {
3464     if (FilterInputBytes(chanPtr, &gs) != 0) {
3465     goto restore;
3466     }
3467     dstEnd = dst + gs.bytesWrote;
3468     }
3469    
3470     /*
3471     * Remember if EOF char is seen, then look for EOL anyhow, because
3472     * the EOL might be before the EOF char.
3473     */
3474    
3475     if (inEofChar != '\0') {
3476     for (eol = dst; eol < dstEnd; eol++) {
3477     if (*eol == inEofChar) {
3478     dstEnd = eol;
3479     eof = eol;
3480     break;
3481     }
3482     }
3483     }
3484    
3485     /*
3486     * On EOL, leave current file position pointing after the EOL, but
3487     * don't store the EOL in the output string.
3488     */
3489    
3490     eol = dst;
3491     switch (chanPtr->inputTranslation) {
3492     case TCL_TRANSLATE_LF: {
3493     for (eol = dst; eol < dstEnd; eol++) {
3494     if (*eol == '\n') {
3495     skip = 1;
3496     goto goteol;
3497     }
3498     }
3499     break;
3500     }
3501     case TCL_TRANSLATE_CR: {
3502     for (eol = dst; eol < dstEnd; eol++) {
3503     if (*eol == '\r') {
3504     skip = 1;
3505     goto goteol;
3506     }
3507     }
3508     break;
3509     }
3510     case TCL_TRANSLATE_CRLF: {
3511     for (eol = dst; eol < dstEnd; eol++) {
3512     if (*eol == '\r') {
3513     eol++;
3514     if (eol >= dstEnd) {
3515     int offset;
3516    
3517     offset = eol - objPtr->bytes;
3518     dst = dstEnd;
3519     if (FilterInputBytes(chanPtr, &gs) != 0) {
3520     goto restore;
3521     }
3522     dstEnd = dst + gs.bytesWrote;
3523     eol = objPtr->bytes + offset;
3524     if (eol >= dstEnd) {
3525     skip = 0;
3526     goto goteol;
3527     }
3528     }
3529     if (*eol == '\n') {
3530     eol--;
3531     skip = 2;
3532     goto goteol;
3533     }
3534     }
3535     }
3536     break;
3537     }
3538     case TCL_TRANSLATE_AUTO: {
3539     skip = 1;
3540     if (chanPtr->flags & INPUT_SAW_CR) {
3541     chanPtr->flags &= ~INPUT_SAW_CR;
3542     if (*eol == '\n') {
3543     /*
3544     * Skip the raw bytes that make up the '\n'.
3545     */
3546    
3547     char tmp[1 + TCL_UTF_MAX];
3548     int rawRead;
3549    
3550     bufPtr = gs.bufPtr;
3551     Tcl_ExternalToUtf(NULL, gs.encoding,
3552     bufPtr->buf + bufPtr->nextRemoved,
3553     gs.rawRead, chanPtr->inputEncodingFlags,
3554     &gs.state, tmp, 1 + TCL_UTF_MAX, &rawRead,
3555     NULL, NULL);
3556     bufPtr->nextRemoved += rawRead;
3557     gs.rawRead -= rawRead;
3558     gs.bytesWrote--;
3559     gs.charsWrote--;
3560     memmove(dst, dst + 1, (size_t) (dstEnd - dst));
3561     dstEnd--;
3562     }
3563     }
3564     for (eol = dst; eol < dstEnd; eol++) {
3565     if (*eol == '\r') {
3566     eol++;
3567     if (eol == dstEnd) {
3568     /*
3569     * If buffer ended on \r, peek ahead to see if a
3570     * \n is available.
3571     */
3572    
3573     int offset;
3574    
3575     offset = eol - objPtr->bytes;
3576     dst = dstEnd;
3577     PeekAhead(chanPtr, &dstEnd, &gs);
3578     eol = objPtr->bytes + offset;
3579     if (eol >= dstEnd) {
3580     eol--;
3581     chanPtr->flags |= INPUT_SAW_CR;
3582     goto goteol;
3583     }
3584     }
3585     if (*eol == '\n') {
3586     skip++;
3587     }
3588     eol--;
3589     goto goteol;
3590     } else if (*eol == '\n') {
3591     goto goteol;
3592     }
3593     }
3594     }
3595     }
3596     if (eof != NULL) {
3597     /*
3598     * EOF character was seen. On EOF, leave current file position
3599     * pointing at the EOF character, but don't store the EOF
3600     * character in the output string.
3601     */
3602    
3603     dstEnd = eof;
3604     chanPtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
3605     chanPtr->inputEncodingFlags |= TCL_ENCODING_END;
3606     }
3607     if (chanPtr->flags & CHANNEL_EOF) {
3608     skip = 0;
3609     eol = dstEnd;
3610     if (eol == objPtr->bytes) {
3611     /*
3612     * If we didn't produce any bytes before encountering EOF,
3613     * caller needs to see -1.
3614     */
3615    
3616     Tcl_SetObjLength(objPtr, 0);
3617     CommonGetsCleanup(chanPtr, encoding);
3618     copiedTotal = -1;
3619     goto done;
3620     }
3621     goto goteol;
3622     }
3623     dst = dstEnd;
3624     }
3625    
3626     /*
3627     * Found EOL or EOF, but the output buffer may now contain too many
3628     * UTF-8 characters. We need to know how many raw bytes correspond to
3629     * the number of UTF-8 characters we want, plus how many raw bytes
3630     * correspond to the character(s) making up EOL (if any), so we can
3631     * remove the correct number of bytes from the channel buffer.
3632     */
3633    
3634     goteol:
3635     bufPtr = gs.bufPtr;
3636     chanPtr->inputEncodingState = gs.state;
3637     Tcl_ExternalToUtf(NULL, gs.encoding, bufPtr->buf + bufPtr->nextRemoved,
3638     gs.rawRead, chanPtr->inputEncodingFlags,
3639     &chanPtr->inputEncodingState, dst, eol - dst + skip + TCL_UTF_MAX,
3640     &gs.rawRead, NULL, &gs.charsWrote);
3641     bufPtr->nextRemoved += gs.rawRead;
3642    
3643     /*
3644     * Recycle all the emptied buffers.
3645     */
3646    
3647     Tcl_SetObjLength(objPtr, eol - objPtr->bytes);
3648     CommonGetsCleanup(chanPtr, encoding);
3649     chanPtr->flags &= ~CHANNEL_BLOCKED;
3650     copiedTotal = gs.totalChars + gs.charsWrote - skip;
3651     goto done;
3652    
3653     /*
3654     * Couldn't get a complete line. This only happens if we get a error
3655     * reading from the channel or we are non-blocking and there wasn't
3656     * an EOL or EOF in the data available.
3657     */
3658    
3659     restore:
3660     bufPtr = chanPtr->inQueueHead;
3661     bufPtr->nextRemoved = oldRemoved;
3662    
3663     for (bufPtr = bufPtr->nextPtr; bufPtr != NULL; bufPtr = bufPtr->nextPtr) {
3664     bufPtr->nextRemoved = BUFFER_PADDING;
3665     }
3666     CommonGetsCleanup(chanPtr, encoding);
3667    
3668     chanPtr->inputEncodingState = oldState;
3669     chanPtr->inputEncodingFlags = oldFlags;
3670     Tcl_SetObjLength(objPtr, oldLength);
3671    
3672     /*
3673     * We didn't get a complete line so we need to indicate to UpdateInterest
3674     * that the gets blocked. It will wait for more data instead of firing
3675     * a timer, avoiding a busy wait. This is where we are assuming that the
3676     * next operation is a gets. No more file events will be delivered on
3677     * this channel until new data arrives or some operation is performed
3678     * on the channel (e.g. gets, read, fconfigure) that changes the blocking
3679     * state. Note that this means a file event will not be delivered even
3680     * though a read would be able to consume the buffered data.
3681     */
3682    
3683     chanPtr->flags |= CHANNEL_NEED_MORE_DATA;
3684     copiedTotal = -1;
3685    
3686     done:
3687     /*
3688     * Update the notifier state so we don't block while there is still
3689     * data in the buffers.
3690     */
3691    
3692     UpdateInterest(chanPtr);
3693     return copiedTotal;
3694     }
3695    
3696     /*
3697     *---------------------------------------------------------------------------
3698     *
3699     * FilterInputBytes --
3700     *
3701     * Helper function for Tcl_GetsObj. Produces UTF-8 characters from
3702     * raw bytes read from the channel.
3703     *
3704     * Consumes available bytes from channel buffers. When channel
3705     * buffers are exhausted, reads more bytes from channel device into
3706     * a new channel buffer. It is the caller's responsibility to
3707     * free the channel buffers that have been exhausted.
3708     *
3709     * Results:
3710     * The return value is -1 if there was an error reading from the
3711     * channel, 0 otherwise.
3712     *
3713     * Side effects:
3714     * Status object keeps track of how much data from channel buffers
3715     * has been consumed and where UTF-8 bytes should be stored.
3716     *
3717     *---------------------------------------------------------------------------
3718     */
3719    
3720     static int
3721     FilterInputBytes(chanPtr, gsPtr)
3722     Channel *chanPtr; /* Channel to read. */
3723     GetsState *gsPtr; /* Current state of gets operation. */
3724     {
3725     ChannelBuffer *bufPtr;
3726     char *raw, *rawStart, *rawEnd;
3727     char *dst;
3728     int offset, toRead, dstNeeded, spaceLeft, result, rawLen, length;
3729     Tcl_Obj *objPtr;
3730     #define ENCODING_LINESIZE 30 /* Lower bound on how many bytes to convert
3731     * at a time. Since we don't know a priori
3732     * how many bytes of storage this many source
3733     * bytes will use, we actually need at least
3734     * ENCODING_LINESIZE * TCL_MAX_UTF bytes of
3735     * room. */
3736    
3737     objPtr = gsPtr->objPtr;
3738    
3739     /*
3740     * Subtract the number of bytes that were removed from channel buffer
3741     * during last call.
3742     */
3743    
3744     bufPtr = gsPtr->bufPtr;
3745     if (bufPtr != NULL) {
3746     bufPtr->nextRemoved += gsPtr->rawRead;
3747     if (bufPtr->nextRemoved >= bufPtr->nextAdded) {
3748     bufPtr = bufPtr->nextPtr;
3749     }
3750     }
3751     gsPtr->totalChars += gsPtr->charsWrote;
3752    
3753     if ((bufPtr == NULL) || (bufPtr->nextAdded == BUFFER_PADDING)) {
3754     /*
3755     * All channel buffers were exhausted and the caller still hasn't
3756     * seen EOL. Need to read more bytes from the channel device.
3757     * Side effect is to allocate another channel buffer.
3758     */
3759    
3760     read:
3761     if (chanPtr->flags & CHANNEL_BLOCKED) {
3762     if (chanPtr->flags & CHANNEL_NONBLOCKING) {
3763     gsPtr->charsWrote = 0;
3764     gsPtr->rawRead = 0;
3765     return -1;
3766     }
3767     chanPtr->flags &= ~CHANNEL_BLOCKED;
3768     }
3769     if (GetInput(chanPtr) != 0) {
3770     gsPtr->charsWrote = 0;
3771     gsPtr->rawRead = 0;
3772     return -1;
3773     }
3774     bufPtr = chanPtr->inQueueTail;
3775     gsPtr->bufPtr = bufPtr;
3776     }
3777    
3778     /*
3779     * Convert some of the bytes from the channel buffer to UTF-8. Space in
3780     * objPtr's string rep is used to hold the UTF-8 characters. Grow the
3781     * string rep if we need more space.
3782     */
3783    
3784     rawStart = bufPtr->buf + bufPtr->nextRemoved;
3785     raw = rawStart;
3786     rawEnd = bufPtr->buf + bufPtr->nextAdded;
3787     rawLen = rawEnd - rawStart;
3788    
3789     dst = *gsPtr->dstPtr;
3790     offset = dst - objPtr->bytes;
3791     toRead = ENCODING_LINESIZE;
3792     if (toRead > rawLen) {
3793     toRead = rawLen;
3794     }
3795     dstNeeded = toRead * TCL_UTF_MAX + 1;
3796     spaceLeft = objPtr->length - offset - TCL_UTF_MAX - 1;
3797     if (dstNeeded > spaceLeft) {
3798     length = offset * 2;
3799     if (offset < dstNeeded) {
3800     length = offset + dstNeeded;
3801     }
3802     length += TCL_UTF_MAX + 1;
3803     Tcl_SetObjLength(objPtr, length);
3804     spaceLeft = length - offset;
3805     dst = objPtr->bytes + offset;
3806     *gsPtr->dstPtr = dst;
3807     }
3808     gsPtr->state = chanPtr->inputEncodingState;
3809     result = Tcl_ExternalToUtf(NULL, gsPtr->encoding, raw, rawLen,
3810     chanPtr->inputEncodingFlags, &chanPtr->inputEncodingState,
3811     dst, spaceLeft, &gsPtr->rawRead, &gsPtr->bytesWrote,
3812     &gsPtr->charsWrote);
3813     if (result == TCL_CONVERT_MULTIBYTE) {
3814     /*
3815     * The last few bytes in this channel buffer were the start of a
3816     * multibyte sequence. If this buffer was full, then move them to
3817     * the next buffer so the bytes will be contiguous.
3818     */
3819    
3820     ChannelBuffer *nextPtr;
3821     int extra;
3822    
3823     nextPtr = bufPtr->nextPtr;
3824     if (bufPtr->nextAdded < bufPtr->bufLength) {
3825     if (gsPtr->rawRead > 0) {
3826     /*
3827     * Some raw bytes were converted to UTF-8. Fall through,
3828     * returning those UTF-8 characters because a EOL might be
3829     * present in them.
3830     */
3831     } else if (chanPtr->flags & CHANNEL_EOF) {
3832     /*
3833     * There was a partial character followed by EOF on the
3834     * device. Fall through, returning that nothing was found.
3835     */
3836    
3837     bufPtr->nextRemoved = bufPtr->nextAdded;
3838     } else {
3839     /*
3840     * There are no more cached raw bytes left. See if we can
3841     * get some more.
3842     */
3843    
3844     goto read;
3845     }
3846     } else {
3847     if (nextPtr == NULL) {
3848     nextPtr = AllocChannelBuffer(chanPtr->bufSize);
3849     bufPtr->nextPtr = nextPtr;
3850     chanPtr->inQueueTail = nextPtr;
3851     }
3852     extra = rawLen - gsPtr->rawRead;
3853     memcpy((VOID *) (nextPtr->buf + BUFFER_PADDING - extra),
3854     (VOID *) (raw + gsPtr->rawRead), (size_t) extra);
3855     nextPtr->nextRemoved -= extra;
3856     bufPtr->nextAdded -= extra;
3857     }
3858     }
3859    
3860     gsPtr->bufPtr = bufPtr;
3861     return 0;
3862     }
3863    
3864     /*
3865     *---------------------------------------------------------------------------
3866     *
3867     * PeekAhead --
3868     *
3869     * Helper function used by Tcl_GetsObj(). Called when we've seen a
3870     * \r at the end of the UTF-8 string and want to look ahead one
3871     * character to see if it is a \n.
3872     *
3873     * Results:
3874     * *gsPtr->dstPtr is filled with a pointer to the start of the range of
3875     * UTF-8 characters that were found by peeking and *dstEndPtr is filled
3876     * with a pointer to the bytes just after the end of the range.
3877     *
3878     * Side effects:
3879     * If no more raw bytes were available in one of the channel buffers,
3880     * tries to perform a non-blocking read to get more bytes from the
3881     * chann