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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 66 - (show annotations) (download)
Sun Oct 30 21:57:38 2016 UTC (8 years ago) by dashley
File MIME type: text/plain
File size: 261861 byte(s)
Header and footer cleanup.
1 /* $Header$ */
2 /*
3 * tclIO.c --
4 *
5 * This file provides the generic portions (those that are the same on
6 * all platforms and for all channel types) of Tcl's IO facilities.
7 *
8 * Copyright (c) 1998 Scriptics Corporation
9 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
10 *
11 * See the file "license.terms" for information on usage and redistribution
12 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
13 *
14 * RCS: @(#) $Id: tclio.c,v 1.1.1.1 2001/06/13 04:42:01 dtashley Exp $
15 */
16
17 #include "tclInt.h"
18 #include "tclPort.h"
19
20 /*
21 * Make sure that both EAGAIN and EWOULDBLOCK are defined. This does not
22 * compile on systems where neither is defined. We want both defined so
23 * that we can test safely for both. In the code we still have to test for
24 * both because there may be systems on which both are defined and have
25 * different values.
26 */
27
28 #if ((!defined(EWOULDBLOCK)) && (defined(EAGAIN)))
29 # define EWOULDBLOCK EAGAIN
30 #endif
31 #if ((!defined(EAGAIN)) && (defined(EWOULDBLOCK)))
32 # define EAGAIN EWOULDBLOCK
33 #endif
34 #if ((!defined(EAGAIN)) && (!defined(EWOULDBLOCK)))
35 error one of EWOULDBLOCK or EAGAIN must be defined
36 #endif
37
38 /*
39 * The following structure encapsulates the state for a background channel
40 * copy. Note that the data buffer for the copy will be appended to this
41 * structure.
42 */
43
44 typedef struct CopyState {
45 struct Channel *readPtr; /* Pointer to input channel. */
46 struct Channel *writePtr; /* Pointer to output channel. */
47 int readFlags; /* Original read channel flags. */
48 int writeFlags; /* Original write channel flags. */
49 int toRead; /* Number of bytes to copy, or -1. */
50 int total; /* Total bytes transferred (written). */
51 Tcl_Interp *interp; /* Interp that started the copy. */
52 Tcl_Obj *cmdPtr; /* Command to be invoked at completion. */
53 int bufSize; /* Size of appended buffer. */
54 char buffer[1]; /* Copy buffer, this must be the last
55 * field. */
56 } CopyState;
57
58 /*
59 * struct ChannelBuffer:
60 *
61 * Buffers data being sent to or from a channel.
62 */
63
64 typedef struct ChannelBuffer {
65 int nextAdded; /* The next position into which a character
66 * will be put in the buffer. */
67 int nextRemoved; /* Position of next byte to be removed
68 * from the buffer. */
69 int bufLength; /* How big is the buffer? */
70 struct ChannelBuffer *nextPtr;
71 /* Next buffer in chain. */
72 char buf[4]; /* Placeholder for real buffer. The real
73 * buffer occuppies this space + bufSize-4
74 * bytes. This must be the last field in
75 * the structure. */
76 } ChannelBuffer;
77
78 #define CHANNELBUFFER_HEADER_SIZE (sizeof(ChannelBuffer) - 4)
79
80 /*
81 * How much extra space to allocate in buffer to hold bytes from previous
82 * buffer (when converting to UTF-8) or to hold bytes that will go to
83 * next buffer (when converting from UTF-8).
84 */
85
86 #define BUFFER_PADDING 16
87
88 /*
89 * The following defines the *default* buffer size for channels.
90 */
91
92 #define CHANNELBUFFER_DEFAULT_SIZE (1024 * 4)
93
94 /*
95 * Structure to record a close callback. One such record exists for
96 * each close callback registered for a channel.
97 */
98
99 typedef struct CloseCallback {
100 Tcl_CloseProc *proc; /* The procedure to call. */
101 ClientData clientData; /* Arbitrary one-word data to pass
102 * to the callback. */
103 struct CloseCallback *nextPtr; /* For chaining close callbacks. */
104 } CloseCallback;
105
106 /*
107 * The following structure describes the information saved from a call to
108 * "fileevent". This is used later when the event being waited for to
109 * invoke the saved script in the interpreter designed in this record.
110 */
111
112 typedef struct EventScriptRecord {
113 struct Channel *chanPtr; /* The channel for which this script is
114 * registered. This is used only when an
115 * error occurs during evaluation of the
116 * script, to delete the handler. */
117 Tcl_Obj *scriptPtr; /* Script to invoke. */
118 Tcl_Interp *interp; /* In what interpreter to invoke script? */
119 int mask; /* Events must overlap current mask for the
120 * stored script to be invoked. */
121 struct EventScriptRecord *nextPtr;
122 /* Next in chain of records. */
123 } EventScriptRecord;
124
125 /*
126 * struct Channel:
127 *
128 * One of these structures is allocated for each open channel. It contains data
129 * specific to the channel but which belongs to the generic part of the Tcl
130 * channel mechanism, and it points at an instance specific (and type
131 * specific) * instance data, and at a channel type structure.
132 */
133
134 typedef struct Channel {
135 char *channelName; /* The name of the channel instance in Tcl
136 * commands. Storage is owned by the generic IO
137 * code, is dynamically allocated. */
138 int flags; /* ORed combination of the flags defined
139 * below. */
140 Tcl_Encoding encoding; /* Encoding to apply when reading or writing
141 * data on this channel. NULL means no
142 * encoding is applied to data. */
143 Tcl_EncodingState inputEncodingState;
144 /* Current encoding state, used when converting
145 * input data bytes to UTF-8. */
146 int inputEncodingFlags; /* Encoding flags to pass to conversion
147 * routine when converting input data bytes to
148 * UTF-8. May be TCL_ENCODING_START before
149 * converting first byte and TCL_ENCODING_END
150 * when EOF is seen. */
151 Tcl_EncodingState outputEncodingState;
152 /* Current encoding state, used when converting
153 * UTF-8 to output data bytes. */
154 int outputEncodingFlags; /* Encoding flags to pass to conversion
155 * routine when converting UTF-8 to output
156 * data bytes. May be TCL_ENCODING_START
157 * before converting first byte and
158 * TCL_ENCODING_END when EOF is seen. */
159 Tcl_EolTranslation inputTranslation;
160 /* What translation to apply for end of line
161 * sequences on input? */
162 Tcl_EolTranslation outputTranslation;
163 /* What translation to use for generating
164 * end of line sequences in output? */
165 int inEofChar; /* If nonzero, use this as a signal of EOF
166 * on input. */
167 int outEofChar; /* If nonzero, append this to the channel
168 * when it is closed if it is open for
169 * writing. */
170 int unreportedError; /* Non-zero if an error report was deferred
171 * because it happened in the background. The
172 * value is the POSIX error code. */
173 ClientData instanceData; /* Instance-specific data provided by
174 * creator of channel. */
175
176 Tcl_ChannelType *typePtr; /* Pointer to channel type structure. */
177 int refCount; /* How many interpreters hold references to
178 * this IO channel? */
179 CloseCallback *closeCbPtr; /* Callbacks registered to be called when the
180 * channel is closed. */
181 char *outputStage; /* Temporary staging buffer used when
182 * translating EOL before converting from
183 * UTF-8 to external form. */
184 ChannelBuffer *curOutPtr; /* Current output buffer being filled. */
185 ChannelBuffer *outQueueHead;/* Points at first buffer in output queue. */
186 ChannelBuffer *outQueueTail;/* Points at last buffer in output queue. */
187
188 ChannelBuffer *saveInBufPtr;/* Buffer saved for input queue - eliminates
189 * need to allocate a new buffer for "gets"
190 * that crosses buffer boundaries. */
191 ChannelBuffer *inQueueHead; /* Points at first buffer in input queue. */
192 ChannelBuffer *inQueueTail; /* Points at last buffer in input queue. */
193
194 struct ChannelHandler *chPtr;/* List of channel handlers registered
195 * for this channel. */
196 int interestMask; /* Mask of all events this channel has
197 * handlers for. */
198 struct Channel *nextChanPtr;/* Next in list of channels currently open. */
199 EventScriptRecord *scriptRecordPtr;
200 /* Chain of all scripts registered for
201 * event handlers ("fileevent") on this
202 * channel. */
203 int bufSize; /* What size buffers to allocate? */
204 Tcl_TimerToken timer; /* Handle to wakeup timer for this channel. */
205 CopyState *csPtr; /* State of background copy, or NULL. */
206 struct Channel* supercedes; /* Refers to channel this one was stacked upon.
207 This reference is NULL for normal channels.
208 See Tcl_StackChannel. */
209
210 } Channel;
211
212 /*
213 * Values for the flags field in Channel. Any ORed combination of the
214 * following flags can be stored in the field. These flags record various
215 * options and state bits about the channel. In addition to the flags below,
216 * the channel can also have TCL_READABLE (1<<1) and TCL_WRITABLE (1<<2) set.
217 */
218
219 #define CHANNEL_NONBLOCKING (1<<3) /* Channel is currently in
220 * nonblocking mode. */
221 #define CHANNEL_LINEBUFFERED (1<<4) /* Output to the channel must be
222 * flushed after every newline. */
223 #define CHANNEL_UNBUFFERED (1<<5) /* Output to the channel must always
224 * be flushed immediately. */
225 #define BUFFER_READY (1<<6) /* Current output buffer (the
226 * curOutPtr field in the
227 * channel structure) should be
228 * output as soon as possible even
229 * though it may not be full. */
230 #define BG_FLUSH_SCHEDULED (1<<7) /* A background flush of the
231 * queued output buffers has been
232 * scheduled. */
233 #define CHANNEL_CLOSED (1<<8) /* Channel has been closed. No
234 * further Tcl-level IO on the
235 * channel is allowed. */
236 #define CHANNEL_EOF (1<<9) /* EOF occurred on this channel.
237 * This bit is cleared before every
238 * input operation. */
239 #define CHANNEL_STICKY_EOF (1<<10) /* EOF occurred on this channel because
240 * we saw the input eofChar. This bit
241 * prevents clearing of the EOF bit
242 * before every input operation. */
243 #define CHANNEL_BLOCKED (1<<11) /* EWOULDBLOCK or EAGAIN occurred
244 * on this channel. This bit is
245 * cleared before every input or
246 * output operation. */
247 #define INPUT_SAW_CR (1<<12) /* Channel is in CRLF eol input
248 * translation mode and the last
249 * byte seen was a "\r". */
250 #define INPUT_NEED_NL (1<<15) /* Saw a '\r' at end of last buffer,
251 * and there should be a '\n' at
252 * beginning of next buffer. */
253 #define CHANNEL_DEAD (1<<13) /* The channel has been closed by
254 * the exit handler (on exit) but
255 * not deallocated. When any IO
256 * operation sees this flag on a
257 * channel, it does not call driver
258 * level functions to avoid referring
259 * to deallocated data. */
260 #define CHANNEL_NEED_MORE_DATA (1<<14) /* The last input operation failed
261 * because there was not enough data
262 * to complete the operation. This
263 * flag is set when gets fails to
264 * get a complete line or when read
265 * fails to get a complete character.
266 * When set, file events will not be
267 * delivered for buffered data until
268 * the state of the channel changes. */
269
270 /*
271 * For each channel handler registered in a call to Tcl_CreateChannelHandler,
272 * there is one record of the following type. All of records for a specific
273 * channel are chained together in a singly linked list which is stored in
274 * the channel structure.
275 */
276
277 typedef struct ChannelHandler {
278 Channel *chanPtr; /* The channel structure for this channel. */
279 int mask; /* Mask of desired events. */
280 Tcl_ChannelProc *proc; /* Procedure to call in the type of
281 * Tcl_CreateChannelHandler. */
282 ClientData clientData; /* Argument to pass to procedure. */
283 struct ChannelHandler *nextPtr;
284 /* Next one in list of registered handlers. */
285 } ChannelHandler;
286
287 /*
288 * This structure keeps track of the current ChannelHandler being invoked in
289 * the current invocation of ChannelHandlerEventProc. There is a potential
290 * problem if a ChannelHandler is deleted while it is the current one, since
291 * ChannelHandlerEventProc needs to look at the nextPtr field. To handle this
292 * problem, structures of the type below indicate the next handler to be
293 * processed for any (recursively nested) dispatches in progress. The
294 * nextHandlerPtr field is updated if the handler being pointed to is deleted.
295 * The nextPtr field is used to chain together all recursive invocations, so
296 * that Tcl_DeleteChannelHandler can find all the recursively nested
297 * invocations of ChannelHandlerEventProc and compare the handler being
298 * deleted against the NEXT handler to be invoked in that invocation; when it
299 * finds such a situation, Tcl_DeleteChannelHandler updates the nextHandlerPtr
300 * field of the structure to the next handler.
301 */
302
303 typedef struct NextChannelHandler {
304 ChannelHandler *nextHandlerPtr; /* The next handler to be invoked in
305 * this invocation. */
306 struct NextChannelHandler *nestedHandlerPtr;
307 /* Next nested invocation of
308 * ChannelHandlerEventProc. */
309 } NextChannelHandler;
310
311
312 /*
313 * The following structure describes the event that is added to the Tcl
314 * event queue by the channel handler check procedure.
315 */
316
317 typedef struct ChannelHandlerEvent {
318 Tcl_Event header; /* Standard header for all events. */
319 Channel *chanPtr; /* The channel that is ready. */
320 int readyMask; /* Events that have occurred. */
321 } ChannelHandlerEvent;
322
323 /*
324 * The following structure is used by Tcl_GetsObj() to encapsulates the
325 * state for a "gets" operation.
326 */
327
328 typedef struct GetsState {
329 Tcl_Obj *objPtr; /* The object to which UTF-8 characters
330 * will be appended. */
331 char **dstPtr; /* Pointer into objPtr's string rep where
332 * next character should be stored. */
333 Tcl_Encoding encoding; /* The encoding to use to convert raw bytes
334 * to UTF-8. */
335 ChannelBuffer *bufPtr; /* The current buffer of raw bytes being
336 * emptied. */
337 Tcl_EncodingState state; /* The encoding state just before the last
338 * external to UTF-8 conversion in
339 * FilterInputBytes(). */
340 int rawRead; /* The number of bytes removed from bufPtr
341 * in the last call to FilterInputBytes(). */
342 int bytesWrote; /* The number of bytes of UTF-8 data
343 * appended to objPtr during the last call to
344 * FilterInputBytes(). */
345 int charsWrote; /* The corresponding number of UTF-8
346 * characters appended to objPtr during the
347 * last call to FilterInputBytes(). */
348 int totalChars; /* The total number of UTF-8 characters
349 * appended to objPtr so far, just before the
350 * last call to FilterInputBytes(). */
351 } GetsState;
352
353 /*
354 * All static variables used in this file are collected into a single
355 * instance of the following structure. For multi-threaded implementations,
356 * there is one instance of this structure for each thread.
357 *
358 * Notice that different structures with the same name appear in other
359 * files. The structure defined below is used in this file only.
360 */
361
362 typedef struct ThreadSpecificData {
363
364 /*
365 * This variable holds the list of nested ChannelHandlerEventProc
366 * invocations.
367 */
368 NextChannelHandler *nestedHandlerPtr;
369
370 /*
371 * List of all channels currently open.
372 */
373 Channel *firstChanPtr;
374 #ifdef oldcode
375 /*
376 * Has a channel exit handler been created yet?
377 */
378 int channelExitHandlerCreated;
379
380 /*
381 * Has the channel event source been created and registered with the
382 * notifier?
383 */
384 int channelEventSourceCreated;
385 #endif
386 /*
387 * Static variables to hold channels for stdin, stdout and stderr.
388 */
389 Tcl_Channel stdinChannel;
390 int stdinInitialized;
391 Tcl_Channel stdoutChannel;
392 int stdoutInitialized;
393 Tcl_Channel stderrChannel;
394 int stderrInitialized;
395
396 } ThreadSpecificData;
397
398 static Tcl_ThreadDataKey dataKey;
399
400
401 /*
402 * Static functions in this file:
403 */
404
405 static ChannelBuffer * AllocChannelBuffer _ANSI_ARGS_((int length));
406 static void ChannelEventScriptInvoker _ANSI_ARGS_((
407 ClientData clientData, int flags));
408 static void ChannelTimerProc _ANSI_ARGS_((
409 ClientData clientData));
410 static int CheckChannelErrors _ANSI_ARGS_((Channel *chanPtr,
411 int direction));
412 static int CheckFlush _ANSI_ARGS_((Channel *chanPtr,
413 ChannelBuffer *bufPtr, int newlineFlag));
414 static int CheckForDeadChannel _ANSI_ARGS_((Tcl_Interp *interp,
415 Channel *chan));
416 static void CheckForStdChannelsBeingClosed _ANSI_ARGS_((
417 Tcl_Channel chan));
418 static void CleanupChannelHandlers _ANSI_ARGS_((
419 Tcl_Interp *interp, Channel *chanPtr));
420 static int CloseChannel _ANSI_ARGS_((Tcl_Interp *interp,
421 Channel *chanPtr, int errorCode));
422 static void CommonGetsCleanup _ANSI_ARGS_((Channel *chanPtr,
423 Tcl_Encoding encoding));
424 static int CopyAndTranslateBuffer _ANSI_ARGS_((
425 Channel *chanPtr, char *result, int space));
426 static int CopyData _ANSI_ARGS_((CopyState *csPtr, int mask));
427 static void CopyEventProc _ANSI_ARGS_((ClientData clientData,
428 int mask));
429 static void CreateScriptRecord _ANSI_ARGS_((
430 Tcl_Interp *interp, Channel *chanPtr,
431 int mask, Tcl_Obj *scriptPtr));
432 static void DeleteChannelTable _ANSI_ARGS_((
433 ClientData clientData, Tcl_Interp *interp));
434 static void DeleteScriptRecord _ANSI_ARGS_((Tcl_Interp *interp,
435 Channel *chanPtr, int mask));
436 static void DiscardInputQueued _ANSI_ARGS_((
437 Channel *chanPtr, int discardSavedBuffers));
438 static void DiscardOutputQueued _ANSI_ARGS_((
439 Channel *chanPtr));
440 static int DoRead _ANSI_ARGS_((Channel *chanPtr, char *srcPtr,
441 int slen));
442 static int DoWrite _ANSI_ARGS_((Channel *chanPtr, char *src,
443 int srcLen));
444 static int FilterInputBytes _ANSI_ARGS_((Channel *chanPtr,
445 GetsState *statePtr));
446 static int FlushChannel _ANSI_ARGS_((Tcl_Interp *interp,
447 Channel *chanPtr, int calledFromAsyncFlush));
448 static Tcl_HashTable * GetChannelTable _ANSI_ARGS_((Tcl_Interp *interp));
449 static int GetInput _ANSI_ARGS_((Channel *chanPtr));
450 static void PeekAhead _ANSI_ARGS_((Channel *chanPtr,
451 char **dstEndPtr, GetsState *gsPtr));
452 static int ReadBytes _ANSI_ARGS_((Channel *chanPtr,
453 Tcl_Obj *objPtr, int charsLeft, int *offsetPtr));
454 static int ReadChars _ANSI_ARGS_((Channel *chanPtr,
455 Tcl_Obj *objPtr, int charsLeft, int *offsetPtr,
456 int *factorPtr));
457 static void RecycleBuffer _ANSI_ARGS_((Channel *chanPtr,
458 ChannelBuffer *bufPtr, int mustDiscard));
459 static int SetBlockMode _ANSI_ARGS_((Tcl_Interp *interp,
460 Channel *chanPtr, int mode));
461 static void StopCopy _ANSI_ARGS_((CopyState *csPtr));
462 static int TranslateInputEOL _ANSI_ARGS_((Channel *chanPtr,
463 char *dst, CONST char *src, int *dstLenPtr,
464 int *srcLenPtr));
465 static int TranslateOutputEOL _ANSI_ARGS_((Channel *chanPtr,
466 char *dst, CONST char *src, int *dstLenPtr,
467 int *srcLenPtr));
468 static void UpdateInterest _ANSI_ARGS_((Channel *chanPtr));
469 static int WriteBytes _ANSI_ARGS_((Channel *chanPtr,
470 CONST char *src, int srcLen));
471 static int WriteChars _ANSI_ARGS_((Channel *chanPtr,
472 CONST char *src, int srcLen));
473
474
475 /*
476 *---------------------------------------------------------------------------
477 *
478 * TclInitIOSubsystem --
479 *
480 * Initialize all resources used by this subsystem on a per-process
481 * basis.
482 *
483 * Results:
484 * None.
485 *
486 * Side effects:
487 * Depends on the memory subsystems.
488 *
489 *---------------------------------------------------------------------------
490 */
491
492 void
493 TclInitIOSubsystem()
494 {
495 /*
496 * By fetching thread local storage we take care of
497 * allocating it for each thread.
498 */
499 (void) TCL_TSD_INIT(&dataKey);
500 }
501
502 /*
503 *-------------------------------------------------------------------------
504 *
505 * TclFinalizeIOSubsystem --
506 *
507 * Releases all resources used by this subsystem on a per-process
508 * basis. Closes all extant channels that have not already been
509 * closed because they were not owned by any interp.
510 *
511 * Results:
512 * None.
513 *
514 * Side effects:
515 * Depends on encoding and memory subsystems.
516 *
517 *-------------------------------------------------------------------------
518 */
519
520 /* ARGSUSED */
521 void
522 TclFinalizeIOSubsystem()
523 {
524 ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
525 Channel *chanPtr; /* Iterates over open channels. */
526 Channel *nextChanPtr; /* Iterates over open channels. */
527
528
529 for (chanPtr = tsdPtr->firstChanPtr; chanPtr != (Channel *) NULL;
530 chanPtr = nextChanPtr) {
531 nextChanPtr = chanPtr->nextChanPtr;
532
533 /*
534 * Set the channel back into blocking mode to ensure that we wait
535 * for all data to flush out.
536 */
537
538 (void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr,
539 "-blocking", "on");
540
541 if ((chanPtr == (Channel *) tsdPtr->stdinChannel) ||
542 (chanPtr == (Channel *) tsdPtr->stdoutChannel) ||
543 (chanPtr == (Channel *) tsdPtr->stderrChannel)) {
544
545 /*
546 * Decrement the refcount which was earlier artificially bumped
547 * up to keep the channel from being closed.
548 */
549
550 chanPtr->refCount--;
551 }
552
553 if (chanPtr->refCount <= 0) {
554
555 /*
556 * Close it only if the refcount indicates that the channel is not
557 * referenced from any interpreter. If it is, that interpreter will
558 * close the channel when it gets destroyed.
559 */
560
561 (void) Tcl_Close((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
562
563 } else {
564
565 /*
566 * The refcount is greater than zero, so flush the channel.
567 */
568
569 Tcl_Flush((Tcl_Channel) chanPtr);
570
571 /*
572 * Call the device driver to actually close the underlying
573 * device for this channel.
574 */
575
576 if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {
577 (chanPtr->typePtr->closeProc)(chanPtr->instanceData,
578 (Tcl_Interp *) NULL);
579 } else {
580 (chanPtr->typePtr->close2Proc)(chanPtr->instanceData,
581 (Tcl_Interp *) NULL, 0);
582 }
583
584 /*
585 * Finally, we clean up the fields in the channel data structure
586 * since all of them have been deleted already. We mark the
587 * channel with CHANNEL_DEAD to prevent any further IO operations
588 * on it.
589 */
590
591 chanPtr->instanceData = (ClientData) NULL;
592 chanPtr->flags |= CHANNEL_DEAD;
593 }
594 }
595 }
596
597
598 /*
599 *----------------------------------------------------------------------
600 *
601 * Tcl_SetStdChannel --
602 *
603 * This function is used to change the channels that are used
604 * for stdin/stdout/stderr in new interpreters.
605 *
606 * Results:
607 * None
608 *
609 * Side effects:
610 * None.
611 *
612 *----------------------------------------------------------------------
613 */
614
615 void
616 Tcl_SetStdChannel(channel, type)
617 Tcl_Channel channel;
618 int type; /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
619 {
620 ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
621 switch (type) {
622 case TCL_STDIN:
623 tsdPtr->stdinInitialized = 1;
624 tsdPtr->stdinChannel = channel;
625 break;
626 case TCL_STDOUT:
627 tsdPtr->stdoutInitialized = 1;
628 tsdPtr->stdoutChannel = channel;
629 break;
630 case TCL_STDERR:
631 tsdPtr->stderrInitialized = 1;
632 tsdPtr->stderrChannel = channel;
633 break;
634 }
635 }
636
637 /*
638 *----------------------------------------------------------------------
639 *
640 * Tcl_GetStdChannel --
641 *
642 * Returns the specified standard channel.
643 *
644 * Results:
645 * Returns the specified standard channel, or NULL.
646 *
647 * Side effects:
648 * May cause the creation of a standard channel and the underlying
649 * file.
650 *
651 *----------------------------------------------------------------------
652 */
653 Tcl_Channel
654 Tcl_GetStdChannel(type)
655 int type; /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
656 {
657 Tcl_Channel channel = NULL;
658 ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
659
660 /*
661 * If the channels were not created yet, create them now and
662 * store them in the static variables.
663 */
664
665 switch (type) {
666 case TCL_STDIN:
667 if (!tsdPtr->stdinInitialized) {
668 tsdPtr->stdinChannel = TclpGetDefaultStdChannel(TCL_STDIN);
669 tsdPtr->stdinInitialized = 1;
670
671 /*
672 * Artificially bump the refcount to ensure that the channel
673 * is only closed on exit.
674 *
675 * NOTE: Must only do this if stdinChannel is not NULL. It
676 * can be NULL in situations where Tcl is unable to connect
677 * to the standard input.
678 */
679
680 if (tsdPtr->stdinChannel != (Tcl_Channel) NULL) {
681 (void) Tcl_RegisterChannel((Tcl_Interp *) NULL,
682 tsdPtr->stdinChannel);
683 }
684 }
685 channel = tsdPtr->stdinChannel;
686 break;
687 case TCL_STDOUT:
688 if (!tsdPtr->stdoutInitialized) {
689 tsdPtr->stdoutChannel = TclpGetDefaultStdChannel(TCL_STDOUT);
690 tsdPtr->stdoutInitialized = 1;
691 if (tsdPtr->stdoutChannel != (Tcl_Channel) NULL) {
692 (void) Tcl_RegisterChannel((Tcl_Interp *) NULL,
693 tsdPtr->stdoutChannel);
694 }
695 }
696 channel = tsdPtr->stdoutChannel;
697 break;
698 case TCL_STDERR:
699 if (!tsdPtr->stderrInitialized) {
700 tsdPtr->stderrChannel = TclpGetDefaultStdChannel(TCL_STDERR);
701 tsdPtr->stderrInitialized = 1;
702 if (tsdPtr->stderrChannel != (Tcl_Channel) NULL) {
703 (void) Tcl_RegisterChannel((Tcl_Interp *) NULL,
704 tsdPtr->stderrChannel);
705 }
706 }
707 channel = tsdPtr->stderrChannel;
708 break;
709 }
710 return channel;
711 }
712
713
714 /*
715 *----------------------------------------------------------------------
716 *
717 * Tcl_CreateCloseHandler
718 *
719 * Creates a close callback which will be called when the channel is
720 * closed.
721 *
722 * Results:
723 * None.
724 *
725 * Side effects:
726 * Causes the callback to be called in the future when the channel
727 * will be closed.
728 *
729 *----------------------------------------------------------------------
730 */
731
732 void
733 Tcl_CreateCloseHandler(chan, proc, clientData)
734 Tcl_Channel chan; /* The channel for which to create the
735 * close callback. */
736 Tcl_CloseProc *proc; /* The callback routine to call when the
737 * channel will be closed. */
738 ClientData clientData; /* Arbitrary data to pass to the
739 * close callback. */
740 {
741 Channel *chanPtr;
742 CloseCallback *cbPtr;
743
744 chanPtr = (Channel *) chan;
745
746 cbPtr = (CloseCallback *) ckalloc((unsigned) sizeof(CloseCallback));
747 cbPtr->proc = proc;
748 cbPtr->clientData = clientData;
749
750 cbPtr->nextPtr = chanPtr->closeCbPtr;
751 chanPtr->closeCbPtr = cbPtr;
752 }
753
754 /*
755 *----------------------------------------------------------------------
756 *
757 * Tcl_DeleteCloseHandler --
758 *
759 * Removes a callback that would have been called on closing
760 * the channel. If there is no matching callback then this
761 * function has no effect.
762 *
763 * Results:
764 * None.
765 *
766 * Side effects:
767 * The callback will not be called in the future when the channel
768 * is eventually closed.
769 *
770 *----------------------------------------------------------------------
771 */
772
773 void
774 Tcl_DeleteCloseHandler(chan, proc, clientData)
775 Tcl_Channel chan; /* The channel for which to cancel the
776 * close callback. */
777 Tcl_CloseProc *proc; /* The procedure for the callback to
778 * remove. */
779 ClientData clientData; /* The callback data for the callback
780 * to remove. */
781 {
782 Channel *chanPtr;
783 CloseCallback *cbPtr, *cbPrevPtr;
784
785 chanPtr = (Channel *) chan;
786 for (cbPtr = chanPtr->closeCbPtr, cbPrevPtr = (CloseCallback *) NULL;
787 cbPtr != (CloseCallback *) NULL;
788 cbPtr = cbPtr->nextPtr) {
789 if ((cbPtr->proc == proc) && (cbPtr->clientData == clientData)) {
790 if (cbPrevPtr == (CloseCallback *) NULL) {
791 chanPtr->closeCbPtr = cbPtr->nextPtr;
792 }
793 ckfree((char *) cbPtr);
794 break;
795 } else {
796 cbPrevPtr = cbPtr;
797 }
798 }
799 }
800
801 /*
802 *----------------------------------------------------------------------
803 *
804 * GetChannelTable --
805 *
806 * Gets and potentially initializes the channel table for an
807 * interpreter. If it is initializing the table it also inserts
808 * channels for stdin, stdout and stderr if the interpreter is
809 * trusted.
810 *
811 * Results:
812 * A pointer to the hash table created, for use by the caller.
813 *
814 * Side effects:
815 * Initializes the channel table for an interpreter. May create
816 * channels for stdin, stdout and stderr.
817 *
818 *----------------------------------------------------------------------
819 */
820
821 static Tcl_HashTable *
822 GetChannelTable(interp)
823 Tcl_Interp *interp;
824 {
825 Tcl_HashTable *hTblPtr; /* Hash table of channels. */
826 Tcl_Channel stdinChan, stdoutChan, stderrChan;
827
828 hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
829 if (hTblPtr == (Tcl_HashTable *) NULL) {
830 hTblPtr = (Tcl_HashTable *) ckalloc((unsigned) sizeof(Tcl_HashTable));
831 Tcl_InitHashTable(hTblPtr, TCL_STRING_KEYS);
832
833 (void) Tcl_SetAssocData(interp, "tclIO",
834 (Tcl_InterpDeleteProc *) DeleteChannelTable,
835 (ClientData) hTblPtr);
836
837 /*
838 * If the interpreter is trusted (not "safe"), insert channels
839 * for stdin, stdout and stderr (possibly creating them in the
840 * process).
841 */
842
843 if (Tcl_IsSafe(interp) == 0) {
844 stdinChan = Tcl_GetStdChannel(TCL_STDIN);
845 if (stdinChan != NULL) {
846 Tcl_RegisterChannel(interp, stdinChan);
847 }
848 stdoutChan = Tcl_GetStdChannel(TCL_STDOUT);
849 if (stdoutChan != NULL) {
850 Tcl_RegisterChannel(interp, stdoutChan);
851 }
852 stderrChan = Tcl_GetStdChannel(TCL_STDERR);
853 if (stderrChan != NULL) {
854 Tcl_RegisterChannel(interp, stderrChan);
855 }
856 }
857
858 }
859 return hTblPtr;
860 }
861
862 /*
863 *----------------------------------------------------------------------
864 *
865 * DeleteChannelTable --
866 *
867 * Deletes the channel table for an interpreter, closing any open
868 * channels whose refcount reaches zero. This procedure is invoked
869 * when an interpreter is deleted, via the AssocData cleanup
870 * mechanism.
871 *
872 * Results:
873 * None.
874 *
875 * Side effects:
876 * Deletes the hash table of channels. May close channels. May flush
877 * output on closed channels. Removes any channeEvent handlers that were
878 * registered in this interpreter.
879 *
880 *----------------------------------------------------------------------
881 */
882
883 static void
884 DeleteChannelTable(clientData, interp)
885 ClientData clientData; /* The per-interpreter data structure. */
886 Tcl_Interp *interp; /* The interpreter being deleted. */
887 {
888 Tcl_HashTable *hTblPtr; /* The hash table. */
889 Tcl_HashSearch hSearch; /* Search variable. */
890 Tcl_HashEntry *hPtr; /* Search variable. */
891 Channel *chanPtr; /* Channel being deleted. */
892 EventScriptRecord *sPtr, *prevPtr, *nextPtr;
893 /* Variables to loop over all channel events
894 * registered, to delete the ones that refer
895 * to the interpreter being deleted. */
896
897 /*
898 * Delete all the registered channels - this will close channels whose
899 * refcount reaches zero.
900 */
901
902 hTblPtr = (Tcl_HashTable *) clientData;
903 for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
904 hPtr != (Tcl_HashEntry *) NULL;
905 hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch)) {
906
907 chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
908
909 /*
910 * Remove any fileevents registered in this interpreter.
911 */
912
913 for (sPtr = chanPtr->scriptRecordPtr,
914 prevPtr = (EventScriptRecord *) NULL;
915 sPtr != (EventScriptRecord *) NULL;
916 sPtr = nextPtr) {
917 nextPtr = sPtr->nextPtr;
918 if (sPtr->interp == interp) {
919 if (prevPtr == (EventScriptRecord *) NULL) {
920 chanPtr->scriptRecordPtr = nextPtr;
921 } else {
922 prevPtr->nextPtr = nextPtr;
923 }
924
925 Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
926 ChannelEventScriptInvoker, (ClientData) sPtr);
927
928 Tcl_DecrRefCount(sPtr->scriptPtr);
929 ckfree((char *) sPtr);
930 } else {
931 prevPtr = sPtr;
932 }
933 }
934
935 /*
936 * Cannot call Tcl_UnregisterChannel because that procedure calls
937 * Tcl_GetAssocData to get the channel table, which might already
938 * be inaccessible from the interpreter structure. Instead, we
939 * emulate the behavior of Tcl_UnregisterChannel directly here.
940 */
941
942 Tcl_DeleteHashEntry(hPtr);
943 chanPtr->refCount--;
944 if (chanPtr->refCount <= 0) {
945 if (!(chanPtr->flags & BG_FLUSH_SCHEDULED)) {
946 (void) Tcl_Close(interp, (Tcl_Channel) chanPtr);
947 }
948 }
949 }
950 Tcl_DeleteHashTable(hTblPtr);
951 ckfree((char *) hTblPtr);
952 }
953
954 /*
955 *----------------------------------------------------------------------
956 *
957 * CheckForStdChannelsBeingClosed --
958 *
959 * Perform special handling for standard channels being closed. When
960 * given a standard channel, if the refcount is now 1, it means that
961 * the last reference to the standard channel is being explicitly
962 * closed. Now bump the refcount artificially down to 0, to ensure the
963 * normal handling of channels being closed will occur. Also reset the
964 * static pointer to the channel to NULL, to avoid dangling references.
965 *
966 * Results:
967 * None.
968 *
969 * Side effects:
970 * Manipulates the refcount on standard channels. May smash the global
971 * static pointer to a standard channel.
972 *
973 *----------------------------------------------------------------------
974 */
975
976 static void
977 CheckForStdChannelsBeingClosed(chan)
978 Tcl_Channel chan;
979 {
980 Channel *chanPtr = (Channel *) chan;
981 ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
982
983 if ((chan == tsdPtr->stdinChannel) && (tsdPtr->stdinInitialized)) {
984 if (chanPtr->refCount < 2) {
985 chanPtr->refCount = 0;
986 tsdPtr->stdinChannel = NULL;
987 return;
988 }
989 } else if ((chan == tsdPtr->stdoutChannel) && (tsdPtr->stdoutInitialized)) {
990 if (chanPtr->refCount < 2) {
991 chanPtr->refCount = 0;
992 tsdPtr->stdoutChannel = NULL;
993 return;
994 }
995 } else if ((chan == tsdPtr->stderrChannel) && (tsdPtr->stderrInitialized)) {
996 if (chanPtr->refCount < 2) {
997 chanPtr->refCount = 0;
998 tsdPtr->stderrChannel = NULL;
999 return;
1000 }
1001 }
1002 }
1003
1004 /*
1005 *----------------------------------------------------------------------
1006 *
1007 * Tcl_RegisterChannel --
1008 *
1009 * Adds an already-open channel to the channel table of an interpreter.
1010 * If the interpreter passed as argument is NULL, it only increments
1011 * the channel refCount.
1012 *
1013 * Results:
1014 * None.
1015 *
1016 * Side effects:
1017 * May increment the reference count of a channel.
1018 *
1019 *----------------------------------------------------------------------
1020 */
1021
1022 void
1023 Tcl_RegisterChannel(interp, chan)
1024 Tcl_Interp *interp; /* Interpreter in which to add the channel. */
1025 Tcl_Channel chan; /* The channel to add to this interpreter
1026 * channel table. */
1027 {
1028 Tcl_HashTable *hTblPtr; /* Hash table of channels. */
1029 Tcl_HashEntry *hPtr; /* Search variable. */
1030 int new; /* Is the hash entry new or does it exist? */
1031 Channel *chanPtr; /* The actual channel. */
1032
1033 chanPtr = (Channel *) chan;
1034
1035 if (chanPtr->channelName == (char *) NULL) {
1036 panic("Tcl_RegisterChannel: channel without name");
1037 }
1038 if (interp != (Tcl_Interp *) NULL) {
1039 hTblPtr = GetChannelTable(interp);
1040 hPtr = Tcl_CreateHashEntry(hTblPtr, chanPtr->channelName, &new);
1041 if (new == 0) {
1042 if (chan == (Tcl_Channel) Tcl_GetHashValue(hPtr)) {
1043 return;
1044 }
1045
1046 /* Andreas Kupries <a.kupries@westend.com>, 12/13/1998
1047 * "Trf-Patch for filtering channels"
1048 *
1049 * This is the change to 'Tcl_RegisterChannel'.
1050 *
1051 * Explanation:
1052 * The moment a channel is stacked upon another he
1053 * takes the identity of the channel he supercedes,
1054 * i.e. he gets the *same* name. Because of this we
1055 * cannot check for duplicate names anymore, they
1056 * have to be allowed now.
1057 */
1058
1059 /* panic("Tcl_RegisterChannel: duplicate channel names"); */
1060 }
1061 Tcl_SetHashValue(hPtr, (ClientData) chanPtr);
1062 }
1063 chanPtr->refCount++;
1064 }
1065
1066 /*
1067 *----------------------------------------------------------------------
1068 *
1069 * Tcl_UnregisterChannel --
1070 *
1071 * Deletes the hash entry for a channel associated with an interpreter.
1072 * If the interpreter given as argument is NULL, it only decrements the
1073 * reference count.
1074 *
1075 * Results:
1076 * A standard Tcl result.
1077 *
1078 * Side effects:
1079 * Deletes the hash entry for a channel associated with an interpreter.
1080 *
1081 *----------------------------------------------------------------------
1082 */
1083
1084 int
1085 Tcl_UnregisterChannel(interp, chan)
1086 Tcl_Interp *interp; /* Interpreter in which channel is defined. */
1087 Tcl_Channel chan; /* Channel to delete. */
1088 {
1089 Tcl_HashTable *hTblPtr; /* Hash table of channels. */
1090 Tcl_HashEntry *hPtr; /* Search variable. */
1091 Channel *chanPtr; /* The real IO channel. */
1092
1093 chanPtr = (Channel *) chan;
1094
1095 if (interp != (Tcl_Interp *) NULL) {
1096 hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
1097 if (hTblPtr == (Tcl_HashTable *) NULL) {
1098 return TCL_OK;
1099 }
1100 hPtr = Tcl_FindHashEntry(hTblPtr, chanPtr->channelName);
1101 if (hPtr == (Tcl_HashEntry *) NULL) {
1102 return TCL_OK;
1103 }
1104 if ((Channel *) Tcl_GetHashValue(hPtr) != chanPtr) {
1105 return TCL_OK;
1106 }
1107 Tcl_DeleteHashEntry(hPtr);
1108
1109 /*
1110 * Remove channel handlers that refer to this interpreter, so that they
1111 * will not be present if the actual close is delayed and more events
1112 * happen on the channel. This may occur if the channel is shared
1113 * between several interpreters, or if the channel has async
1114 * flushing active.
1115 */
1116
1117 CleanupChannelHandlers(interp, chanPtr);
1118 }
1119
1120 chanPtr->refCount--;
1121
1122 /*
1123 * Perform special handling for standard channels being closed. If the
1124 * refCount is now 1 it means that the last reference to the standard
1125 * channel is being explicitly closed, so bump the refCount down
1126 * artificially to 0. This will ensure that the channel is actually
1127 * closed, below. Also set the static pointer to NULL for the channel.
1128 */
1129
1130 CheckForStdChannelsBeingClosed(chan);
1131
1132 /*
1133 * If the refCount reached zero, close the actual channel.
1134 */
1135
1136 if (chanPtr->refCount <= 0) {
1137
1138 /*
1139 * Ensure that if there is another buffer, it gets flushed
1140 * whether or not we are doing a background flush.
1141 */
1142
1143 if ((chanPtr->curOutPtr != NULL) &&
1144 (chanPtr->curOutPtr->nextAdded >
1145 chanPtr->curOutPtr->nextRemoved)) {
1146 chanPtr->flags |= BUFFER_READY;
1147 }
1148 chanPtr->flags |= CHANNEL_CLOSED;
1149 if (!(chanPtr->flags & BG_FLUSH_SCHEDULED)) {
1150 if (Tcl_Close(interp, chan) != TCL_OK) {
1151 return TCL_ERROR;
1152 }
1153 }
1154 }
1155 return TCL_OK;
1156 }
1157
1158 /*
1159 *---------------------------------------------------------------------------
1160 *
1161 * Tcl_GetChannel --
1162 *
1163 * Finds an existing Tcl_Channel structure by name in a given
1164 * interpreter. This function is public because it is used by
1165 * channel-type-specific functions.
1166 *
1167 * Results:
1168 * A Tcl_Channel or NULL on failure. If failed, interp's result
1169 * object contains an error message. *modePtr is filled with the
1170 * modes in which the channel was opened.
1171 *
1172 * Side effects:
1173 * None.
1174 *
1175 *---------------------------------------------------------------------------
1176 */
1177
1178 Tcl_Channel
1179 Tcl_GetChannel(interp, chanName, modePtr)
1180 Tcl_Interp *interp; /* Interpreter in which to find or create
1181 * the channel. */
1182 char *chanName; /* The name of the channel. */
1183 int *modePtr; /* Where to store the mode in which the
1184 * channel was opened? Will contain an ORed
1185 * combination of TCL_READABLE and
1186 * TCL_WRITABLE, if non-NULL. */
1187 {
1188 Channel *chanPtr; /* The actual channel. */
1189 Tcl_HashTable *hTblPtr; /* Hash table of channels. */
1190 Tcl_HashEntry *hPtr; /* Search variable. */
1191 char *name; /* Translated name. */
1192
1193 /*
1194 * Substitute "stdin", etc. Note that even though we immediately
1195 * find the channel using Tcl_GetStdChannel, we still need to look
1196 * it up in the specified interpreter to ensure that it is present
1197 * in the channel table. Otherwise, safe interpreters would always
1198 * have access to the standard channels.
1199 */
1200
1201 name = chanName;
1202 if ((chanName[0] == 's') && (chanName[1] == 't')) {
1203 chanPtr = NULL;
1204 if (strcmp(chanName, "stdin") == 0) {
1205 chanPtr = (Channel *)Tcl_GetStdChannel(TCL_STDIN);
1206 } else if (strcmp(chanName, "stdout") == 0) {
1207 chanPtr = (Channel *)Tcl_GetStdChannel(TCL_STDOUT);
1208 } else if (strcmp(chanName, "stderr") == 0) {
1209 chanPtr = (Channel *)Tcl_GetStdChannel(TCL_STDERR);
1210 }
1211 if (chanPtr != NULL) {
1212 name = chanPtr->channelName;
1213 }
1214 }
1215
1216 hTblPtr = GetChannelTable(interp);
1217 hPtr = Tcl_FindHashEntry(hTblPtr, name);
1218 if (hPtr == (Tcl_HashEntry *) NULL) {
1219 Tcl_AppendResult(interp, "can not find channel named \"",
1220 chanName, "\"", (char *) NULL);
1221 return NULL;
1222 }
1223
1224 chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
1225 if (modePtr != NULL) {
1226 *modePtr = (chanPtr->flags & (TCL_READABLE|TCL_WRITABLE));
1227 }
1228
1229 return (Tcl_Channel) chanPtr;
1230 }
1231
1232 /*
1233 *----------------------------------------------------------------------
1234 *
1235 * Tcl_CreateChannel --
1236 *
1237 * Creates a new entry in the hash table for a Tcl_Channel
1238 * record.
1239 *
1240 * Results:
1241 * Returns the new Tcl_Channel.
1242 *
1243 * Side effects:
1244 * Creates a new Tcl_Channel instance and inserts it into the
1245 * hash table.
1246 *
1247 *----------------------------------------------------------------------
1248 */
1249
1250 Tcl_Channel
1251 Tcl_CreateChannel(typePtr, chanName, instanceData, mask)
1252 Tcl_ChannelType *typePtr; /* The channel type record. */
1253 char *chanName; /* Name of channel to record. */
1254 ClientData instanceData; /* Instance specific data. */
1255 int mask; /* TCL_READABLE & TCL_WRITABLE to indicate
1256 * if the channel is readable, writable. */
1257 {
1258 Channel *chanPtr; /* The channel structure newly created. */
1259 CONST char *name;
1260 ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
1261
1262 chanPtr = (Channel *) ckalloc((unsigned) sizeof(Channel));
1263
1264 if (chanName != (char *) NULL) {
1265 chanPtr->channelName = ckalloc((unsigned) (strlen(chanName) + 1));
1266 strcpy(chanPtr->channelName, chanName);
1267 } else {
1268 panic("Tcl_CreateChannel: NULL channel name");
1269 }
1270
1271 chanPtr->flags = mask;
1272
1273 /*
1274 * Set the channel to system default encoding.
1275 */
1276
1277 chanPtr->encoding = NULL;
1278 name = Tcl_GetEncodingName(NULL);
1279 if (strcmp(name, "binary") != 0) {
1280 chanPtr->encoding = Tcl_GetEncoding(NULL, name);
1281 }
1282 chanPtr->inputEncodingState = NULL;
1283 chanPtr->inputEncodingFlags = TCL_ENCODING_START;
1284 chanPtr->outputEncodingState = NULL;
1285 chanPtr->outputEncodingFlags = TCL_ENCODING_START;
1286
1287 /*
1288 * Set the channel up initially in AUTO input translation mode to
1289 * accept "\n", "\r" and "\r\n". Output translation mode is set to
1290 * a platform specific default value. The eofChar is set to 0 for both
1291 * input and output, so that Tcl does not look for an in-file EOF
1292 * indicator (e.g. ^Z) and does not append an EOF indicator to files.
1293 */
1294
1295 chanPtr->inputTranslation = TCL_TRANSLATE_AUTO;
1296 chanPtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
1297 chanPtr->inEofChar = 0;
1298 chanPtr->outEofChar = 0;
1299
1300 chanPtr->unreportedError = 0;
1301 chanPtr->instanceData = instanceData;
1302 chanPtr->typePtr = typePtr;
1303 chanPtr->refCount = 0;
1304 chanPtr->closeCbPtr = (CloseCallback *) NULL;
1305 chanPtr->curOutPtr = (ChannelBuffer *) NULL;
1306 chanPtr->outQueueHead = (ChannelBuffer *) NULL;
1307 chanPtr->outQueueTail = (ChannelBuffer *) NULL;
1308 chanPtr->saveInBufPtr = (ChannelBuffer *) NULL;
1309 chanPtr->inQueueHead = (ChannelBuffer *) NULL;
1310 chanPtr->inQueueTail = (ChannelBuffer *) NULL;
1311 chanPtr->chPtr = (ChannelHandler *) NULL;
1312 chanPtr->interestMask = 0;
1313 chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL;
1314 chanPtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE;
1315 chanPtr->timer = NULL;
1316 chanPtr->csPtr = NULL;
1317 chanPtr->supercedes = (Channel*) NULL;
1318
1319 chanPtr->outputStage = NULL;
1320 if ((chanPtr->encoding != NULL) && (chanPtr->flags & TCL_WRITABLE)) {
1321 chanPtr->outputStage = (char *)
1322 ckalloc((unsigned) (chanPtr->bufSize + 2));
1323 }
1324
1325 /*
1326 * Link the channel into the list of all channels; create an on-exit
1327 * handler if there is not one already, to close off all the channels
1328 * in the list on exit.
1329 */
1330
1331 chanPtr->nextChanPtr = tsdPtr->firstChanPtr;
1332 tsdPtr->firstChanPtr = chanPtr;
1333
1334 /*
1335 * Install this channel in the first empty standard channel slot, if
1336 * the channel was previously closed explicitly.
1337 */
1338
1339 if ((tsdPtr->stdinChannel == NULL) && (tsdPtr->stdinInitialized == 1)) {
1340 Tcl_SetStdChannel((Tcl_Channel)chanPtr, TCL_STDIN);
1341 Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
1342 } else if ((tsdPtr->stdoutChannel == NULL) && (tsdPtr->stdoutInitialized == 1)) {
1343 Tcl_SetStdChannel((Tcl_Channel)chanPtr, TCL_STDOUT);
1344 Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
1345 } else if ((tsdPtr->stderrChannel == NULL) && (tsdPtr->stderrInitialized == 1)) {
1346 Tcl_SetStdChannel((Tcl_Channel)chanPtr, TCL_STDERR);
1347 Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
1348 }
1349 return (Tcl_Channel) chanPtr;
1350 }
1351
1352 /*
1353 *----------------------------------------------------------------------
1354 *
1355 * Tcl_StackChannel --
1356 *
1357 * Replaces an entry in the hash table for a Tcl_Channel
1358 * record. The replacement is a new channel with same name,
1359 * it supercedes the replaced channel. Input and output of
1360 * the superceded channel is now going through the newly
1361 * created channel and allows the arbitrary filtering/manipulation
1362 * of the dataflow.
1363 *
1364 * Andreas Kupries <a.kupries@westend.com>, 12/13/1998
1365 * "Trf-Patch for filtering channels"
1366 *
1367 * Results:
1368 * Returns the new Tcl_Channel, which actually contains the
1369 * saved information about prevChan.
1370 *
1371 * Side effects:
1372 * A new channel structure is allocated and linked below
1373 * the existing channel. The channel operations and client
1374 * data of the existing channel are copied down to the newly
1375 * created channel, and the current channel has its operations
1376 * replaced by the new typePtr.
1377 *
1378 *----------------------------------------------------------------------
1379 */
1380
1381 Tcl_Channel
1382 Tcl_StackChannel(interp, typePtr, instanceData, mask, prevChan)
1383 Tcl_Interp* interp; /* The interpreter we are working in */
1384 Tcl_ChannelType *typePtr; /* The channel type record for the new
1385 * channel. */
1386 ClientData instanceData; /* Instance specific data for the new
1387 * channel. */
1388 int mask; /* TCL_READABLE & TCL_WRITABLE to indicate
1389 * if the channel is readable, writable. */
1390 Tcl_Channel prevChan; /* The channel structure to replace */
1391 {
1392 ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
1393 Channel *chanPtr, *pt;
1394 int interest = 0;
1395
1396 /*
1397 * AK, 06/30/1999
1398 *
1399 * Tcl_StackChannel differs from Tcl_ReplaceChannel of the
1400 * original "Trf" patch. Instead of seeing the
1401 * newly created structure as the *new* channel to cover the specified
1402 * one use it to *save* the current state of the specified channel and
1403 * then reinitialize the current structure for the given transformation.
1404 *
1405 * Advantages:
1406 * - No splicing into the (thread-)global list of channels (or the per-
1407 * interp hash-tables).
1408 * - Users of the C-API still have valid channel references even after
1409 * the call to this procedure.
1410 *
1411 * Disadvantages:
1412 * - Untested code.
1413 */
1414
1415 /*
1416 * Find the given channel in the list of all channels.
1417 */
1418
1419 pt = (Channel*) tsdPtr->firstChanPtr;
1420
1421 while (pt != (Channel *) prevChan) {
1422 pt = pt->nextChanPtr;
1423 }
1424
1425 /*
1426 * 'pt == prevChan' now (or NULL, if not found).
1427 */
1428
1429 if (!pt) {
1430 return (Tcl_Channel) NULL;
1431 }
1432
1433 /*
1434 * Here we check if the given "mask" matches the "flags"
1435 * of the already existing channel.
1436 *
1437 * | - | R | W | RW |
1438 * --+---+---+---+----+ <=> 0 != (chan->mask & prevChan->mask)
1439 * - | | | | |
1440 * R | | + | | + | The superceding channel is allowed to
1441 * W | | | + | + | restrict the capabilities of the
1442 * RW| | + | + | + | superceded one !
1443 * --+---+---+---+----+
1444 */
1445
1446 if ((mask & Tcl_GetChannelMode (prevChan)) == 0) {
1447 return (Tcl_Channel) NULL;
1448 }
1449
1450 chanPtr = (Channel *) ckalloc((unsigned) sizeof(Channel));
1451
1452 /*
1453 * If there is some interest in the channel, remove it, break
1454 * down the whole chain. It will be reconstructed later.
1455 */
1456
1457 interest = pt->interestMask;
1458
1459 pt->interestMask = 0;
1460
1461 if (interest) {
1462 (pt->typePtr->watchProc) (pt->instanceData, 0);
1463 }
1464
1465 /*
1466 * Save some of the current state into the new structure,
1467 * reinitialize the parts which will stay with the transformation.
1468 *
1469 * Remarks:
1470 * - We cannot discard the buffers, and they cannot be used from the
1471 * transformation placed later into the 'pt' structure. Save them,
1472 * and believe that Tcl_SetChannelOption (buffering, none) will do
1473 * the right thing.
1474 * - encoding and EOL-translation control information is initialized
1475 * to values for 'binary'. This is later reinforced via
1476 * Tcl_SetChanneloption to get the handling of flags and the event
1477 * system right.
1478 * - The 'interestMask' of the saved channel is cleared, but the
1479 * transformations WatchProc is used to establish the connection
1480 * between transformation and underlying channel. This should
1481 * reestablish the correct mask.
1482 * - TTO = Transform Takes Over. The hidden channel no longer
1483 * needs to perform this function.
1484 */
1485
1486 chanPtr->channelName = (char *) ckalloc (strlen(pt->channelName)+1);
1487 strcpy (chanPtr->channelName, pt->channelName);
1488
1489 chanPtr->flags = pt->flags; /* Save */
1490
1491 chanPtr->encoding = (Tcl_Encoding) NULL; /* == 'binary' */
1492 chanPtr->inputEncodingState = (Tcl_EncodingState) NULL;
1493 chanPtr->inputEncodingFlags = TCL_ENCODING_START;
1494 chanPtr->outputEncodingState = (Tcl_EncodingState) NULL;
1495 chanPtr->outputEncodingFlags = TCL_ENCODING_START;
1496
1497 chanPtr->inputTranslation = TCL_TRANSLATE_LF; /* == 'binary' */
1498 chanPtr->outputTranslation = TCL_TRANSLATE_LF; /* == 'binary' */
1499 chanPtr->inEofChar = pt->inEofChar; /* Save */
1500 chanPtr->outEofChar = pt->outEofChar; /* Save */
1501
1502 chanPtr->unreportedError = pt->unreportedError; /* Save */
1503 chanPtr->instanceData = pt->instanceData; /* Save */
1504 chanPtr->typePtr = pt->typePtr; /* Save */
1505 chanPtr->refCount = 0; /* None, as the structure is covered */
1506 chanPtr->closeCbPtr = (CloseCallback*) NULL; /* TTO */
1507
1508 chanPtr->outputStage = (char*) NULL;
1509 chanPtr->curOutPtr = pt->curOutPtr; /* Save */
1510 chanPtr->outQueueHead = pt->outQueueHead; /* Save */
1511 chanPtr->outQueueTail = pt->outQueueTail; /* Save */
1512 chanPtr->saveInBufPtr = pt->saveInBufPtr; /* Save */
1513 chanPtr->inQueueHead = pt->inQueueHead; /* Save */
1514 chanPtr->inQueueTail = pt->inQueueTail; /* Save */
1515
1516 chanPtr->chPtr = (ChannelHandler *) NULL; /* TTO */
1517 chanPtr->interestMask = 0;
1518 chanPtr->nextChanPtr = (Channel*) NULL; /* Is not in list! */
1519 chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL; /* TTO */
1520 chanPtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE;
1521 chanPtr->timer = (Tcl_TimerToken) NULL; /* TTO */
1522 chanPtr->csPtr = (CopyState*) NULL; /* TTO */
1523
1524 /*
1525 * Place new block at the head of a possibly existing list of previously
1526 * stacked channels, then do the missing initializations of translation
1527 * and buffer system.
1528 */
1529
1530 chanPtr->supercedes = pt->supercedes;
1531
1532 Tcl_SetChannelOption (interp, (Tcl_Channel) chanPtr,
1533 "-translation", "binary");
1534 Tcl_SetChannelOption (interp, (Tcl_Channel) chanPtr,
1535 "-buffering", "none");
1536
1537 /*
1538 * Save accomplished, now reinitialize the (old) structure for the
1539 * transformation.
1540 *
1541 * - The information about encoding and eol-translation is taken
1542 * without change. There is no need to fiddle with
1543 * refCount et. al.
1544 *
1545 * Don't forget to use the same blocking mode as the old channel.
1546 */
1547
1548 pt->flags = mask | (chanPtr->flags & CHANNEL_NONBLOCKING);
1549
1550 /*
1551 * EDITORS NOTE: all the lines with "take it as is" should get
1552 * deleted once this code has been debugged.
1553 */
1554
1555 /* pt->encoding, take it as is */
1556 /* pt->inputEncodingState, take it as is */
1557 /* pt->inputEncodingFlags, take it as is */
1558 /* pt->outputEncodingState, take it as is */
1559 /* pt->outputEncodingFlags, take it as is */
1560
1561 /* pt->inputTranslation, take it as is */
1562 /* pt->outputTranslation, take it as is */
1563
1564 /*
1565 * No special EOF character, that condition is determined by the
1566 * old channel
1567 */
1568
1569 pt->inEofChar = 0;
1570 pt->outEofChar = 0;
1571
1572 pt->unreportedError = 0; /* No errors yet */
1573 pt->instanceData = instanceData; /* Transformation state */
1574 pt->typePtr = typePtr; /* Transformation type */
1575 /* pt->refCount, take it as it is */
1576 /* pt->closeCbPtr, take it as it is */
1577
1578 /* pt->outputStage, take it as it is */
1579 pt->curOutPtr = (ChannelBuffer *) NULL;
1580 pt->outQueueHead = (ChannelBuffer *) NULL;
1581 pt->outQueueTail = (ChannelBuffer *) NULL;
1582 pt->saveInBufPtr = (ChannelBuffer *) NULL;
1583 pt->inQueueHead = (ChannelBuffer *) NULL;
1584 pt->inQueueTail = (ChannelBuffer *) NULL;
1585
1586 /* pt->chPtr, take it as it is */
1587 /* pt->interestMask, take it as it is */
1588 /* pt->nextChanPtr, take it as it is */
1589 /* pt->scriptRecordPtr, take it as it is */
1590 pt->bufSize = CHANNELBUFFER_DEFAULT_SIZE;
1591 /* pt->timer, take it as it is */
1592 /* pt->csPtr, take it as it is */
1593
1594 /*
1595 * Have the transformation reference the new structure containing
1596 * the saved channel.
1597 */
1598
1599 pt->supercedes = chanPtr;
1600
1601 /*
1602 * Don't forget to reinitialize the output buffer used for encodings.
1603 */
1604
1605 if ((chanPtr->encoding != NULL) && (chanPtr->flags & TCL_WRITABLE)) {
1606 chanPtr->outputStage = (char *)
1607 ckalloc((unsigned) (chanPtr->bufSize + 2));
1608 }
1609
1610 /*
1611 * Event handling: If the information in the old channel shows
1612 * that there was interest in some events call the 'WatchProc'
1613 * of the transformation to establish the proper connection
1614 * between them.
1615 */
1616
1617 if (interest) {
1618 (pt->typePtr->watchProc) (pt->instanceData, interest);
1619 }
1620
1621 /*
1622 * The superceded channel is effectively unregistered
1623 * We cannot decrement its reference count because that
1624 * can cause it to get garbage collected out from under us.
1625 * Don't add the following code:
1626 *
1627 * chanPtr->supercedes->refCount --;
1628 */
1629
1630 return (Tcl_Channel) chanPtr;
1631 }
1632
1633 /*
1634 *----------------------------------------------------------------------
1635 *
1636 * Tcl_UnstackChannel --
1637 *
1638 * Unstacks an entry in the hash table for a Tcl_Channel
1639 * record. This is the reverse to 'Tcl_StackChannel'.
1640 * The old, superceded channel is uncovered and re-registered
1641 * in the appropriate data structures.
1642 *
1643 * Results:
1644 * Returns the old Tcl_Channel, i.e. the one which was stacked over.
1645 *
1646 * Side effects:
1647 * See above.
1648 *
1649 *----------------------------------------------------------------------
1650 */
1651
1652 void
1653 Tcl_UnstackChannel (interp, chan)
1654 Tcl_Interp* interp; /* The interpreter we are working in */
1655 Tcl_Channel chan; /* The channel to unstack */
1656 {
1657 ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
1658 Channel* chanPtr = (Channel*) chan;
1659
1660 if (chanPtr->supercedes != (Channel*) NULL) {
1661 /*
1662 * Instead of manipulating the per-thread / per-interp list/hashtable
1663 * of registered channels we wind down the state of the transformation,
1664 * and then restore the state of underlying channel into the old
1665 * structure.
1666 */
1667
1668 Tcl_DString dsTrans; /* storage to save option information */
1669 Tcl_DString dsBuf; /* storage to save option information */
1670 Channel top; /* Save area for current transformation */
1671 Channel* chanDownPtr = chanPtr->supercedes;
1672 int interest; /* interest mask of transformation
1673 * before destruct. */
1674 int saveInputEncodingFlags; /* Save area for encoding */
1675 int saveOutputEncodingFlags; /* related information */
1676 Tcl_EncodingState saveInputEncodingState;
1677 Tcl_EncodingState saveOutputEncodingState;
1678 Tcl_Encoding saveEncoding;
1679
1680 /*
1681 * Event handling: Disallow the delivery of events from the
1682 * old, now uncovered channel to the transformation.
1683 *
1684 * This is done before everything else to avoid problems
1685 * after our heavy-duty shuffling of pointers around.
1686 */
1687
1688 interest = chanPtr->interestMask;
1689 (chanPtr->typePtr->watchProc) (chanPtr->instanceData, 0);
1690
1691 /* 1. Swap the information in the top channel (the transformation)
1692 * and the channel below, with some exceptions. This additionally
1693 * cuts the top channel out of the chain. Without the latter
1694 * a Tcl_Close on the transformation would be impossible, as that
1695 * procedure will free the structure, making 'top' unusable.
1696 *
1697 * chanPtr -> top channel, transformation.
1698 * chanDownPtr -> channel immediately below the transformation.
1699 */
1700
1701 memcpy ((void*) &top, (void*) chanPtr, sizeof (Channel));
1702 memcpy ((void*) chanPtr, (void*) chanDownPtr, sizeof (Channel));
1703 top.supercedes = (Channel*) NULL;
1704 memcpy ((void*) chanDownPtr, (void*) &top, sizeof (Channel));
1705
1706 /* Now:
1707 * chanPtr -> channel immediately below the transformation, now top
1708 * chanDownPtr -> transformation, cut loose.
1709 *
1710 * Handle the exceptions mentioned above, i.e. move the information
1711 * from the transformation into the new top, and reinitialize it to
1712 * safe values in the transformation.
1713 */
1714
1715 chanPtr->refCount = chanDownPtr->refCount;
1716 chanPtr->closeCbPtr = chanDownPtr->closeCbPtr;
1717 chanPtr->chPtr = chanDownPtr->chPtr;
1718 chanPtr->nextChanPtr = chanDownPtr->nextChanPtr;
1719 chanPtr->scriptRecordPtr = chanDownPtr->scriptRecordPtr;
1720 chanPtr->timer = chanDownPtr->timer;
1721 chanPtr->csPtr = chanDownPtr->csPtr;
1722
1723 chanDownPtr->refCount = 0;
1724 chanDownPtr->closeCbPtr = (CloseCallback*) NULL;
1725 chanDownPtr->chPtr = (ChannelHandler*) NULL;
1726 chanDownPtr->nextChanPtr = (Channel*) NULL;
1727 chanDownPtr->scriptRecordPtr = (EventScriptRecord*) NULL;
1728 chanDownPtr->timer = (Tcl_TimerToken) NULL;
1729 chanDownPtr->csPtr = (CopyState*) NULL;
1730
1731 /* The now uncovered channel still has encoding and eol-translation
1732 * deactivated, i.e. switched to 'binary'. *Don't* touch this until
1733 * after the transformation is closed for good, as it may write
1734 * information into it during that (-> flushing of data waiting in
1735 * internal buffers!) and rely on these settings. Thanks to Matt
1736 * Newman <matt@sensus.org> for finding this goof.
1737 *
1738 * But we also have to protect the state of the encoding from removal
1739 * during the close. So we save it in some local variables.
1740 * Additionally the current value of the options is lost after we
1741 * close, we have to save them now.
1742 */
1743
1744 saveEncoding = chanDownPtr->encoding;
1745 saveInputEncodingState = chanDownPtr->inputEncodingState;
1746 saveInputEncodingFlags = chanDownPtr->inputEncodingFlags;
1747 saveOutputEncodingState = chanDownPtr->outputEncodingState;
1748 saveOutputEncodingFlags = chanDownPtr->outputEncodingFlags;
1749
1750 Tcl_DStringInit (&dsTrans);
1751 Tcl_GetChannelOption (interp, (Tcl_Channel) chanDownPtr,
1752 "-translation", &dsTrans);
1753
1754 Tcl_DStringInit (&dsBuf);
1755 Tcl_GetChannelOption (interp, (Tcl_Channel) chanDownPtr,
1756 "-buffering", &dsBuf);
1757
1758 /*
1759 * Prevent the accidential removal of the encoding during
1760 * the destruction of the transformation channel.
1761 */
1762
1763 chanDownPtr->encoding = (Tcl_Encoding) NULL;
1764 chanDownPtr->inputEncodingState = (Tcl_EncodingState) NULL;
1765 chanDownPtr->inputEncodingFlags = TCL_ENCODING_START;
1766 chanDownPtr->outputEncodingState = (Tcl_EncodingState) NULL;
1767 chanDownPtr->outputEncodingFlags = TCL_ENCODING_START;
1768
1769 /*
1770 * A little trick: Add the transformation structure to the
1771 * per-thread list of existing channels (which it never were
1772 * part of so far), or Tcl_Close/FlushChannel will panic
1773 * ("damaged channel list").
1774 *
1775 * Afterward do a regular close upon the transformation.
1776 * This may cause flushing of data into the old channel (if the
1777 * transformation remembered its own channel in itself).
1778 *
1779 * We know that its refCount dropped to 0.
1780 */
1781
1782 chanDownPtr->nextChanPtr = tsdPtr->firstChanPtr;
1783 tsdPtr->firstChanPtr = chanDownPtr;
1784
1785 Tcl_Close (interp, (Tcl_Channel)chanDownPtr);
1786
1787 /*
1788 * Now it is possible to wind down the transformation (in 'top'),
1789 * especially to copy the current encoding and translation control
1790 * information down.
1791 */
1792
1793 /*
1794 * Move the currently active encoding from the save area
1795 * to the now uncovered channel. We assume here that this
1796 * channel uses 'encoding binary' (==> encoding == NULL, etc.
1797 * This allows us to simply copy the pointers without having to
1798 * think about refcounts and deallocation of the old encoding.
1799 *
1800 * And don't forget to reenable the EOL-translation used by the
1801 * transformation. Using a DString to do this *is* a bit awkward,
1802 * but still the best way to handle the complexities here, like
1803 * flag manipulation and event system.
1804 */
1805
1806 chanPtr->encoding = saveEncoding;
1807 chanPtr->inputEncodingState = saveInputEncodingState;
1808 chanPtr->inputEncodingFlags = saveInputEncodingFlags;
1809 chanPtr->outputEncodingState = saveOutputEncodingState;
1810 chanPtr->outputEncodingFlags = saveOutputEncodingFlags;
1811
1812 Tcl_SetChannelOption (interp, (Tcl_Channel) chanPtr,
1813 "-translation", dsTrans.string);
1814
1815 Tcl_SetChannelOption (interp, (Tcl_Channel) chanPtr,
1816 "-buffering", dsBuf.string);
1817
1818 Tcl_DStringFree (&dsTrans);
1819 Tcl_DStringFree (&dsBuf);
1820
1821 /*
1822 * Event handling: If the information from the now destroyed
1823 * transformation shows that there was interest in some events
1824 * call the 'WatchProc' of the now uncovered channel to renew
1825 * that interest with underlying channels or the driver.
1826 */
1827
1828 if (interest) {
1829 chanPtr->interestMask = 0;
1830 (chanPtr->typePtr->watchProc) (chanPtr->instanceData,
1831 interest);
1832 chanPtr->interestMask = interest;
1833 }
1834
1835 } else {
1836 /* This channel does not cover another one.
1837 * Simply do a close, if necessary.
1838 */
1839
1840 if (chanPtr->refCount == 0) {
1841 Tcl_Close (interp, chan);
1842 }
1843 }
1844 }
1845
1846 /*
1847 *----------------------------------------------------------------------
1848 *
1849 * Tcl_GetStackedChannel --
1850 *
1851 * Determines wether the specified channel is stacked upon another.
1852 *
1853 * Results:
1854 * NULL if the channel is not stacked upon another one, or a reference
1855 * to the channel it is stacked upon. This reference can be used in
1856 * queries, but modification is not allowed.
1857 *
1858 * Side effects:
1859 * None.
1860 *
1861 *----------------------------------------------------------------------
1862 */
1863
1864 Tcl_Channel
1865 Tcl_GetStackedChannel(chan)
1866 Tcl_Channel chan;
1867 {
1868 Channel* chanPtr = (Channel*) chan;
1869 return (Tcl_Channel) chanPtr->supercedes;
1870 }
1871
1872 /*
1873 *----------------------------------------------------------------------
1874 *
1875 * Tcl_GetChannelMode --
1876 *
1877 * Computes a mask indicating whether the channel is open for
1878 * reading and writing.
1879 *
1880 * Results:
1881 * An OR-ed combination of TCL_READABLE and TCL_WRITABLE.
1882 *
1883 * Side effects:
1884 * None.
1885 *
1886 *----------------------------------------------------------------------
1887 */
1888
1889 int
1890 Tcl_GetChannelMode(chan)
1891 Tcl_Channel chan; /* The channel for which the mode is
1892 * being computed. */
1893 {
1894 Channel *chanPtr; /* The actual channel. */
1895
1896 chanPtr = (Channel *) chan;
1897 return (chanPtr->flags & (TCL_READABLE | TCL_WRITABLE));
1898 }
1899
1900 /*
1901 *----------------------------------------------------------------------
1902 *
1903 * Tcl_GetChannelName --
1904 *
1905 * Returns the string identifying the channel name.
1906 *
1907 * Results:
1908 * The string containing the channel name. This memory is
1909 * owned by the generic layer and should not be modified by
1910 * the caller.
1911 *
1912 * Side effects:
1913 * None.
1914 *
1915 *----------------------------------------------------------------------
1916 */
1917
1918 char *
1919 Tcl_GetChannelName(chan)
1920 Tcl_Channel chan; /* The channel for which to return the name. */
1921 {
1922 Channel *chanPtr; /* The actual channel. */
1923
1924 chanPtr = (Channel *) chan;
1925 return chanPtr->channelName;
1926 }
1927
1928 /*
1929 *----------------------------------------------------------------------
1930 *
1931 * Tcl_GetChannelType --
1932 *
1933 * Given a channel structure, returns the channel type structure.
1934 *
1935 * Results:
1936 * Returns a pointer to the channel type structure.
1937 *
1938 * Side effects:
1939 * None.
1940 *
1941 *----------------------------------------------------------------------
1942 */
1943
1944 Tcl_ChannelType *
1945 Tcl_GetChannelType(chan)
1946 Tcl_Channel chan; /* The channel to return type for. */
1947 {
1948 Channel *chanPtr; /* The actual channel. */
1949
1950 chanPtr = (Channel *) chan;
1951 return chanPtr->typePtr;
1952 }
1953
1954 /*
1955 *----------------------------------------------------------------------
1956 *
1957 * Tcl_GetChannelHandle --
1958 *
1959 * Returns an OS handle associated with a channel.
1960 *
1961 * Results:
1962 * Returns TCL_OK and places the handle in handlePtr, or returns
1963 * TCL_ERROR on failure.
1964 *
1965 * Side effects:
1966 * None.
1967 *
1968 *----------------------------------------------------------------------
1969 */
1970
1971 int
1972 Tcl_GetChannelHandle(chan, direction, handlePtr)
1973 Tcl_Channel chan; /* The channel to get file from. */
1974 int direction; /* TCL_WRITABLE or TCL_READABLE. */
1975 ClientData *handlePtr; /* Where to store handle */
1976 {
1977 Channel *chanPtr; /* The actual channel. */
1978 ClientData handle;
1979 int result;
1980
1981 chanPtr = (Channel *) chan;
1982 result = (chanPtr->typePtr->getHandleProc)(chanPtr->instanceData,
1983 direction, &handle);
1984 if (handlePtr) {
1985 *handlePtr = handle;
1986 }
1987 return result;
1988 }
1989
1990 /*
1991 *----------------------------------------------------------------------
1992 *
1993 * Tcl_GetChannelInstanceData --
1994 *
1995 * Returns the client data associated with a channel.
1996 *
1997 * Results:
1998 * The client data.
1999 *
2000 * Side effects:
2001 * None.
2002 *
2003 *----------------------------------------------------------------------
2004 */
2005
2006 ClientData
2007 Tcl_GetChannelInstanceData(chan)
2008 Tcl_Channel chan; /* Channel for which to return client data. */
2009 {
2010 Channel *chanPtr; /* The actual channel. */
2011
2012 chanPtr = (Channel *) chan;
2013 return chanPtr->instanceData;
2014 }
2015
2016 /*
2017 *---------------------------------------------------------------------------
2018 *
2019 * AllocChannelBuffer --
2020 *
2021 * A channel buffer has BUFFER_PADDING bytes extra at beginning to
2022 * hold any bytes of a native-encoding character that got split by
2023 * the end of the previous buffer and need to be moved to the
2024 * beginning of the next buffer to make a contiguous string so it
2025 * can be converted to UTF-8.
2026 *
2027 * A channel buffer has BUFFER_PADDING bytes extra at the end to
2028 * hold any bytes of a native-encoding character (generated from a
2029 * UTF-8 character) that overflow past the end of the buffer and
2030 * need to be moved to the next buffer.
2031 *
2032 * Results:
2033 * A newly allocated channel buffer.
2034 *
2035 * Side effects:
2036 * None.
2037 *
2038 *---------------------------------------------------------------------------
2039 */
2040
2041 static ChannelBuffer *
2042 AllocChannelBuffer(length)
2043 int length; /* Desired length of channel buffer. */
2044 {
2045 ChannelBuffer *bufPtr;
2046 int n;
2047
2048 n = length + CHANNELBUFFER_HEADER_SIZE + BUFFER_PADDING + BUFFER_PADDING;
2049 bufPtr = (ChannelBuffer *) ckalloc((unsigned) n);
2050 bufPtr->nextAdded = BUFFER_PADDING;
2051 bufPtr->nextRemoved = BUFFER_PADDING;
2052 bufPtr->bufLength = length + BUFFER_PADDING;
2053 bufPtr->nextPtr = (ChannelBuffer *) NULL;
2054 return bufPtr;
2055 }
2056
2057 /*
2058 *----------------------------------------------------------------------
2059 *
2060 * RecycleBuffer --
2061 *
2062 * Helper function to recycle input and output buffers. Ensures
2063 * that two input buffers are saved (one in the input queue and
2064 * another in the saveInBufPtr field) and that curOutPtr is set
2065 * to a buffer. Only if these conditions are met is the buffer
2066 * freed to the OS.
2067 *
2068 * Results:
2069 * None.
2070 *
2071 * Side effects:
2072 * May free a buffer to the OS.
2073 *
2074 *----------------------------------------------------------------------
2075 */
2076
2077 static void
2078 RecycleBuffer(chanPtr, bufPtr, mustDiscard)
2079 Channel *chanPtr; /* Channel for which to recycle buffers. */
2080 ChannelBuffer *bufPtr; /* The buffer to recycle. */
2081 int mustDiscard; /* If nonzero, free the buffer to the
2082 * OS, always. */
2083 {
2084 /*
2085 * Do we have to free the buffer to the OS?
2086 */
2087
2088 if (mustDiscard) {
2089 ckfree((char *) bufPtr);
2090 return;
2091 }
2092
2093 /*
2094 * Only save buffers for the input queue if the channel is readable.
2095 */
2096
2097 if (chanPtr->flags & TCL_READABLE) {
2098 if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
2099 chanPtr->inQueueHead = bufPtr;
2100 chanPtr->inQueueTail = bufPtr;
2101 goto keepit;
2102 }
2103 if (chanPtr->saveInBufPtr == (ChannelBuffer *) NULL) {
2104 chanPtr->saveInBufPtr = bufPtr;
2105 goto keepit;
2106 }
2107 }
2108
2109 /*
2110 * Only save buffers for the output queue if the channel is writable.
2111 */
2112
2113 if (chanPtr->flags & TCL_WRITABLE) {
2114 if (chanPtr->curOutPtr == (ChannelBuffer *) NULL) {
2115 chanPtr->curOutPtr = bufPtr;
2116 goto keepit;
2117 }
2118 }
2119
2120 /*
2121 * If we reached this code we return the buffer to the OS.
2122 */
2123
2124 ckfree((char *) bufPtr);
2125 return;
2126
2127 keepit:
2128 bufPtr->nextRemoved = BUFFER_PADDING;
2129 bufPtr->nextAdded = BUFFER_PADDING;
2130 bufPtr->nextPtr = (ChannelBuffer *) NULL;
2131 }
2132
2133 /*
2134 *----------------------------------------------------------------------
2135 *
2136 * DiscardOutputQueued --
2137 *
2138 * Discards all output queued in the output queue of a channel.
2139 *
2140 * Results:
2141 * None.
2142 *
2143 * Side effects:
2144 * Recycles buffers.
2145 *
2146 *----------------------------------------------------------------------
2147 */
2148
2149 static void
2150 DiscardOutputQueued(chanPtr)
2151 Channel *chanPtr; /* The channel for which to discard output. */
2152 {
2153 ChannelBuffer *bufPtr;
2154
2155 while (chanPtr->outQueueHead != (ChannelBuffer *) NULL) {
2156 bufPtr = chanPtr->outQueueHead;
2157 chanPtr->outQueueHead = bufPtr->nextPtr;
2158 RecycleBuffer(chanPtr, bufPtr, 0);
2159 }
2160 chanPtr->outQueueHead = (ChannelBuffer *) NULL;
2161 chanPtr->outQueueTail = (ChannelBuffer *) NULL;
2162 }
2163
2164 /*
2165 *----------------------------------------------------------------------
2166 *
2167 * CheckForDeadChannel --
2168 *
2169 * This function checks is a given channel is Dead.
2170 * (A channel that has been closed but not yet deallocated.)
2171 *
2172 * Results:
2173 * True (1) if channel is Dead, False (0) if channel is Ok
2174 *
2175 * Side effects:
2176 * None
2177 *
2178 *----------------------------------------------------------------------
2179 */
2180
2181 static int
2182 CheckForDeadChannel(interp, chanPtr)
2183 Tcl_Interp *interp; /* For error reporting (can be NULL) */
2184 Channel *chanPtr; /* The channel to check. */
2185 {
2186 if (chanPtr->flags & CHANNEL_DEAD) {
2187 Tcl_SetErrno(EINVAL);
2188 if (interp) {
2189 Tcl_AppendResult(interp,
2190 "unable to access channel: invalid channel",
2191 (char *) NULL);
2192 }
2193 return 1;
2194 }
2195 return 0;
2196 }
2197
2198 /*
2199 *----------------------------------------------------------------------
2200 *
2201 * FlushChannel --
2202 *
2203 * This function flushes as much of the queued output as is possible
2204 * now. If calledFromAsyncFlush is nonzero, it is being called in an
2205 * event handler to flush channel output asynchronously.
2206 *
2207 * Results:
2208 * 0 if successful, else the error code that was returned by the
2209 * channel type operation.
2210 *
2211 * Side effects:
2212 * May produce output on a channel. May block indefinitely if the
2213 * channel is synchronous. May schedule an async flush on the channel.
2214 * May recycle memory for buffers in the output queue.
2215 *
2216 *----------------------------------------------------------------------
2217 */
2218
2219 static int
2220 FlushChannel(interp, chanPtr, calledFromAsyncFlush)
2221 Tcl_Interp *interp; /* For error reporting during close. */
2222 Channel *chanPtr; /* The channel to flush on. */
2223 int calledFromAsyncFlush; /* If nonzero then we are being
2224 * called from an asynchronous
2225 * flush callback. */
2226 {
2227 ChannelBuffer *bufPtr; /* Iterates over buffered output
2228 * queue. */
2229 int toWrite; /* Amount of output data in current
2230 * buffer available to be written. */
2231 int written; /* Amount of output data actually
2232 * written in current round. */
2233 int errorCode = 0; /* Stores POSIX error codes from
2234 * channel driver operations. */
2235 int wroteSome = 0; /* Set to one if any data was
2236 * written to the driver. */
2237
2238 /*
2239 * Prevent writing on a dead channel -- a channel that has been closed
2240 * but not yet deallocated. This can occur if the exit handler for the
2241 * channel deallocation runs before all channels are deregistered in
2242 * all interpreters.
2243 */
2244
2245 if (CheckForDeadChannel(interp,chanPtr)) return -1;
2246
2247 /*
2248 * Loop over the queued buffers and attempt to flush as
2249 * much as possible of the queued output to the channel.
2250 */
2251
2252 while (1) {
2253
2254 /*
2255 * If the queue is empty and there is a ready current buffer, OR if
2256 * the current buffer is full, then move the current buffer to the
2257 * queue.
2258 */
2259
2260 if (((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&
2261 (chanPtr->curOutPtr->nextAdded == chanPtr->curOutPtr->bufLength))
2262 || ((chanPtr->flags & BUFFER_READY) &&
2263 (chanPtr->outQueueHead == (ChannelBuffer *) NULL))) {
2264 chanPtr->flags &= (~(BUFFER_READY));
2265 chanPtr->curOutPtr->nextPtr = (ChannelBuffer *) NULL;
2266 if (chanPtr->outQueueHead == (ChannelBuffer *) NULL) {
2267 chanPtr->outQueueHead = chanPtr->curOutPtr;
2268 } else {
2269 chanPtr->outQueueTail->nextPtr = chanPtr->curOutPtr;
2270 }
2271 chanPtr->outQueueTail = chanPtr->curOutPtr;
2272 chanPtr->curOutPtr = (ChannelBuffer *) NULL;
2273 }
2274 bufPtr = chanPtr->outQueueHead;
2275
2276 /*
2277 * If we are not being called from an async flush and an async
2278 * flush is active, we just return without producing any output.
2279 */
2280
2281 if ((!calledFromAsyncFlush) &&
2282 (chanPtr->flags & BG_FLUSH_SCHEDULED)) {
2283 return 0;
2284 }
2285
2286 /*
2287 * If the output queue is still empty, break out of the while loop.
2288 */
2289
2290 if (bufPtr == (ChannelBuffer *) NULL) {
2291 break; /* Out of the "while (1)". */
2292 }
2293
2294 /*
2295 * Produce the output on the channel.
2296 */
2297
2298 toWrite = bufPtr->nextAdded - bufPtr->nextRemoved;
2299 written = (chanPtr->typePtr->outputProc) (chanPtr->instanceData,
2300 (char *) bufPtr->buf + bufPtr->nextRemoved, toWrite,
2301 &errorCode);
2302
2303 /*
2304 * If the write failed completely attempt to start the asynchronous
2305 * flush mechanism and break out of this loop - do not attempt to
2306 * write any more output at this time.
2307 */
2308
2309 if (written < 0) {
2310
2311 /*
2312 * If the last attempt to write was interrupted, simply retry.
2313 */
2314
2315 if (errorCode == EINTR) {
2316 errorCode = 0;
2317 continue;
2318 }
2319
2320 /*
2321 * If the channel is non-blocking and we would have blocked,
2322 * start a background flushing handler and break out of the loop.
2323 */
2324
2325 if ((errorCode == EWOULDBLOCK) || (errorCode == EAGAIN)) {
2326 /*
2327 * This used to check for CHANNEL_NONBLOCKING, and panic
2328 * if the channel was blocking. However, it appears
2329 * that setting stdin to -blocking 0 has some effect on
2330 * the stdout when it's a tty channel (dup'ed underneath)
2331 */
2332 if (!(chanPtr->flags & BG_FLUSH_SCHEDULED)) {
2333 chanPtr->flags |= BG_FLUSH_SCHEDULED;
2334 UpdateInterest(chanPtr);
2335 }
2336 errorCode = 0;
2337 break;
2338 }
2339
2340 /*
2341 * Decide whether to report the error upwards or defer it.
2342 */
2343
2344 if (calledFromAsyncFlush) {
2345 if (chanPtr->unreportedError == 0) {
2346 chanPtr->unreportedError = errorCode;
2347 }
2348 } else {
2349 Tcl_SetErrno(errorCode);
2350 if (interp != NULL) {
2351 Tcl_SetResult(interp,
2352 Tcl_PosixError(interp), TCL_VOLATILE);
2353 }
2354 }
2355
2356 /*
2357 * When we get an error we throw away all the output
2358 * currently queued.
2359 */
2360
2361 DiscardOutputQueued(chanPtr);
2362 continue;
2363 } else {
2364 wroteSome = 1;
2365 }
2366
2367 bufPtr->nextRemoved += written;
2368
2369 /*
2370 * If this buffer is now empty, recycle it.
2371 */
2372
2373 if (bufPtr->nextRemoved == bufPtr->nextAdded) {
2374 chanPtr->outQueueHead = bufPtr->nextPtr;
2375 if (chanPtr->outQueueHead == (ChannelBuffer *) NULL) {
2376 chanPtr->outQueueTail = (ChannelBuffer *) NULL;
2377 }
2378 RecycleBuffer(chanPtr, bufPtr, 0);
2379 }
2380 } /* Closes "while (1)". */
2381
2382 /*
2383 * If we wrote some data while flushing in the background, we are done.
2384 * We can't finish the background flush until we run out of data and
2385 * the channel becomes writable again. This ensures that all of the
2386 * pending data has been flushed at the system level.
2387 */
2388
2389 if (chanPtr->flags & BG_FLUSH_SCHEDULED) {
2390 if (wroteSome) {
2391 return errorCode;
2392 } else if (chanPtr->outQueueHead == (ChannelBuffer *) NULL) {
2393 chanPtr->flags &= (~(BG_FLUSH_SCHEDULED));
2394 (chanPtr->typePtr->watchProc)(chanPtr->instanceData,
2395 chanPtr->interestMask);
2396 }
2397 }
2398
2399 /*
2400 * If the channel is flagged as closed, delete it when the refCount
2401 * drops to zero, the output queue is empty and there is no output
2402 * in the current output buffer.
2403 */
2404
2405 if ((chanPtr->flags & CHANNEL_CLOSED) && (chanPtr->refCount <= 0) &&
2406 (chanPtr->outQueueHead == (ChannelBuffer *) NULL) &&
2407 ((chanPtr->curOutPtr == (ChannelBuffer *) NULL) ||
2408 (chanPtr->curOutPtr->nextAdded ==
2409 chanPtr->curOutPtr->nextRemoved))) {
2410 return CloseChannel(interp, chanPtr, errorCode);
2411 }
2412 return errorCode;
2413 }
2414
2415 /*
2416 *----------------------------------------------------------------------
2417 *
2418 * CloseChannel --
2419 *
2420 * Utility procedure to close a channel and free its associated
2421 * resources.
2422 *
2423 * Results:
2424 * 0 on success or a POSIX error code if the operation failed.
2425 *
2426 * Side effects:
2427 * May close the actual channel; may free memory.
2428 *
2429 *----------------------------------------------------------------------
2430 */
2431
2432 static int
2433 CloseChannel(interp, chanPtr, errorCode)
2434 Tcl_Interp *interp; /* For error reporting. */
2435 Channel *chanPtr; /* The channel to close. */
2436 int errorCode; /* Status of operation so far. */
2437 {
2438 int result = 0; /* Of calling driver close
2439 * operation. */
2440 Channel *prevChanPtr; /* Preceding channel in list of
2441 * all channels - used to splice a
2442 * channel out of the list on close. */
2443 ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
2444
2445 if (chanPtr == NULL) {
2446 return result;
2447 }
2448
2449 /*
2450 * No more input can be consumed so discard any leftover input.
2451 */
2452
2453 DiscardInputQueued(chanPtr, 1);
2454
2455 /*
2456 * Discard a leftover buffer in the current output buffer field.
2457 */
2458
2459 if (chanPtr->curOutPtr != (ChannelBuffer *) NULL) {
2460 ckfree((char *) chanPtr->curOutPtr);
2461 chanPtr->curOutPtr = (ChannelBuffer *) NULL;
2462 }
2463
2464 /*
2465 * The caller guarantees that there are no more buffers
2466 * queued for output.
2467 */
2468
2469 if (chanPtr->outQueueHead != (ChannelBuffer *) NULL) {
2470 panic("TclFlush, closed channel: queued output left");
2471 }
2472
2473 /*
2474 * If the EOF character is set in the channel, append that to the
2475 * output device.
2476 */
2477
2478 if ((chanPtr->outEofChar != 0) && (chanPtr->flags & TCL_WRITABLE)) {
2479 int dummy;
2480 char c;
2481
2482 c = (char) chanPtr->outEofChar;
2483 (chanPtr->typePtr->outputProc) (chanPtr->instanceData, &c, 1, &dummy);
2484 }
2485
2486 /*
2487 * Remove TCL_READABLE and TCL_WRITABLE from chanPtr->flags, so
2488 * that close callbacks can not do input or output (assuming they
2489 * squirreled the channel away in their clientData). This also
2490 * prevents infinite loops if the callback calls any C API that
2491 * could call FlushChannel.
2492 */
2493
2494 chanPtr->flags &= (~(TCL_READABLE|TCL_WRITABLE));
2495
2496 /*
2497 * Splice this channel out of the list of all channels.
2498 */
2499
2500 if (chanPtr == tsdPtr->firstChanPtr) {
2501 tsdPtr->firstChanPtr = chanPtr->nextChanPtr;
2502 } else {
2503 for (prevChanPtr = tsdPtr->firstChanPtr;
2504 (prevChanPtr != (Channel *) NULL) &&
2505 (prevChanPtr->nextChanPtr != chanPtr);
2506 prevChanPtr = prevChanPtr->nextChanPtr) {
2507 /* Empty loop body. */
2508 }
2509 if (prevChanPtr == (Channel *) NULL) {
2510 panic("FlushChannel: damaged channel list");
2511 }
2512 prevChanPtr->nextChanPtr = chanPtr->nextChanPtr;
2513 }
2514
2515 /*
2516 * Close and free the channel driver state.
2517 */
2518
2519 if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {
2520 result = (chanPtr->typePtr->closeProc)(chanPtr->instanceData, interp);
2521 } else {
2522 result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData, interp,
2523 0);
2524 }
2525
2526 if (chanPtr->channelName != (char *) NULL) {
2527 ckfree(chanPtr->channelName);
2528 }
2529 Tcl_FreeEncoding(chanPtr->encoding);
2530 if (chanPtr->outputStage != NULL) {
2531 ckfree((char *) chanPtr->outputStage);
2532 }
2533
2534 /*
2535 * If we are being called synchronously, report either
2536 * any latent error on the channel or the current error.
2537 */
2538
2539 if (chanPtr->unreportedError != 0) {
2540 errorCode = chanPtr->unreportedError;
2541 }
2542 if (errorCode == 0) {
2543 errorCode = result;
2544 if (errorCode != 0) {
2545 Tcl_SetErrno(errorCode);
2546 }
2547 }
2548
2549 /* Andreas Kupries <a.kupries@westend.com>, 12/13/1998
2550 * "Trf-Patch for filtering channels"
2551 *
2552 * This is the change to 'CloseChannel'.
2553 *
2554 * Explanation
2555 * Closing a filtering channel closes the one it
2556 * superceded too. This basically ripples through
2557 * the whole chain of filters until it reaches
2558 * the underlying normal channel.
2559 *
2560 * This is done by reintegrating the superceded
2561 * channel into the (thread) global list of open
2562 * channels and then invoking a regular close.
2563 * There is no need to handle the complexities of
2564 * this process by ourselves.
2565 *
2566 * *Note*
2567 * This has to be done after the call to the
2568 * 'closeProc' of the filtering channel to allow
2569 * that one to flush internal buffers into
2570 * the underlying channel.
2571 */
2572
2573 if (chanPtr->supercedes != (Channel*) NULL) {
2574 /*
2575 * Insert the channel we were stacked upon back into
2576 * the list of open channels, then do a regular close.
2577 */
2578
2579 chanPtr->supercedes->nextChanPtr = tsdPtr->firstChanPtr;
2580 tsdPtr->firstChanPtr = chanPtr->supercedes;
2581 chanPtr->supercedes->refCount --; /* is deregistered */
2582 Tcl_Close (interp, (Tcl_Channel) chanPtr->supercedes);
2583 }
2584
2585 /*
2586 * Cancel any outstanding timer.
2587 */
2588
2589 Tcl_DeleteTimerHandler(chanPtr->timer);
2590
2591 /*
2592 * Mark the channel as deleted by clearing the type structure.
2593 */
2594
2595 chanPtr->typePtr = NULL;
2596
2597 Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC);
2598
2599 return errorCode;
2600 }
2601
2602 /*
2603 *----------------------------------------------------------------------
2604 *
2605 * Tcl_Close --
2606 *
2607 * Closes a channel.
2608 *
2609 * Results:
2610 * A standard Tcl result.
2611 *
2612 * Side effects:
2613 * Closes the channel if this is the last reference.
2614 *
2615 * NOTE:
2616 * Tcl_Close removes the channel as far as the user is concerned.
2617 * However, it may continue to exist for a while longer if it has
2618 * a background flush scheduled. The device itself is eventually
2619 * closed and the channel record removed, in CloseChannel, above.
2620 *
2621 *----------------------------------------------------------------------
2622 */
2623
2624 /* ARGSUSED */
2625 int
2626 Tcl_Close(interp, chan)
2627 Tcl_Interp *interp; /* Interpreter for errors. */
2628 Tcl_Channel chan; /* The channel being closed. Must
2629 * not be referenced in any
2630 * interpreter. */
2631 {
2632 ChannelHandler *chPtr, *chNext; /* Iterate over channel handlers. */
2633 CloseCallback *cbPtr; /* Iterate over close callbacks
2634 * for this channel. */
2635 EventScriptRecord *ePtr, *eNextPtr; /* Iterate over eventscript records. */
2636 Channel *chanPtr; /* The real IO channel. */
2637 int result; /* Of calling FlushChannel. */
2638 ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
2639 NextChannelHandler *nhPtr;
2640
2641 if (chan == (Tcl_Channel) NULL) {
2642 return TCL_OK;
2643 }
2644
2645 /*
2646 * Perform special handling for standard channels being closed. If the
2647 * refCount is now 1 it means that the last reference to the standard
2648 * channel is being explicitly closed, so bump the refCount down
2649 * artificially to 0. This will ensure that the channel is actually
2650 * closed, below. Also set the static pointer to NULL for the channel.
2651 */
2652
2653 CheckForStdChannelsBeingClosed(chan);
2654
2655 chanPtr = (Channel *) chan;
2656 if (chanPtr->refCount > 0) {
2657 panic("called Tcl_Close on channel with refCount > 0");
2658 }
2659
2660 /*
2661 * Remove any references to channel handlers for this channel that
2662 * may be about to be invoked.
2663 */
2664
2665 for (nhPtr = tsdPtr->nestedHandlerPtr;
2666 nhPtr != (NextChannelHandler *) NULL;
2667 nhPtr = nhPtr->nestedHandlerPtr) {
2668 if (nhPtr->nextHandlerPtr &&
2669 (nhPtr->nextHandlerPtr->chanPtr == chanPtr)) {
2670 nhPtr->nextHandlerPtr = NULL;
2671 }
2672 }
2673
2674 /*
2675 * Remove all the channel handler records attached to the channel
2676 * itself.
2677 */
2678
2679 for (chPtr = chanPtr->chPtr;
2680 chPtr != (ChannelHandler *) NULL;
2681 chPtr = chNext) {
2682 chNext = chPtr->nextPtr;
2683 ckfree((char *) chPtr);
2684 }
2685 chanPtr->chPtr = (ChannelHandler *) NULL;
2686
2687
2688 /*
2689 * Cancel any pending copy operation.
2690 */
2691
2692 StopCopy(chanPtr->csPtr);
2693
2694 /*
2695 * Must set the interest mask now to 0, otherwise infinite loops
2696 * will occur if Tcl_DoOneEvent is called before the channel is
2697 * finally deleted in FlushChannel. This can happen if the channel
2698 * has a background flush active.
2699 */
2700
2701 chanPtr->interestMask = 0;
2702
2703 /*
2704 * Remove any EventScript records for this channel.
2705 */
2706
2707 for (ePtr = chanPtr->scriptRecordPtr;
2708 ePtr != (EventScriptRecord *) NULL;
2709 ePtr = eNextPtr) {
2710 eNextPtr = ePtr->nextPtr;
2711 Tcl_DecrRefCount(ePtr->scriptPtr);
2712 ckfree((char *) ePtr);
2713 }
2714 chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL;
2715
2716 /*
2717 * Invoke the registered close callbacks and delete their records.
2718 */
2719
2720 while (chanPtr->closeCbPtr != (CloseCallback *) NULL) {
2721 cbPtr = chanPtr->closeCbPtr;
2722 chanPtr->closeCbPtr = cbPtr->nextPtr;
2723 (cbPtr->proc) (cbPtr->clientData);
2724 ckfree((char *) cbPtr);
2725 }
2726
2727 /*
2728 * Ensure that the last output buffer will be flushed.
2729 */
2730
2731 if ((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&
2732 (chanPtr->curOutPtr->nextAdded > chanPtr->curOutPtr->nextRemoved)) {
2733 chanPtr->flags |= BUFFER_READY;
2734 }
2735
2736 /*
2737 * If this channel supports it, close the read side, since we don't need it
2738 * anymore and this will help avoid deadlocks on some channel types.
2739 */
2740
2741 if (chanPtr->typePtr->closeProc == TCL_CLOSE2PROC) {
2742 result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData, interp,
2743 TCL_CLOSE_READ);
2744 } else {
2745 result = 0;
2746 }
2747
2748 /*
2749 * The call to FlushChannel will flush any queued output and invoke
2750 * the close function of the channel driver, or it will set up the
2751 * channel to be flushed and closed asynchronously.
2752 */
2753
2754 chanPtr->flags |= CHANNEL_CLOSED;
2755 if ((FlushChannel(interp, chanPtr, 0) != 0) || (result != 0)) {
2756 return TCL_ERROR;
2757 }
2758 return TCL_OK;
2759 }
2760
2761 /*
2762 *----------------------------------------------------------------------
2763 *
2764 * Tcl_Write --
2765 *
2766 * Puts a sequence of bytes into an output buffer, may queue the
2767 * buffer for output if it gets full, and also remembers whether the
2768 * current buffer is ready e.g. if it contains a newline and we are in
2769 * line buffering mode.
2770 *
2771 * Results:
2772 * The number of bytes written or -1 in case of error. If -1,
2773 * Tcl_GetErrno will return the error code.
2774 *
2775 * Side effects:
2776 * May buffer up output and may cause output to be produced on the
2777 * channel.
2778 *
2779 *----------------------------------------------------------------------
2780 */
2781
2782 int
2783 Tcl_Write(chan, src, srcLen)
2784 Tcl_Channel chan; /* The channel to buffer output for. */
2785 char *src; /* Data to queue in output buffer. */
2786 int srcLen; /* Length of data in bytes, or < 0 for
2787 * strlen(). */
2788 {
2789 Channel *chanPtr;
2790
2791 chanPtr = (Channel *) chan;
2792 if (CheckChannelErrors(chanPtr, TCL_WRITABLE) != 0) {
2793 return -1;
2794 }
2795 if (srcLen < 0) {
2796 srcLen = strlen(src);
2797 }
2798 return DoWrite(chanPtr, src, srcLen);
2799 }
2800
2801 /*
2802 *---------------------------------------------------------------------------
2803 *
2804 * Tcl_WriteChars --
2805 *
2806 * Takes a sequence of UTF-8 characters and converts them for output
2807 * using the channel's current encoding, may queue the buffer for
2808 * output if it gets full, and also remembers whether the current
2809 * buffer is ready e.g. if it contains a newline and we are in
2810 * line buffering mode.
2811 *
2812 * Results:
2813 * The number of bytes written or -1 in case of error. If -1,
2814 * Tcl_GetErrno will return the error code.
2815 *
2816 * Side effects:
2817 * May buffer up output and may cause output to be produced on the
2818 * channel.
2819 *
2820 *----------------------------------------------------------------------
2821 */
2822
2823 int
2824 Tcl_WriteChars(chan, src, len)
2825 Tcl_Channel chan; /* The channel to buffer output for. */
2826 CONST char *src; /* UTF-8 characters to queue in output buffer. */
2827 int len; /* Length of string in bytes, or < 0 for
2828 * strlen(). */
2829 {
2830 Channel *chanPtr;
2831
2832 chanPtr = (Channel *) chan;
2833 if (CheckChannelErrors(chanPtr, TCL_WRITABLE) != 0) {
2834 return -1;
2835 }
2836 if (len < 0) {
2837 len = strlen(src);
2838 }
2839 if (chanPtr->encoding == NULL) {
2840 /*
2841 * Inefficient way to convert UTF-8 to byte-array, but the
2842 * code parallels the way it is done for objects.
2843 */
2844
2845 Tcl_Obj *objPtr;
2846 int result;
2847
2848 objPtr = Tcl_NewStringObj(src, len);
2849 src = (char *) Tcl_GetByteArrayFromObj(objPtr, &len);
2850 result = WriteBytes(chanPtr, src, len);
2851 Tcl_DecrRefCount(objPtr);
2852 return result;
2853 }
2854 return WriteChars(chanPtr, src, len);
2855 }
2856
2857 /*
2858 *---------------------------------------------------------------------------
2859 *
2860 * Tcl_WriteObj --
2861 *
2862 * Takes the Tcl object and queues its contents for output. If the
2863 * encoding of the channel is NULL, takes the byte-array representation
2864 * of the object and queues those bytes for output. Otherwise, takes
2865 * the characters in the UTF-8 (string) representation of the object
2866 * and converts them for output using the channel's current encoding.
2867 * May flush internal buffers to output if one becomes full or is ready
2868 * for some other reason, e.g. if it contains a newline and the channel
2869 * is in line buffering mode.
2870 *
2871 * Results:
2872 * The number of bytes written or -1 in case of error. If -1,
2873 * Tcl_GetErrno() will return the error code.
2874 *
2875 * Side effects:
2876 * May buffer up output and may cause output to be produced on the
2877 * channel.
2878 *
2879 *----------------------------------------------------------------------
2880 */
2881
2882 int
2883 Tcl_WriteObj(chan, objPtr)
2884 Tcl_Channel chan; /* The channel to buffer output for. */
2885 Tcl_Obj *objPtr; /* The object to write. */
2886 {
2887 Channel *chanPtr;
2888 char *src;
2889 int srcLen;
2890
2891 chanPtr = (Channel *) chan;
2892 if (CheckChannelErrors(chanPtr, TCL_WRITABLE) != 0) {
2893 return -1;
2894 }
2895 if (chanPtr->encoding == NULL) {
2896 src = (char *) Tcl_GetByteArrayFromObj(objPtr, &srcLen);
2897 return WriteBytes(chanPtr, src, srcLen);
2898 } else {
2899 src = Tcl_GetStringFromObj(objPtr, &srcLen);
2900 return WriteChars(chanPtr, src, srcLen);
2901 }
2902 }
2903
2904 /*
2905 *----------------------------------------------------------------------
2906 *
2907 * WriteBytes --
2908 *
2909 * Write a sequence of bytes into an output buffer, may queue the
2910 * buffer for output if it gets full, and also remembers whether the
2911 * current buffer is ready e.g. if it contains a newline and we are in
2912 * line buffering mode.
2913 *
2914 * Results:
2915 * The number of bytes written or -1 in case of error. If -1,
2916 * Tcl_GetErrno will return the error code.
2917 *
2918 * Side effects:
2919 * May buffer up output and may cause output to be produced on the
2920 * channel.
2921 *
2922 *----------------------------------------------------------------------
2923 */
2924
2925 static int
2926 WriteBytes(chanPtr, src, srcLen)
2927 Channel *chanPtr; /* The channel to buffer output for. */
2928 CONST char *src; /* Bytes to write. */
2929 int srcLen; /* Number of bytes to write. */
2930 {
2931 ChannelBuffer *bufPtr;
2932 char *dst;
2933 int dstLen, dstMax, sawLF, savedLF, total, toWrite;
2934
2935 total = 0;
2936 sawLF = 0;
2937 savedLF = 0;
2938
2939 /*
2940 * Loop over all bytes in src, storing them in output buffer with
2941 * proper EOL translation.
2942 */
2943
2944 while (srcLen + savedLF > 0) {
2945 bufPtr = chanPtr->curOutPtr;
2946 if (bufPtr == NULL) {
2947 bufPtr = AllocChannelBuffer(chanPtr->bufSize);
2948 chanPtr->curOutPtr = bufPtr;
2949 }
2950 dst = bufPtr->buf + bufPtr->nextAdded;
2951 dstMax = bufPtr->bufLength - bufPtr->nextAdded;
2952 dstLen = dstMax;
2953
2954 toWrite = dstLen;
2955 if (toWrite > srcLen) {
2956 toWrite = srcLen;
2957 }
2958
2959 if (savedLF) {
2960 /*
2961 * A '\n' was left over from last call to TranslateOutputEOL()
2962 * and we need to store it in this buffer. If the channel is
2963 * line-based, we will need to flush it.
2964 */
2965
2966 *dst++ = '\n';
2967 dstLen--;
2968 sawLF++;
2969 }
2970 sawLF += TranslateOutputEOL(chanPtr, dst, src, &dstLen, &toWrite);
2971 dstLen += savedLF;
2972 savedLF = 0;
2973
2974 if (dstLen > dstMax) {
2975 savedLF = 1;
2976 dstLen = dstMax;
2977 }
2978 bufPtr->nextAdded += dstLen;
2979 if (CheckFlush(chanPtr, bufPtr, sawLF) != 0) {
2980 return -1;
2981 }
2982 total += dstLen;
2983 src += toWrite;
2984 srcLen -= toWrite;
2985 sawLF = 0;
2986 }
2987 return total;
2988 }
2989
2990 /*
2991 *----------------------------------------------------------------------
2992 *
2993 * WriteChars --
2994 *
2995 * Convert UTF-8 bytes to the channel's external encoding and
2996 * write the produced bytes into an output buffer, may queue the
2997 * buffer for output if it gets full, and also remembers whether the
2998 * current buffer is ready e.g. if it contains a newline and we are in
2999 * line buffering mode.
3000 *
3001 * Results:
3002 * The number of bytes written or -1 in case of error. If -1,
3003 * Tcl_GetErrno will return the error code.
3004 *
3005 * Side effects:
3006 * May buffer up output and may cause output to be produced on the
3007 * channel.
3008 *
3009 *----------------------------------------------------------------------
3010 */
3011
3012 static int
3013 WriteChars(chanPtr, src, srcLen)
3014 Channel *chanPtr; /* The channel to buffer output for. */
3015 CONST char *src; /* UTF-8 string to write. */
3016 int srcLen; /* Length of UTF-8 string in bytes. */
3017 {
3018 ChannelBuffer *bufPtr;
3019 char *dst, *stage;
3020 int saved, savedLF, sawLF, total, toWrite, flags;
3021 int dstWrote, dstLen, stageLen, stageMax, stageRead;
3022 Tcl_Encoding encoding;
3023 char safe[BUFFER_PADDING];
3024
3025 total = 0;
3026 sawLF = 0;
3027 savedLF = 0;
3028 saved = 0;
3029 encoding = chanPtr->encoding;
3030
3031 /*
3032 * Loop over all UTF-8 characters in src, storing them in staging buffer
3033 * with proper EOL translation.
3034 */
3035
3036 while (srcLen + savedLF > 0) {
3037 stage = chanPtr->outputStage;
3038 stageMax = chanPtr->bufSize;
3039 stageLen = stageMax;
3040
3041 toWrite = stageLen;
3042 if (toWrite > srcLen) {
3043 toWrite = srcLen;
3044 }
3045
3046 if (savedLF) {
3047 /*
3048 * A '\n' was left over from last call to TranslateOutputEOL()
3049 * and we need to store it in the staging buffer. If the
3050 * channel is line-based, we will need to flush the output
3051 * buffer (after translating the staging buffer).
3052 */
3053
3054 *stage++ = '\n';
3055 stageLen--;
3056 sawLF++;
3057 }
3058 sawLF += TranslateOutputEOL(chanPtr, stage, src, &stageLen, &toWrite);
3059
3060 stage -= savedLF;
3061 stageLen += savedLF;
3062 savedLF = 0;
3063
3064 if (stageLen > stageMax) {
3065 savedLF = 1;
3066 stageLen = stageMax;
3067 }
3068 src += toWrite;
3069 srcLen -= toWrite;
3070
3071 flags = chanPtr->outputEncodingFlags;
3072 if (srcLen == 0) {
3073 flags |= TCL_ENCODING_END;
3074 }
3075
3076 /*
3077 * Loop over all UTF-8 characters in staging buffer, converting them
3078 * to external encoding, storing them in output buffer.
3079 */
3080
3081 while (stageLen + saved > 0) {
3082 bufPtr = chanPtr->curOutPtr;
3083 if (bufPtr == NULL) {
3084 bufPtr = AllocChannelBuffer(chanPtr->bufSize);
3085 chanPtr->curOutPtr = bufPtr;
3086 }
3087 dst = bufPtr->buf + bufPtr->nextAdded;
3088 dstLen = bufPtr->bufLength - bufPtr->nextAdded;
3089
3090 if (saved != 0) {
3091 /*
3092 * Here's some translated bytes left over from the last
3093 * buffer that we need to stick at the beginning of this
3094 * buffer.
3095 */
3096
3097 memcpy((VOID *) dst, (VOID *) safe, (size_t) saved);
3098 bufPtr->nextAdded += saved;
3099 dst += saved;
3100 dstLen -= saved;
3101 saved = 0;
3102 }
3103
3104 Tcl_UtfToExternal(NULL, encoding, stage, stageLen, flags,
3105 &chanPtr->outputEncodingState, dst,
3106 dstLen + BUFFER_PADDING, &stageRead, &dstWrote, NULL);
3107 if (stageRead + dstWrote == 0) {
3108 /*
3109 * We have an incomplete UTF-8 character at the end of the
3110 * staging buffer. It will get moved to the beginning of the
3111 * staging buffer followed by more bytes from src.
3112 */
3113
3114 src -= stageLen;
3115 srcLen += stageLen;
3116 stageLen = 0;
3117 savedLF = 0;
3118 break;
3119 }
3120 bufPtr->nextAdded += dstWrote;
3121 if (bufPtr->nextAdded > bufPtr->bufLength) {
3122 /*
3123 * When translating from UTF-8 to external encoding, we
3124 * allowed the translation to produce a character that
3125 * crossed the end of the output buffer, so that we would
3126 * get a completely full buffer before flushing it. The
3127 * extra bytes will be moved to the beginning of the next
3128 * buffer.
3129 */
3130
3131 saved = bufPtr->nextAdded - bufPtr->bufLength;
3132 memcpy((VOID *) safe, (VOID *) (dst + dstLen), (size_t) saved);
3133 bufPtr->nextAdded = bufPtr->bufLength;
3134 }
3135 if (CheckFlush(chanPtr, bufPtr, sawLF) != 0) {
3136 return -1;
3137 }
3138
3139 total += dstWrote;
3140 stage += stageRead;
3141 stageLen -= stageRead;
3142 sawLF = 0;
3143 }
3144 }
3145 return total;
3146 }
3147
3148 /*
3149 *---------------------------------------------------------------------------
3150 *
3151 * TranslateOutputEOL --
3152 *
3153 * Helper function for WriteBytes() and WriteChars(). Converts the
3154 * '\n' characters in the source buffer into the appropriate EOL
3155 * form specified by the output translation mode.
3156 *
3157 * EOL translation stops either when the source buffer is empty
3158 * or the output buffer is full.
3159 *
3160 * When converting to CRLF mode and there is only 1 byte left in
3161 * the output buffer, this routine stores the '\r' in the last
3162 * byte and then stores the '\n' in the byte just past the end of the
3163 * buffer. The caller is responsible for passing in a buffer that
3164 * is large enough to hold the extra byte.
3165 *
3166 * Results:
3167 * The return value is 1 if a '\n' was translated from the source
3168 * buffer, or 0 otherwise -- this can be used by the caller to
3169 * decide to flush a line-based channel even though the channel
3170 * buffer is not full.
3171 *
3172 * *dstLenPtr is filled with how many bytes of the output buffer
3173 * were used. As mentioned above, this can be one more that
3174 * the output buffer's specified length if a CRLF was stored.
3175 *
3176 * *srcLenPtr is filled with how many bytes of the source buffer
3177 * were consumed.
3178 *
3179 * Side effects:
3180 * It may be obvious, but bears mentioning that when converting
3181 * in CRLF mode (which requires two bytes of storage in the output
3182 * buffer), the number of bytes consumed from the source buffer
3183 * will be less than the number of bytes stored in the output buffer.
3184 *
3185 *---------------------------------------------------------------------------
3186 */
3187
3188 static int
3189 TranslateOutputEOL(chanPtr, dst, src, dstLenPtr, srcLenPtr)
3190 Channel *chanPtr; /* Channel being read, for translation and
3191 * buffering modes. */
3192 char *dst; /* Output buffer filled with UTF-8 chars by
3193 * applying appropriate EOL translation to
3194 * source characters. */
3195 CONST char *src; /* Source UTF-8 characters. */
3196 int *dstLenPtr; /* On entry, the maximum length of output
3197 * buffer in bytes. On exit, the number of
3198 * bytes actually used in output buffer. */
3199 int *srcLenPtr; /* On entry, the length of source buffer.
3200 * On exit, the number of bytes read from
3201 * the source buffer. */
3202 {
3203 char *dstEnd;
3204 int srcLen, newlineFound;
3205
3206 newlineFound = 0;
3207 srcLen = *srcLenPtr;
3208
3209 switch (chanPtr->outputTranslation) {
3210 case TCL_TRANSLATE_LF: {
3211 for (dstEnd = dst + srcLen; dst < dstEnd; ) {
3212 if (*src == '\n') {
3213 newlineFound = 1;
3214 }
3215 *dst++ = *src++;
3216 }
3217 *dstLenPtr = srcLen;
3218 break;
3219 }
3220 case TCL_TRANSLATE_CR: {
3221 for (dstEnd = dst + srcLen; dst < dstEnd;) {
3222 if (*src == '\n') {
3223 *dst++ = '\r';
3224 newlineFound = 1;
3225 src++;
3226 } else {
3227 *dst++ = *src++;
3228 }
3229 }
3230 *dstLenPtr = srcLen;
3231 break;
3232 }
3233 case TCL_TRANSLATE_CRLF: {
3234 /*
3235 * Since this causes the number of bytes to grow, we
3236 * start off trying to put 'srcLen' bytes into the
3237 * output buffer, but allow it to store more bytes, as
3238 * long as there's still source bytes and room in the
3239 * output buffer.
3240 */
3241
3242 char *dstStart, *dstMax;
3243 CONST char *srcStart;
3244
3245 dstStart = dst;
3246 dstMax = dst + *dstLenPtr;
3247
3248 srcStart = src;
3249
3250 if (srcLen < *dstLenPtr) {
3251 dstEnd = dst + srcLen;
3252 } else {
3253 dstEnd = dst + *dstLenPtr;
3254 }
3255 while (dst < dstEnd) {
3256 if (*src == '\n') {
3257 if (dstEnd < dstMax) {
3258 dstEnd++;
3259 }
3260 *dst++ = '\r';
3261 newlineFound = 1;
3262 }
3263 *dst++ = *src++;
3264 }
3265 *srcLenPtr = src - srcStart;
3266 *dstLenPtr = dst - dstStart;
3267 break;
3268 }
3269 default: {
3270 break;
3271 }
3272 }
3273 return newlineFound;
3274 }
3275
3276 /*
3277 *---------------------------------------------------------------------------
3278 *
3279 * CheckFlush --
3280 *
3281 * Helper function for WriteBytes() and WriteChars(). If the
3282 * channel buffer is ready to be flushed, flush it.
3283 *
3284 * Results:
3285 * The return value is -1 if there was a problem flushing the
3286 * channel buffer, or 0 otherwise.
3287 *
3288 * Side effects:
3289 * The buffer will be recycled if it is flushed.
3290 *
3291 *---------------------------------------------------------------------------
3292 */
3293
3294 static int
3295 CheckFlush(chanPtr, bufPtr, newlineFlag)
3296 Channel *chanPtr; /* Channel being read, for buffering mode. */
3297 ChannelBuffer *bufPtr; /* Channel buffer to possibly flush. */
3298 int newlineFlag; /* Non-zero if a the channel buffer
3299 * contains a newline. */
3300 {
3301 /*
3302 * The current buffer is ready for output:
3303 * 1. if it is full.
3304 * 2. if it contains a newline and this channel is line-buffered.
3305 * 3. if it contains any output and this channel is unbuffered.
3306 */
3307
3308 if ((chanPtr->flags & BUFFER_READY) == 0) {
3309 if (bufPtr->nextAdded == bufPtr->bufLength) {
3310 chanPtr->flags |= BUFFER_READY;
3311 } else if (chanPtr->flags & CHANNEL_LINEBUFFERED) {
3312 if (newlineFlag != 0) {
3313 chanPtr->flags |= BUFFER_READY;
3314 }
3315 } else if (chanPtr->flags & CHANNEL_UNBUFFERED) {
3316 chanPtr->flags |= BUFFER_READY;
3317 }
3318 }
3319 if (chanPtr->flags & BUFFER_READY) {
3320 if (FlushChannel(NULL, chanPtr, 0) != 0) {
3321 return -1;
3322 }
3323 }
3324 return 0;
3325 }
3326
3327 /*
3328 *---------------------------------------------------------------------------
3329 *
3330 * Tcl_Gets --
3331 *
3332 * Reads a complete line of input from the channel into a Tcl_DString.
3333 *
3334 * Results:
3335 * Length of line read (in characters) or -1 if error, EOF, or blocked.
3336 * If -1, use Tcl_GetErrno() to retrieve the POSIX error code for the
3337 * error or condition that occurred.
3338 *
3339 * Side effects:
3340 * May flush output on the channel. May cause input to be consumed
3341 * from the channel.
3342 *
3343 *---------------------------------------------------------------------------
3344 */
3345
3346 int
3347 Tcl_Gets(chan, lineRead)
3348 Tcl_Channel chan; /* Channel from which to read. */
3349 Tcl_DString *lineRead; /* The line read will be appended to this
3350 * DString as UTF-8 characters. The caller
3351 * must have initialized it and is responsible
3352 * for managing the storage. */
3353 {
3354 Tcl_Obj *objPtr;
3355 int charsStored, length;
3356 char *string;
3357
3358 objPtr = Tcl_NewObj();
3359 charsStored = Tcl_GetsObj(chan, objPtr);
3360 if (charsStored > 0) {
3361 string = Tcl_GetStringFromObj(objPtr, &length);
3362 Tcl_DStringAppend(lineRead, string, length);
3363 }
3364 Tcl_DecrRefCount(objPtr);
3365 return charsStored;
3366 }
3367
3368 /*
3369 *---------------------------------------------------------------------------
3370 *
3371 * Tcl_GetsObj --
3372 *
3373 * Accumulate input from the input channel until end-of-line or
3374 * end-of-file has been seen. Bytes read from the input channel
3375 * are converted to UTF-8 using the encoding specified by the
3376 * channel.
3377 *
3378 * Results:
3379 * Number of characters accumulated in the object or -1 if error,
3380 * blocked, or EOF. If -1, use Tcl_GetErrno() to retrieve the
3381 * POSIX error code for the error or condition that occurred.
3382 *
3383 * Side effects:
3384 * Consumes input from the channel.
3385 *
3386 * On reading EOF, leave channel pointing at EOF char.
3387 * On reading EOL, leave channel pointing after EOL, but don't
3388 * return EOL in dst buffer.
3389 *
3390 *---------------------------------------------------------------------------
3391 */
3392
3393 int
3394 Tcl_GetsObj(chan, objPtr)
3395 Tcl_Channel chan; /* Channel from which to read. */
3396 Tcl_Obj *objPtr; /* The line read will be appended to this
3397 * object as UTF-8 characters. */
3398 {
3399 GetsState gs;
3400 Channel *chanPtr;
3401 int inEofChar, skip, copiedTotal;
3402 ChannelBuffer *bufPtr;
3403 Tcl_Encoding encoding;
3404 char *dst, *dstEnd, *eol, *eof;
3405 Tcl_EncodingState oldState;
3406 int oldLength, oldFlags, oldRemoved;
3407
3408 chanPtr = (Channel *) chan;
3409 if (CheckChannelErrors(chanPtr, TCL_READABLE) != 0) {
3410 copiedTotal = -1;
3411 goto done;
3412 }
3413
3414 bufPtr = chanPtr->inQueueHead;
3415 encoding = chanPtr->encoding;
3416
3417 /*
3418 * Preserved so we can restore the channel's state in case we don't
3419 * find a newline in the available input.
3420 */
3421
3422 Tcl_GetStringFromObj(objPtr, &oldLength);
3423 oldFlags = chanPtr->inputEncodingFlags;
3424 oldState = chanPtr->inputEncodingState;
3425 oldRemoved = BUFFER_PADDING;
3426 if (bufPtr != NULL) {
3427 oldRemoved = bufPtr->nextRemoved;
3428 }
3429
3430 /*
3431 * If there is no encoding, use "iso8859-1" -- Tcl_GetsObj() doesn't
3432 * produce ByteArray objects. To avoid circularity problems,
3433 * "iso8859-1" is builtin to Tcl.
3434 */
3435
3436 if (encoding == NULL) {
3437 encoding = Tcl_GetEncoding(NULL, "iso8859-1");
3438 }
3439
3440 /*
3441 * Object used by FilterInputBytes to keep track of how much data has
3442 * been consumed from the channel buffers.
3443 */
3444
3445 gs.objPtr = objPtr;
3446 gs.dstPtr = &dst;
3447 gs.encoding = encoding;
3448 gs.bufPtr = bufPtr;
3449 gs.state = oldState;
3450 gs.rawRead = 0;
3451 gs.bytesWrote = 0;
3452 gs.charsWrote = 0;
3453 gs.totalChars = 0;
3454
3455 dst = objPtr->bytes + oldLength;
3456 dstEnd = dst;
3457
3458 skip = 0;
3459 eof = NULL;
3460 inEofChar = chanPtr->inEofChar;
3461
3462 while (1) {
3463 if (dst >= dstEnd) {
3464 if (FilterInputBytes(chanPtr, &gs) != 0) {
3465 goto restore;
3466 }
3467 dstEnd = dst + gs.bytesWrote;
3468 }
3469
3470 /*
3471 * Remember if EOF char is seen, then look for EOL anyhow, because
3472 * the EOL might be before the EOF char.
3473 */
3474
3475 if (inEofChar != '\0') {
3476 for (eol = dst; eol < dstEnd; eol++) {
3477 if (*eol == inEofChar) {
3478 dstEnd = eol;
3479 eof = eol;
3480 break;
3481 }
3482 }
3483 }
3484
3485 /*
3486 * On EOL, leave current file position pointing after the EOL, but
3487 * don't store the EOL in the output string.
3488 */
3489
3490 eol = dst;
3491 switch (chanPtr->inputTranslation) {
3492 case TCL_TRANSLATE_LF: {
3493 for (eol = dst; eol < dstEnd; eol++) {
3494 if (*eol == '\n') {
3495 skip = 1;
3496 goto goteol;
3497 }
3498 }
3499 break;
3500 }
3501 case TCL_TRANSLATE_CR: {
3502 for (eol = dst; eol < dstEnd; eol++) {
3503 if (*eol == '\r') {
3504 skip = 1;
3505 goto goteol;
3506 }
3507 }
3508 break;
3509 }
3510 case TCL_TRANSLATE_CRLF: {
3511 for (eol = dst; eol < dstEnd; eol++) {
3512 if (*eol == '\r') {
3513 eol++;
3514 if (eol >= dstEnd) {
3515 int offset;
3516
3517 offset = eol - objPtr->bytes;
3518 dst = dstEnd;
3519 if (FilterInputBytes(chanPtr, &gs) != 0) {
3520 goto restore;
3521 }
3522 dstEnd = dst + gs.bytesWrote;
3523 eol = objPtr->bytes + offset;
3524 if (eol >= dstEnd) {
3525 skip = 0;
3526 goto goteol;
3527 }
3528 }
3529 if (*eol == '\n') {
3530 eol--;
3531 skip = 2;
3532 goto goteol;
3533 }
3534 }
3535 }
3536 break;
3537 }
3538 case TCL_TRANSLATE_AUTO: {
3539 skip = 1;
3540 if (chanPtr->flags & INPUT_SAW_CR) {
3541 chanPtr->flags &= ~INPUT_SAW_CR;
3542 if (*eol == '\n') {
3543 /*
3544 * Skip the raw bytes that make up the '\n'.
3545 */
3546
3547 char tmp[1 + TCL_UTF_MAX];
3548 int rawRead;
3549
3550 bufPtr = gs.bufPtr;
3551 Tcl_ExternalToUtf(NULL, gs.encoding,
3552 bufPtr->buf + bufPtr->nextRemoved,
3553 gs.rawRead, chanPtr->inputEncodingFlags,
3554 &gs.state, tmp, 1 + TCL_UTF_MAX, &rawRead,
3555 NULL, NULL);
3556 bufPtr->nextRemoved += rawRead;
3557 gs.rawRead -= rawRead;
3558 gs.bytesWrote--;
3559 gs.charsWrote--;
3560 memmove(dst, dst + 1, (size_t) (dstEnd - dst));
3561 dstEnd--;
3562 }
3563 }
3564 for (eol = dst; eol < dstEnd; eol++) {
3565 if (*eol == '\r') {
3566 eol++;
3567 if (eol == dstEnd) {
3568 /*
3569 * If buffer ended on \r, peek ahead to see if a
3570 * \n is available.
3571 */
3572
3573 int offset;
3574
3575 offset = eol - objPtr->bytes;
3576 dst = dstEnd;
3577 PeekAhead(chanPtr, &dstEnd, &gs);
3578 eol = objPtr->bytes + offset;
3579 if (eol >= dstEnd) {
3580 eol--;
3581 chanPtr->flags |= INPUT_SAW_CR;
3582 goto goteol;
3583 }
3584 }
3585 if (*eol == '\n') {
3586 skip++;
3587 }
3588 eol--;
3589 goto goteol;
3590 } else if (*eol == '\n') {
3591 goto goteol;
3592 }
3593 }
3594 }
3595 }
3596 if (eof != NULL) {
3597 /*
3598 * EOF character was seen. On EOF, leave current file position
3599 * pointing at the EOF character, but don't store the EOF
3600 * character in the output string.
3601 */
3602
3603 dstEnd = eof;
3604 chanPtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
3605 chanPtr->inputEncodingFlags |= TCL_ENCODING_END;
3606 }
3607 if (chanPtr->flags & CHANNEL_EOF) {
3608 skip = 0;
3609 eol = dstEnd;
3610 if (eol == objPtr->bytes) {
3611 /*
3612 * If we didn't produce any bytes before encountering EOF,
3613 * caller needs to see -1.
3614 */
3615
3616 Tcl_SetObjLength(objPtr, 0);
3617 CommonGetsCleanup(chanPtr, encoding);
3618 copiedTotal = -1;
3619 goto done;
3620 }
3621 goto goteol;
3622 }
3623 dst = dstEnd;
3624 }
3625
3626 /*
3627 * Found EOL or EOF, but the output buffer may now contain too many
3628 * UTF-8 characters. We need to know how many raw bytes correspond to
3629 * the number of UTF-8 characters we want, plus how many raw bytes
3630 * correspond to the character(s) making up EOL (if any), so we can
3631 * remove the correct number of bytes from the channel buffer.
3632 */
3633
3634 goteol:
3635 bufPtr = gs.bufPtr;
3636 chanPtr->inputEncodingState = gs.state;
3637 Tcl_ExternalToUtf(NULL, gs.encoding, bufPtr->buf + bufPtr->nextRemoved,
3638 gs.rawRead, chanPtr->inputEncodingFlags,
3639 &chanPtr->inputEncodingState, dst, eol - dst + skip + TCL_UTF_MAX,
3640 &gs.rawRead, NULL, &gs.charsWrote);
3641 bufPtr->nextRemoved += gs.rawRead;
3642
3643 /*
3644 * Recycle all the emptied buffers.
3645 */
3646
3647 Tcl_SetObjLength(objPtr, eol - objPtr->bytes);
3648 CommonGetsCleanup(chanPtr, encoding);
3649 chanPtr->flags &= ~CHANNEL_BLOCKED;
3650 copiedTotal = gs.totalChars + gs.charsWrote - skip;
3651 goto done;
3652
3653 /*
3654 * Couldn't get a complete line. This only happens if we get a error
3655 * reading from the channel or we are non-blocking and there wasn't
3656 * an EOL or EOF in the data available.
3657 */
3658
3659 restore:
3660 bufPtr = chanPtr->inQueueHead;
3661 bufPtr->nextRemoved = oldRemoved;
3662
3663 for (bufPtr = bufPtr->nextPtr; bufPtr != NULL; bufPtr = bufPtr->nextPtr) {
3664 bufPtr->nextRemoved = BUFFER_PADDING;
3665 }
3666 CommonGetsCleanup(chanPtr, encoding);
3667
3668 chanPtr->inputEncodingState = oldState;
3669 chanPtr->inputEncodingFlags = oldFlags;
3670 Tcl_SetObjLength(objPtr, oldLength);
3671
3672 /*
3673 * We didn't get a complete line so we need to indicate to UpdateInterest
3674 * that the gets blocked. It will wait for more data instead of firing
3675 * a timer, avoiding a busy wait. This is where we are assuming that the
3676 * next operation is a gets. No more file events will be delivered on
3677 * this channel until new data arrives or some operation is performed
3678 * on the channel (e.g. gets, read, fconfigure) that changes the blocking
3679 * state. Note that this means a file event will not be delivered even
3680 * though a read would be able to consume the buffered data.
3681 */
3682
3683 chanPtr->flags |= CHANNEL_NEED_MORE_DATA;
3684 copiedTotal = -1;
3685
3686 done:
3687 /*
3688 * Update the notifier state so we don't block while there is still
3689 * data in the buffers.
3690 */
3691
3692 UpdateInterest(chanPtr);
3693 return copiedTotal;
3694 }
3695
3696 /*
3697 *---------------------------------------------------------------------------
3698 *
3699 * FilterInputBytes --
3700 *
3701 * Helper function for Tcl_GetsObj. Produces UTF-8 characters from
3702 * raw bytes read from the channel.
3703 *
3704 * Consumes available bytes from channel buffers. When channel
3705 * buffers are exhausted, reads more bytes from channel device into
3706 * a new channel buffer. It is the caller's responsibility to
3707 * free the channel buffers that have been exhausted.
3708 *
3709 * Results:
3710 * The return value is -1 if there was an error reading from the
3711 * channel, 0 otherwise.
3712 *
3713 * Side effects:
3714 * Status object keeps track of how much data from channel buffers
3715 * has been consumed and where UTF-8 bytes should be stored.
3716 *
3717 *---------------------------------------------------------------------------
3718 */
3719
3720 static int
3721 FilterInputBytes(chanPtr, gsPtr)
3722 Channel *chanPtr; /* Channel to read. */
3723 GetsState *gsPtr; /* Current state of gets operation. */
3724 {
3725 ChannelBuffer *bufPtr;
3726 char *raw, *rawStart, *rawEnd;
3727 char *dst;
3728 int offset, toRead, dstNeeded, spaceLeft, result, rawLen, length;
3729 Tcl_Obj *objPtr;
3730 #define ENCODING_LINESIZE 30 /* Lower bound on how many bytes to convert
3731 * at a time. Since we don't know a priori
3732 * how many bytes of storage this many source
3733 * bytes will use, we actually need at least
3734 * ENCODING_LINESIZE * TCL_MAX_UTF bytes of
3735 * room. */
3736
3737 objPtr = gsPtr->objPtr;
3738
3739 /*
3740 * Subtract the number of bytes that were removed from channel buffer
3741 * during last call.
3742 */
3743
3744 bufPtr = gsPtr->bufPtr;
3745 if (bufPtr != NULL) {
3746 bufPtr->nextRemoved += gsPtr->rawRead;
3747 if (bufPtr->nextRemoved >= bufPtr->nextAdded) {
3748 bufPtr = bufPtr->nextPtr;
3749 }
3750 }
3751 gsPtr->totalChars += gsPtr->charsWrote;
3752
3753 if ((bufPtr == NULL) || (bufPtr->nextAdded == BUFFER_PADDING)) {
3754 /*
3755 * All channel buffers were exhausted and the caller still hasn't
3756 * seen EOL. Need to read more bytes from the channel device.
3757 * Side effect is to allocate another channel buffer.
3758 */
3759
3760 read:
3761 if (chanPtr->flags & CHANNEL_BLOCKED) {
3762 if (chanPtr->flags & CHANNEL_NONBLOCKING) {
3763 gsPtr->charsWrote = 0;
3764 gsPtr->rawRead = 0;
3765 return -1;
3766 }
3767 chanPtr->flags &= ~CHANNEL_BLOCKED;
3768 }
3769 if (GetInput(chanPtr) != 0) {
3770 gsPtr->charsWrote = 0;
3771 gsPtr->rawRead = 0;
3772 return -1;
3773 }
3774 bufPtr = chanPtr->inQueueTail;
3775 gsPtr->bufPtr = bufPtr;
3776 }
3777
3778 /*
3779 * Convert some of the bytes from the channel buffer to UTF-8. Space in
3780 * objPtr's string rep is used to hold the UTF-8 characters. Grow the
3781 * string rep if we need more space.
3782 */
3783
3784 rawStart = bufPtr->buf + bufPtr->nextRemoved;
3785 raw = rawStart;
3786 rawEnd = bufPtr->buf + bufPtr->nextAdded;
3787 rawLen = rawEnd - rawStart;
3788
3789 dst = *gsPtr->dstPtr;
3790 offset = dst - objPtr->bytes;
3791 toRead = ENCODING_LINESIZE;
3792 if (toRead > rawLen) {
3793 toRead = rawLen;
3794 }
3795 dstNeeded = toRead * TCL_UTF_MAX + 1;
3796 spaceLeft = objPtr->length - offset - TCL_UTF_MAX - 1;
3797 if (dstNeeded > spaceLeft) {
3798 length = offset * 2;
3799 if (offset < dstNeeded) {
3800 length = offset + dstNeeded;
3801 }
3802 length += TCL_UTF_MAX + 1;
3803 Tcl_SetObjLength(objPtr, length);
3804 spaceLeft = length - offset;
3805 dst = objPtr->bytes + offset;
3806 *gsPtr->dstPtr = dst;
3807 }
3808 gsPtr->state = chanPtr->inputEncodingState;
3809 result = Tcl_ExternalToUtf(NULL, gsPtr->encoding, raw, rawLen,
3810 chanPtr->inputEncodingFlags, &chanPtr->inputEncodingState,
3811 dst, spaceLeft, &gsPtr->rawRead, &gsPtr->bytesWrote,
3812 &gsPtr->charsWrote);
3813 if (result == TCL_CONVERT_MULTIBYTE) {
3814 /*
3815 * The last few bytes in this channel buffer were the start of a
3816 * multibyte sequence. If this buffer was full, then move them to
3817 * the next buffer so the bytes will be contiguous.
3818 */
3819
3820 ChannelBuffer *nextPtr;
3821 int extra;
3822
3823 nextPtr = bufPtr->nextPtr;
3824 if (bufPtr->nextAdded < bufPtr->bufLength) {
3825 if (gsPtr->rawRead > 0) {
3826 /*
3827 * Some raw bytes were converted to UTF-8. Fall through,
3828 * returning those UTF-8 characters because a EOL might be
3829 * present in them.
3830 */
3831 } else if (chanPtr->flags & CHANNEL_EOF) {
3832 /*
3833 * There was a partial character followed by EOF on the
3834 * device. Fall through, returning that nothing was found.
3835 */
3836
3837 bufPtr->nextRemoved = bufPtr->nextAdded;
3838 } else {
3839 /*
3840 * There are no more cached raw bytes left. See if we can
3841 * get some more.
3842 */
3843
3844 goto read;
3845 }
3846 } else {
3847 if (nextPtr == NULL) {
3848 nextPtr = AllocChannelBuffer(chanPtr->bufSize);
3849 bufPtr->nextPtr = nextPtr;
3850 chanPtr->inQueueTail = nextPtr;
3851 }
3852 extra = rawLen - gsPtr->rawRead;
3853 memcpy((VOID *) (nextPtr->buf + BUFFER_PADDING - extra),
3854 (VOID *) (raw + gsPtr->rawRead), (size_t) extra);
3855 nextPtr->nextRemoved -= extra;
3856 bufPtr->nextAdded -= extra;
3857 }
3858 }
3859
3860 gsPtr->bufPtr = bufPtr;
3861 return 0;
3862 }
3863
3864 /*
3865 *---------------------------------------------------------------------------
3866 *
3867 * PeekAhead --
3868 *
3869 * Helper function used by Tcl_GetsObj(). Called when we've seen a
3870 * \r at the end of the UTF-8 string and want to look ahead one
3871 * character to see if it is a \n.
3872 *
3873 * Results:
3874 * *gsPtr->dstPtr is filled with a pointer to the start of the range of
3875 * UTF-8 characters that were found by peeking and *dstEndPtr is filled
3876 * with a pointer to the bytes just after the end of the range.
3877 *
3878 * Side effects:
3879 * If no more raw bytes were available in one of the channel buffers,
3880 * tries to perform a non-blocking read to get more bytes from the
3881 * channel device.
3882 *
3883 *---------------------------------------------------------------------------
3884 */
3885
3886 static void
3887 PeekAhead(chanPtr, dstEndPtr, gsPtr)
3888 Channel *chanPtr; /* The channel to read. */
3889 char **dstEndPtr; /* Filled with pointer to end of new range
3890 * of UTF-8 characters. */
3891 GetsState *gsPtr; /* Current state of gets operation. */
3892 {
3893 ChannelBuffer *bufPtr;
3894 Tcl_DriverBlockModeProc *blockModeProc;
3895 int bytesLeft;
3896
3897 bufPtr = gsPtr->bufPtr;
3898
3899 /*
3900 * If there's any more raw input that's still buffered, we'll peek into
3901 * that. Otherwise, only get more data from the channel driver if it
3902 * looks like there might actually be more data. The assumption is that
3903 * if the channel buffer is filled right up to the end, then there
3904 * might be more data to read.
3905 */
3906
3907 blockModeProc = NULL;
3908 if (bufPtr->nextPtr == NULL) {
3909 bytesLeft = bufPtr->nextAdded - (bufPtr->nextRemoved + gsPtr->rawRead);
3910 if (bytesLeft == 0) {
3911 if (bufPtr->nextAdded < bufPtr->bufLength) {
3912 /*
3913 * Don't peek ahead if last read was short read.
3914 */
3915
3916 goto cleanup;
3917 }
3918 if ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0) {
3919 blockModeProc = chanPtr->typePtr->blockModeProc;
3920 if (blockModeProc == NULL) {
3921 /*
3922 * Don't peek ahead if cannot set non-blocking mode.
3923 */
3924
3925 goto cleanup;
3926 }
3927 (*blockModeProc)(chanPtr->instanceData, TCL_MODE_NONBLOCKING);
3928 }
3929 }
3930 }
3931 if (FilterInputBytes(chanPtr, gsPtr) == 0) {
3932 *dstEndPtr = *gsPtr->dstPtr + gsPtr->bytesWrote;
3933 }
3934 if (blockModeProc != NULL) {
3935 (*blockModeProc)(chanPtr->instanceData, TCL_MODE_BLOCKING);
3936 }
3937 return;
3938
3939 cleanup:
3940 bufPtr->nextRemoved += gsPtr->rawRead;
3941 gsPtr->rawRead = 0;
3942 gsPtr->totalChars += gsPtr->charsWrote;
3943 gsPtr->bytesWrote = 0;
3944 gsPtr->charsWrote = 0;
3945 }
3946
3947 /*
3948 *---------------------------------------------------------------------------
3949 *
3950 * CommonGetsCleanup --
3951 *
3952 * Helper function for Tcl_GetsObj() to restore the channel after
3953 * a "gets" operation.
3954 *
3955 * Results:
3956 * None.
3957 *
3958 * Side effects:
3959 * Encoding may be freed.
3960 *
3961 *---------------------------------------------------------------------------
3962 */
3963
3964 static void
3965 CommonGetsCleanup(chanPtr, encoding)
3966 Channel *chanPtr;
3967 Tcl_Encoding encoding;
3968 {
3969 ChannelBuffer *bufPtr, *nextPtr;
3970
3971 bufPtr = chanPtr->inQueueHead;
3972 for ( ; bufPtr != NULL; bufPtr = nextPtr) {
3973 nextPtr = bufPtr->nextPtr;
3974 if (bufPtr->nextRemoved < bufPtr->nextAdded) {
3975 break;
3976 }
3977 RecycleBuffer(chanPtr, bufPtr, 0);
3978 }
3979 chanPtr->inQueueHead = bufPtr;
3980 if (bufPtr == NULL) {
3981 chanPtr->inQueueTail = NULL;
3982 } else {
3983 /*
3984 * If any multi-byte characters were split across channel buffer
3985 * boundaries, the split-up bytes were moved to the next channel
3986 * buffer by FilterInputBytes(). Move the bytes back to their
3987 * original buffer because the caller could change the channel's
3988 * encoding which could change the interpretation of whether those
3989 * bytes really made up multi-byte characters after all.
3990 */
3991
3992 nextPtr = bufPtr->nextPtr;
3993 for ( ; nextPtr != NULL; nextPtr = bufPtr->nextPtr) {
3994 int extra;
3995
3996 extra = bufPtr->bufLength - bufPtr->nextAdded;
3997 if (extra > 0) {
3998 memcpy((VOID *) (bufPtr->buf + bufPtr->nextAdded),
3999 (VOID *) (nextPtr->buf + BUFFER_PADDING - extra),
4000 (size_t) extra);
4001 bufPtr->nextAdded += extra;
4002 nextPtr->nextRemoved = BUFFER_PADDING;
4003 }
4004 bufPtr = nextPtr;
4005 }
4006 }
4007 if (chanPtr->encoding == NULL) {
4008 Tcl_FreeEncoding(encoding);
4009 }
4010 }
4011
4012 /*
4013 *----------------------------------------------------------------------
4014 *
4015 * Tcl_Read --
4016 *
4017 * Reads a given number of bytes from a channel. EOL and EOF
4018 * translation is done on the bytes being read, so the the number
4019 * of bytes consumed from the channel may not be equal to the
4020 * number of bytes stored in the destination buffer.
4021 *
4022 * No encoding conversions are applied to the bytes being read.
4023 *
4024 * Results:
4025 * The number of bytes read, or -1 on error. Use Tcl_GetErrno()
4026 * to retrieve the error code for the error that occurred.
4027 *
4028 * Side effects:
4029 * May cause input to be buffered.
4030 *
4031 *----------------------------------------------------------------------
4032 */
4033
4034 int
4035 Tcl_Read(chan, dst, bytesToRead)
4036 Tcl_Channel chan; /* The channel from which to read. */
4037 char *dst; /* Where to store input read. */
4038 int bytesToRead; /* Maximum number of bytes to read. */
4039 {
4040 Channel *chanPtr;
4041
4042 chanPtr = (Channel *) chan;
4043 if (CheckChannelErrors(chanPtr, TCL_READABLE) != 0) {
4044 return -1;
4045 }
4046
4047 return DoRead(chanPtr, dst, bytesToRead);
4048 }
4049
4050 /*
4051 *---------------------------------------------------------------------------
4052 *
4053 * Tcl_ReadChars --
4054 *
4055 * Reads from the channel until the requested number of characters
4056 * have been seen, EOF is seen, or the channel would block. EOL
4057 * and EOF translation is done. If reading binary data, the raw
4058 * bytes are wrapped in a Tcl byte array object. Otherwise, the raw
4059 * bytes are converted to UTF-8 using the channel's current encoding
4060 * and stored in a Tcl string object.
4061 *
4062 * Results:
4063 * The number of characters read, or -1 on error. Use Tcl_GetErrno()
4064 * to retrieve the error code for the error that occurred.
4065 *
4066 * Side effects:
4067 * May cause input to be buffered.
4068 *
4069 *---------------------------------------------------------------------------
4070 */
4071
4072 int
4073 Tcl_ReadChars(chan, objPtr, toRead, appendFlag)
4074 Tcl_Channel chan; /* The channel to read. */
4075 Tcl_Obj *objPtr; /* Input data is stored in this object. */
4076 int toRead; /* Maximum number of characters to store,
4077 * or -1 to read all available data (up to EOF
4078 * or when channel blocks). */
4079 int appendFlag; /* If non-zero, data read from the channel
4080 * will be appended to the object. Otherwise,
4081 * the data will replace the existing contents
4082 * of the object. */
4083
4084 {
4085 Channel *chanPtr;
4086 int offset, factor, copied, copiedNow, result;
4087 ChannelBuffer *bufPtr;
4088 Tcl_Encoding encoding;
4089 #define UTF_EXPANSION_FACTOR 1024
4090
4091 chanPtr = (Channel *) chan;
4092 if (CheckChannelErrors(chanPtr, TCL_READABLE) != 0) {
4093 copied = -1;
4094 goto done;
4095 }
4096
4097 encoding = chanPtr->encoding;
4098 factor = UTF_EXPANSION_FACTOR;
4099
4100 if (appendFlag == 0) {
4101 if (encoding == NULL) {
4102 Tcl_SetByteArrayLength(objPtr, 0);
4103 } else {
4104 Tcl_SetObjLength(objPtr, 0);
4105 }
4106 offset = 0;
4107 } else {
4108 if (encoding == NULL) {
4109 Tcl_GetByteArrayFromObj(objPtr, &offset);
4110 } else {
4111 Tcl_GetStringFromObj(objPtr, &offset);
4112 }
4113 }
4114
4115 for (copied = 0; (unsigned) toRead > 0; ) {
4116 copiedNow = -1;
4117 if (chanPtr->inQueueHead != NULL) {
4118 if (encoding == NULL) {
4119 copiedNow = ReadBytes(chanPtr, objPtr, toRead, &offset);
4120 } else {
4121 copiedNow = ReadChars(chanPtr, objPtr, toRead, &offset,
4122 &factor);
4123 }
4124
4125 /*
4126 * If the current buffer is empty recycle it.
4127 */
4128
4129 bufPtr = chanPtr->inQueueHead;
4130 if (bufPtr->nextRemoved == bufPtr->nextAdded) {
4131 ChannelBuffer *nextPtr;
4132
4133 nextPtr = bufPtr->nextPtr;
4134 RecycleBuffer(chanPtr, bufPtr, 0);
4135 chanPtr->inQueueHead = nextPtr;
4136 if (nextPtr == NULL) {
4137 chanPtr->inQueueTail = nextPtr;
4138 }
4139 }
4140 }
4141 if (copiedNow < 0) {
4142 if (chanPtr->flags & CHANNEL_EOF) {
4143 break;
4144 }
4145 if (chanPtr->flags & CHANNEL_BLOCKED) {
4146 if (chanPtr->flags & CHANNEL_NONBLOCKING) {
4147 break;
4148 }
4149 chanPtr->flags &= ~CHANNEL_BLOCKED;
4150 }
4151 result = GetInput(chanPtr);
4152 if (result != 0) {
4153 if (result == EAGAIN) {
4154 break;
4155 }
4156 copied = -1;
4157 goto done;
4158 }
4159 } else {
4160 copied += copiedNow;
4161 toRead -= copiedNow;
4162 }
4163 }
4164 chanPtr->flags &= ~CHANNEL_BLOCKED;
4165 if (encoding == NULL) {
4166 Tcl_SetByteArrayLength(objPtr, offset);
4167 } else {
4168 Tcl_SetObjLength(objPtr, offset);
4169 }
4170
4171 done:
4172 /*
4173 * Update the notifier state so we don't block while there is still
4174 * data in the buffers.
4175 */
4176
4177 UpdateInterest(chanPtr);
4178 return copied;
4179 }
4180 /*
4181 *---------------------------------------------------------------------------
4182 *
4183 * ReadBytes --
4184 *
4185 * Reads from the channel until the requested number of bytes have
4186 * been seen, EOF is seen, or the channel would block. Bytes from
4187 * the channel are stored in objPtr as a ByteArray object. EOL
4188 * and EOF translation are done.
4189 *
4190 * 'bytesToRead' can safely be a very large number because
4191 * space is only allocated to hold data read from the channel
4192 * as needed.
4193 *
4194 * Results:
4195 * The return value is the number of bytes appended to the object
4196 * and *offsetPtr is filled with the total number of bytes in the
4197 * object (greater than the return value if there were already bytes
4198 * in the object).
4199 *
4200 * Side effects:
4201 * None.
4202 *
4203 *---------------------------------------------------------------------------
4204 */
4205
4206 static int
4207 ReadBytes(chanPtr, objPtr, bytesToRead, offsetPtr)
4208 Channel *chanPtr; /* The channel to read. */
4209 int bytesToRead; /* Maximum number of characters to store,
4210 * or < 0 to get all available characters.
4211 * Characters are obtained from the first
4212 * buffer in the queue -- even if this number
4213 * is larger than the number of characters
4214 * available in the first buffer, only the
4215 * characters from the first buffer are
4216 * returned. */
4217 Tcl_Obj *objPtr; /* Input data is appended to this ByteArray
4218 * object. Its length is how much space
4219 * has been allocated to hold data, not how
4220 * many bytes of data have been stored in the
4221 * object. */
4222 int *offsetPtr; /* On input, contains how many bytes of
4223 * objPtr have been used to hold data. On
4224 * output, filled with how many bytes are now
4225 * being used. */
4226 {
4227 int toRead, srcLen, srcRead, dstWrote, offset, length;
4228 ChannelBuffer *bufPtr;
4229 char *src, *dst;
4230
4231 offset = *offsetPtr;
4232
4233 bufPtr = chanPtr->inQueueHead;
4234 src = bufPtr->buf + bufPtr->nextRemoved;
4235 srcLen = bufPtr->nextAdded - bufPtr->nextRemoved;
4236
4237 toRead = bytesToRead;
4238 if ((unsigned) toRead > (unsigned) srcLen) {
4239 toRead = srcLen;
4240 }
4241
4242 dst = (char *) Tcl_GetByteArrayFromObj(objPtr, &length);
4243 if (toRead > length - offset - 1) {
4244 /*
4245 * Double the existing size of the object or make enough room to
4246 * hold all the characters we may get from the source buffer,
4247 * whichever is larger.
4248 */
4249
4250 length = offset * 2;
4251 if (offset < toRead) {
4252 length = offset + toRead + 1;
4253 }
4254 dst = (char *) Tcl_SetByteArrayLength(objPtr, length);
4255 }
4256 dst += offset;
4257
4258 if (chanPtr->flags & INPUT_NEED_NL) {
4259 chanPtr->flags &= ~INPUT_NEED_NL;
4260 if ((srcLen == 0) || (*src != '\n')) {
4261 *dst = '\r';
4262 *offsetPtr += 1;
4263 return 1;
4264 }
4265 *dst++ = '\n';
4266 src++;
4267 srcLen--;
4268 toRead--;
4269 }
4270
4271 srcRead = srcLen;
4272 dstWrote = toRead;
4273 if (TranslateInputEOL(chanPtr, dst, src, &dstWrote, &srcRead) != 0) {
4274 if (dstWrote == 0) {
4275 return -1;
4276 }
4277 }
4278 bufPtr->nextRemoved += srcRead;
4279 *offsetPtr += dstWrote;
4280 return dstWrote;
4281 }
4282
4283 /*
4284 *---------------------------------------------------------------------------
4285 *
4286 * ReadChars --
4287 *
4288 * Reads from the channel until the requested number of UTF-8
4289 * characters have been seen, EOF is seen, or the channel would
4290 * block. Raw bytes from the channel are converted to UTF-8
4291 * and stored in objPtr. EOL and EOF translation is done.
4292 *
4293 * 'charsToRead' can safely be a very large number because
4294 * space is only allocated to hold data read from the channel
4295 * as needed.
4296 *
4297 * Results:
4298 * The return value is the number of characters appended to
4299 * the object, *offsetPtr is filled with the number of bytes that
4300 * were appended, and *factorPtr is filled with the expansion
4301 * factor used to guess how many bytes of UTF-8 to allocate to
4302 * hold N source bytes.
4303 *
4304 * Side effects:
4305 * None.
4306 *
4307 *---------------------------------------------------------------------------
4308 */
4309
4310 static int
4311 ReadChars(chanPtr, objPtr, charsToRead, offsetPtr, factorPtr)
4312 Channel *chanPtr; /* The channel to read. */
4313 int charsToRead; /* Maximum number of characters to store,
4314 * or -1 to get all available characters.
4315 * Characters are obtained from the first
4316 * buffer in the queue -- even if this number
4317 * is larger than the number of characters
4318 * available in the first buffer, only the
4319 * characters from the first buffer are
4320 * returned. */
4321 Tcl_Obj *objPtr; /* Input data is appended to this object.
4322 * objPtr->length is how much space has been
4323 * allocated to hold data, not how many bytes
4324 * of data have been stored in the object. */
4325 int *offsetPtr; /* On input, contains how many bytes of
4326 * objPtr have been used to hold data. On
4327 * output, filled with how many bytes are now
4328 * being used. */
4329 int *factorPtr; /* On input, contains a guess of how many
4330 * bytes need to be allocated to hold the
4331 * result of converting N source bytes to
4332 * UTF-8. On output, contains another guess
4333 * based on the data seen so far. */
4334 {
4335 int toRead, factor, offset, spaceLeft, length;
4336 int srcLen, srcRead, dstNeeded, dstRead, dstWrote, numChars;
4337 ChannelBuffer *bufPtr;
4338 char *src, *dst;
4339 Tcl_EncodingState oldState;
4340
4341 factor = *factorPtr;
4342 offset = *offsetPtr;
4343
4344 bufPtr = chanPtr->inQueueHead;
4345 src = bufPtr->buf + bufPtr->nextRemoved;
4346 srcLen = bufPtr->nextAdded - bufPtr->nextRemoved;
4347
4348 toRead = charsToRead;
4349 if ((unsigned) toRead > (unsigned) srcLen) {
4350 toRead = srcLen;
4351 }
4352
4353 /*
4354 * 'factor' is how much we guess that the bytes in the source buffer
4355 * will expand when converted to UTF-8 chars. This guess comes from
4356 * analyzing how many characters were produced by the previous
4357 * pass.
4358 */
4359
4360 dstNeeded = toRead * factor / UTF_EXPANSION_FACTOR;
4361 spaceLeft = objPtr->length - offset - TCL_UTF_MAX - 1;
4362
4363 if (dstNeeded > spaceLeft) {
4364 /*
4365 * Double the existing size of the object or make enough room to
4366 * hold all the characters we want from the source buffer,
4367 * whichever is larger.
4368 */
4369
4370 length = offset * 2;
4371 if (offset < dstNeeded) {
4372 length = offset + dstNeeded;
4373 }
4374 spaceLeft = length - offset;
4375 length += TCL_UTF_MAX + 1;
4376 Tcl_SetObjLength(objPtr, length);
4377 }
4378 if (toRead == srcLen) {
4379 /*
4380 * Want to convert the whole buffer in one pass. If we have
4381 * enough space, convert it using all available space in object
4382 * rather than using the factor.
4383 */
4384
4385 dstNeeded = spaceLeft;
4386 }
4387 dst = objPtr->bytes + offset;
4388
4389 oldState = chanPtr->inputEncodingState;
4390 if (chanPtr->flags & INPUT_NEED_NL) {
4391 /*
4392 * We want a '\n' because the last character we saw was '\r'.
4393 */
4394
4395 chanPtr->flags &= ~INPUT_NEED_NL;
4396 Tcl_ExternalToUtf(NULL, chanPtr->encoding, src, srcLen,
4397 chanPtr->inputEncodingFlags, &chanPtr->inputEncodingState,
4398 dst, TCL_UTF_MAX + 1, &srcRead, &dstWrote, &numChars);
4399 if ((dstWrote > 0) && (*dst == '\n')) {
4400 /*
4401 * The next char was a '\n'. Consume it and produce a '\n'.
4402 */
4403
4404 bufPtr->nextRemoved += srcRead;
4405 } else {
4406 /*
4407 * The next char was not a '\n'. Produce a '\r'.
4408 */
4409
4410 *dst = '\r';
4411 }
4412 chanPtr->inputEncodingFlags &= ~TCL_ENCODING_START;
4413 *offsetPtr += 1;
4414 return 1;
4415 }
4416
4417 Tcl_ExternalToUtf(NULL, chanPtr->encoding, src, srcLen,
4418 chanPtr->inputEncodingFlags, &chanPtr->inputEncodingState, dst,
4419 dstNeeded + TCL_UTF_MAX, &srcRead, &dstWrote, &numChars);
4420 if (srcRead == 0) {
4421 /*
4422 * Not enough bytes in src buffer to make a complete char. Copy
4423 * the bytes to the next buffer to make a new contiguous string,
4424 * then tell the caller to fill the buffer with more bytes.
4425 */
4426
4427 ChannelBuffer *nextPtr;
4428
4429 nextPtr = bufPtr->nextPtr;
4430 if (nextPtr == NULL) {
4431 /*
4432 * There isn't enough data in the buffers to complete the next
4433 * character, so we need to wait for more data before the next
4434 * file event can be delivered.
4435 */
4436
4437 chanPtr->flags |= CHANNEL_NEED_MORE_DATA;
4438 return -1;
4439 }
4440 nextPtr->nextRemoved -= srcLen;
4441 memcpy((VOID *) (nextPtr->buf + nextPtr->nextRemoved), (VOID *) src,
4442 (size_t) srcLen);
4443 RecycleBuffer(chanPtr, bufPtr, 0);
4444 chanPtr->inQueueHead = nextPtr;
4445 return ReadChars(chanPtr, objPtr, charsToRead, offsetPtr, factorPtr);
4446 }
4447
4448 dstRead = dstWrote;
4449 if (TranslateInputEOL(chanPtr, dst, dst, &dstWrote, &dstRead) != 0) {
4450 /*
4451 * Hit EOF char. How many bytes of src correspond to where the
4452 * EOF was located in dst?
4453 */
4454
4455 if (dstWrote == 0) {
4456 return -1;
4457 }
4458 chanPtr->inputEncodingState = oldState;
4459 Tcl_ExternalToUtf(NULL, chanPtr->encoding, src, srcLen,
4460 chanPtr->inputEncodingFlags, &chanPtr->inputEncodingState,
4461 dst, dstRead + TCL_UTF_MAX, &srcRead, &dstWrote, &numChars);
4462 TranslateInputEOL(chanPtr, dst, dst, &dstWrote, &dstRead);
4463 }
4464
4465 /*
4466 * The number of characters that we got may be less than the number
4467 * that we started with because "\r\n" sequences may have been
4468 * turned into just '\n' in dst.
4469 */
4470
4471 numChars -= (dstRead - dstWrote);
4472
4473 if ((unsigned) numChars > (unsigned) toRead) {
4474 /*
4475 * Got too many chars.
4476 */
4477
4478 char *eof;
4479
4480 eof = Tcl_UtfAtIndex(dst, toRead);
4481 chanPtr->inputEncodingState = oldState;
4482 Tcl_ExternalToUtf(NULL, chanPtr->encoding, src, srcLen,
4483 chanPtr->inputEncodingFlags, &chanPtr->inputEncodingState,
4484 dst, eof - dst + TCL_UTF_MAX, &srcRead, &dstWrote, &numChars);
4485 dstRead = dstWrote;
4486 TranslateInputEOL(chanPtr, dst, dst, &dstWrote, &dstRead);
4487 numChars -= (dstRead - dstWrote);
4488 }
4489 chanPtr->inputEncodingFlags &= ~TCL_ENCODING_START;
4490
4491 bufPtr->nextRemoved += srcRead;
4492 if (dstWrote > srcRead + 1) {
4493 *factorPtr = dstWrote * UTF_EXPANSION_FACTOR / srcRead;
4494 }
4495 *offsetPtr += dstWrote;
4496 return numChars;
4497 }
4498
4499 /*
4500 *---------------------------------------------------------------------------
4501 *
4502 * TranslateInputEOL --
4503 *
4504 * Perform input EOL and EOF translation on the source buffer,
4505 * leaving the translated result in the destination buffer.
4506 *
4507 * Results:
4508 * The return value is 1 if the EOF character was found when copying
4509 * bytes to the destination buffer, 0 otherwise.
4510 *
4511 * Side effects:
4512 * None.
4513 *
4514 *---------------------------------------------------------------------------
4515 */
4516
4517 static int
4518 TranslateInputEOL(chanPtr, dstStart, srcStart, dstLenPtr, srcLenPtr)
4519 Channel *chanPtr; /* Channel being read, for EOL translation
4520 * and EOF character. */
4521 char *dstStart; /* Output buffer filled with chars by
4522 * applying appropriate EOL translation to
4523 * source characters. */
4524 CONST char *srcStart; /* Source characters. */
4525 int *dstLenPtr; /* On entry, the maximum length of output
4526 * buffer in bytes; must be <= *srcLenPtr. On
4527 * exit, the number of bytes actually used in
4528 * output buffer. */
4529 int *srcLenPtr; /* On entry, the length of source buffer.
4530 * On exit, the number of bytes read from
4531 * the source buffer. */
4532 {
4533 int dstLen, srcLen, inEofChar;
4534 CONST char *eof;
4535
4536 dstLen = *dstLenPtr;
4537
4538 eof = NULL;
4539 inEofChar = chanPtr->inEofChar;
4540 if (inEofChar != '\0') {
4541 /*
4542 * Find EOF in translated buffer then compress out the EOL. The
4543 * source buffer may be much longer than the destination buffer --
4544 * we only want to return EOF if the EOF has been copied to the
4545 * destination buffer.
4546 */
4547
4548 CONST char *src, *srcMax;
4549
4550 srcMax = srcStart + *srcLenPtr;
4551 for (src = srcStart; src < srcMax; src++) {
4552 if (*src == inEofChar) {
4553 eof = src;
4554 srcLen = src - srcStart;
4555 if (srcLen < dstLen) {
4556 dstLen = srcLen;
4557 }
4558 *srcLenPtr = srcLen;
4559 break;
4560 }
4561 }
4562 }
4563 switch (chanPtr->inputTranslation) {
4564 case TCL_TRANSLATE_LF: {
4565 if (dstStart != srcStart) {
4566 memcpy((VOID *) dstStart, (VOID *) srcStart, (size_t) dstLen);
4567 }
4568 srcLen = dstLen;
4569 break;
4570 }
4571 case TCL_TRANSLATE_CR: {
4572 char *dst, *dstEnd;
4573
4574 if (dstStart != srcStart) {
4575 memcpy((VOID *) dstStart, (VOID *) srcStart, (size_t) dstLen);
4576 }
4577 dstEnd = dstStart + dstLen;
4578 for (dst = dstStart; dst < dstEnd; dst++) {
4579 if (*dst == '\r') {
4580 *dst = '\n';
4581 }
4582 }
4583 srcLen = dstLen;
4584 break;
4585 }
4586 case TCL_TRANSLATE_CRLF: {
4587 char *dst;
4588 CONST char *src, *srcEnd, *srcMax;
4589
4590 dst = dstStart;
4591 src = srcStart;
4592 srcEnd = srcStart + dstLen;
4593 srcMax = srcStart + *srcLenPtr;
4594
4595 for ( ; src < srcEnd; ) {
4596 if (*src == '\r') {
4597 src++;
4598 if (src >= srcMax) {
4599 chanPtr->flags |= INPUT_NEED_NL;
4600 } else if (*src == '\n') {
4601 *dst++ = *src++;
4602 } else {
4603 *dst++ = '\r';
4604 }
4605 } else {
4606 *dst++ = *src++;
4607 }
4608 }
4609 srcLen = src - srcStart;
4610 dstLen = dst - dstStart;
4611 break;
4612 }
4613 case TCL_TRANSLATE_AUTO: {
4614 char *dst;
4615 CONST char *src, *srcEnd, *srcMax;
4616
4617 dst = dstStart;
4618 src = srcStart;
4619 srcEnd = srcStart + dstLen;
4620 srcMax = srcStart + *srcLenPtr;
4621
4622 if ((chanPtr->flags & INPUT_SAW_CR) && (src < srcMax)) {
4623 if (*src == '\n') {
4624 src++;
4625 }
4626 chanPtr->flags &= ~INPUT_SAW_CR;
4627 }
4628 for ( ; src < srcEnd; ) {
4629 if (*src == '\r') {
4630 src++;
4631 if (src >= srcMax) {
4632 chanPtr->flags |= INPUT_SAW_CR;
4633 } else if (*src == '\n') {
4634 if (srcEnd < srcMax) {
4635 srcEnd++;
4636 }
4637 src++;
4638 }
4639 *dst++ = '\n';
4640 } else {
4641 *dst++ = *src++;
4642 }
4643 }
4644 srcLen = src - srcStart;
4645 dstLen = dst - dstStart;
4646 break;
4647 }
4648 default: { /* lint. */
4649 return 0;
4650 }
4651 }
4652 *dstLenPtr = dstLen;
4653
4654 if ((eof != NULL) && (srcStart + srcLen >= eof)) {
4655 /*
4656 * EOF character was seen in EOL translated range. Leave current
4657 * file position pointing at the EOF character, but don't store the
4658 * EOF character in the output string.
4659 */
4660
4661 chanPtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
4662 chanPtr->inputEncodingFlags |= TCL_ENCODING_END;
4663 chanPtr->flags &= ~(INPUT_SAW_CR | INPUT_NEED_NL);
4664 return 1;
4665 }
4666
4667 *srcLenPtr = srcLen;
4668 return 0;
4669 }
4670
4671 /*
4672 *----------------------------------------------------------------------
4673 *
4674 * Tcl_Ungets --
4675 *
4676 * Causes the supplied string to be added to the input queue of
4677 * the channel, at either the head or tail of the queue.
4678 *
4679 * Results:
4680 * The number of bytes stored in the channel, or -1 on error.
4681 *
4682 * Side effects:
4683 * Adds input to the input queue of a channel.
4684 *
4685 *----------------------------------------------------------------------
4686 */
4687
4688 int
4689 Tcl_Ungets(chan, str, len, atEnd)
4690 Tcl_Channel chan; /* The channel for which to add the input. */
4691 char *str; /* The input itself. */
4692 int len; /* The length of the input. */
4693 int atEnd; /* If non-zero, add at end of queue; otherwise
4694 * add at head of queue. */
4695 {
4696 Channel *chanPtr; /* The real IO channel. */
4697 ChannelBuffer *bufPtr; /* Buffer to contain the data. */
4698 int i, flags;
4699
4700 chanPtr = (Channel *) chan;
4701
4702 /*
4703 * CheckChannelErrors clears too many flag bits in this one case.
4704 */
4705
4706 flags = chanPtr->flags;
4707 if (CheckChannelErrors(chanPtr, TCL_READABLE) != 0) {
4708 len = -1;
4709 goto done;
4710 }
4711 chanPtr->flags = flags;
4712
4713 /*
4714 * If we have encountered a sticky EOF, just punt without storing.
4715 * (sticky EOF is set if we have seen the input eofChar, to prevent
4716 * reading beyond the eofChar). Otherwise, clear the EOF flags, and
4717 * clear the BLOCKED bit. We want to discover these conditions anew
4718 * in each operation.
4719 */
4720
4721 if (chanPtr->flags & CHANNEL_STICKY_EOF) {
4722 goto done;
4723 }
4724 chanPtr->flags &= (~(CHANNEL_BLOCKED | CHANNEL_EOF));
4725
4726 bufPtr = AllocChannelBuffer(len);
4727 for (i = 0; i < len; i++) {
4728 bufPtr->buf[i] = str[i];
4729 }
4730 bufPtr->nextAdded += len;
4731
4732 if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
4733 bufPtr->nextPtr = (ChannelBuffer *) NULL;
4734 chanPtr->inQueueHead = bufPtr;
4735 chanPtr->inQueueTail = bufPtr;
4736 } else if (atEnd) {
4737 bufPtr->nextPtr = (ChannelBuffer *) NULL;
4738 chanPtr->inQueueTail->nextPtr = bufPtr;
4739 chanPtr->inQueueTail = bufPtr;
4740 } else {
4741 bufPtr->nextPtr = chanPtr->inQueueHead;
4742 chanPtr->inQueueHead = bufPtr;
4743 }
4744
4745 done:
4746 /*
4747 * Update the notifier state so we don't block while there is still
4748 * data in the buffers.
4749 */
4750
4751 UpdateInterest(chanPtr);
4752 return len;
4753 }
4754
4755 /*
4756 *----------------------------------------------------------------------
4757 *
4758 * Tcl_Flush --
4759 *
4760 * Flushes output data on a channel.
4761 *
4762 * Results:
4763 * A standard Tcl result.
4764 *
4765 * Side effects:
4766 * May flush output queued on this channel.
4767 *
4768 *----------------------------------------------------------------------
4769 */
4770
4771 int
4772 Tcl_Flush(chan)
4773 Tcl_Channel chan; /* The Channel to flush. */
4774 {
4775 int result; /* Of calling FlushChannel. */
4776 Channel *chanPtr; /* The actual channel. */
4777
4778 chanPtr = (Channel *) chan;
4779 if (CheckChannelErrors(chanPtr, TCL_WRITABLE) != 0) {
4780 return -1;
4781 }
4782
4783 /*
4784 * Force current output buffer to be output also.
4785 */
4786
4787 if ((chanPtr->curOutPtr != NULL)
4788 && (chanPtr->curOutPtr->nextAdded > 0)) {
4789 chanPtr->flags |= BUFFER_READY;
4790 }
4791
4792 result = FlushChannel(NULL, chanPtr, 0);
4793 if (result != 0) {
4794 return TCL_ERROR;
4795 }
4796
4797 return TCL_OK;
4798 }
4799
4800 /*
4801 *----------------------------------------------------------------------
4802 *
4803 * DiscardInputQueued --
4804 *
4805 * Discards any input read from the channel but not yet consumed
4806 * by Tcl reading commands.
4807 *
4808 * Results:
4809 * None.
4810 *
4811 * Side effects:
4812 * May discard input from the channel. If discardLastBuffer is zero,
4813 * leaves one buffer in place for back-filling.
4814 *
4815 *----------------------------------------------------------------------
4816 */
4817
4818 static void
4819 DiscardInputQueued(chanPtr, discardSavedBuffers)
4820 Channel *chanPtr; /* Channel on which to discard
4821 * the queued input. */
4822 int discardSavedBuffers; /* If non-zero, discard all buffers including
4823 * last one. */
4824 {
4825 ChannelBuffer *bufPtr, *nxtPtr; /* Loop variables. */
4826
4827 bufPtr = chanPtr->inQueueHead;
4828 chanPtr->inQueueHead = (ChannelBuffer *) NULL;
4829 chanPtr->inQueueTail = (ChannelBuffer *) NULL;
4830 for (; bufPtr != (ChannelBuffer *) NULL; bufPtr = nxtPtr) {
4831 nxtPtr = bufPtr->nextPtr;
4832 RecycleBuffer(chanPtr, bufPtr, discardSavedBuffers);
4833 }
4834
4835 /*
4836 * If discardSavedBuffers is nonzero, must also discard any previously
4837 * saved buffer in the saveInBufPtr field.
4838 */
4839
4840 if (discardSavedBuffers) {
4841 if (chanPtr->saveInBufPtr != (ChannelBuffer *) NULL) {
4842 ckfree((char *) chanPtr->saveInBufPtr);
4843 chanPtr->saveInBufPtr = (ChannelBuffer *) NULL;
4844 }
4845 }
4846 }
4847
4848 /*
4849 *---------------------------------------------------------------------------
4850 *
4851 * GetInput --
4852 *
4853 * Reads input data from a device into a channel buffer.
4854 *
4855 * Results:
4856 * The return value is the Posix error code if an error occurred while
4857 * reading from the file, or 0 otherwise.
4858 *
4859 * Side effects:
4860 * Reads from the underlying device.
4861 *
4862 *---------------------------------------------------------------------------
4863 */
4864
4865 static int
4866 GetInput(chanPtr)
4867 Channel *chanPtr; /* Channel to read input from. */
4868 {
4869 int toRead; /* How much to read? */
4870 int result; /* Of calling driver. */
4871 int nread; /* How much was read from channel? */
4872 ChannelBuffer *bufPtr; /* New buffer to add to input queue. */
4873
4874 /*
4875 * Prevent reading from a dead channel -- a channel that has been closed
4876 * but not yet deallocated, which can happen if the exit handler for
4877 * channel cleanup has run but the channel is still registered in some
4878 * interpreter.
4879 */
4880
4881 if (CheckForDeadChannel(NULL, chanPtr)) {
4882 return EINVAL;
4883 }
4884
4885 /*
4886 * See if we can fill an existing buffer. If we can, read only
4887 * as much as will fit in it. Otherwise allocate a new buffer,
4888 * add it to the input queue and attempt to fill it to the max.
4889 */
4890
4891 bufPtr = chanPtr->inQueueTail;
4892 if ((bufPtr != NULL) && (bufPtr->nextAdded < bufPtr->bufLength)) {
4893 toRead = bufPtr->bufLength - bufPtr->nextAdded;
4894 } else {
4895 bufPtr = chanPtr->saveInBufPtr;
4896 chanPtr->saveInBufPtr = NULL;
4897 if (bufPtr == NULL) {
4898 bufPtr = AllocChannelBuffer(chanPtr->bufSize);
4899 }
4900 bufPtr->nextPtr = (ChannelBuffer *) NULL;
4901
4902 toRead = chanPtr->bufSize;
4903 if (chanPtr->inQueueTail == NULL) {
4904 chanPtr->inQueueHead = bufPtr;
4905 } else {
4906 chanPtr->inQueueTail->nextPtr = bufPtr;
4907 }
4908 chanPtr->inQueueTail = bufPtr;
4909 }
4910
4911 /*
4912 * If EOF is set, we should avoid calling the driver because on some
4913 * platforms it is impossible to read from a device after EOF.
4914 */
4915
4916 if (chanPtr->flags & CHANNEL_EOF) {
4917 return 0;
4918 }
4919
4920 nread = (*chanPtr->typePtr->inputProc)(chanPtr->instanceData,
4921 bufPtr->buf + bufPtr->nextAdded, toRead, &result);
4922
4923 if (nread > 0) {
4924 bufPtr->nextAdded += nread;
4925
4926 /*
4927 * If we get a short read, signal up that we may be BLOCKED. We
4928 * should avoid calling the driver because on some platforms we
4929 * will block in the low level reading code even though the
4930 * channel is set into nonblocking mode.
4931 */
4932
4933 if (nread < toRead) {
4934 chanPtr->flags |= CHANNEL_BLOCKED;
4935 }
4936 } else if (nread == 0) {
4937 chanPtr->flags |= CHANNEL_EOF;
4938 chanPtr->inputEncodingFlags |= TCL_ENCODING_END;
4939 } else if (nread < 0) {
4940 if ((result == EWOULDBLOCK) || (result == EAGAIN)) {
4941 chanPtr->flags |= CHANNEL_BLOCKED;
4942 result = EAGAIN;
4943 }
4944 Tcl_SetErrno(result);
4945 return result;
4946 }
4947 return 0;
4948 }
4949
4950 /*
4951 *----------------------------------------------------------------------
4952 *
4953 * Tcl_Seek --
4954 *
4955 * Implements seeking on Tcl Channels. This is a public function
4956 * so that other C facilities may be implemented on top of it.
4957 *
4958 * Results:
4959 * The new access point or -1 on error. If error, use Tcl_GetErrno()
4960 * to retrieve the POSIX error code for the error that occurred.
4961 *
4962 * Side effects:
4963 * May flush output on the channel. May discard queued input.
4964 *
4965 *----------------------------------------------------------------------
4966 */
4967
4968 int
4969 Tcl_Seek(chan, offset, mode)
4970 Tcl_Channel chan; /* The channel on which to seek. */
4971 int offset; /* Offset to seek to. */
4972 int mode; /* Relative to which location to seek? */
4973 {
4974 Channel *chanPtr; /* The real IO channel. */
4975 ChannelBuffer *bufPtr;
4976 int inputBuffered, outputBuffered;
4977 int result; /* Of device driver operations. */
4978 int curPos; /* Position on the device. */
4979 int wasAsync; /* Was the channel nonblocking before the
4980 * seek operation? If so, must restore to
4981 * nonblocking mode after the seek. */
4982
4983 chanPtr = (Channel *) chan;
4984 if (CheckChannelErrors(chanPtr, TCL_WRITABLE | TCL_READABLE) != 0) {
4985 return -1;
4986 }
4987
4988 /*
4989 * Disallow seek on dead channels -- channels that have been closed but
4990 * not yet been deallocated. Such channels can be found if the exit
4991 * handler for channel cleanup has run but the channel is still
4992 * registered in an interpreter.
4993 */
4994
4995 if (CheckForDeadChannel(NULL,chanPtr)) return -1;
4996
4997 /*
4998 * Disallow seek on channels whose type does not have a seek procedure
4999 * defined. This means that the channel does not support seeking.
5000 */
5001
5002 if (chanPtr->typePtr->seekProc == (Tcl_DriverSeekProc *) NULL) {
5003 Tcl_SetErrno(EINVAL);
5004 return -1;
5005 }
5006
5007 /*
5008 * Compute how much input and output is buffered. If both input and
5009 * output is buffered, cannot compute the current position.
5010 */
5011
5012 for (bufPtr = chanPtr->inQueueHead, inputBuffered = 0;
5013 bufPtr != (ChannelBuffer *) NULL;
5014 bufPtr = bufPtr->nextPtr) {
5015 inputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
5016 }
5017 for (bufPtr = chanPtr->outQueueHead, outputBuffered = 0;
5018 bufPtr != (ChannelBuffer *) NULL;
5019 bufPtr = bufPtr->nextPtr) {
5020 outputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
5021 }
5022 if ((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&
5023 (chanPtr->curOutPtr->nextAdded > chanPtr->curOutPtr->nextRemoved)) {
5024 chanPtr->flags |= BUFFER_READY;
5025 outputBuffered +=
5026 (chanPtr->curOutPtr->nextAdded - chanPtr->curOutPtr->nextRemoved);
5027 }
5028
5029 if ((inputBuffered != 0) && (outputBuffered != 0)) {
5030 Tcl_SetErrno(EFAULT);
5031 return -1;
5032 }
5033
5034 /*
5035 * If we are seeking relative to the current position, compute the
5036 * corrected offset taking into account the amount of unread input.
5037 */
5038
5039 if (mode == SEEK_CUR) {
5040 offset -= inputBuffered;
5041 }
5042
5043 /*
5044 * Discard any queued input - this input should not be read after
5045 * the seek.
5046 */
5047
5048 DiscardInputQueued(chanPtr, 0);
5049
5050 /*
5051 * Reset EOF and BLOCKED flags. We invalidate them by moving the
5052 * access point. Also clear CR related flags.
5053 */
5054
5055 chanPtr->flags &=
5056 (~(CHANNEL_EOF | CHANNEL_STICKY_EOF | CHANNEL_BLOCKED | INPUT_SAW_CR));
5057
5058 /*
5059 * If the channel is in asynchronous output mode, switch it back
5060 * to synchronous mode and cancel any async flush that may be
5061 * scheduled. After the flush, the channel will be put back into
5062 * asynchronous output mode.
5063 */
5064
5065 wasAsync = 0;
5066 if (chanPtr->flags & CHANNEL_NONBLOCKING) {
5067 wasAsync = 1;
5068 result = 0;
5069 if (chanPtr->typePtr->blockModeProc != NULL) {
5070 result = (chanPtr->typePtr->blockModeProc) (chanPtr->instanceData,
5071 TCL_MODE_BLOCKING);
5072 }
5073 if (result != 0) {
5074 Tcl_SetErrno(result);
5075 return -1;
5076 }
5077 chanPtr->flags &= (~(CHANNEL_NONBLOCKING));
5078 if (chanPtr->flags & BG_FLUSH_SCHEDULED) {
5079 chanPtr->flags &= (~(BG_FLUSH_SCHEDULED));
5080 }
5081 }
5082
5083 /*
5084 * If the flush fails we cannot recover the original position. In
5085 * that case the seek is not attempted because we do not know where
5086 * the access position is - instead we return the error. FlushChannel
5087 * has already called Tcl_SetErrno() to report the error upwards.
5088 * If the flush succeeds we do the seek also.
5089 */
5090
5091 if (FlushChannel(NULL, chanPtr, 0) != 0) {
5092 curPos = -1;
5093 } else {
5094
5095 /*
5096 * Now seek to the new position in the channel as requested by the
5097 * caller.
5098 */
5099
5100 curPos = (chanPtr->typePtr->seekProc) (chanPtr->instanceData,
5101 (long) offset, mode, &result);
5102 if (curPos == -1) {
5103 Tcl_SetErrno(result);
5104 }
5105 }
5106
5107 /*
5108 * Restore to nonblocking mode if that was the previous behavior.
5109 *
5110 * NOTE: Even if there was an async flush active we do not restore
5111 * it now because we already flushed all the queued output, above.
5112 */
5113
5114 if (wasAsync) {
5115 chanPtr->flags |= CHANNEL_NONBLOCKING;
5116 result = 0;
5117 if (chanPtr->typePtr->blockModeProc != NULL) {
5118 result = (chanPtr->typePtr->blockModeProc) (chanPtr->instanceData,
5119 TCL_MODE_NONBLOCKING);
5120 }
5121 if (result != 0) {
5122 Tcl_SetErrno(result);
5123 return -1;
5124 }
5125 }
5126
5127 return curPos;
5128 }
5129
5130 /*
5131 *----------------------------------------------------------------------
5132 *
5133 * Tcl_Tell --
5134 *
5135 * Returns the position of the next character to be read/written on
5136 * this channel.
5137 *
5138 * Results:
5139 * A nonnegative integer on success, -1 on failure. If failed,
5140 * use Tcl_GetErrno() to retrieve the POSIX error code for the
5141 * error that occurred.
5142 *
5143 * Side effects:
5144 * None.
5145 *
5146 *----------------------------------------------------------------------
5147 */
5148
5149 int
5150 Tcl_Tell(chan)
5151 Tcl_Channel chan; /* The channel to return pos for. */
5152 {
5153 Channel *chanPtr; /* The actual channel to tell on. */
5154 ChannelBuffer *bufPtr;
5155 int inputBuffered, outputBuffered;
5156 int result; /* Of calling device driver. */
5157 int curPos; /* Position on device. */
5158
5159 chanPtr = (Channel *) chan;
5160 if (CheckChannelErrors(chanPtr, TCL_WRITABLE | TCL_READABLE) != 0) {
5161 return -1;
5162 }
5163
5164 /*
5165 * Disallow tell on dead channels -- channels that have been closed but
5166 * not yet been deallocated. Such channels can be found if the exit
5167 * handler for channel cleanup has run but the channel is still
5168 * registered in an interpreter.
5169 */
5170
5171 if (CheckForDeadChannel(NULL,chanPtr)) {
5172 return -1;
5173 }
5174
5175 /*
5176 * Disallow tell on channels whose type does not have a seek procedure
5177 * defined. This means that the channel does not support seeking.
5178 */
5179
5180 if (chanPtr->typePtr->seekProc == (Tcl_DriverSeekProc *) NULL) {
5181 Tcl_SetErrno(EINVAL);
5182 return -1;
5183 }
5184
5185 /*
5186 * Compute how much input and output is buffered. If both input and
5187 * output is buffered, cannot compute the current position.
5188 */
5189
5190 for (bufPtr = chanPtr->inQueueHead, inputBuffered = 0;
5191 bufPtr != (ChannelBuffer *) NULL;
5192 bufPtr = bufPtr->nextPtr) {
5193 inputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
5194 }
5195 for (bufPtr = chanPtr->outQueueHead, outputBuffered = 0;
5196 bufPtr != (ChannelBuffer *) NULL;
5197 bufPtr = bufPtr->nextPtr) {
5198 outputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
5199 }
5200 if ((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&
5201 (chanPtr->curOutPtr->nextAdded > chanPtr->curOutPtr->nextRemoved)) {
5202 chanPtr->flags |= BUFFER_READY;
5203 outputBuffered +=
5204 (chanPtr->curOutPtr->nextAdded - chanPtr->curOutPtr->nextRemoved);
5205 }
5206
5207 if ((inputBuffered != 0) && (outputBuffered != 0)) {
5208 Tcl_SetErrno(EFAULT);
5209 return -1;
5210 }
5211
5212 /*
5213 * Get the current position in the device and compute the position
5214 * where the next character will be read or written.
5215 */
5216
5217 curPos = (chanPtr->typePtr->seekProc) (chanPtr->instanceData,
5218 (long) 0, SEEK_CUR, &result);
5219 if (curPos == -1) {
5220 Tcl_SetErrno(result);
5221 return -1;
5222 }
5223 if (inputBuffered != 0) {
5224 return (curPos - inputBuffered);
5225 }
5226 return (curPos + outputBuffered);
5227 }
5228
5229 /*
5230 *---------------------------------------------------------------------------
5231 *
5232 * CheckChannelErrors --
5233 *
5234 * See if the channel is in an ready state and can perform the
5235 * desired operation.
5236 *
5237 * Results:
5238 * The return value is 0 if the channel is OK, otherwise the
5239 * return value is -1 and errno is set to indicate the error.
5240 *
5241 * Side effects:
5242 * May clear the EOF and/or BLOCKED bits if reading from channel.
5243 *
5244 *---------------------------------------------------------------------------
5245 */
5246
5247 static int
5248 CheckChannelErrors(chanPtr, direction)
5249 Channel *chanPtr; /* Channel to check. */
5250 int direction; /* Test if channel supports desired operation:
5251 * TCL_READABLE, TCL_WRITABLE. */
5252 {
5253 /*
5254 * Check for unreported error.
5255 */
5256
5257 if (chanPtr->unreportedError != 0) {
5258 Tcl_SetErrno(chanPtr->unreportedError);
5259 chanPtr->unreportedError = 0;
5260 return -1;
5261 }
5262
5263 /*
5264 * Fail if the channel is not opened for desired operation.
5265 */
5266
5267 if ((chanPtr->flags & direction) == 0) {
5268 Tcl_SetErrno(EACCES);
5269 return -1;
5270 }
5271
5272 /*
5273 * Fail if the channel is in the middle of a background copy.
5274 */
5275
5276 if (chanPtr->csPtr != NULL) {
5277 Tcl_SetErrno(EBUSY);
5278 return -1;
5279 }
5280
5281 if (direction == TCL_READABLE) {
5282 /*
5283 * If we have not encountered a sticky EOF, clear the EOF bit
5284 * (sticky EOF is set if we have seen the input eofChar, to prevent
5285 * reading beyond the eofChar). Also, always clear the BLOCKED bit.
5286 * We want to discover these conditions anew in each operation.
5287 */
5288
5289 if ((chanPtr->flags & CHANNEL_STICKY_EOF) == 0) {
5290 chanPtr->flags &= ~CHANNEL_EOF;
5291 }
5292 chanPtr->flags &= ~(CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA);
5293 }
5294
5295 return 0;
5296 }
5297
5298 /*
5299 *----------------------------------------------------------------------
5300 *
5301 * Tcl_Eof --
5302 *
5303 * Returns 1 if the channel is at EOF, 0 otherwise.
5304 *
5305 * Results:
5306 * 1 or 0, always.
5307 *
5308 * Side effects:
5309 * None.
5310 *
5311 *----------------------------------------------------------------------
5312 */
5313
5314 int
5315 Tcl_Eof(chan)
5316 Tcl_Channel chan; /* Does this channel have EOF? */
5317 {
5318 Channel *chanPtr; /* The real channel structure. */
5319
5320 chanPtr = (Channel *) chan;
5321 return ((chanPtr->flags & CHANNEL_STICKY_EOF) ||
5322 ((chanPtr->flags & CHANNEL_EOF) && (Tcl_InputBuffered(chan) == 0)))
5323 ? 1 : 0;
5324 }
5325
5326 /*
5327 *----------------------------------------------------------------------
5328 *
5329 * Tcl_InputBlocked --
5330 *
5331 * Returns 1 if input is blocked on this channel, 0 otherwise.
5332 *
5333 * Results:
5334 * 0 or 1, always.
5335 *
5336 * Side effects:
5337 * None.
5338 *
5339 *----------------------------------------------------------------------
5340 */
5341
5342 int
5343 Tcl_InputBlocked(chan)
5344 Tcl_Channel chan; /* Is this channel blocked? */
5345 {
5346 Channel *chanPtr; /* The real channel structure. */
5347
5348 chanPtr = (Channel *) chan;
5349 return (chanPtr->flags & CHANNEL_BLOCKED) ? 1 : 0;
5350 }
5351
5352 /*
5353 *----------------------------------------------------------------------
5354 *
5355 * Tcl_InputBuffered --
5356 *
5357 * Returns the number of bytes of input currently buffered in the
5358 * internal buffer of a channel.
5359 *
5360 * Results:
5361 * The number of input bytes buffered, or zero if the channel is not
5362 * open for reading.
5363 *
5364 * Side effects:
5365 * None.
5366 *
5367 *----------------------------------------------------------------------
5368 */
5369
5370 int
5371 Tcl_InputBuffered(chan)
5372 Tcl_Channel chan; /* The channel to query. */
5373 {
5374 Channel *chanPtr;
5375 int bytesBuffered;
5376 ChannelBuffer *bufPtr;
5377
5378 chanPtr = (Channel *) chan;
5379 for (bytesBuffered = 0, bufPtr = chanPtr->inQueueHead;
5380 bufPtr != (ChannelBuffer *) NULL;
5381 bufPtr = bufPtr->nextPtr) {
5382 bytesBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
5383 }
5384 return bytesBuffered;
5385 }
5386
5387 /*
5388 *----------------------------------------------------------------------
5389 *
5390 * Tcl_SetChannelBufferSize --
5391 *
5392 * Sets the size of buffers to allocate to store input or output
5393 * in the channel. The size must be between 10 bytes and 1 MByte.
5394 *
5395 * Results:
5396 * None.
5397 *
5398 * Side effects:
5399 * Sets the size of buffers subsequently allocated for this channel.
5400 *
5401 *----------------------------------------------------------------------
5402 */
5403
5404 void
5405 Tcl_SetChannelBufferSize(chan, sz)
5406 Tcl_Channel chan; /* The channel whose buffer size
5407 * to set. */
5408 int sz; /* The size to set. */
5409 {
5410 Channel *chanPtr;
5411
5412 /*
5413 * If the buffer size is smaller than 10 bytes or larger than one MByte,
5414 * do not accept the requested size and leave the current buffer size.
5415 */
5416
5417 if (sz < 10) {
5418 return;
5419 }
5420 if (sz > (1024 * 1024)) {
5421 return;
5422 }
5423
5424 chanPtr = (Channel *) chan;
5425 chanPtr->bufSize = sz;
5426
5427 if (chanPtr->outputStage != NULL) {
5428 ckfree((char *) chanPtr->outputStage);
5429 chanPtr->outputStage = NULL;
5430 }
5431 if ((chanPtr->encoding != NULL) && (chanPtr->flags & TCL_WRITABLE)) {
5432 chanPtr->outputStage = (char *)
5433 ckalloc((unsigned) (chanPtr->bufSize + 2));
5434 }
5435 }
5436
5437 /*
5438 *----------------------------------------------------------------------
5439 *
5440 * Tcl_GetChannelBufferSize --
5441 *
5442 * Retrieves the size of buffers to allocate for this channel.
5443 *
5444 * Results:
5445 * The size.
5446 *
5447 * Side effects:
5448 * None.
5449 *
5450 *----------------------------------------------------------------------
5451 */
5452
5453 int
5454 Tcl_GetChannelBufferSize(chan)
5455 Tcl_Channel chan; /* The channel for which to find the
5456 * buffer size. */
5457 {
5458 Channel *chanPtr;
5459
5460 chanPtr = (Channel *) chan;
5461 return chanPtr->bufSize;
5462 }
5463
5464 /*
5465 *----------------------------------------------------------------------
5466 *
5467 * Tcl_BadChannelOption --
5468 *
5469 * This procedure generates a "bad option" error message in an
5470 * (optional) interpreter. It is used by channel drivers when
5471 * a invalid Set/Get option is requested. Its purpose is to concatenate
5472 * the generic options list to the specific ones and factorize
5473 * the generic options error message string.
5474 *
5475 * Results:
5476 * TCL_ERROR.
5477 *
5478 * Side effects:
5479 * An error message is generated in interp's result object to
5480 * indicate that a command was invoked with the a bad option
5481 * The message has the form
5482 * bad option "blah": should be one of
5483 * <...generic options...>+<...specific options...>
5484 * "blah" is the optionName argument and "<specific options>"
5485 * is a space separated list of specific option words.
5486 * The function takes good care of inserting minus signs before
5487 * each option, commas after, and an "or" before the last option.
5488 *
5489 *----------------------------------------------------------------------
5490 */
5491
5492 int
5493 Tcl_BadChannelOption(interp, optionName, optionList)
5494 Tcl_Interp *interp; /* Current interpreter. (can be NULL)*/
5495 char *optionName; /* 'bad option' name */
5496 char *optionList; /* Specific options list to append
5497 * to the standard generic options.
5498 * can be NULL for generic options
5499 * only.
5500 */
5501 {
5502 if (interp) {
5503 CONST char *genericopt =
5504 "blocking buffering buffersize encoding eofchar translation";
5505 char **argv;
5506 int argc, i;
5507 Tcl_DString ds;
5508
5509 Tcl_DStringInit(&ds);
5510 Tcl_DStringAppend(&ds, (char *) genericopt, -1);
5511 if (optionList && (*optionList)) {
5512 Tcl_DStringAppend(&ds, " ", 1);
5513 Tcl_DStringAppend(&ds, optionList, -1);
5514 }
5515 if (Tcl_SplitList(interp, Tcl_DStringValue(&ds),
5516 &argc, &argv) != TCL_OK) {
5517 panic("malformed option list in channel driver");
5518 }
5519 Tcl_ResetResult(interp);
5520 Tcl_AppendResult(interp, "bad option \"", optionName,
5521 "\": should be one of ", (char *) NULL);
5522 argc--;
5523 for (i = 0; i < argc; i++) {
5524 Tcl_AppendResult(interp, "-", argv[i], ", ", (char *) NULL);
5525 }
5526 Tcl_AppendResult(interp, "or -", argv[i], (char *) NULL);
5527 Tcl_DStringFree(&ds);
5528 ckfree((char *) argv);
5529 }
5530 Tcl_SetErrno(EINVAL);
5531 return TCL_ERROR;
5532 }
5533
5534 /*
5535 *----------------------------------------------------------------------
5536 *
5537 * Tcl_GetChannelOption --
5538 *
5539 * Gets a mode associated with an IO channel. If the optionName arg
5540 * is non NULL, retrieves the value of that option. If the optionName
5541 * arg is NULL, retrieves a list of alternating option names and
5542 * values for the given channel.
5543 *
5544 * Results:
5545 * A standard Tcl result. Also sets the supplied DString to the
5546 * string value of the option(s) returned.
5547 *
5548 * Side effects:
5549 * None.
5550 *
5551 *----------------------------------------------------------------------
5552 */
5553
5554 int
5555 Tcl_GetChannelOption(interp, chan, optionName, dsPtr)
5556 Tcl_Interp *interp; /* For error reporting - can be NULL. */
5557 Tcl_Channel chan; /* Channel on which to get option. */
5558 char *optionName; /* Option to get. */
5559 Tcl_DString *dsPtr; /* Where to store value(s). */
5560 {
5561 size_t len; /* Length of optionName string. */
5562 char optionVal[128]; /* Buffer for sprintf. */
5563 Channel *chanPtr = (Channel *) chan;
5564 int flags;
5565
5566 /*
5567 * If we are in the middle of a background copy, use the saved flags.
5568 */
5569
5570 if (chanPtr->csPtr) {
5571 if (chanPtr == chanPtr->csPtr->readPtr) {
5572 flags = chanPtr->csPtr->readFlags;
5573 } else {
5574 flags = chanPtr->csPtr->writeFlags;
5575 }
5576 } else {
5577 flags = chanPtr->flags;
5578 }
5579
5580 /*
5581 * Disallow options on dead channels -- channels that have been closed but
5582 * not yet been deallocated. Such channels can be found if the exit
5583 * handler for channel cleanup has run but the channel is still
5584 * registered in an interpreter.
5585 */
5586
5587 if (CheckForDeadChannel(interp,chanPtr)) return TCL_ERROR;
5588
5589 /*
5590 * If the optionName is NULL it means that we want a list of all
5591 * options and values.
5592 */
5593
5594 if (optionName == (char *) NULL) {
5595 len = 0;
5596 } else {
5597 len = strlen(optionName);
5598 }
5599
5600 if ((len == 0) || ((len > 2) && (optionName[1] == 'b') &&
5601 (strncmp(optionName, "-blocking", len) == 0))) {
5602 if (len == 0) {
5603 Tcl_DStringAppendElement(dsPtr, "-blocking");
5604 }
5605 Tcl_DStringAppendElement(dsPtr,
5606 (flags & CHANNEL_NONBLOCKING) ? "0" : "1");
5607 if (len > 0) {
5608 return TCL_OK;
5609 }
5610 }
5611 if ((len == 0) || ((len > 7) && (optionName[1] == 'b') &&
5612 (strncmp(optionName, "-buffering", len) == 0))) {
5613 if (len == 0) {
5614 Tcl_DStringAppendElement(dsPtr, "-buffering");
5615 }
5616 if (flags & CHANNEL_LINEBUFFERED) {
5617 Tcl_DStringAppendElement(dsPtr, "line");
5618 } else if (flags & CHANNEL_UNBUFFERED) {
5619 Tcl_DStringAppendElement(dsPtr, "none");
5620 } else {
5621 Tcl_DStringAppendElement(dsPtr, "full");
5622 }
5623 if (len > 0) {
5624 return TCL_OK;
5625 }
5626 }
5627 if ((len == 0) || ((len > 7) && (optionName[1] == 'b') &&
5628 (strncmp(optionName, "-buffersize", len) == 0))) {
5629 if (len == 0) {
5630 Tcl_DStringAppendElement(dsPtr, "-buffersize");
5631 }
5632 TclFormatInt(optionVal, chanPtr->bufSize);
5633 Tcl_DStringAppendElement(dsPtr, optionVal);
5634 if (len > 0) {
5635 return TCL_OK;
5636 }
5637 }
5638 if ((len == 0) ||
5639 ((len > 2) && (optionName[1] == 'e') &&
5640 (strncmp(optionName, "-encoding", len) == 0))) {
5641 if (len == 0) {
5642 Tcl_DStringAppendElement(dsPtr, "-encoding");
5643 }
5644 if (chanPtr->encoding == NULL) {
5645 Tcl_DStringAppendElement(dsPtr, "binary");
5646 } else {
5647 Tcl_DStringAppendElement(dsPtr,
5648 Tcl_GetEncodingName(chanPtr->encoding));
5649 }
5650 if (len > 0) {
5651 return TCL_OK;
5652 }
5653 }
5654 if ((len == 0) ||
5655 ((len > 2) && (optionName[1] == 'e') &&
5656 (strncmp(optionName, "-eofchar", len) == 0))) {
5657 if (len == 0) {
5658 Tcl_DStringAppendElement(dsPtr, "-eofchar");
5659 }
5660 if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==
5661 (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {
5662 Tcl_DStringStartSublist(dsPtr);
5663 }
5664 if (flags & TCL_READABLE) {
5665 if (chanPtr->inEofChar == 0) {
5666 Tcl_DStringAppendElement(dsPtr, "");
5667 } else {
5668 char buf[4];
5669
5670 sprintf(buf, "%c", chanPtr->inEofChar);
5671 Tcl_DStringAppendElement(dsPtr, buf);
5672 }
5673 }
5674 if (flags & TCL_WRITABLE) {
5675 if (chanPtr->outEofChar == 0) {
5676 Tcl_DStringAppendElement(dsPtr, "");
5677 } else {
5678 char buf[4];
5679
5680 sprintf(buf, "%c", chanPtr->outEofChar);
5681 Tcl_DStringAppendElement(dsPtr, buf);
5682 }
5683 }
5684 if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==
5685 (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {
5686 Tcl_DStringEndSublist(dsPtr);
5687 }
5688 if (len > 0) {
5689 return TCL_OK;
5690 }
5691 }
5692 if ((len == 0) ||
5693 ((len > 1) && (optionName[1] == 't') &&
5694 (strncmp(optionName, "-translation", len) == 0))) {
5695 if (len == 0) {
5696 Tcl_DStringAppendElement(dsPtr, "-translation");
5697 }
5698 if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==
5699 (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {
5700 Tcl_DStringStartSublist(dsPtr);
5701 }
5702 if (flags & TCL_READABLE) {
5703 if (chanPtr->inputTranslation == TCL_TRANSLATE_AUTO) {
5704 Tcl_DStringAppendElement(dsPtr, "auto");
5705 } else if (chanPtr->inputTranslation == TCL_TRANSLATE_CR) {
5706 Tcl_DStringAppendElement(dsPtr, "cr");
5707 } else if (chanPtr->inputTranslation == TCL_TRANSLATE_CRLF) {
5708 Tcl_DStringAppendElement(dsPtr, "crlf");
5709 } else {
5710 Tcl_DStringAppendElement(dsPtr, "lf");
5711 }
5712 }
5713 if (flags & TCL_WRITABLE) {
5714 if (chanPtr->outputTranslation == TCL_TRANSLATE_AUTO) {
5715 Tcl_DStringAppendElement(dsPtr, "auto");
5716 } else if (chanPtr->outputTranslation == TCL_TRANSLATE_CR) {
5717 Tcl_DStringAppendElement(dsPtr, "cr");
5718 } else if (chanPtr->outputTranslation == TCL_TRANSLATE_CRLF) {
5719 Tcl_DStringAppendElement(dsPtr, "crlf");
5720 } else {
5721 Tcl_DStringAppendElement(dsPtr, "lf");
5722 }
5723 }
5724 if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==
5725 (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {
5726 Tcl_DStringEndSublist(dsPtr);
5727 }
5728 if (len > 0) {
5729 return TCL_OK;
5730 }
5731 }
5732 if (chanPtr->typePtr->getOptionProc != (Tcl_DriverGetOptionProc *) NULL) {
5733 /*
5734 * let the driver specific handle additional options
5735 * and result code and message.
5736 */
5737
5738 return (chanPtr->typePtr->getOptionProc) (chanPtr->instanceData,
5739 interp, optionName, dsPtr);
5740 } else {
5741 /*
5742 * no driver specific options case.
5743 */
5744
5745 if (len == 0) {
5746 return TCL_OK;
5747 }
5748 return Tcl_BadChannelOption(interp, optionName, NULL);
5749 }
5750 }
5751
5752 /*
5753 *---------------------------------------------------------------------------
5754 *
5755 * Tcl_SetChannelOption --
5756 *
5757 * Sets an option on a channel.
5758 *
5759 * Results:
5760 * A standard Tcl result. On error, sets interp's result object
5761 * if interp is not NULL.
5762 *
5763 * Side effects:
5764 * May modify an option on a device.
5765 *
5766 *---------------------------------------------------------------------------
5767 */
5768
5769 int
5770 Tcl_SetChannelOption(interp, chan, optionName, newValue)
5771 Tcl_Interp *interp; /* For error reporting - can be NULL. */
5772 Tcl_Channel chan; /* Channel on which to set mode. */
5773 char *optionName; /* Which option to set? */
5774 char *newValue; /* New value for option. */
5775 {
5776 int newMode; /* New (numeric) mode to sert. */
5777 Channel *chanPtr; /* The real IO channel. */
5778 size_t len; /* Length of optionName string. */
5779 int argc;
5780 char **argv;
5781
5782 chanPtr = (Channel *) chan;
5783
5784 /*
5785 * If the channel is in the middle of a background copy, fail.
5786 */
5787
5788 if (chanPtr->csPtr) {
5789 if (interp) {
5790 Tcl_AppendResult(interp,
5791 "unable to set channel options: background copy in progress",
5792 (char *) NULL);
5793 }
5794 return TCL_ERROR;
5795 }
5796
5797
5798 /*
5799 * Disallow options on dead channels -- channels that have been closed but
5800 * not yet been deallocated. Such channels can be found if the exit
5801 * handler for channel cleanup has run but the channel is still
5802 * registered in an interpreter.
5803 */
5804
5805 if (CheckForDeadChannel(NULL,chanPtr)) return TCL_ERROR;
5806
5807 len = strlen(optionName);
5808
5809 if ((len > 2) && (optionName[1] == 'b') &&
5810 (strncmp(optionName, "-blocking", len) == 0)) {
5811 if (Tcl_GetBoolean(interp, newValue, &newMode) == TCL_ERROR) {
5812 return TCL_ERROR;
5813 }
5814 if (newMode) {
5815 newMode = TCL_MODE_BLOCKING;
5816 } else {
5817 newMode = TCL_MODE_NONBLOCKING;
5818 }
5819 return SetBlockMode(interp, chanPtr, newMode);
5820 } else if ((len > 7) && (optionName[1] == 'b') &&
5821 (strncmp(optionName, "-buffering", len) == 0)) {
5822