/[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 (7 years, 4 months 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 len = strlen(newValue);
5823 if ((newValue[0] == 'f') && (strncmp(newValue, "full", len) == 0)) {
5824 chanPtr->flags &=
5825 (~(CHANNEL_UNBUFFERED|CHANNEL_LINEBUFFERED));
5826 } else if ((newValue[0] == 'l') &&
5827 (strncmp(newValue, "line", len) == 0)) {
5828 chanPtr->flags &= (~(CHANNEL_UNBUFFERED));
5829 chanPtr->flags |= CHANNEL_LINEBUFFERED;
5830 } else if ((newValue[0] == 'n') &&
5831 (strncmp(newValue, "none", len) == 0)) {
5832 chanPtr->flags &= (~(CHANNEL_LINEBUFFERED));
5833 chanPtr->flags |= CHANNEL_UNBUFFERED;
5834 } else {
5835 if (interp) {
5836 Tcl_AppendResult(interp, "bad value for -buffering: ",
5837 "must be one of full, line, or none",
5838 (char *) NULL);
5839 return TCL_ERROR;
5840 }
5841 }
5842 return TCL_OK;
5843 } else if ((len > 7) && (optionName[1] == 'b') &&
5844 (strncmp(optionName, "-buffersize", len) == 0)) {
5845 chanPtr->bufSize = atoi(newValue); /* INTL: "C", UTF safe. */
5846 if ((chanPtr->bufSize < 10) || (chanPtr->bufSize > (1024 * 1024))) {
5847 chanPtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE;
5848 }
5849 } else if ((len > 2) && (optionName[1] == 'e') &&
5850 (strncmp(optionName, "-encoding", len) == 0)) {
5851 Tcl_Encoding encoding;
5852
5853 if ((newValue[0] == '\0') || (strcmp(newValue, "binary") == 0)) {
5854 encoding = NULL;
5855 } else {
5856 encoding = Tcl_GetEncoding(interp, newValue);
5857 if (encoding == NULL) {
5858 return TCL_ERROR;
5859 }
5860 }
5861 Tcl_FreeEncoding(chanPtr->encoding);
5862 chanPtr->encoding = encoding;
5863 chanPtr->inputEncodingState = NULL;
5864 chanPtr->inputEncodingFlags = TCL_ENCODING_START;
5865 chanPtr->outputEncodingState = NULL;
5866 chanPtr->outputEncodingFlags = TCL_ENCODING_START;
5867 chanPtr->flags &= ~CHANNEL_NEED_MORE_DATA;
5868 UpdateInterest(chanPtr);
5869 } else if ((len > 2) && (optionName[1] == 'e') &&
5870 (strncmp(optionName, "-eofchar", len) == 0)) {
5871 if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) {
5872 return TCL_ERROR;
5873 }
5874 if (argc == 0) {
5875 chanPtr->inEofChar = 0;
5876 chanPtr->outEofChar = 0;
5877 } else if (argc == 1) {
5878 if (chanPtr->flags & TCL_WRITABLE) {
5879 chanPtr->outEofChar = (int) argv[0][0];
5880 }
5881 if (chanPtr->flags & TCL_READABLE) {
5882 chanPtr->inEofChar = (int) argv[0][0];
5883 }
5884 } else if (argc != 2) {
5885 if (interp) {
5886 Tcl_AppendResult(interp,
5887 "bad value for -eofchar: should be a list of one or",
5888 " two elements", (char *) NULL);
5889 }
5890 ckfree((char *) argv);
5891 return TCL_ERROR;
5892 } else {
5893 if (chanPtr->flags & TCL_READABLE) {
5894 chanPtr->inEofChar = (int) argv[0][0];
5895 }
5896 if (chanPtr->flags & TCL_WRITABLE) {
5897 chanPtr->outEofChar = (int) argv[1][0];
5898 }
5899 }
5900 if (argv != (char **) NULL) {
5901 ckfree((char *) argv);
5902 }
5903 return TCL_OK;
5904 } else if ((len > 1) && (optionName[1] == 't') &&
5905 (strncmp(optionName, "-translation", len) == 0)) {
5906 char *readMode, *writeMode;
5907
5908 if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) {
5909 return TCL_ERROR;
5910 }
5911
5912 if (argc == 1) {
5913 readMode = (chanPtr->flags & TCL_READABLE) ? argv[0] : NULL;
5914 writeMode = (chanPtr->flags & TCL_WRITABLE) ? argv[0] : NULL;
5915 } else if (argc == 2) {
5916 readMode = (chanPtr->flags & TCL_READABLE) ? argv[0] : NULL;
5917 writeMode = (chanPtr->flags & TCL_WRITABLE) ? argv[1] : NULL;
5918 } else {
5919 if (interp) {
5920 Tcl_AppendResult(interp,
5921 "bad value for -translation: must be a one or two",
5922 " element list", (char *) NULL);
5923 }
5924 ckfree((char *) argv);
5925 return TCL_ERROR;
5926 }
5927
5928 if (readMode) {
5929 if (*readMode == '\0') {
5930 newMode = chanPtr->inputTranslation;
5931 } else if (strcmp(readMode, "auto") == 0) {
5932 newMode = TCL_TRANSLATE_AUTO;
5933 } else if (strcmp(readMode, "binary") == 0) {
5934 newMode = TCL_TRANSLATE_LF;
5935 chanPtr->inEofChar = 0;
5936 Tcl_FreeEncoding(chanPtr->encoding);
5937 chanPtr->encoding = NULL;
5938 } else if (strcmp(readMode, "lf") == 0) {
5939 newMode = TCL_TRANSLATE_LF;
5940 } else if (strcmp(readMode, "cr") == 0) {
5941 newMode = TCL_TRANSLATE_CR;
5942 } else if (strcmp(readMode, "crlf") == 0) {
5943 newMode = TCL_TRANSLATE_CRLF;
5944 } else if (strcmp(readMode, "platform") == 0) {
5945 newMode = TCL_PLATFORM_TRANSLATION;
5946 } else {
5947 if (interp) {
5948 Tcl_AppendResult(interp,
5949 "bad value for -translation: ",
5950 "must be one of auto, binary, cr, lf, crlf,",
5951 " or platform", (char *) NULL);
5952 }
5953 ckfree((char *) argv);
5954 return TCL_ERROR;
5955 }
5956
5957 /*
5958 * Reset the EOL flags since we need to look at any buffered
5959 * data to see if the new translation mode allows us to
5960 * complete the line.
5961 */
5962
5963 if (newMode != chanPtr->inputTranslation) {
5964 chanPtr->inputTranslation = (Tcl_EolTranslation) newMode;
5965 chanPtr->flags &= ~(INPUT_SAW_CR);
5966 chanPtr->flags &= ~(CHANNEL_NEED_MORE_DATA);
5967 UpdateInterest(chanPtr);
5968 }
5969 }
5970 if (writeMode) {
5971 if (*writeMode == '\0') {
5972 /* Do nothing. */
5973 } else if (strcmp(writeMode, "auto") == 0) {
5974 /*
5975 * This is a hack to get TCP sockets to produce output
5976 * in CRLF mode if they are being set into AUTO mode.
5977 * A better solution for achieving this effect will be
5978 * coded later.
5979 */
5980
5981 if (strcmp(chanPtr->typePtr->typeName, "tcp") == 0) {
5982 chanPtr->outputTranslation = TCL_TRANSLATE_CRLF;
5983 } else {
5984 chanPtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
5985 }
5986 } else if (strcmp(writeMode, "binary") == 0) {
5987 chanPtr->outEofChar = 0;
5988 chanPtr->outputTranslation = TCL_TRANSLATE_LF;
5989 Tcl_FreeEncoding(chanPtr->encoding);
5990 chanPtr->encoding = NULL;
5991 } else if (strcmp(writeMode, "lf") == 0) {
5992 chanPtr->outputTranslation = TCL_TRANSLATE_LF;
5993 } else if (strcmp(writeMode, "cr") == 0) {
5994 chanPtr->outputTranslation = TCL_TRANSLATE_CR;
5995 } else if (strcmp(writeMode, "crlf") == 0) {
5996 chanPtr->outputTranslation = TCL_TRANSLATE_CRLF;
5997 } else if (strcmp(writeMode, "platform") == 0) {
5998 chanPtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
5999 } else {
6000 if (interp) {
6001 Tcl_AppendResult(interp,
6002 "bad value for -translation: ",
6003 "must be one of auto, binary, cr, lf, crlf,",
6004 " or platform", (char *) NULL);
6005 }
6006 ckfree((char *) argv);
6007 return TCL_ERROR;
6008 }
6009 }
6010 ckfree((char *) argv);
6011 return TCL_OK;
6012 } else if (chanPtr->typePtr->setOptionProc != NULL) {
6013 return (*chanPtr->typePtr->setOptionProc)(chanPtr->instanceData,
6014 interp, optionName, newValue);
6015 } else {
6016 return Tcl_BadChannelOption(interp, optionName, (char *) NULL);
6017 }
6018
6019 /*
6020 * If bufsize changes, need to get rid of old utility buffer.
6021 */
6022
6023 if (chanPtr->saveInBufPtr != NULL) {
6024 RecycleBuffer(chanPtr, chanPtr->saveInBufPtr, 1);
6025 chanPtr->saveInBufPtr = NULL;
6026 }
6027 if (chanPtr->inQueueHead != NULL) {
6028 if ((chanPtr->inQueueHead->nextPtr == NULL)
6029 && (chanPtr->inQueueHead->nextAdded ==
6030 chanPtr->inQueueHead->nextRemoved)) {
6031 RecycleBuffer(chanPtr, chanPtr->inQueueHead, 1);
6032 chanPtr->inQueueHead = NULL;
6033 chanPtr->inQueueTail = NULL;
6034 }
6035 }
6036
6037 /*
6038 * If encoding or bufsize changes, need to update output staging buffer.
6039 */
6040
6041 if (chanPtr->outputStage != NULL) {
6042 ckfree((char *) chanPtr->outputStage);
6043 chanPtr->outputStage = NULL;
6044 }
6045 if ((chanPtr->encoding != NULL) && (chanPtr->flags & TCL_WRITABLE)) {
6046 chanPtr->outputStage = (char *)
6047 ckalloc((unsigned) (chanPtr->bufSize + 2));
6048 }
6049 return TCL_OK;
6050 }
6051
6052 /*
6053 *----------------------------------------------------------------------
6054 *
6055 * CleanupChannelHandlers --
6056 *
6057 * Removes channel handlers that refer to the supplied interpreter,
6058 * so that if the actual channel is not closed now, these handlers
6059 * will not run on subsequent events on the channel. This would be
6060 * erroneous, because the interpreter no longer has a reference to
6061 * this channel.
6062 *
6063 * Results:
6064 * None.
6065 *
6066 * Side effects:
6067 * Removes channel handlers.
6068 *
6069 *----------------------------------------------------------------------
6070 */
6071
6072 static void
6073 CleanupChannelHandlers(interp, chanPtr)
6074 Tcl_Interp *interp;
6075 Channel *chanPtr;
6076 {
6077 EventScriptRecord *sPtr, *prevPtr, *nextPtr;
6078
6079 /*
6080 * Remove fileevent records on this channel that refer to the
6081 * given interpreter.
6082 */
6083
6084 for (sPtr = chanPtr->scriptRecordPtr,
6085 prevPtr = (EventScriptRecord *) NULL;
6086 sPtr != (EventScriptRecord *) NULL;
6087 sPtr = nextPtr) {
6088 nextPtr = sPtr->nextPtr;
6089 if (sPtr->interp == interp) {
6090 if (prevPtr == (EventScriptRecord *) NULL) {
6091 chanPtr->scriptRecordPtr = nextPtr;
6092 } else {
6093 prevPtr->nextPtr = nextPtr;
6094 }
6095
6096 Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
6097 ChannelEventScriptInvoker, (ClientData) sPtr);
6098
6099 Tcl_DecrRefCount(sPtr->scriptPtr);
6100 ckfree((char *) sPtr);
6101 } else {
6102 prevPtr = sPtr;
6103 }
6104 }
6105 }
6106
6107 /*
6108 *----------------------------------------------------------------------
6109 *
6110 * Tcl_NotifyChannel --
6111 *
6112 * This procedure is called by a channel driver when a driver
6113 * detects an event on a channel. This procedure is responsible
6114 * for actually handling the event by invoking any channel
6115 * handler callbacks.
6116 *
6117 * Results:
6118 * None.
6119 *
6120 * Side effects:
6121 * Whatever the channel handler callback procedure does.
6122 *
6123 *----------------------------------------------------------------------
6124 */
6125
6126 void
6127 Tcl_NotifyChannel(channel, mask)
6128 Tcl_Channel channel; /* Channel that detected an event. */
6129 int mask; /* OR'ed combination of TCL_READABLE,
6130 * TCL_WRITABLE, or TCL_EXCEPTION: indicates
6131 * which events were detected. */
6132 {
6133 Channel *chanPtr = (Channel *) channel;
6134 ChannelHandler *chPtr;
6135 ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
6136 NextChannelHandler nh;
6137
6138 /* Walk all channels in a stack ! and notify them in order.
6139 */
6140
6141 while (chanPtr != (Channel *) NULL) {
6142 /*
6143 * Preserve the channel struct in case the script closes it.
6144 */
6145
6146 Tcl_Preserve((ClientData) channel);
6147
6148 /*
6149 * If we are flushing in the background, be sure to call FlushChannel
6150 * for writable events. Note that we have to discard the writable
6151 * event so we don't call any write handlers before the flush is
6152 * complete.
6153 */
6154
6155 if ((chanPtr->flags & BG_FLUSH_SCHEDULED) && (mask & TCL_WRITABLE)) {
6156 FlushChannel(NULL, chanPtr, 1);
6157 mask &= ~TCL_WRITABLE;
6158 }
6159
6160 /*
6161 * Add this invocation to the list of recursive invocations of
6162 * ChannelHandlerEventProc.
6163 */
6164
6165 nh.nextHandlerPtr = (ChannelHandler *) NULL;
6166 nh.nestedHandlerPtr = tsdPtr->nestedHandlerPtr;
6167 tsdPtr->nestedHandlerPtr = &nh;
6168
6169 for (chPtr = chanPtr->chPtr; chPtr != (ChannelHandler *) NULL; ) {
6170
6171 /*
6172 * If this channel handler is interested in any of the events that
6173 * have occurred on the channel, invoke its procedure.
6174 */
6175
6176 if ((chPtr->mask & mask) != 0) {
6177 nh.nextHandlerPtr = chPtr->nextPtr;
6178 (*(chPtr->proc))(chPtr->clientData, mask);
6179 chPtr = nh.nextHandlerPtr;
6180 } else {
6181 chPtr = chPtr->nextPtr;
6182 }
6183 }
6184
6185 /*
6186 * Update the notifier interest, since it may have changed after
6187 * invoking event handlers. Skip that if the channel was deleted
6188 * in the call to the channel handler.
6189 */
6190
6191 if (chanPtr->typePtr != NULL) {
6192 UpdateInterest(chanPtr);
6193
6194 /* Walk down the stack.
6195 */
6196 chanPtr = chanPtr-> supercedes;
6197 } else {
6198 /* Stop walking the chain, the whole stack was destroyed!
6199 */
6200 chanPtr = (Channel*) NULL;
6201 }
6202
6203 Tcl_Release((ClientData) channel);
6204
6205 tsdPtr->nestedHandlerPtr = nh.nestedHandlerPtr;
6206
6207 channel = (Tcl_Channel) chanPtr;
6208 }
6209 }
6210
6211 /*
6212 *----------------------------------------------------------------------
6213 *
6214 * UpdateInterest --
6215 *
6216 * Arrange for the notifier to call us back at appropriate times
6217 * based on the current state of the channel.
6218 *
6219 * Results:
6220 * None.
6221 *
6222 * Side effects:
6223 * May schedule a timer or driver handler.
6224 *
6225 *----------------------------------------------------------------------
6226 */
6227
6228 static void
6229 UpdateInterest(chanPtr)
6230 Channel *chanPtr; /* Channel to update. */
6231 {
6232 int mask = chanPtr->interestMask;
6233
6234 /*
6235 * If there are flushed buffers waiting to be written, then
6236 * we need to watch for the channel to become writable.
6237 */
6238
6239 if (chanPtr->flags & BG_FLUSH_SCHEDULED) {
6240 mask |= TCL_WRITABLE;
6241 }
6242
6243 /*
6244 * If there is data in the input queue, and we aren't waiting for more
6245 * data, then we need to schedule a timer so we don't block in the
6246 * notifier. Also, cancel the read interest so we don't get duplicate
6247 * events.
6248 */
6249
6250 if (mask & TCL_READABLE) {
6251 if (!(chanPtr->flags & CHANNEL_NEED_MORE_DATA)
6252 && (chanPtr->inQueueHead != (ChannelBuffer *) NULL)
6253 && (chanPtr->inQueueHead->nextRemoved <
6254 chanPtr->inQueueHead->nextAdded)) {
6255 mask &= ~TCL_READABLE;
6256 if (!chanPtr->timer) {
6257 chanPtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,
6258 (ClientData) chanPtr);
6259 }
6260 }
6261 }
6262 (chanPtr->typePtr->watchProc)(chanPtr->instanceData, mask);
6263 }
6264
6265 /*
6266 *----------------------------------------------------------------------
6267 *
6268 * ChannelTimerProc --
6269 *
6270 * Timer handler scheduled by UpdateInterest to monitor the
6271 * channel buffers until they are empty.
6272 *
6273 * Results:
6274 * None.
6275 *
6276 * Side effects:
6277 * May invoke channel handlers.
6278 *
6279 *----------------------------------------------------------------------
6280 */
6281
6282 static void
6283 ChannelTimerProc(clientData)
6284 ClientData clientData;
6285 {
6286 Channel *chanPtr = (Channel *) clientData;
6287
6288 if (!(chanPtr->flags & CHANNEL_NEED_MORE_DATA)
6289 && (chanPtr->interestMask & TCL_READABLE)
6290 && (chanPtr->inQueueHead != (ChannelBuffer *) NULL)
6291 && (chanPtr->inQueueHead->nextRemoved <
6292 chanPtr->inQueueHead->nextAdded)) {
6293 /*
6294 * Restart the timer in case a channel handler reenters the
6295 * event loop before UpdateInterest gets called by Tcl_NotifyChannel.
6296 */
6297
6298 chanPtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,
6299 (ClientData) chanPtr);
6300 Tcl_NotifyChannel((Tcl_Channel)chanPtr, TCL_READABLE);
6301
6302 } else {
6303 chanPtr->timer = NULL;
6304 UpdateInterest(chanPtr);
6305 }
6306 }
6307
6308 /*
6309 *----------------------------------------------------------------------
6310 *
6311 * Tcl_CreateChannelHandler --
6312 *
6313 * Arrange for a given procedure to be invoked whenever the
6314 * channel indicated by the chanPtr arg becomes readable or
6315 * writable.
6316 *
6317 * Results:
6318 * None.
6319 *
6320 * Side effects:
6321 * From now on, whenever the I/O channel given by chanPtr becomes
6322 * ready in the way indicated by mask, proc will be invoked.
6323 * See the manual entry for details on the calling sequence
6324 * to proc. If there is already an event handler for chan, proc
6325 * and clientData, then the mask will be updated.
6326 *
6327 *----------------------------------------------------------------------
6328 */
6329
6330 void
6331 Tcl_CreateChannelHandler(chan, mask, proc, clientData)
6332 Tcl_Channel chan; /* The channel to create the handler for. */
6333 int mask; /* OR'ed combination of TCL_READABLE,
6334 * TCL_WRITABLE, and TCL_EXCEPTION:
6335 * indicates conditions under which
6336 * proc should be called. Use 0 to
6337 * disable a registered handler. */
6338 Tcl_ChannelProc *proc; /* Procedure to call for each
6339 * selected event. */
6340 ClientData clientData; /* Arbitrary data to pass to proc. */
6341 {
6342 ChannelHandler *chPtr;
6343 Channel *chanPtr;
6344
6345 chanPtr = (Channel *) chan;
6346
6347 /*
6348 * Check whether this channel handler is not already registered. If
6349 * it is not, create a new record, else reuse existing record (smash
6350 * current values).
6351 */
6352
6353 for (chPtr = chanPtr->chPtr;
6354 chPtr != (ChannelHandler *) NULL;
6355 chPtr = chPtr->nextPtr) {
6356 if ((chPtr->chanPtr == chanPtr) && (chPtr->proc == proc) &&
6357 (chPtr->clientData == clientData)) {
6358 break;
6359 }
6360 }
6361 if (chPtr == (ChannelHandler *) NULL) {
6362 chPtr = (ChannelHandler *) ckalloc((unsigned) sizeof(ChannelHandler));
6363 chPtr->mask = 0;
6364 chPtr->proc = proc;
6365 chPtr->clientData = clientData;
6366 chPtr->chanPtr = chanPtr;
6367 chPtr->nextPtr = chanPtr->chPtr;
6368 chanPtr->chPtr = chPtr;
6369 }
6370
6371 /*
6372 * The remainder of the initialization below is done regardless of
6373 * whether or not this is a new record or a modification of an old
6374 * one.
6375 */
6376
6377 chPtr->mask = mask;
6378
6379 /*
6380 * Recompute the interest mask for the channel - this call may actually
6381 * be disabling an existing handler.
6382 */
6383
6384 chanPtr->interestMask = 0;
6385 for (chPtr = chanPtr->chPtr;
6386 chPtr != (ChannelHandler *) NULL;
6387 chPtr = chPtr->nextPtr) {
6388 chanPtr->interestMask |= chPtr->mask;
6389 }
6390
6391 UpdateInterest(chanPtr);
6392 }
6393
6394 /*
6395 *----------------------------------------------------------------------
6396 *
6397 * Tcl_DeleteChannelHandler --
6398 *
6399 * Cancel a previously arranged callback arrangement for an IO
6400 * channel.
6401 *
6402 * Results:
6403 * None.
6404 *
6405 * Side effects:
6406 * If a callback was previously registered for this chan, proc and
6407 * clientData , it is removed and the callback will no longer be called
6408 * when the channel becomes ready for IO.
6409 *
6410 *----------------------------------------------------------------------
6411 */
6412
6413 void
6414 Tcl_DeleteChannelHandler(chan, proc, clientData)
6415 Tcl_Channel chan; /* The channel for which to remove the
6416 * callback. */
6417 Tcl_ChannelProc *proc; /* The procedure in the callback to delete. */
6418 ClientData clientData; /* The client data in the callback
6419 * to delete. */
6420
6421 {
6422 ChannelHandler *chPtr, *prevChPtr;
6423 Channel *chanPtr;
6424 ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
6425 NextChannelHandler *nhPtr;
6426
6427 chanPtr = (Channel *) chan;
6428
6429 /*
6430 * Find the entry and the previous one in the list.
6431 */
6432
6433 for (prevChPtr = (ChannelHandler *) NULL, chPtr = chanPtr->chPtr;
6434 chPtr != (ChannelHandler *) NULL;
6435 chPtr = chPtr->nextPtr) {
6436 if ((chPtr->chanPtr == chanPtr) && (chPtr->clientData == clientData)
6437 && (chPtr->proc == proc)) {
6438 break;
6439 }
6440 prevChPtr = chPtr;
6441 }
6442
6443 /*
6444 * If not found, return without doing anything.
6445 */
6446
6447 if (chPtr == (ChannelHandler *) NULL) {
6448 return;
6449 }
6450
6451 /*
6452 * If ChannelHandlerEventProc is about to process this handler, tell it to
6453 * process the next one instead - we are going to delete *this* one.
6454 */
6455
6456 for (nhPtr = tsdPtr->nestedHandlerPtr;
6457 nhPtr != (NextChannelHandler *) NULL;
6458 nhPtr = nhPtr->nestedHandlerPtr) {
6459 if (nhPtr->nextHandlerPtr == chPtr) {
6460 nhPtr->nextHandlerPtr = chPtr->nextPtr;
6461 }
6462 }
6463
6464 /*
6465 * Splice it out of the list of channel handlers.
6466 */
6467
6468 if (prevChPtr == (ChannelHandler *) NULL) {
6469 chanPtr->chPtr = chPtr->nextPtr;
6470 } else {
6471 prevChPtr->nextPtr = chPtr->nextPtr;
6472 }
6473 ckfree((char *) chPtr);
6474
6475 /*
6476 * Recompute the interest list for the channel, so that infinite loops
6477 * will not result if Tcl_DeleteChannelHandler is called inside an
6478 * event.
6479 */
6480
6481 chanPtr->interestMask = 0;
6482 for (chPtr = chanPtr->chPtr;
6483 chPtr != (ChannelHandler *) NULL;
6484 chPtr = chPtr->nextPtr) {
6485 chanPtr->interestMask |= chPtr->mask;
6486 }
6487
6488 UpdateInterest(chanPtr);
6489 }
6490
6491 /*
6492 *----------------------------------------------------------------------
6493 *
6494 * DeleteScriptRecord --
6495 *
6496 * Delete a script record for this combination of channel, interp
6497 * and mask.
6498 *
6499 * Results:
6500 * None.
6501 *
6502 * Side effects:
6503 * Deletes a script record and cancels a channel event handler.
6504 *
6505 *----------------------------------------------------------------------
6506 */
6507
6508 static void
6509 DeleteScriptRecord(interp, chanPtr, mask)
6510 Tcl_Interp *interp; /* Interpreter in which script was to be
6511 * executed. */
6512 Channel *chanPtr; /* The channel for which to delete the
6513 * script record (if any). */
6514 int mask; /* Events in mask must exactly match mask
6515 * of script to delete. */
6516 {
6517 EventScriptRecord *esPtr, *prevEsPtr;
6518
6519 for (esPtr = chanPtr->scriptRecordPtr,
6520 prevEsPtr = (EventScriptRecord *) NULL;
6521 esPtr != (EventScriptRecord *) NULL;
6522 prevEsPtr = esPtr, esPtr = esPtr->nextPtr) {
6523 if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
6524 if (esPtr == chanPtr->scriptRecordPtr) {
6525 chanPtr->scriptRecordPtr = esPtr->nextPtr;
6526 } else {
6527 prevEsPtr->nextPtr = esPtr->nextPtr;
6528 }
6529
6530 Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
6531 ChannelEventScriptInvoker, (ClientData) esPtr);
6532
6533 Tcl_DecrRefCount(esPtr->scriptPtr);
6534 ckfree((char *) esPtr);
6535
6536 break;
6537 }
6538 }
6539 }
6540
6541 /*
6542 *----------------------------------------------------------------------
6543 *
6544 * CreateScriptRecord --
6545 *
6546 * Creates a record to store a script to be executed when a specific
6547 * event fires on a specific channel.
6548 *
6549 * Results:
6550 * None.
6551 *
6552 * Side effects:
6553 * Causes the script to be stored for later execution.
6554 *
6555 *----------------------------------------------------------------------
6556 */
6557
6558 static void
6559 CreateScriptRecord(interp, chanPtr, mask, scriptPtr)
6560 Tcl_Interp *interp; /* Interpreter in which to execute
6561 * the stored script. */
6562 Channel *chanPtr; /* Channel for which script is to
6563 * be stored. */
6564 int mask; /* Set of events for which script
6565 * will be invoked. */
6566 Tcl_Obj *scriptPtr; /* Pointer to script object. */
6567 {
6568 EventScriptRecord *esPtr;
6569
6570 for (esPtr = chanPtr->scriptRecordPtr;
6571 esPtr != (EventScriptRecord *) NULL;
6572 esPtr = esPtr->nextPtr) {
6573 if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
6574 Tcl_DecrRefCount(esPtr->scriptPtr);
6575 esPtr->scriptPtr = (Tcl_Obj *) NULL;
6576 break;
6577 }
6578 }
6579 if (esPtr == (EventScriptRecord *) NULL) {
6580 esPtr = (EventScriptRecord *) ckalloc((unsigned)
6581 sizeof(EventScriptRecord));
6582 Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
6583 ChannelEventScriptInvoker, (ClientData) esPtr);
6584 esPtr->nextPtr = chanPtr->scriptRecordPtr;
6585 chanPtr->scriptRecordPtr = esPtr;
6586 }
6587 esPtr->chanPtr = chanPtr;
6588 esPtr->interp = interp;
6589 esPtr->mask = mask;
6590 Tcl_IncrRefCount(scriptPtr);
6591 esPtr->scriptPtr = scriptPtr;
6592 }
6593
6594 /*
6595 *----------------------------------------------------------------------
6596 *
6597 * ChannelEventScriptInvoker --
6598 *
6599 * Invokes a script scheduled by "fileevent" for when the channel
6600 * becomes ready for IO. This function is invoked by the channel
6601 * handler which was created by the Tcl "fileevent" command.
6602 *
6603 * Results:
6604 * None.
6605 *
6606 * Side effects:
6607 * Whatever the script does.
6608 *
6609 *----------------------------------------------------------------------
6610 */
6611
6612 static void
6613 ChannelEventScriptInvoker(clientData, mask)
6614 ClientData clientData; /* The script+interp record. */
6615 int mask; /* Not used. */
6616 {
6617 Tcl_Interp *interp; /* Interpreter in which to eval the script. */
6618 Channel *chanPtr; /* The channel for which this handler is
6619 * registered. */
6620 EventScriptRecord *esPtr; /* The event script + interpreter to eval it
6621 * in. */
6622 int result; /* Result of call to eval script. */
6623
6624 esPtr = (EventScriptRecord *) clientData;
6625
6626 chanPtr = esPtr->chanPtr;
6627 mask = esPtr->mask;
6628 interp = esPtr->interp;
6629
6630 /*
6631 * We must preserve the interpreter so we can report errors on it
6632 * later. Note that we do not need to preserve the channel because
6633 * that is done by Tcl_NotifyChannel before calling channel handlers.
6634 */
6635
6636 Tcl_Preserve((ClientData) interp);
6637 result = Tcl_EvalObjEx(interp, esPtr->scriptPtr, TCL_EVAL_GLOBAL);
6638
6639 /*
6640 * On error, cause a background error and remove the channel handler
6641 * and the script record.
6642 *
6643 * NOTE: Must delete channel handler before causing the background error
6644 * because the background error may want to reinstall the handler.
6645 */
6646
6647 if (result != TCL_OK) {
6648 if (chanPtr->typePtr != NULL) {
6649 DeleteScriptRecord(interp, chanPtr, mask);
6650 }
6651 Tcl_BackgroundError(interp);
6652 }
6653 Tcl_Release((ClientData) interp);
6654 }
6655
6656 /*
6657 *----------------------------------------------------------------------
6658 *
6659 * Tcl_FileEventObjCmd --
6660 *
6661 * This procedure implements the "fileevent" Tcl command. See the
6662 * user documentation for details on what it does. This command is
6663 * based on the Tk command "fileevent" which in turn is based on work
6664 * contributed by Mark Diekhans.
6665 *
6666 * Results:
6667 * A standard Tcl result.
6668 *
6669 * Side effects:
6670 * May create a channel handler for the specified channel.
6671 *
6672 *----------------------------------------------------------------------
6673 */
6674
6675 /* ARGSUSED */
6676 int
6677 Tcl_FileEventObjCmd(clientData, interp, objc, objv)
6678 ClientData clientData; /* Not used. */
6679 Tcl_Interp *interp; /* Interpreter in which the channel
6680 * for which to create the handler
6681 * is found. */
6682 int objc; /* Number of arguments. */
6683 Tcl_Obj *CONST objv[]; /* Argument objects. */
6684 {
6685 Channel *chanPtr; /* The channel to create
6686 * the handler for. */
6687 Tcl_Channel chan; /* The opaque type for the channel. */
6688 char *chanName;
6689 int modeIndex; /* Index of mode argument. */
6690 int mask;
6691 static char *modeOptions[] = {"readable", "writable", NULL};
6692 static int maskArray[] = {TCL_READABLE, TCL_WRITABLE};
6693
6694 if ((objc != 3) && (objc != 4)) {
6695 Tcl_WrongNumArgs(interp, 1, objv, "channelId event ?script?");
6696 return TCL_ERROR;
6697 }
6698 if (Tcl_GetIndexFromObj(interp, objv[2], modeOptions, "event name", 0,
6699 &modeIndex) != TCL_OK) {
6700 return TCL_ERROR;
6701 }
6702 mask = maskArray[modeIndex];
6703
6704 chanName = Tcl_GetString(objv[1]);
6705 chan = Tcl_GetChannel(interp, chanName, NULL);
6706 if (chan == (Tcl_Channel) NULL) {
6707 return TCL_ERROR;
6708 }
6709 chanPtr = (Channel *) chan;
6710 if ((chanPtr->flags & mask) == 0) {
6711 Tcl_AppendResult(interp, "channel is not ",
6712 (mask == TCL_READABLE) ? "readable" : "writable",
6713 (char *) NULL);
6714 return TCL_ERROR;
6715 }
6716
6717 /*
6718 * If we are supposed to return the script, do so.
6719 */
6720
6721 if (objc == 3) {
6722 EventScriptRecord *esPtr;
6723 for (esPtr = chanPtr->scriptRecordPtr;
6724 esPtr != (EventScriptRecord *) NULL;
6725 esPtr = esPtr->nextPtr) {
6726 if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
6727 Tcl_SetObjResult(interp, esPtr->scriptPtr);
6728 break;
6729 }
6730 }
6731 return TCL_OK;
6732 }
6733
6734 /*
6735 * If we are supposed to delete a stored script, do so.
6736 */
6737
6738 if (*(Tcl_GetString(objv[3])) == '\0') {
6739 DeleteScriptRecord(interp, chanPtr, mask);
6740 return TCL_OK;
6741 }
6742
6743 /*
6744 * Make the script record that will link between the event and the
6745 * script to invoke. This also creates a channel event handler which
6746 * will evaluate the script in the supplied interpreter.
6747 */
6748
6749 CreateScriptRecord(interp, chanPtr, mask, objv[3]);
6750
6751 return TCL_OK;
6752 }
6753
6754 /*
6755 *----------------------------------------------------------------------
6756 *
6757 * TclTestChannelCmd --
6758 *
6759 * Implements the Tcl "testchannel" debugging command and its
6760 * subcommands. This is part of the testing environment but must be
6761 * in this file instead of tclTest.c because it needs access to the
6762 * fields of struct Channel.
6763 *
6764 * Results:
6765 * A standard Tcl result.
6766 *
6767 * Side effects:
6768 * None.
6769 *
6770 *----------------------------------------------------------------------
6771 */
6772
6773 /* ARGSUSED */
6774 int
6775 TclTestChannelCmd(clientData, interp, argc, argv)
6776 ClientData clientData; /* Not used. */
6777 Tcl_Interp *interp; /* Interpreter for result. */
6778 int argc; /* Count of additional args. */
6779 char **argv; /* Additional arg strings. */
6780 {
6781 char *cmdName; /* Sub command. */
6782 Tcl_HashTable *hTblPtr; /* Hash table of channels. */
6783 Tcl_HashSearch hSearch; /* Search variable. */
6784 Tcl_HashEntry *hPtr; /* Search variable. */
6785 Channel *chanPtr; /* The actual channel. */
6786 Tcl_Channel chan; /* The opaque type. */
6787 size_t len; /* Length of subcommand string. */
6788 int IOQueued; /* How much IO is queued inside channel? */
6789 ChannelBuffer *bufPtr; /* For iterating over queued IO. */
6790 char buf[TCL_INTEGER_SPACE];/* For sprintf. */
6791
6792 if (argc < 2) {
6793 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
6794 " subcommand ?additional args..?\"", (char *) NULL);
6795 return TCL_ERROR;
6796 }
6797 cmdName = argv[1];
6798 len = strlen(cmdName);
6799
6800 chanPtr = (Channel *) NULL;
6801
6802 if (argc > 2) {
6803 chan = Tcl_GetChannel(interp, argv[2], NULL);
6804 if (chan == (Tcl_Channel) NULL) {
6805 return TCL_ERROR;
6806 }
6807 chanPtr = (Channel *) chan;
6808 }
6809
6810
6811 if ((cmdName[0] == 'i') && (strncmp(cmdName, "info", len) == 0)) {
6812 if (argc != 3) {
6813 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
6814 " info channelName\"", (char *) NULL);
6815 return TCL_ERROR;
6816 }
6817 Tcl_AppendElement(interp, argv[2]);
6818 Tcl_AppendElement(interp, chanPtr->typePtr->typeName);
6819 if (chanPtr->flags & TCL_READABLE) {
6820 Tcl_AppendElement(interp, "read");
6821 } else {
6822 Tcl_AppendElement(interp, "");
6823 }
6824 if (chanPtr->flags & TCL_WRITABLE) {
6825 Tcl_AppendElement(interp, "write");
6826 } else {
6827 Tcl_AppendElement(interp, "");
6828 }
6829 if (chanPtr->flags & CHANNEL_NONBLOCKING) {
6830 Tcl_AppendElement(interp, "nonblocking");
6831 } else {
6832 Tcl_AppendElement(interp, "blocking");
6833 }
6834 if (chanPtr->flags & CHANNEL_LINEBUFFERED) {
6835 Tcl_AppendElement(interp, "line");
6836 } else if (chanPtr->flags & CHANNEL_UNBUFFERED) {
6837 Tcl_AppendElement(interp, "none");
6838 } else {
6839 Tcl_AppendElement(interp, "full");
6840 }
6841 if (chanPtr->flags & BG_FLUSH_SCHEDULED) {
6842 Tcl_AppendElement(interp, "async_flush");
6843 } else {
6844 Tcl_AppendElement(interp, "");
6845 }
6846 if (chanPtr->flags & CHANNEL_EOF) {
6847 Tcl_AppendElement(interp, "eof");
6848 } else {
6849 Tcl_AppendElement(interp, "");
6850 }
6851 if (chanPtr->flags & CHANNEL_BLOCKED) {
6852 Tcl_AppendElement(interp, "blocked");
6853 } else {
6854 Tcl_AppendElement(interp, "unblocked");
6855 }
6856 if (chanPtr->inputTranslation == TCL_TRANSLATE_AUTO) {
6857 Tcl_AppendElement(interp, "auto");
6858 if (chanPtr->flags & INPUT_SAW_CR) {
6859 Tcl_AppendElement(interp, "saw_cr");
6860 } else {
6861 Tcl_AppendElement(interp, "");
6862 }
6863 } else if (chanPtr->inputTranslation == TCL_TRANSLATE_LF) {
6864 Tcl_AppendElement(interp, "lf");
6865 Tcl_AppendElement(interp, "");
6866 } else if (chanPtr->inputTranslation == TCL_TRANSLATE_CR) {
6867 Tcl_AppendElement(interp, "cr");
6868 Tcl_AppendElement(interp, "");
6869 } else if (chanPtr->inputTranslation == TCL_TRANSLATE_CRLF) {
6870 Tcl_AppendElement(interp, "crlf");
6871 if (chanPtr->flags & INPUT_SAW_CR) {
6872 Tcl_AppendElement(interp, "queued_cr");
6873 } else {
6874 Tcl_AppendElement(interp, "");
6875 }
6876 }
6877 if (chanPtr->outputTranslation == TCL_TRANSLATE_AUTO) {
6878 Tcl_AppendElement(interp, "auto");
6879 } else if (chanPtr->outputTranslation == TCL_TRANSLATE_LF) {
6880 Tcl_AppendElement(interp, "lf");
6881 } else if (chanPtr->outputTranslation == TCL_TRANSLATE_CR) {
6882 Tcl_AppendElement(interp, "cr");
6883 } else if (chanPtr->outputTranslation == TCL_TRANSLATE_CRLF) {
6884 Tcl_AppendElement(interp, "crlf");
6885 }
6886 for (IOQueued = 0, bufPtr = chanPtr->inQueueHead;
6887 bufPtr != (ChannelBuffer *) NULL;
6888 bufPtr = bufPtr->nextPtr) {
6889 IOQueued += bufPtr->nextAdded - bufPtr->nextRemoved;
6890 }
6891 TclFormatInt(buf, IOQueued);
6892 Tcl_AppendElement(interp, buf);
6893
6894 IOQueued = 0;
6895 if (chanPtr->curOutPtr != (ChannelBuffer *) NULL) {
6896 IOQueued = chanPtr->curOutPtr->nextAdded -
6897 chanPtr->curOutPtr->nextRemoved;
6898 }
6899 for (bufPtr = chanPtr->outQueueHead;
6900 bufPtr != (ChannelBuffer *) NULL;
6901 bufPtr = bufPtr->nextPtr) {
6902 IOQueued += (bufPtr->nextAdded - bufPtr->nextRemoved);
6903 }
6904 TclFormatInt(buf, IOQueued);
6905 Tcl_AppendElement(interp, buf);
6906
6907 TclFormatInt(buf, Tcl_Tell((Tcl_Channel) chanPtr));
6908 Tcl_AppendElement(interp, buf);
6909
6910 TclFormatInt(buf, chanPtr->refCount);
6911 Tcl_AppendElement(interp, buf);
6912
6913 return TCL_OK;
6914 }
6915
6916 if ((cmdName[0] == 'i') &&
6917 (strncmp(cmdName, "inputbuffered", len) == 0)) {
6918 if (argc != 3) {
6919 Tcl_AppendResult(interp, "channel name required",
6920 (char *) NULL);
6921 return TCL_ERROR;
6922 }
6923
6924 for (IOQueued = 0, bufPtr = chanPtr->inQueueHead;
6925 bufPtr != (ChannelBuffer *) NULL;
6926 bufPtr = bufPtr->nextPtr) {
6927 IOQueued += bufPtr->nextAdded - bufPtr->nextRemoved;
6928 }
6929 TclFormatInt(buf, IOQueued);
6930 Tcl_AppendResult(interp, buf, (char *) NULL);
6931 return TCL_OK;
6932 }
6933
6934 if ((cmdName[0] == 'm') && (strncmp(cmdName, "mode", len) == 0)) {
6935 if (argc != 3) {
6936 Tcl_AppendResult(interp, "channel name required",
6937 (char *) NULL);
6938 return TCL_ERROR;
6939 }
6940
6941 if (chanPtr->flags & TCL_READABLE) {
6942 Tcl_AppendElement(interp, "read");
6943 } else {
6944 Tcl_AppendElement(interp, "");
6945 }
6946 if (chanPtr->flags & TCL_WRITABLE) {
6947 Tcl_AppendElement(interp, "write");
6948 } else {
6949 Tcl_AppendElement(interp, "");
6950 }
6951 return TCL_OK;
6952 }
6953
6954 if ((cmdName[0] == 'n') && (strncmp(cmdName, "name", len) == 0)) {
6955 if (argc != 3) {
6956 Tcl_AppendResult(interp, "channel name required",
6957 (char *) NULL);
6958 return TCL_ERROR;
6959 }
6960 Tcl_AppendResult(interp, chanPtr->channelName, (char *) NULL);
6961 return TCL_OK;
6962 }
6963
6964 if ((cmdName[0] == 'o') && (strncmp(cmdName, "open", len) == 0)) {
6965 hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
6966 if (hTblPtr == (Tcl_HashTable *) NULL) {
6967 return TCL_OK;
6968 }
6969 for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
6970 hPtr != (Tcl_HashEntry *) NULL;
6971 hPtr = Tcl_NextHashEntry(&hSearch)) {
6972 Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
6973 }
6974 return TCL_OK;
6975 }
6976
6977 if ((cmdName[0] == 'o') &&
6978 (strncmp(cmdName, "outputbuffered", len) == 0)) {
6979 if (argc != 3) {
6980 Tcl_AppendResult(interp, "channel name required",
6981 (char *) NULL);
6982 return TCL_ERROR;
6983 }
6984
6985 IOQueued = 0;
6986 if (chanPtr->curOutPtr != (ChannelBuffer *) NULL) {
6987 IOQueued = chanPtr->curOutPtr->nextAdded -
6988 chanPtr->curOutPtr->nextRemoved;
6989 }
6990 for (bufPtr = chanPtr->outQueueHead;
6991 bufPtr != (ChannelBuffer *) NULL;
6992 bufPtr = bufPtr->nextPtr) {
6993 IOQueued += (bufPtr->nextAdded - bufPtr->nextRemoved);
6994 }
6995 TclFormatInt(buf, IOQueued);
6996 Tcl_AppendResult(interp, buf, (char *) NULL);
6997 return TCL_OK;
6998 }
6999
7000 if ((cmdName[0] == 'q') &&
7001 (strncmp(cmdName, "queuedcr", len) == 0)) {
7002 if (argc != 3) {
7003 Tcl_AppendResult(interp, "channel name required",
7004 (char *) NULL);
7005 return TCL_ERROR;
7006 }
7007
7008 Tcl_AppendResult(interp,
7009 (chanPtr->flags & INPUT_SAW_CR) ? "1" : "0",
7010 (char *) NULL);
7011 return TCL_OK;
7012 }
7013
7014 if ((cmdName[0] == 'r') && (strncmp(cmdName, "readable", len) == 0)) {
7015 hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
7016 if (hTblPtr == (Tcl_HashTable *) NULL) {
7017 return TCL_OK;
7018 }
7019 for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
7020 hPtr != (Tcl_HashEntry *) NULL;
7021 hPtr = Tcl_NextHashEntry(&hSearch)) {
7022 chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
7023 if (chanPtr->flags & TCL_READABLE) {
7024 Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
7025 }
7026 }
7027 return TCL_OK;
7028 }
7029
7030 if ((cmdName[0] == 'r') && (strncmp(cmdName, "refcount", len) == 0)) {
7031 if (argc != 3) {
7032 Tcl_AppendResult(interp, "channel name required",
7033 (char *) NULL);
7034 return TCL_ERROR;
7035 }
7036
7037 TclFormatInt(buf, chanPtr->refCount);
7038 Tcl_AppendResult(interp, buf, (char *) NULL);
7039 return TCL_OK;
7040 }
7041
7042 if ((cmdName[0] == 't') && (strncmp(cmdName, "type", len) == 0)) {
7043 if (argc != 3) {
7044 Tcl_AppendResult(interp, "channel name required",
7045 (char *) NULL);
7046 return TCL_ERROR;
7047 }
7048 Tcl_AppendResult(interp, chanPtr->typePtr->typeName, (char *) NULL);
7049 return TCL_OK;
7050 }
7051
7052 if ((cmdName[0] == 'w') && (strncmp(cmdName, "writable", len) == 0)) {
7053 hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
7054 if (hTblPtr == (Tcl_HashTable *) NULL) {
7055 return TCL_OK;
7056 }
7057 for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
7058 hPtr != (Tcl_HashEntry *) NULL;
7059 hPtr = Tcl_NextHashEntry(&hSearch)) {
7060 chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
7061 if (chanPtr->flags & TCL_WRITABLE) {
7062 Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
7063 }
7064 }
7065 return TCL_OK;
7066 }
7067
7068 Tcl_AppendResult(interp, "bad option \"", cmdName, "\": should be ",
7069 "info, open, readable, or writable",
7070 (char *) NULL);
7071 return TCL_ERROR;
7072 }
7073
7074 /*
7075 *----------------------------------------------------------------------
7076 *
7077 * TclTestChannelEventCmd --
7078 *
7079 * This procedure implements the "testchannelevent" command. It is
7080 * used to test the Tcl channel event mechanism. It is present in
7081 * this file instead of tclTest.c because it needs access to the
7082 * internal structure of the channel.
7083 *
7084 * Results:
7085 * A standard Tcl result.
7086 *
7087 * Side effects:
7088 * Creates, deletes and returns channel event handlers.
7089 *
7090 *----------------------------------------------------------------------
7091 */
7092
7093 /* ARGSUSED */
7094 int
7095 TclTestChannelEventCmd(dummy, interp, argc, argv)
7096 ClientData dummy; /* Not used. */
7097 Tcl_Interp *interp; /* Current interpreter. */
7098 int argc; /* Number of arguments. */
7099 char **argv; /* Argument strings. */
7100 {
7101 Tcl_Obj *resultListPtr;
7102 Channel *chanPtr;
7103 EventScriptRecord *esPtr, *prevEsPtr, *nextEsPtr;
7104 char *cmd;
7105 int index, i, mask, len;
7106
7107 if ((argc < 3) || (argc > 5)) {
7108 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
7109 " channelName cmd ?arg1? ?arg2?\"", (char *) NULL);
7110 return TCL_ERROR;
7111 }
7112 chanPtr = (Channel *) Tcl_GetChannel(interp, argv[1], NULL);
7113 if (chanPtr == (Channel *) NULL) {
7114 return TCL_ERROR;
7115 }
7116 cmd = argv[2];
7117 len = strlen(cmd);
7118 if ((cmd[0] == 'a') && (strncmp(cmd, "add", (unsigned) len) == 0)) {
7119 if (argc != 5) {
7120 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
7121 " channelName add eventSpec script\"", (char *) NULL);
7122 return TCL_ERROR;
7123 }
7124 if (strcmp(argv[3], "readable") == 0) {
7125 mask = TCL_READABLE;
7126 } else if (strcmp(argv[3], "writable") == 0) {
7127 mask = TCL_WRITABLE;
7128 } else if (strcmp(argv[3], "none") == 0) {
7129 mask = 0;
7130 } else {
7131 Tcl_AppendResult(interp, "bad event name \"", argv[3],
7132 "\": must be readable, writable, or none", (char *) NULL);
7133 return TCL_ERROR;
7134 }
7135
7136 esPtr = (EventScriptRecord *) ckalloc((unsigned)
7137 sizeof(EventScriptRecord));
7138 esPtr->nextPtr = chanPtr->scriptRecordPtr;
7139 chanPtr->scriptRecordPtr = esPtr;
7140
7141 esPtr->chanPtr = chanPtr;
7142 esPtr->interp = interp;
7143 esPtr->mask = mask;
7144 esPtr->scriptPtr = Tcl_NewStringObj(argv[4], -1);
7145 Tcl_IncrRefCount(esPtr->scriptPtr);
7146
7147 Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
7148 ChannelEventScriptInvoker, (ClientData) esPtr);
7149
7150 return TCL_OK;
7151 }
7152
7153 if ((cmd[0] == 'd') && (strncmp(cmd, "delete", (unsigned) len) == 0)) {
7154 if (argc != 4) {
7155 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
7156 " channelName delete index\"", (char *) NULL);
7157 return TCL_ERROR;
7158 }
7159 if (Tcl_GetInt(interp, argv[3], &index) == TCL_ERROR) {
7160 return TCL_ERROR;
7161 }
7162 if (index < 0) {
7163 Tcl_AppendResult(interp, "bad event index: ", argv[3],
7164 ": must be nonnegative", (char *) NULL);
7165 return TCL_ERROR;
7166 }
7167 for (i = 0, esPtr = chanPtr->scriptRecordPtr;
7168 (i < index) && (esPtr != (EventScriptRecord *) NULL);
7169 i++, esPtr = esPtr->nextPtr) {
7170 /* Empty loop body. */
7171 }
7172 if (esPtr == (EventScriptRecord *) NULL) {
7173 Tcl_AppendResult(interp, "bad event index ", argv[3],
7174 ": out of range", (char *) NULL);
7175 return TCL_ERROR;
7176 }
7177 if (esPtr == chanPtr->scriptRecordPtr) {
7178 chanPtr->scriptRecordPtr = esPtr->nextPtr;
7179 } else {
7180 for (prevEsPtr = chanPtr->scriptRecordPtr;
7181 (prevEsPtr != (EventScriptRecord *) NULL) &&
7182 (prevEsPtr->nextPtr != esPtr);
7183 prevEsPtr = prevEsPtr->nextPtr) {
7184 /* Empty loop body. */
7185 }
7186 if (prevEsPtr == (EventScriptRecord *) NULL) {
7187 panic("TclTestChannelEventCmd: damaged event script list");
7188 }
7189 prevEsPtr->nextPtr = esPtr->nextPtr;
7190 }
7191 Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
7192 ChannelEventScriptInvoker, (ClientData) esPtr);
7193 Tcl_DecrRefCount(esPtr->scriptPtr);
7194 ckfree((char *) esPtr);
7195
7196 return TCL_OK;
7197 }
7198
7199 if ((cmd[0] == 'l') && (strncmp(cmd, "list", (unsigned) len) == 0)) {
7200 if (argc != 3) {
7201 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
7202 " channelName list\"", (char *) NULL);
7203 return TCL_ERROR;
7204 }
7205 resultListPtr = Tcl_GetObjResult(interp);
7206 for (esPtr = chanPtr->scriptRecordPtr;
7207 esPtr != (EventScriptRecord *) NULL;
7208 esPtr = esPtr->nextPtr) {
7209 if (esPtr->mask) {
7210 Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj(
7211 (esPtr->mask == TCL_READABLE) ? "readable" : "writable", -1));
7212 } else {
7213 Tcl_ListObjAppendElement(interp, resultListPtr,
7214 Tcl_NewStringObj("none", -1));
7215 }
7216 Tcl_ListObjAppendElement(interp, resultListPtr, esPtr->scriptPtr);
7217 }
7218 Tcl_SetObjResult(interp, resultListPtr);
7219 return TCL_OK;
7220 }
7221
7222 if ((cmd[0] == 'r') && (strncmp(cmd, "removeall", (unsigned) len) == 0)) {
7223 if (argc != 3) {
7224 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
7225 " channelName removeall\"", (char *) NULL);
7226 return TCL_ERROR;
7227 }
7228 for (esPtr = chanPtr->scriptRecordPtr;
7229 esPtr != (EventScriptRecord *) NULL;
7230 esPtr = nextEsPtr) {
7231 nextEsPtr = esPtr->nextPtr;
7232 Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
7233 ChannelEventScriptInvoker, (ClientData) esPtr);
7234 Tcl_DecrRefCount(esPtr->scriptPtr);
7235 ckfree((char *) esPtr);
7236 }
7237 chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL;
7238 return TCL_OK;
7239 }
7240
7241 if ((cmd[0] == 's') && (strncmp(cmd, "set", (unsigned) len) == 0)) {
7242 if (argc != 5) {
7243 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
7244 " channelName delete index event\"", (char *) NULL);
7245 return TCL_ERROR;
7246 }
7247 if (Tcl_GetInt(interp, argv[3], &index) == TCL_ERROR) {
7248 return TCL_ERROR;
7249 }
7250 if (index < 0) {
7251 Tcl_AppendResult(interp, "bad event index: ", argv[3],
7252 ": must be nonnegative", (char *) NULL);
7253 return TCL_ERROR;
7254 }
7255 for (i = 0, esPtr = chanPtr->scriptRecordPtr;
7256 (i < index) && (esPtr != (EventScriptRecord *) NULL);
7257 i++, esPtr = esPtr->nextPtr) {
7258 /* Empty loop body. */
7259 }
7260 if (esPtr == (EventScriptRecord *) NULL) {
7261 Tcl_AppendResult(interp, "bad event index ", argv[3],
7262 ": out of range", (char *) NULL);
7263 return TCL_ERROR;
7264 }
7265
7266 if (strcmp(argv[4], "readable") == 0) {
7267 mask = TCL_READABLE;
7268 } else if (strcmp(argv[4], "writable") == 0) {
7269 mask = TCL_WRITABLE;
7270 } else if (strcmp(argv[4], "none") == 0) {
7271 mask = 0;
7272 } else {
7273 Tcl_AppendResult(interp, "bad event name \"", argv[4],
7274 "\": must be readable, writable, or none", (char *) NULL);
7275 return TCL_ERROR;
7276 }
7277 esPtr->mask = mask;
7278 Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
7279 ChannelEventScriptInvoker, (ClientData) esPtr);
7280 return TCL_OK;
7281 }
7282 Tcl_AppendResult(interp, "bad command ", cmd, ", must be one of ",
7283 "add, delete, list, set, or removeall", (char *) NULL);
7284 return TCL_ERROR;
7285 }
7286
7287 /*
7288 *----------------------------------------------------------------------
7289 *
7290 * TclCopyChannel --
7291 *
7292 * This routine copies data from one channel to another, either
7293 * synchronously or asynchronously. If a command script is
7294 * supplied, the operation runs in the background. The script
7295 * is invoked when the copy completes. Otherwise the function
7296 * waits until the copy is completed before returning.
7297 *
7298 * Results:
7299 * A standard Tcl result.
7300 *
7301 * Side effects:
7302 * May schedule a background copy operation that causes both
7303 * channels to be marked busy.
7304 *
7305 *----------------------------------------------------------------------
7306 */
7307
7308 int
7309 TclCopyChannel(interp, inChan, outChan, toRead, cmdPtr)
7310 Tcl_Interp *interp; /* Current interpreter. */
7311 Tcl_Channel inChan; /* Channel to read from. */
7312 Tcl_Channel outChan; /* Channel to write to. */
7313 int toRead; /* Amount of data to copy, or -1 for all. */
7314 Tcl_Obj *cmdPtr; /* Pointer to script to execute or NULL. */
7315 {
7316 Channel *inPtr = (Channel *) inChan;
7317 Channel *outPtr = (Channel *) outChan;
7318 int readFlags, writeFlags;
7319 CopyState *csPtr;
7320 int nonBlocking = (cmdPtr) ? CHANNEL_NONBLOCKING : 0;
7321
7322 if (inPtr->csPtr) {
7323 Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"",
7324 Tcl_GetChannelName(inChan), "\" is busy", NULL);
7325 return TCL_ERROR;
7326 }
7327 if (outPtr->csPtr) {
7328 Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"",
7329 Tcl_GetChannelName(outChan), "\" is busy", NULL);
7330 return TCL_ERROR;
7331 }
7332
7333 readFlags = inPtr->flags;
7334 writeFlags = outPtr->flags;
7335
7336 /*
7337 * Set up the blocking mode appropriately. Background copies need
7338 * non-blocking channels. Foreground copies need blocking channels.
7339 * If there is an error, restore the old blocking mode.
7340 */
7341
7342 if (nonBlocking != (readFlags & CHANNEL_NONBLOCKING)) {
7343 if (SetBlockMode(interp, inPtr,
7344 nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING)
7345 != TCL_OK) {
7346 return TCL_ERROR;
7347 }
7348 }
7349 if (inPtr != outPtr) {
7350 if (nonBlocking != (writeFlags & CHANNEL_NONBLOCKING)) {
7351 if (SetBlockMode(NULL, outPtr,
7352 nonBlocking ? TCL_MODE_BLOCKING : TCL_MODE_NONBLOCKING)
7353 != TCL_OK) {
7354 if (nonBlocking != (readFlags & CHANNEL_NONBLOCKING)) {
7355 SetBlockMode(NULL, inPtr,
7356 (readFlags & CHANNEL_NONBLOCKING)
7357 ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING);
7358 return TCL_ERROR;
7359 }
7360 }
7361 }
7362 }
7363
7364 /*
7365 * Make sure the output side is unbuffered.
7366 */
7367
7368 outPtr->flags = (outPtr->flags & ~(CHANNEL_LINEBUFFERED))
7369 | CHANNEL_UNBUFFERED;
7370
7371 /*
7372 * Allocate a new CopyState to maintain info about the current copy in
7373 * progress. This structure will be deallocated when the copy is
7374 * completed.
7375 */
7376
7377 csPtr = (CopyState*) ckalloc(sizeof(CopyState) + inPtr->bufSize);
7378 csPtr->bufSize = inPtr->bufSize;
7379 csPtr->readPtr = inPtr;
7380 csPtr->writePtr = outPtr;
7381 csPtr->readFlags = readFlags;
7382 csPtr->writeFlags = writeFlags;
7383 csPtr->toRead = toRead;
7384 csPtr->total = 0;
7385 csPtr->interp = interp;
7386 if (cmdPtr) {
7387 Tcl_IncrRefCount(cmdPtr);
7388 }
7389 csPtr->cmdPtr = cmdPtr;
7390 inPtr->csPtr = csPtr;
7391 outPtr->csPtr = csPtr;
7392
7393 /*
7394 * Start copying data between the channels.
7395 */
7396
7397 return CopyData(csPtr, 0);
7398 }
7399
7400 /*
7401 *----------------------------------------------------------------------
7402 *
7403 * CopyData --
7404 *
7405 * This function implements the lowest level of the copying
7406 * mechanism for TclCopyChannel.
7407 *
7408 * Results:
7409 * Returns TCL_OK on success, else TCL_ERROR.
7410 *
7411 * Side effects:
7412 * Moves data between channels, may create channel handlers.
7413 *
7414 *----------------------------------------------------------------------
7415 */
7416
7417 static int
7418 CopyData(csPtr, mask)
7419 CopyState *csPtr; /* State of copy operation. */
7420 int mask; /* Current channel event flags. */
7421 {
7422 Tcl_Interp *interp;
7423 Tcl_Obj *cmdPtr, *errObj = NULL;
7424 Tcl_Channel inChan, outChan;
7425 int result = TCL_OK;
7426 int size;
7427 int total;
7428
7429 inChan = (Tcl_Channel)csPtr->readPtr;
7430 outChan = (Tcl_Channel)csPtr->writePtr;
7431 interp = csPtr->interp;
7432 cmdPtr = csPtr->cmdPtr;
7433
7434 /*
7435 * Copy the data the slow way, using the translation mechanism.
7436 */
7437
7438 while (csPtr->toRead != 0) {
7439
7440 /*
7441 * Check for unreported background errors.
7442 */
7443
7444 if (csPtr->readPtr->unreportedError != 0) {
7445 Tcl_SetErrno(csPtr->readPtr->unreportedError);
7446 csPtr->readPtr->unreportedError = 0;
7447 goto readError;
7448 }
7449 if (csPtr->writePtr->unreportedError != 0) {
7450 Tcl_SetErrno(csPtr->writePtr->unreportedError);
7451 csPtr->writePtr->unreportedError = 0;
7452 goto writeError;
7453 }
7454
7455 /*
7456 * Read up to bufSize bytes.
7457 */
7458
7459 if ((csPtr->toRead == -1)
7460 || (csPtr->toRead > csPtr->bufSize)) {
7461 size = csPtr->bufSize;
7462 } else {
7463 size = csPtr->toRead;
7464 }
7465 size = DoRead(csPtr->readPtr, csPtr->buffer, size);
7466
7467 if (size < 0) {
7468 readError:
7469 errObj = Tcl_NewObj();
7470 Tcl_AppendStringsToObj(errObj, "error reading \"",
7471 Tcl_GetChannelName(inChan), "\": ",
7472 Tcl_PosixError(interp), (char *) NULL);
7473 break;
7474 } else if (size == 0) {
7475 /*
7476 * We had an underflow on the read side. If we are at EOF,
7477 * then the copying is done, otherwise set up a channel
7478 * handler to detect when the channel becomes readable again.
7479 */
7480
7481 if (Tcl_Eof(inChan)) {
7482 break;
7483 } else if (!(mask & TCL_READABLE)) {
7484 if (mask & TCL_WRITABLE) {
7485 Tcl_DeleteChannelHandler(outChan, CopyEventProc,
7486 (ClientData) csPtr);
7487 }
7488 Tcl_CreateChannelHandler(inChan, TCL_READABLE,
7489 CopyEventProc, (ClientData) csPtr);
7490 }
7491 return TCL_OK;
7492 }
7493
7494 /*
7495 * Now write the buffer out.
7496 */
7497
7498 size = DoWrite(csPtr->writePtr, csPtr->buffer, size);
7499 if (size < 0) {
7500 writeError:
7501 errObj = Tcl_NewObj();
7502 Tcl_AppendStringsToObj(errObj, "error writing \"",
7503 Tcl_GetChannelName(outChan), "\": ",
7504 Tcl_PosixError(interp), (char *) NULL);
7505 break;
7506 }
7507
7508 /*
7509 * Check to see if the write is happening in the background. If so,
7510 * stop copying and wait for the channel to become writable again.
7511 */
7512
7513 if (csPtr->writePtr->flags & BG_FLUSH_SCHEDULED) {
7514 if (!(mask & TCL_WRITABLE)) {
7515 if (mask & TCL_READABLE) {
7516 Tcl_DeleteChannelHandler(outChan, CopyEventProc,
7517 (ClientData) csPtr);
7518 }
7519 Tcl_CreateChannelHandler(outChan, TCL_WRITABLE,
7520 CopyEventProc, (ClientData) csPtr);
7521 }
7522 return TCL_OK;
7523 }
7524
7525 /*
7526 * Update the current byte count if we care.
7527 */
7528
7529 if (csPtr->toRead != -1) {
7530 csPtr->toRead -= size;
7531 }
7532 csPtr->total += size;
7533
7534 /*
7535 * For background copies, we only do one buffer per invocation so
7536 * we don't starve the rest of the system.
7537 */
7538
7539 if (cmdPtr) {
7540 /*
7541 * The first time we enter this code, there won't be a
7542 * channel handler established yet, so do it here.
7543 */
7544
7545 if (mask == 0) {
7546 Tcl_CreateChannelHandler(outChan, TCL_WRITABLE,
7547 CopyEventProc, (ClientData) csPtr);
7548 }
7549 return TCL_OK;
7550 }
7551 }
7552
7553 /*
7554 * Make the callback or return the number of bytes transferred.
7555 * The local total is used because StopCopy frees csPtr.
7556 */
7557
7558 total = csPtr->total;
7559 if (cmdPtr) {
7560 /*
7561 * Get a private copy of the command so we can mutate it
7562 * by adding arguments. Note that StopCopy frees our saved
7563 * reference to the original command obj.
7564 */
7565
7566 cmdPtr = Tcl_DuplicateObj(cmdPtr);
7567 Tcl_IncrRefCount(cmdPtr);
7568 StopCopy(csPtr);
7569 Tcl_Preserve((ClientData) interp);
7570
7571 Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewIntObj(total));
7572 if (errObj) {
7573 Tcl_ListObjAppendElement(interp, cmdPtr, errObj);
7574 }
7575 if (Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL) != TCL_OK) {
7576 Tcl_BackgroundError(interp);
7577 result = TCL_ERROR;
7578 }
7579 Tcl_DecrRefCount(cmdPtr);
7580 Tcl_Release((ClientData) interp);
7581 } else {
7582 StopCopy(csPtr);
7583 if (errObj) {
7584 Tcl_SetObjResult(interp, errObj);
7585 result = TCL_ERROR;
7586 } else {
7587 Tcl_ResetResult(interp);
7588 Tcl_SetIntObj(Tcl_GetObjResult(interp), total);
7589 }
7590 }
7591 return result;
7592 }
7593
7594 /*
7595 *----------------------------------------------------------------------
7596 *
7597 * DoRead --
7598 *
7599 * Reads a given number of bytes from a channel.
7600 *
7601 * Results:
7602 * The number of characters read, or -1 on error. Use Tcl_GetErrno()
7603 * to retrieve the error code for the error that occurred.
7604 *
7605 * Side effects:
7606 * May cause input to be buffered.
7607 *
7608 *----------------------------------------------------------------------
7609 */
7610
7611 static int
7612 DoRead(chanPtr, bufPtr, toRead)
7613 Channel *chanPtr; /* The channel from which to read. */
7614 char *bufPtr; /* Where to store input read. */
7615 int toRead; /* Maximum number of bytes to read. */
7616 {
7617 int copied; /* How many characters were copied into
7618 * the result string? */
7619 int copiedNow; /* How many characters were copied from
7620 * the current input buffer? */
7621 int result; /* Of calling GetInput. */
7622
7623 /*
7624 * If we have not encountered a sticky EOF, clear the EOF bit. Either
7625 * way clear the BLOCKED bit. We want to discover these anew during
7626 * each operation.
7627 */
7628
7629 if (!(chanPtr->flags & CHANNEL_STICKY_EOF)) {
7630 chanPtr->flags &= ~CHANNEL_EOF;
7631 }
7632 chanPtr->flags &= ~(CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA);
7633
7634 for (copied = 0; copied < toRead; copied += copiedNow) {
7635 copiedNow = CopyAndTranslateBuffer(chanPtr, bufPtr + copied,
7636 toRead - copied);
7637 if (copiedNow == 0) {
7638 if (chanPtr->flags & CHANNEL_EOF) {
7639 goto done;
7640 }
7641 if (chanPtr->flags & CHANNEL_BLOCKED) {
7642 if (chanPtr->flags & CHANNEL_NONBLOCKING) {
7643 goto done;
7644 }
7645 chanPtr->flags &= (~(CHANNEL_BLOCKED));
7646 }
7647 result = GetInput(chanPtr);
7648 if (result != 0) {
7649 if (result != EAGAIN) {
7650 copied = -1;
7651 }
7652 goto done;
7653 }
7654 }
7655 }
7656
7657 chanPtr->flags &= (~(CHANNEL_BLOCKED));
7658
7659 done:
7660 /*
7661 * Update the notifier state so we don't block while there is still
7662 * data in the buffers.
7663 */
7664
7665 UpdateInterest(chanPtr);
7666 return copied;
7667 }
7668
7669 /*
7670 *----------------------------------------------------------------------
7671 *
7672 * CopyAndTranslateBuffer --
7673 *
7674 * Copy at most one buffer of input to the result space, doing
7675 * eol translations according to mode in effect currently.
7676 *
7677 * Results:
7678 * Number of bytes stored in the result buffer (as opposed to the
7679 * number of bytes read from the channel). May return
7680 * zero if no input is available to be translated.
7681 *
7682 * Side effects:
7683 * Consumes buffered input. May deallocate one buffer.
7684 *
7685 *----------------------------------------------------------------------
7686 */
7687
7688 static int
7689 CopyAndTranslateBuffer(chanPtr, result, space)
7690 Channel *chanPtr; /* The channel from which to read input. */
7691 char *result; /* Where to store the copied input. */
7692 int space; /* How many bytes are available in result
7693 * to store the copied input? */
7694 {
7695 int bytesInBuffer; /* How many bytes are available to be
7696 * copied in the current input buffer? */
7697 int copied; /* How many characters were already copied
7698 * into the destination space? */
7699 ChannelBuffer *bufPtr; /* The buffer from which to copy bytes. */
7700 int i; /* Iterates over the copied input looking
7701 * for the input eofChar. */
7702
7703 /*
7704 * If there is no input at all, return zero. The invariant is that either
7705 * there is no buffer in the queue, or if the first buffer is empty, it
7706 * is also the last buffer (and thus there is no input in the queue).
7707 * Note also that if the buffer is empty, we leave it in the queue.
7708 */
7709
7710 if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
7711 return 0;
7712 }
7713 bufPtr = chanPtr->inQueueHead;
7714 bytesInBuffer = bufPtr->nextAdded - bufPtr->nextRemoved;
7715
7716 copied = 0;
7717 switch (chanPtr->inputTranslation) {
7718 case TCL_TRANSLATE_LF: {
7719 if (bytesInBuffer == 0) {
7720 return 0;
7721 }
7722
7723 /*
7724 * Copy the current chunk into the result buffer.
7725 */
7726
7727 if (bytesInBuffer < space) {
7728 space = bytesInBuffer;
7729 }
7730 memcpy((VOID *) result,
7731 (VOID *) (bufPtr->buf + bufPtr->nextRemoved),
7732 (size_t) space);
7733 bufPtr->nextRemoved += space;
7734 copied = space;
7735 break;
7736 }
7737 case TCL_TRANSLATE_CR: {
7738 char *end;
7739
7740 if (bytesInBuffer == 0) {
7741 return 0;
7742 }
7743
7744 /*
7745 * Copy the current chunk into the result buffer, then
7746 * replace all \r with \n.
7747 */
7748
7749 if (bytesInBuffer < space) {
7750 space = bytesInBuffer;
7751 }
7752 memcpy((VOID *) result,
7753 (VOID *) (bufPtr->buf + bufPtr->nextRemoved),
7754 (size_t) space);
7755 bufPtr->nextRemoved += space;
7756 copied = space;
7757
7758 for (end = result + copied; result < end; result++) {
7759 if (*result == '\r') {
7760 *result = '\n';
7761 }
7762 }
7763 break;
7764 }
7765 case TCL_TRANSLATE_CRLF: {
7766 char *src, *end, *dst;
7767 int curByte;
7768
7769 /*
7770 * If there is a held-back "\r" at EOF, produce it now.
7771 */
7772
7773 if (bytesInBuffer == 0) {
7774 if ((chanPtr->flags & (INPUT_SAW_CR | CHANNEL_EOF)) ==
7775 (INPUT_SAW_CR | CHANNEL_EOF)) {
7776 result[0] = '\r';
7777 chanPtr->flags &= ~INPUT_SAW_CR;
7778 return 1;
7779 }
7780 return 0;
7781 }
7782
7783 /*
7784 * Copy the current chunk and replace "\r\n" with "\n"
7785 * (but not standalone "\r"!).
7786 */
7787
7788 if (bytesInBuffer < space) {
7789 space = bytesInBuffer;
7790 }
7791 memcpy((VOID *) result,
7792 (VOID *) (bufPtr->buf + bufPtr->nextRemoved),
7793 (size_t) space);
7794 bufPtr->nextRemoved += space;
7795 copied = space;
7796
7797 end = result + copied;
7798 dst = result;
7799 for (src = result; src < end; src++) {
7800 curByte = *src;
7801 if (curByte == '\n') {
7802 chanPtr->flags &= ~INPUT_SAW_CR;
7803 } else if (chanPtr->flags & INPUT_SAW_CR) {
7804 chanPtr->flags &= ~INPUT_SAW_CR;
7805 *dst = '\r';
7806 dst++;
7807 }
7808 if (curByte == '\r') {
7809 chanPtr->flags |= INPUT_SAW_CR;
7810 } else {
7811 *dst = (char) curByte;
7812 dst++;
7813 }
7814 }
7815 copied = dst - result;
7816 break;
7817 }
7818 case TCL_TRANSLATE_AUTO: {
7819 char *src, *end, *dst;
7820 int curByte;
7821
7822 if (bytesInBuffer == 0) {
7823 return 0;
7824 }
7825
7826 /*
7827 * Loop over the current buffer, converting "\r" and "\r\n"
7828 * to "\n".
7829 */
7830
7831 if (bytesInBuffer < space) {
7832 space = bytesInBuffer;
7833 }
7834 memcpy((VOID *) result,
7835 (VOID *) (bufPtr->buf + bufPtr->nextRemoved),
7836 (size_t) space);
7837 bufPtr->nextRemoved += space;
7838 copied = space;
7839
7840 end = result + copied;
7841 dst = result;
7842 for (src = result; src < end; src++) {
7843 curByte = *src;
7844 if (curByte == '\r') {
7845 chanPtr->flags |= INPUT_SAW_CR;
7846 *dst = '\n';
7847 dst++;
7848 } else {
7849 if ((curByte != '\n') ||
7850 !(chanPtr->flags & INPUT_SAW_CR)) {
7851 *dst = (char) curByte;
7852 dst++;
7853 }
7854 chanPtr->flags &= ~INPUT_SAW_CR;
7855 }
7856 }
7857 copied = dst - result;
7858 break;
7859 }
7860 default: {
7861 panic("unknown eol translation mode");
7862 }
7863 }
7864
7865 /*
7866 * If an in-stream EOF character is set for this channel, check that
7867 * the input we copied so far does not contain the EOF char. If it does,
7868 * copy only up to and excluding that character.
7869 */
7870
7871 if (chanPtr->inEofChar != 0) {
7872 for (i = 0; i < copied; i++) {
7873 if (result[i] == (char) chanPtr->inEofChar) {
7874 /*
7875 * Set sticky EOF so that no further input is presented
7876 * to the caller.
7877 */
7878
7879 chanPtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
7880 chanPtr->inputEncodingFlags |= TCL_ENCODING_END;
7881 copied = i;
7882 break;
7883 }
7884 }
7885 }
7886
7887 /*
7888 * If the current buffer is empty recycle it.
7889 */
7890
7891 if (bufPtr->nextRemoved == bufPtr->nextAdded) {
7892 chanPtr->inQueueHead = bufPtr->nextPtr;
7893 if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
7894 chanPtr->inQueueTail = (ChannelBuffer *) NULL;
7895 }
7896 RecycleBuffer(chanPtr, bufPtr, 0);
7897 }
7898
7899 /*
7900 * Return the number of characters copied into the result buffer.
7901 * This may be different from the number of bytes consumed, because
7902 * of EOL translations.
7903 */
7904
7905 return copied;
7906 }
7907
7908 /*
7909 *----------------------------------------------------------------------
7910 *
7911 * DoWrite --
7912 *
7913 * Puts a sequence of characters into an output buffer, may queue the
7914 * buffer for output if it gets full, and also remembers whether the
7915 * current buffer is ready e.g. if it contains a newline and we are in
7916 * line buffering mode.
7917 *
7918 * Results:
7919 * The number of bytes written or -1 in case of error. If -1,
7920 * Tcl_GetErrno will return the error code.
7921 *
7922 * Side effects:
7923 * May buffer up output and may cause output to be produced on the
7924 * channel.
7925 *
7926 *----------------------------------------------------------------------
7927 */
7928
7929 static int
7930 DoWrite(chanPtr, src, srcLen)
7931 Channel *chanPtr; /* The channel to buffer output for. */
7932 char *src; /* Data to write. */
7933 int srcLen; /* Number of bytes to write. */
7934 {
7935 ChannelBuffer *outBufPtr; /* Current output buffer. */
7936 int foundNewline; /* Did we find a newline in output? */
7937 char *dPtr;
7938 char *sPtr; /* Search variables for newline. */
7939 int crsent; /* In CRLF eol translation mode,
7940 * remember the fact that a CR was
7941 * output to the channel without
7942 * its following NL. */
7943 int i; /* Loop index for newline search. */
7944 int destCopied; /* How many bytes were used in this
7945 * destination buffer to hold the
7946 * output? */
7947 int totalDestCopied; /* How many bytes total were
7948 * copied to the channel buffer? */
7949 int srcCopied; /* How many bytes were copied from
7950 * the source string? */
7951 char *destPtr; /* Where in line to copy to? */
7952
7953 /*
7954 * If we are in network (or windows) translation mode, record the fact
7955 * that we have not yet sent a CR to the channel.
7956 */
7957
7958 crsent = 0;
7959
7960 /*
7961 * Loop filling buffers and flushing them until all output has been
7962 * consumed.
7963 */
7964
7965 srcCopied = 0;
7966 totalDestCopied = 0;
7967
7968 while (srcLen > 0) {
7969
7970 /*
7971 * Make sure there is a current output buffer to accept output.
7972 */
7973
7974 if (chanPtr->curOutPtr == (ChannelBuffer *) NULL) {
7975 chanPtr->curOutPtr = AllocChannelBuffer(chanPtr->bufSize);
7976 }
7977
7978 outBufPtr = chanPtr->curOutPtr;
7979
7980 destCopied = outBufPtr->bufLength - outBufPtr->nextAdded;
7981 if (destCopied > srcLen) {
7982 destCopied = srcLen;
7983 }
7984
7985 destPtr = outBufPtr->buf + outBufPtr->nextAdded;
7986 switch (chanPtr->outputTranslation) {
7987 case TCL_TRANSLATE_LF:
7988 srcCopied = destCopied;
7989 memcpy((VOID *) destPtr, (VOID *) src, (size_t) destCopied);
7990 break;
7991 case TCL_TRANSLATE_CR:
7992 srcCopied = destCopied;
7993 memcpy((VOID *) destPtr, (VOID *) src, (size_t) destCopied);
7994 for (dPtr = destPtr; dPtr < destPtr + destCopied; dPtr++) {
7995 if (*dPtr == '\n') {
7996 *dPtr = '\r';
7997 }
7998 }
7999 break;
8000 case TCL_TRANSLATE_CRLF:
8001 for (srcCopied = 0, dPtr = destPtr, sPtr = src;
8002 dPtr < destPtr + destCopied;
8003 dPtr++, sPtr++, srcCopied++) {
8004 if (*sPtr == '\n') {
8005 if (crsent) {
8006 *dPtr = '\n';
8007 crsent = 0;
8008 } else {
8009 *dPtr = '\r';
8010 crsent = 1;
8011 sPtr--, srcCopied--;
8012 }
8013 } else {
8014 *dPtr = *sPtr;
8015 }
8016 }
8017 break;
8018 case TCL_TRANSLATE_AUTO:
8019 panic("Tcl_Write: AUTO output translation mode not supported");
8020 default:
8021 panic("Tcl_Write: unknown output translation mode");
8022 }
8023
8024 /*
8025 * The current buffer is ready for output if it is full, or if it
8026 * contains a newline and this channel is line-buffered, or if it
8027 * contains any output and this channel is unbuffered.
8028 */
8029
8030 outBufPtr->nextAdded += destCopied;
8031 if (!(chanPtr->flags & BUFFER_READY)) {
8032 if (outBufPtr->nextAdded == outBufPtr->bufLength) {
8033 chanPtr->flags |= BUFFER_READY;
8034 } else if (chanPtr->flags & CHANNEL_LINEBUFFERED) {
8035 for (sPtr = src, i = 0, foundNewline = 0;
8036 (i < srcCopied) && (!foundNewline);
8037 i++, sPtr++) {
8038 if (*sPtr == '\n') {
8039 foundNewline = 1;
8040 break;
8041 }
8042 }
8043 if (foundNewline) {
8044 chanPtr->flags |= BUFFER_READY;
8045 }
8046 } else if (chanPtr->flags & CHANNEL_UNBUFFERED) {
8047 chanPtr->flags |= BUFFER_READY;
8048 }
8049 }
8050
8051 totalDestCopied += srcCopied;
8052 src += srcCopied;
8053 srcLen -= srcCopied;
8054
8055 if (chanPtr->flags & BUFFER_READY) {
8056 if (FlushChannel(NULL, chanPtr, 0) != 0) {
8057 return -1;
8058 }
8059 }
8060 } /* Closes "while" */
8061
8062 return totalDestCopied;
8063 }
8064
8065 /*
8066 *----------------------------------------------------------------------
8067 *
8068 * CopyEventProc --
8069 *
8070 * This routine is invoked as a channel event handler for
8071 * the background copy operation. It is just a trivial wrapper
8072 * around the CopyData routine.
8073 *
8074 * Results:
8075 * None.
8076 *
8077 * Side effects:
8078 * None.
8079 *
8080 *----------------------------------------------------------------------
8081 */
8082
8083 static void
8084 CopyEventProc(clientData, mask)
8085 ClientData clientData;
8086 int mask;
8087 {
8088 (void) CopyData((CopyState *)clientData, mask);
8089 }
8090
8091 /*
8092 *----------------------------------------------------------------------
8093 *
8094 * StopCopy --
8095 *
8096 * This routine halts a copy that is in progress.
8097 *
8098 * Results:
8099 * None.
8100 *
8101 * Side effects:
8102 * Removes any pending channel handlers and restores the blocking
8103 * and buffering modes of the channels. The CopyState is freed.
8104 *
8105 *----------------------------------------------------------------------
8106 */
8107
8108 static void
8109 StopCopy(csPtr)
8110 CopyState *csPtr; /* State for bg copy to stop . */
8111 {
8112 int nonBlocking;
8113
8114 if (!csPtr) {
8115 return;
8116 }
8117
8118 /*
8119 * Restore the old blocking mode and output buffering mode.
8120 */
8121
8122 nonBlocking = (csPtr->readFlags & CHANNEL_NONBLOCKING);
8123 if (nonBlocking != (csPtr->readPtr->flags & CHANNEL_NONBLOCKING)) {
8124 SetBlockMode(NULL, csPtr->readPtr,
8125 nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING);
8126 }
8127 if (csPtr->writePtr != csPtr->writePtr) {
8128 if (nonBlocking != (csPtr->writePtr->flags & CHANNEL_NONBLOCKING)) {
8129 SetBlockMode(NULL, csPtr->writePtr,
8130 nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING);
8131 }
8132 }
8133 csPtr->writePtr->flags &= ~(CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED);
8134 csPtr->writePtr->flags |=
8135 csPtr->writeFlags & (CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED);
8136
8137
8138 if (csPtr->cmdPtr) {
8139 Tcl_DeleteChannelHandler((Tcl_Channel)csPtr->readPtr, CopyEventProc,
8140 (ClientData)csPtr);
8141 if (csPtr->readPtr != csPtr->writePtr) {
8142 Tcl_DeleteChannelHandler((Tcl_Channel)csPtr->writePtr,
8143 CopyEventProc, (ClientData)csPtr);
8144 }
8145 Tcl_DecrRefCount(csPtr->cmdPtr);
8146 }
8147 csPtr->readPtr->csPtr = NULL;
8148 csPtr->writePtr->csPtr = NULL;
8149 ckfree((char*) csPtr);
8150 }
8151
8152 /*
8153 *----------------------------------------------------------------------
8154 *
8155 * SetBlockMode --
8156 *
8157 * This function sets the blocking mode for a channel and updates
8158 * the state flags.
8159 *
8160 * Results:
8161 * A standard Tcl result.
8162 *
8163 * Side effects:
8164 * Modifies the blocking mode of the channel and possibly generates
8165 * an error.
8166 *
8167 *----------------------------------------------------------------------
8168 */
8169
8170 static int
8171 SetBlockMode(interp, chanPtr, mode)
8172 Tcl_Interp *interp; /* Interp for error reporting. */
8173 Channel *chanPtr; /* Channel to modify. */
8174 int mode; /* One of TCL_MODE_BLOCKING or
8175 * TCL_MODE_NONBLOCKING. */
8176 {
8177 int result = 0;
8178 if (chanPtr->typePtr->blockModeProc != NULL) {
8179 result = (chanPtr->typePtr->blockModeProc) (chanPtr->instanceData,
8180 mode);
8181 }
8182 if (result != 0) {
8183 Tcl_SetErrno(result);
8184 if (interp != (Tcl_Interp *) NULL) {
8185 Tcl_AppendResult(interp, "error setting blocking mode: ",
8186 Tcl_PosixError(interp), (char *) NULL);
8187 }
8188 return TCL_ERROR;
8189 }
8190 if (mode == TCL_MODE_BLOCKING) {
8191 chanPtr->flags &= (~(CHANNEL_NONBLOCKING | BG_FLUSH_SCHEDULED));
8192 } else {
8193 chanPtr->flags |= CHANNEL_NONBLOCKING;
8194 }
8195 return TCL_OK;
8196 }
8197
8198 /*
8199 *----------------------------------------------------------------------
8200 *
8201 * Tcl_GetChannelNames --
8202 *
8203 * Return the names of all open channels in the interp.
8204 *
8205 * Results:
8206 * TCL_OK or TCL_ERROR.
8207 *
8208 * Side effects:
8209 * Interp result modified with list of channel names.
8210 *
8211 *----------------------------------------------------------------------
8212 */
8213
8214 int
8215 Tcl_GetChannelNames(interp)
8216 Tcl_Interp *interp; /* Interp for error reporting. */
8217 {
8218 return Tcl_GetChannelNamesEx(interp, (char *) NULL);
8219 }
8220
8221 /*
8222 *----------------------------------------------------------------------
8223 *
8224 * Tcl_GetChannelNamesEx --
8225 *
8226 * Return the names of open channels in the interp filtered
8227 * filtered through a pattern. If pattern is NULL, it returns
8228 * all the open channels.
8229 *
8230 * Results:
8231 * TCL_OK or TCL_ERROR.
8232 *
8233 * Side effects:
8234 * Interp result modified with list of channel names.
8235 *
8236 *----------------------------------------------------------------------
8237 */
8238
8239 int
8240 Tcl_GetChannelNamesEx(interp, pattern)
8241 Tcl_Interp *interp; /* Interp for error reporting. */
8242 char *pattern; /* pattern to filter on. */
8243 {
8244 Channel *chanPtr;
8245 ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
8246 char *name;
8247 Tcl_Obj *resultPtr;
8248
8249 resultPtr = Tcl_GetObjResult(interp);
8250 for (chanPtr = tsdPtr->firstChanPtr;
8251 chanPtr != NULL;
8252 chanPtr = chanPtr->nextChanPtr) {
8253 if (chanPtr == (Channel *) tsdPtr->stdinChannel) {
8254 name = "stdin";
8255 } else if (chanPtr == (Channel *) tsdPtr->stdoutChannel) {
8256 name = "stdout";
8257 } else if (chanPtr == (Channel *) tsdPtr->stderrChannel) {
8258 name = "stderr";
8259 } else {
8260 name = chanPtr->channelName;
8261 }
8262 if (((pattern == NULL) || Tcl_StringMatch(name, pattern)) &&
8263 (Tcl_ListObjAppendElement(interp, resultPtr,
8264 Tcl_NewStringObj(name, -1)) != TCL_OK)) {
8265 return TCL_ERROR;
8266 }
8267 }
8268 return TCL_OK;
8269 }
8270
8271 /* End of tclio.c */

Properties

Name Value
svn:keywords Header

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25