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