1 /*
2 * tclIO.c --
3 *
4 * This file provides the generic portions (those that are the same on
5 * all platforms and for all channel types) of Tcl's IO facilities.
6 *
7 * Copyright (c) 1998 Scriptics Corporation
8 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
9 *
10 * See the file "license.terms" for information on usage and redistribution
11 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
12 *
13 * RCS: @(#) $Id: tclIO.c,v 1.3 1999/04/18 13:27:07 aku Exp $
14 */
15
16 #include "tclInt.h"
17 #include "tclPort.h"
18
19 /*
20 * Make sure that both EAGAIN and EWOULDBLOCK are defined. This does not
21 * compile on systems where neither is defined. We want both defined so
22 * that we can test safely for both. In the code we still have to test for
23 * both because there may be systems on which both are defined and have
24 * different values.
25 */
26
27 #if ((!defined(EWOULDBLOCK)) && (defined(EAGAIN)))
28 # define EWOULDBLOCK EAGAIN
29 #endif
30 #if ((!defined(EAGAIN)) && (defined(EWOULDBLOCK)))
31 # define EAGAIN EWOULDBLOCK
32 #endif
33 #if ((!defined(EAGAIN)) && (!defined(EWOULDBLOCK)))
34 error one of EWOULDBLOCK or EAGAIN must be defined
35 #endif
36
37 /*
38 * The following structure encapsulates the state for a background channel
39 * copy. Note that the data buffer for the copy will be appended to this
40 * structure.
41 */
42
43 typedef struct CopyState {
44 struct Channel *readPtr; /* Pointer to input channel. */
45 struct Channel *writePtr; /* Pointer to output channel. */
46 int readFlags; /* Original read channel flags. */
47 int writeFlags; /* Original write channel flags. */
48 int toRead; /* Number of bytes to copy, or -1. */
49 int total; /* Total bytes transferred (written). */
50 Tcl_Interp *interp; /* Interp that started the copy. */
51 Tcl_Obj *cmdPtr; /* Command to be invoked at completion. */
52 int bufSize; /* Size of appended buffer. */
53 char buffer[1]; /* Copy buffer, this must be the last
54 * field. */
55 } CopyState;
56
57 /*
58 * struct ChannelBuffer:
59 *
60 * Buffers data being sent to or from a channel.
61 */
62
63 typedef struct ChannelBuffer {
64 int nextAdded; /* The next position into which a character
65 * will be put in the buffer. */
66 int nextRemoved; /* Position of next byte to be removed
67 * from the buffer. */
68 int bufLength; /* How big is the buffer? */
69 struct ChannelBuffer *nextPtr;
70 /* Next buffer in chain. */
71 char buf[4]; /* Placeholder for real buffer. The real
72 * buffer occuppies this space + bufSize-4
73 * bytes. This must be the last field in
74 * the structure. */
75 } ChannelBuffer;
76
77 #define CHANNELBUFFER_HEADER_SIZE (sizeof(ChannelBuffer) - 4)
78
79 /*
80 * How much extra space to allocate in buffer to hold bytes from previous
81 * buffer (when converting to UTF-8) or to hold bytes that will go to
82 * next buffer (when converting from UTF-8).
83 */
84
85 #define BUFFER_PADDING 16
86
87 /*
88 * The following defines the *default* buffer size for channels.
89 */
90
91 #define CHANNELBUFFER_DEFAULT_SIZE (1024 * 4)
92
93 /*
94 * Structure to record a close callback. One such record exists for
95 * each close callback registered for a channel.
96 */
97
98 typedef struct CloseCallback {
99 Tcl_CloseProc *proc; /* The procedure to call. */
100 ClientData clientData; /* Arbitrary one-word data to pass
101 * to the callback. */
102 struct CloseCallback *nextPtr; /* For chaining close callbacks. */
103 } CloseCallback;
104
105 /*
106 * The following structure describes the information saved from a call to
107 * "fileevent". This is used later when the event being waited for to
108 * invoke the saved script in the interpreter designed in this record.
109 */
110
111 typedef struct EventScriptRecord {
112 struct Channel *chanPtr; /* The channel for which this script is
113 * registered. This is used only when an
114 * error occurs during evaluation of the
115 * script, to delete the handler. */
116 Tcl_Obj *scriptPtr; /* Script to invoke. */
117 Tcl_Interp *interp; /* In what interpreter to invoke script? */
118 int mask; /* Events must overlap current mask for the
119 * stored script to be invoked. */
120 struct EventScriptRecord *nextPtr;
121 /* Next in chain of records. */
122 } EventScriptRecord;
123
124 /*
125 * struct Channel:
126 *
127 * One of these structures is allocated for each open channel. It contains data
128 * specific to the channel but which belongs to the generic part of the Tcl
129 * channel mechanism, and it points at an instance specific (and type
130 * specific) * instance data, and at a channel type structure.
131 */
132
133 typedef struct Channel {
134 char *channelName; /* The name of the channel instance in Tcl
135 * commands. Storage is owned by the generic IO
136 * code, is dynamically allocated. */
137 int flags; /* ORed combination of the flags defined
138 * below. */
139 Tcl_Encoding encoding; /* Encoding to apply when reading or writing
140 * data on this channel. NULL means no
141 * encoding is applied to data. */
142 Tcl_EncodingState inputEncodingState;
143 /* Current encoding state, used when converting
144 * input data bytes to UTF-8. */
145 int inputEncodingFlags; /* Encoding flags to pass to conversion
146 * routine when converting input data bytes to
147 * UTF-8. May be TCL_ENCODING_START before
148 * converting first byte and TCL_ENCODING_END
149 * when EOF is seen. */
150 Tcl_EncodingState outputEncodingState;
151 /* Current encoding state, used when converting
152 * UTF-8 to output data bytes. */
153 int outputEncodingFlags; /* Encoding flags to pass to conversion
154 * routine when converting UTF-8 to output
155 * data bytes. May be TCL_ENCODING_START
156 * before converting first byte and
157 * TCL_ENCODING_END when EOF is seen. */
158 Tcl_EolTranslation inputTranslation;
159 /* What translation to apply for end of line
160 * sequences on input? */
161 Tcl_EolTranslation outputTranslation;
162 /* What translation to use for generating
163 * end of line sequences in output? */
164 int inEofChar; /* If nonzero, use this as a signal of EOF
165 * on input. */
166 int outEofChar; /* If nonzero, append this to the channel
167 * when it is closed if it is open for
168 * writing. */
169 int unreportedError; /* Non-zero if an error report was deferred
170 * because it happened in the background. The
171 * value is the POSIX error code. */
172 ClientData instanceData; /* Instance-specific data provided by
173 * creator of channel. */
174
175 Tcl_ChannelType *typePtr; /* Pointer to channel type structure. */
176 int refCount; /* How many interpreters hold references to
177 * this IO channel? */
178 CloseCallback *closeCbPtr; /* Callbacks registered to be called when the
179 * channel is closed. */
180 char *outputStage; /* Temporary staging buffer used when
181 * translating EOL before converting from
182 * UTF-8 to external form. */
183 ChannelBuffer *curOutPtr; /* Current output buffer being filled. */
184 ChannelBuffer *outQueueHead;/* Points at first buffer in output queue. */
185 ChannelBuffer *outQueueTail;/* Points at last buffer in output queue. */
186
187 ChannelBuffer *saveInBufPtr;/* Buffer saved for input queue - eliminates
188 * need to allocate a new buffer for "gets"
189 * that crosses buffer boundaries. */
190 ChannelBuffer *inQueueHead; /* Points at first buffer in input queue. */
191 ChannelBuffer *inQueueTail; /* Points at last buffer in input queue. */
192
193 struct ChannelHandler *chPtr;/* List of channel handlers registered
194 * for this channel. */
195 int interestMask; /* Mask of all events this channel has
196 * handlers for. */
197 struct Channel *nextChanPtr;/* Next in list of channels currently open. */
198 EventScriptRecord *scriptRecordPtr;
199 /* Chain of all scripts registered for
200 * event handlers ("fileevent") on this
201 * channel. */
202 int bufSize; /* What size buffers to allocate? */
203 Tcl_TimerToken timer; /* Handle to wakeup timer for this channel. */
204 CopyState *csPtr; /* State of background copy, or NULL. */
205
206 /* Andreas Kupries <andreas_kupries@users.sourceforge.net>, 12/13/1998
207 * "Trf-Patch for filtering channels"
208 *
209 * The single change to the internal datastructures of the core. Every
210 * channel now maintains a reference to the channel he is stacked upon.
211 * This reference is NULL for normal channels. Only the two exported
212 * procedures (Tcl_ReplaceChannel and Tcl_UndoReplaceChannel, see at the
213 * end of 'tcl.h') use this field in a non-trivial way.
214 *
215 * Of the existing procedures the only following are affected by this
216 * change:
217 *
218 * - Tcl_RegisterChannel
219 * - Tcl_CreateChannel
220 * - CloseChannel
221 *
222 * The why is explained at the changed locations.
223 */
224
225 struct Channel* supercedes; /* Refers to channel this one was stacked upon */
226
227 } Channel;
228
229 /*
230 * Values for the flags field in Channel. Any ORed combination of the
231 * following flags can be stored in the field. These flags record various
232 * options and state bits about the channel. In addition to the flags below,
233 * the channel can also have TCL_READABLE (1<<1) and TCL_WRITABLE (1<<2) set.
234 */
235
236 #define CHANNEL_NONBLOCKING (1<<3) /* Channel is currently in
237 * nonblocking mode. */
238 #define CHANNEL_LINEBUFFERED (1<<4) /* Output to the channel must be
239 * flushed after every newline. */
240 #define CHANNEL_UNBUFFERED (1<<5) /* Output to the channel must always
241 * be flushed immediately. */
242 #define BUFFER_READY (1<<6) /* Current output buffer (the
243 * curOutPtr field in the
244 * channel structure) should be
245 * output as soon as possible even
246 * though it may not be full. */
247 #define BG_FLUSH_SCHEDULED (1<<7) /* A background flush of the
248 * queued output buffers has been
249 * scheduled. */
250 #define CHANNEL_CLOSED (1<<8) /* Channel has been closed. No
251 * further Tcl-level IO on the
252 * channel is allowed. */
253 #define CHANNEL_EOF (1<<9) /* EOF occurred on this channel.
254 * This bit is cleared before every
255 * input operation. */
256 #define CHANNEL_STICKY_EOF (1<<10) /* EOF occurred on this channel because
257 * we saw the input eofChar. This bit
258 * prevents clearing of the EOF bit
259 * before every input operation. */
260 #define CHANNEL_BLOCKED (1<<11) /* EWOULDBLOCK or EAGAIN occurred
261 * on this channel. This bit is
262 * cleared before every input or
263 * output operation. */
264 #define INPUT_SAW_CR (1<<12) /* Channel is in CRLF eol input
265 * translation mode and the last
266 * byte seen was a "\r". */
267 #define INPUT_NEED_NL (1<<15) /* Saw a '\r' at end of last buffer,
268 * and there should be a '\n' at
269 * beginning of next buffer. */
270 #define CHANNEL_DEAD (1<<13) /* The channel has been closed by
271 * the exit handler (on exit) but
272 * not deallocated. When any IO
273 * operation sees this flag on a
274 * channel, it does not call driver
275 * level functions to avoid referring
276 * to deallocated data. */
277 #define CHANNEL_NEED_MORE_DATA (1<<14) /* The last input operation failed
278 * because there was not enough data
279 * to complete the operation. This
280 * flag is set when gets fails to
281 * get a complete line or when read
282 * fails to get a complete character.
283 * When set, file events will not be
284 * delivered for buffered data until
285 * the state of the channel changes. */
286 /* Andreas Kupries <andreas_kupries@users.sourceforge.net>, 05/31/1997.
287 * "Trf-Patch for channels with a switchable byteorder"
288 */
289 #define CHANNEL_IS_SMALLENDIAN (1<<16) /* Multibyte words are stored with MSB last */
290
291 /*
292 * For each channel handler registered in a call to Tcl_CreateChannelHandler,
293 * there is one record of the following type. All of records for a specific
294 * channel are chained together in a singly linked list which is stored in
295 * the channel structure.
296 */
297
298 typedef struct ChannelHandler {
299 Channel *chanPtr; /* The channel structure for this channel. */
300 int mask; /* Mask of desired events. */
301 Tcl_ChannelProc *proc; /* Procedure to call in the type of
302 * Tcl_CreateChannelHandler. */
303 ClientData clientData; /* Argument to pass to procedure. */
304 struct ChannelHandler *nextPtr;
305 /* Next one in list of registered handlers. */
306 } ChannelHandler;
307
308 /*
309 * This structure keeps track of the current ChannelHandler being invoked in
310 * the current invocation of ChannelHandlerEventProc. There is a potential
311 * problem if a ChannelHandler is deleted while it is the current one, since
312 * ChannelHandlerEventProc needs to look at the nextPtr field. To handle this
313 * problem, structures of the type below indicate the next handler to be
314 * processed for any (recursively nested) dispatches in progress. The
315 * nextHandlerPtr field is updated if the handler being pointed to is deleted.
316 * The nextPtr field is used to chain together all recursive invocations, so
317 * that Tcl_DeleteChannelHandler can find all the recursively nested
318 * invocations of ChannelHandlerEventProc and compare the handler being
319 * deleted against the NEXT handler to be invoked in that invocation; when it
320 * finds such a situation, Tcl_DeleteChannelHandler updates the nextHandlerPtr
321 * field of the structure to the next handler.
322 */
323
324 typedef struct NextChannelHandler {
325 ChannelHandler *nextHandlerPtr; /* The next handler to be invoked in
326 * this invocation. */
327 struct NextChannelHandler *nestedHandlerPtr;
328 /* Next nested invocation of
329 * ChannelHandlerEventProc. */
330 } NextChannelHandler;
331
332
333 /*
334 * The following structure describes the event that is added to the Tcl
335 * event queue by the channel handler check procedure.
336 */
337
338 typedef struct ChannelHandlerEvent {
339 Tcl_Event header; /* Standard header for all events. */
340 Channel *chanPtr; /* The channel that is ready. */
341 int readyMask; /* Events that have occurred. */
342 } ChannelHandlerEvent;
343
344 /*
345 * The following structure is used by Tcl_GetsObj() to encapsulates the
346 * state for a "gets" operation.
347 */
348
349 typedef struct GetsState {
350 Tcl_Obj *objPtr; /* The object to which UTF-8 characters
351 * will be appended. */
352 char **dstPtr; /* Pointer into objPtr's string rep where
353 * next character should be stored. */
354 Tcl_Encoding encoding; /* The encoding to use to convert raw bytes
355 * to UTF-8. */
356 ChannelBuffer *bufPtr; /* The current buffer of raw bytes being
357 * emptied. */
358 Tcl_EncodingState state; /* The encoding state just before the last
359 * external to UTF-8 conversion in
360 * FilterInputBytes(). */
361 int rawRead; /* The number of bytes removed from bufPtr
362 * in the last call to FilterInputBytes(). */
363 int bytesWrote; /* The number of bytes of UTF-8 data
364 * appended to objPtr during the last call to
365 * FilterInputBytes(). */
366 int charsWrote; /* The corresponding number of UTF-8
367 * characters appended to objPtr during the
368 * last call to FilterInputBytes(). */
369 int totalChars; /* The total number of UTF-8 characters
370 * appended to objPtr so far, just before the
371 * last call to FilterInputBytes(). */
372 } GetsState;
373
374 /*
375 * All static variables used in this file are collected into a single
376 * instance of the following structure. For multi-threaded implementations,
377 * there is one instance of this structure for each thread.
378 *
379 * Notice that different structures with the same name appear in other
380 * files. The structure defined below is used in this file only.
381 */
382
383 typedef struct ThreadSpecificData {
384
385 /*
386 * This variable holds the list of nested ChannelHandlerEventProc
387 * invocations.
388 */
389 NextChannelHandler *nestedHandlerPtr;
390
391 /*
392 * List of all channels currently open.
393 */
394 Channel *firstChanPtr;
395 #ifdef oldcode
396 /*
397 * Has a channel exit handler been created yet?
398 */
399 int channelExitHandlerCreated;
400
401 /*
402 * Has the channel event source been created and registered with the
403 * notifier?
404 */
405 int channelEventSourceCreated;
406 #endif
407 /*
408 * Static variables to hold channels for stdin, stdout and stderr.
409 */
410 Tcl_Channel stdinChannel;
411 int stdinInitialized;
412 Tcl_Channel stdoutChannel;
413 int stdoutInitialized;
414 Tcl_Channel stderrChannel;
415 int stderrInitialized;
416
417 } ThreadSpecificData;
418
419 static Tcl_ThreadDataKey dataKey;
420
421
422 /*
423 * Static functions in this file:
424 */
425
426 static ChannelBuffer * AllocChannelBuffer _ANSI_ARGS_((int length));
427 static void ChannelEventScriptInvoker _ANSI_ARGS_((
428 ClientData clientData, int flags));
429 static void ChannelTimerProc _ANSI_ARGS_((
430 ClientData clientData));
431 static int CheckChannelErrors _ANSI_ARGS_((Channel *chanPtr,
432 int direction));
433 static int CheckFlush _ANSI_ARGS_((Channel *chanPtr,
434 ChannelBuffer *bufPtr, int newlineFlag));
435 static int CheckForDeadChannel _ANSI_ARGS_((Tcl_Interp *interp,
436 Channel *chan));
437 static void CheckForStdChannelsBeingClosed _ANSI_ARGS_((
438 Tcl_Channel chan));
439 static void CleanupChannelHandlers _ANSI_ARGS_((
440 Tcl_Interp *interp, Channel *chanPtr));
441 static int CloseChannel _ANSI_ARGS_((Tcl_Interp *interp,
442 Channel *chanPtr, int errorCode));
443 static void CommonGetsCleanup _ANSI_ARGS_((Channel *chanPtr,
444 Tcl_Encoding encoding));
445 static int CopyAndTranslateBuffer _ANSI_ARGS_((
446 Channel *chanPtr, char *result, int space));
447 static int CopyData _ANSI_ARGS_((CopyState *csPtr, int mask));
448 static void CopyEventProc _ANSI_ARGS_((ClientData clientData,
449 int mask));
450 static void CreateScriptRecord _ANSI_ARGS_((
451 Tcl_Interp *interp, Channel *chanPtr,
452 int mask, Tcl_Obj *scriptPtr));
453 static void DeleteChannelTable _ANSI_ARGS_((
454 ClientData clientData, Tcl_Interp *interp));
455 static void DeleteScriptRecord _ANSI_ARGS_((Tcl_Interp *interp,
456 Channel *chanPtr, int mask));
457 static void DiscardInputQueued _ANSI_ARGS_((
458 Channel *chanPtr, int discardSavedBuffers));
459 static void DiscardOutputQueued _ANSI_ARGS_((
460 Channel *chanPtr));
461 static int DoRead _ANSI_ARGS_((Channel *chanPtr, char *srcPtr,
462 int slen));
463 static int DoWrite _ANSI_ARGS_((Channel *chanPtr, char *src,
464 int srcLen));
465 static int FilterInputBytes _ANSI_ARGS_((Channel *chanPtr,
466 GetsState *statePtr));
467 static int FlushChannel _ANSI_ARGS_((Tcl_Interp *interp,
468 Channel *chanPtr, int calledFromAsyncFlush));
469 static Tcl_HashTable * GetChannelTable _ANSI_ARGS_((Tcl_Interp *interp));
470 static int GetInput _ANSI_ARGS_((Channel *chanPtr));
471 static void PeekAhead _ANSI_ARGS_((Channel *chanPtr,
472 char **dstEndPtr, GetsState *gsPtr));
473 static int ReadBytes _ANSI_ARGS_((Channel *chanPtr,
474 Tcl_Obj *objPtr, int charsLeft, int *offsetPtr));
475 static int ReadChars _ANSI_ARGS_((Channel *chanPtr,
476 Tcl_Obj *objPtr, int charsLeft, int *offsetPtr,
477 int *factorPtr));
478 static void RecycleBuffer _ANSI_ARGS_((Channel *chanPtr,
479 ChannelBuffer *bufPtr, int mustDiscard));
480 static int SetBlockMode _ANSI_ARGS_((Tcl_Interp *interp,
481 Channel *chanPtr, int mode));
482 static void StopCopy _ANSI_ARGS_((CopyState *csPtr));
483 static int TranslateInputEOL _ANSI_ARGS_((Channel *chanPtr,
484 char *dst, CONST char *src, int *dstLenPtr,
485 int *srcLenPtr));
486 static int TranslateOutputEOL _ANSI_ARGS_((Channel *chanPtr,
487 char *dst, CONST char *src, int *dstLenPtr,
488 int *srcLenPtr));
489 static void UpdateInterest _ANSI_ARGS_((Channel *chanPtr));
490 static int WriteBytes _ANSI_ARGS_((Channel *chanPtr,
491 CONST char *src, int srcLen));
492 static int WriteChars _ANSI_ARGS_((Channel *chanPtr,
493 CONST char *src, int srcLen));
494
495
496 /*
497 *---------------------------------------------------------------------------
498 *
499 * TclInitIOSubsystem --
500 *
501 * Initialize all resources used by this subsystem on a per-process
502 * basis.
503 *
504 * Results:
505 * None.
506 *
507 * Side effects:
508 * Depends on the memory subsystems.
509 *
510 *---------------------------------------------------------------------------
511 */
512
513 void
TclInitIOSubsystem()514 TclInitIOSubsystem()
515 {
516 /*
517 * By fetching thread local storage we take care of
518 * allocating it for each thread.
519 */
520 (void) TCL_TSD_INIT(&dataKey);
521 }
522
523 /*
524 *-------------------------------------------------------------------------
525 *
526 * TclFinalizeIOSubsystem --
527 *
528 * Releases all resources used by this subsystem on a per-process
529 * basis. Closes all extant channels that have not already been
530 * closed because they were not owned by any interp.
531 *
532 * Results:
533 * None.
534 *
535 * Side effects:
536 * Depends on encoding and memory subsystems.
537 *
538 *-------------------------------------------------------------------------
539 */
540
541 /* ARGSUSED */
542 void
TclFinalizeIOSubsystem()543 TclFinalizeIOSubsystem()
544 {
545 ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
546 Channel *chanPtr; /* Iterates over open channels. */
547 Channel *nextChanPtr; /* Iterates over open channels. */
548
549
550 for (chanPtr = tsdPtr->firstChanPtr; chanPtr != (Channel *) NULL;
551 chanPtr = nextChanPtr) {
552 nextChanPtr = chanPtr->nextChanPtr;
553
554 /*
555 * Set the channel back into blocking mode to ensure that we wait
556 * for all data to flush out.
557 */
558
559 (void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr,
560 "-blocking", "on");
561
562 if ((chanPtr == (Channel *) tsdPtr->stdinChannel) ||
563 (chanPtr == (Channel *) tsdPtr->stdoutChannel) ||
564 (chanPtr == (Channel *) tsdPtr->stderrChannel)) {
565
566 /*
567 * Decrement the refcount which was earlier artificially bumped
568 * up to keep the channel from being closed.
569 */
570
571 chanPtr->refCount--;
572 }
573
574 if (chanPtr->refCount <= 0) {
575
576 /*
577 * Close it only if the refcount indicates that the channel is not
578 * referenced from any interpreter. If it is, that interpreter will
579 * close the channel when it gets destroyed.
580 */
581
582 (void) Tcl_Close((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
583
584 } else {
585
586 /*
587 * The refcount is greater than zero, so flush the channel.
588 */
589
590 Tcl_Flush((Tcl_Channel) chanPtr);
591
592 /*
593 * Call the device driver to actually close the underlying
594 * device for this channel.
595 */
596
597 if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {
598 (chanPtr->typePtr->closeProc)(chanPtr->instanceData,
599 (Tcl_Interp *) NULL);
600 } else {
601 (chanPtr->typePtr->close2Proc)(chanPtr->instanceData,
602 (Tcl_Interp *) NULL, 0);
603 }
604
605 /*
606 * Finally, we clean up the fields in the channel data structure
607 * since all of them have been deleted already. We mark the
608 * channel with CHANNEL_DEAD to prevent any further IO operations
609 * on it.
610 */
611
612 chanPtr->instanceData = (ClientData) NULL;
613 chanPtr->flags |= CHANNEL_DEAD;
614 }
615 }
616 }
617
618
619
620 /*
621 *----------------------------------------------------------------------
622 *
623 * Tcl_SetStdChannel --
624 *
625 * This function is used to change the channels that are used
626 * for stdin/stdout/stderr in new interpreters.
627 *
628 * Results:
629 * None
630 *
631 * Side effects:
632 * None.
633 *
634 *----------------------------------------------------------------------
635 */
636
637 void
Tcl_SetStdChannel(channel,type)638 Tcl_SetStdChannel(channel, type)
639 Tcl_Channel channel;
640 int type; /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
641 {
642 ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
643 switch (type) {
644 case TCL_STDIN:
645 tsdPtr->stdinInitialized = 1;
646 tsdPtr->stdinChannel = channel;
647 break;
648 case TCL_STDOUT:
649 tsdPtr->stdoutInitialized = 1;
650 tsdPtr->stdoutChannel = channel;
651 break;
652 case TCL_STDERR:
653 tsdPtr->stderrInitialized = 1;
654 tsdPtr->stderrChannel = channel;
655 break;
656 }
657 }
658
659 /*
660 *----------------------------------------------------------------------
661 *
662 * Tcl_GetStdChannel --
663 *
664 * Returns the specified standard channel.
665 *
666 * Results:
667 * Returns the specified standard channel, or NULL.
668 *
669 * Side effects:
670 * May cause the creation of a standard channel and the underlying
671 * file.
672 *
673 *----------------------------------------------------------------------
674 */
675 Tcl_Channel
Tcl_GetStdChannel(type)676 Tcl_GetStdChannel(type)
677 int type; /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
678 {
679 Tcl_Channel channel = NULL;
680 ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
681
682 /*
683 * If the channels were not created yet, create them now and
684 * store them in the static variables.
685 */
686
687 switch (type) {
688 case TCL_STDIN:
689 if (!tsdPtr->stdinInitialized) {
690 tsdPtr->stdinChannel = TclpGetDefaultStdChannel(TCL_STDIN);
691 tsdPtr->stdinInitialized = 1;
692
693 /*
694 * Artificially bump the refcount to ensure that the channel
695 * is only closed on exit.
696 *
697 * NOTE: Must only do this if stdinChannel is not NULL. It
698 * can be NULL in situations where Tcl is unable to connect
699 * to the standard input.
700 */
701
702 if (tsdPtr->stdinChannel != (Tcl_Channel) NULL) {
703 (void) Tcl_RegisterChannel((Tcl_Interp *) NULL,
704 tsdPtr->stdinChannel);
705 }
706 }
707 channel = tsdPtr->stdinChannel;
708 break;
709 case TCL_STDOUT:
710 if (!tsdPtr->stdoutInitialized) {
711 tsdPtr->stdoutChannel = TclpGetDefaultStdChannel(TCL_STDOUT);
712 tsdPtr->stdoutInitialized = 1;
713 if (tsdPtr->stdoutChannel != (Tcl_Channel) NULL) {
714 (void) Tcl_RegisterChannel((Tcl_Interp *) NULL,
715 tsdPtr->stdoutChannel);
716 }
717 }
718 channel = tsdPtr->stdoutChannel;
719 break;
720 case TCL_STDERR:
721 if (!tsdPtr->stderrInitialized) {
722 tsdPtr->stderrChannel = TclpGetDefaultStdChannel(TCL_STDERR);
723 tsdPtr->stderrInitialized = 1;
724 if (tsdPtr->stderrChannel != (Tcl_Channel) NULL) {
725 (void) Tcl_RegisterChannel((Tcl_Interp *) NULL,
726 tsdPtr->stderrChannel);
727 }
728 }
729 channel = tsdPtr->stderrChannel;
730 break;
731 }
732 return channel;
733 }
734
735
736 /*
737 *----------------------------------------------------------------------
738 *
739 * Tcl_CreateCloseHandler
740 *
741 * Creates a close callback which will be called when the channel is
742 * closed.
743 *
744 * Results:
745 * None.
746 *
747 * Side effects:
748 * Causes the callback to be called in the future when the channel
749 * will be closed.
750 *
751 *----------------------------------------------------------------------
752 */
753
754 void
Tcl_CreateCloseHandler(chan,proc,clientData)755 Tcl_CreateCloseHandler(chan, proc, clientData)
756 Tcl_Channel chan; /* The channel for which to create the
757 * close callback. */
758 Tcl_CloseProc *proc; /* The callback routine to call when the
759 * channel will be closed. */
760 ClientData clientData; /* Arbitrary data to pass to the
761 * close callback. */
762 {
763 Channel *chanPtr;
764 CloseCallback *cbPtr;
765
766 chanPtr = (Channel *) chan;
767
768 cbPtr = (CloseCallback *) ckalloc((unsigned) sizeof(CloseCallback));
769 cbPtr->proc = proc;
770 cbPtr->clientData = clientData;
771
772 cbPtr->nextPtr = chanPtr->closeCbPtr;
773 chanPtr->closeCbPtr = cbPtr;
774 }
775
776 /*
777 *----------------------------------------------------------------------
778 *
779 * Tcl_DeleteCloseHandler --
780 *
781 * Removes a callback that would have been called on closing
782 * the channel. If there is no matching callback then this
783 * function has no effect.
784 *
785 * Results:
786 * None.
787 *
788 * Side effects:
789 * The callback will not be called in the future when the channel
790 * is eventually closed.
791 *
792 *----------------------------------------------------------------------
793 */
794
795 void
Tcl_DeleteCloseHandler(chan,proc,clientData)796 Tcl_DeleteCloseHandler(chan, proc, clientData)
797 Tcl_Channel chan; /* The channel for which to cancel the
798 * close callback. */
799 Tcl_CloseProc *proc; /* The procedure for the callback to
800 * remove. */
801 ClientData clientData; /* The callback data for the callback
802 * to remove. */
803 {
804 Channel *chanPtr;
805 CloseCallback *cbPtr, *cbPrevPtr;
806
807 chanPtr = (Channel *) chan;
808 for (cbPtr = chanPtr->closeCbPtr, cbPrevPtr = (CloseCallback *) NULL;
809 cbPtr != (CloseCallback *) NULL;
810 cbPtr = cbPtr->nextPtr) {
811 if ((cbPtr->proc == proc) && (cbPtr->clientData == clientData)) {
812 if (cbPrevPtr == (CloseCallback *) NULL) {
813 chanPtr->closeCbPtr = cbPtr->nextPtr;
814 }
815 ckfree((char *) cbPtr);
816 break;
817 } else {
818 cbPrevPtr = cbPtr;
819 }
820 }
821 }
822
823 /*
824 *----------------------------------------------------------------------
825 *
826 * GetChannelTable --
827 *
828 * Gets and potentially initializes the channel table for an
829 * interpreter. If it is initializing the table it also inserts
830 * channels for stdin, stdout and stderr if the interpreter is
831 * trusted.
832 *
833 * Results:
834 * A pointer to the hash table created, for use by the caller.
835 *
836 * Side effects:
837 * Initializes the channel table for an interpreter. May create
838 * channels for stdin, stdout and stderr.
839 *
840 *----------------------------------------------------------------------
841 */
842
843 static Tcl_HashTable *
GetChannelTable(interp)844 GetChannelTable(interp)
845 Tcl_Interp *interp;
846 {
847 Tcl_HashTable *hTblPtr; /* Hash table of channels. */
848 Tcl_Channel stdinChan, stdoutChan, stderrChan;
849
850 hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
851 if (hTblPtr == (Tcl_HashTable *) NULL) {
852 hTblPtr = (Tcl_HashTable *) ckalloc((unsigned) sizeof(Tcl_HashTable));
853 Tcl_InitHashTable(hTblPtr, TCL_STRING_KEYS);
854
855 (void) Tcl_SetAssocData(interp, "tclIO",
856 (Tcl_InterpDeleteProc *) DeleteChannelTable,
857 (ClientData) hTblPtr);
858
859 /*
860 * If the interpreter is trusted (not "safe"), insert channels
861 * for stdin, stdout and stderr (possibly creating them in the
862 * process).
863 */
864
865 if (Tcl_IsSafe(interp) == 0) {
866 stdinChan = Tcl_GetStdChannel(TCL_STDIN);
867 if (stdinChan != NULL) {
868 Tcl_RegisterChannel(interp, stdinChan);
869 }
870 stdoutChan = Tcl_GetStdChannel(TCL_STDOUT);
871 if (stdoutChan != NULL) {
872 Tcl_RegisterChannel(interp, stdoutChan);
873 }
874 stderrChan = Tcl_GetStdChannel(TCL_STDERR);
875 if (stderrChan != NULL) {
876 Tcl_RegisterChannel(interp, stderrChan);
877 }
878 }
879
880 }
881 return hTblPtr;
882 }
883
884 /*
885 *----------------------------------------------------------------------
886 *
887 * DeleteChannelTable --
888 *
889 * Deletes the channel table for an interpreter, closing any open
890 * channels whose refcount reaches zero. This procedure is invoked
891 * when an interpreter is deleted, via the AssocData cleanup
892 * mechanism.
893 *
894 * Results:
895 * None.
896 *
897 * Side effects:
898 * Deletes the hash table of channels. May close channels. May flush
899 * output on closed channels. Removes any channeEvent handlers that were
900 * registered in this interpreter.
901 *
902 *----------------------------------------------------------------------
903 */
904
905 static void
DeleteChannelTable(clientData,interp)906 DeleteChannelTable(clientData, interp)
907 ClientData clientData; /* The per-interpreter data structure. */
908 Tcl_Interp *interp; /* The interpreter being deleted. */
909 {
910 Tcl_HashTable *hTblPtr; /* The hash table. */
911 Tcl_HashSearch hSearch; /* Search variable. */
912 Tcl_HashEntry *hPtr; /* Search variable. */
913 Channel *chanPtr; /* Channel being deleted. */
914 EventScriptRecord *sPtr, *prevPtr, *nextPtr;
915 /* Variables to loop over all channel events
916 * registered, to delete the ones that refer
917 * to the interpreter being deleted. */
918
919 /*
920 * Delete all the registered channels - this will close channels whose
921 * refcount reaches zero.
922 */
923
924 hTblPtr = (Tcl_HashTable *) clientData;
925 for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
926 hPtr != (Tcl_HashEntry *) NULL;
927 hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch)) {
928
929 chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
930
931 /*
932 * Remove any fileevents registered in this interpreter.
933 */
934
935 for (sPtr = chanPtr->scriptRecordPtr,
936 prevPtr = (EventScriptRecord *) NULL;
937 sPtr != (EventScriptRecord *) NULL;
938 sPtr = nextPtr) {
939 nextPtr = sPtr->nextPtr;
940 if (sPtr->interp == interp) {
941 if (prevPtr == (EventScriptRecord *) NULL) {
942 chanPtr->scriptRecordPtr = nextPtr;
943 } else {
944 prevPtr->nextPtr = nextPtr;
945 }
946
947 Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
948 ChannelEventScriptInvoker, (ClientData) sPtr);
949
950 Tcl_DecrRefCount(sPtr->scriptPtr);
951 ckfree((char *) sPtr);
952 } else {
953 prevPtr = sPtr;
954 }
955 }
956
957 /*
958 * Cannot call Tcl_UnregisterChannel because that procedure calls
959 * Tcl_GetAssocData to get the channel table, which might already
960 * be inaccessible from the interpreter structure. Instead, we
961 * emulate the behavior of Tcl_UnregisterChannel directly here.
962 */
963
964 Tcl_DeleteHashEntry(hPtr);
965 chanPtr->refCount--;
966 if (chanPtr->refCount <= 0) {
967 if (!(chanPtr->flags & BG_FLUSH_SCHEDULED)) {
968 (void) Tcl_Close(interp, (Tcl_Channel) chanPtr);
969 }
970 }
971 }
972 Tcl_DeleteHashTable(hTblPtr);
973 ckfree((char *) hTblPtr);
974 }
975
976 /*
977 *----------------------------------------------------------------------
978 *
979 * CheckForStdChannelsBeingClosed --
980 *
981 * Perform special handling for standard channels being closed. When
982 * given a standard channel, if the refcount is now 1, it means that
983 * the last reference to the standard channel is being explicitly
984 * closed. Now bump the refcount artificially down to 0, to ensure the
985 * normal handling of channels being closed will occur. Also reset the
986 * static pointer to the channel to NULL, to avoid dangling references.
987 *
988 * Results:
989 * None.
990 *
991 * Side effects:
992 * Manipulates the refcount on standard channels. May smash the global
993 * static pointer to a standard channel.
994 *
995 *----------------------------------------------------------------------
996 */
997
998 static void
CheckForStdChannelsBeingClosed(chan)999 CheckForStdChannelsBeingClosed(chan)
1000 Tcl_Channel chan;
1001 {
1002 Channel *chanPtr = (Channel *) chan;
1003 ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
1004
1005 if ((chan == tsdPtr->stdinChannel) && (tsdPtr->stdinInitialized)) {
1006 if (chanPtr->refCount < 2) {
1007 chanPtr->refCount = 0;
1008 tsdPtr->stdinChannel = NULL;
1009 return;
1010 }
1011 } else if ((chan == tsdPtr->stdoutChannel) && (tsdPtr->stdoutInitialized)) {
1012 if (chanPtr->refCount < 2) {
1013 chanPtr->refCount = 0;
1014 tsdPtr->stdoutChannel = NULL;
1015 return;
1016 }
1017 } else if ((chan == tsdPtr->stderrChannel) && (tsdPtr->stderrInitialized)) {
1018 if (chanPtr->refCount < 2) {
1019 chanPtr->refCount = 0;
1020 tsdPtr->stderrChannel = NULL;
1021 return;
1022 }
1023 }
1024 }
1025
1026 /*
1027 *----------------------------------------------------------------------
1028 *
1029 * Tcl_RegisterChannel --
1030 *
1031 * Adds an already-open channel to the channel table of an interpreter.
1032 * If the interpreter passed as argument is NULL, it only increments
1033 * the channel refCount.
1034 *
1035 * Results:
1036 * None.
1037 *
1038 * Side effects:
1039 * May increment the reference count of a channel.
1040 *
1041 *----------------------------------------------------------------------
1042 */
1043
1044 void
Tcl_RegisterChannel(interp,chan)1045 Tcl_RegisterChannel(interp, chan)
1046 Tcl_Interp *interp; /* Interpreter in which to add the channel. */
1047 Tcl_Channel chan; /* The channel to add to this interpreter
1048 * channel table. */
1049 {
1050 Tcl_HashTable *hTblPtr; /* Hash table of channels. */
1051 Tcl_HashEntry *hPtr; /* Search variable. */
1052 int new; /* Is the hash entry new or does it exist? */
1053 Channel *chanPtr; /* The actual channel. */
1054
1055 chanPtr = (Channel *) chan;
1056
1057 if (chanPtr->channelName == (char *) NULL) {
1058 panic("Tcl_RegisterChannel: channel without name");
1059 }
1060 if (interp != (Tcl_Interp *) NULL) {
1061 hTblPtr = GetChannelTable(interp);
1062 hPtr = Tcl_CreateHashEntry(hTblPtr, chanPtr->channelName, &new);
1063 if (new == 0) {
1064 if (chan == (Tcl_Channel) Tcl_GetHashValue(hPtr)) {
1065 return;
1066 }
1067
1068 /* Andreas Kupries <andreas_kupries@users.sourceforge.net>, 12/13/1998
1069 * "Trf-Patch for filtering channels"
1070 *
1071 * This is the change to 'Tcl_RegisterChannel'.
1072 *
1073 * Explanation:
1074 * The moment a channel is stacked upon another he
1075 * takes the identity of the channel he supercedes,
1076 * i.e. he gets the *same* name. Because of this we
1077 * cannot check for duplicate names anymore, they
1078 * have to be allowed now.
1079 */
1080
1081 /* panic("Tcl_RegisterChannel: duplicate channel names"); */
1082 }
1083 Tcl_SetHashValue(hPtr, (ClientData) chanPtr);
1084 }
1085 chanPtr->refCount++;
1086 }
1087
1088 /*
1089 *----------------------------------------------------------------------
1090 *
1091 * Tcl_UnregisterChannel --
1092 *
1093 * Deletes the hash entry for a channel associated with an interpreter.
1094 * If the interpreter given as argument is NULL, it only decrements the
1095 * reference count.
1096 *
1097 * Results:
1098 * A standard Tcl result.
1099 *
1100 * Side effects:
1101 * Deletes the hash entry for a channel associated with an interpreter.
1102 *
1103 *----------------------------------------------------------------------
1104 */
1105
1106 int
Tcl_UnregisterChannel(interp,chan)1107 Tcl_UnregisterChannel(interp, chan)
1108 Tcl_Interp *interp; /* Interpreter in which channel is defined. */
1109 Tcl_Channel chan; /* Channel to delete. */
1110 {
1111 Tcl_HashTable *hTblPtr; /* Hash table of channels. */
1112 Tcl_HashEntry *hPtr; /* Search variable. */
1113 Channel *chanPtr; /* The real IO channel. */
1114
1115 chanPtr = (Channel *) chan;
1116
1117 if (interp != (Tcl_Interp *) NULL) {
1118 hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
1119 if (hTblPtr == (Tcl_HashTable *) NULL) {
1120 return TCL_OK;
1121 }
1122 hPtr = Tcl_FindHashEntry(hTblPtr, chanPtr->channelName);
1123 if (hPtr == (Tcl_HashEntry *) NULL) {
1124 return TCL_OK;
1125 }
1126 if ((Channel *) Tcl_GetHashValue(hPtr) != chanPtr) {
1127 return TCL_OK;
1128 }
1129 Tcl_DeleteHashEntry(hPtr);
1130
1131 /*
1132 * Remove channel handlers that refer to this interpreter, so that they
1133 * will not be present if the actual close is delayed and more events
1134 * happen on the channel. This may occur if the channel is shared
1135 * between several interpreters, or if the channel has async
1136 * flushing active.
1137 */
1138
1139 CleanupChannelHandlers(interp, chanPtr);
1140 }
1141
1142 chanPtr->refCount--;
1143
1144 /*
1145 * Perform special handling for standard channels being closed. If the
1146 * refCount is now 1 it means that the last reference to the standard
1147 * channel is being explicitly closed, so bump the refCount down
1148 * artificially to 0. This will ensure that the channel is actually
1149 * closed, below. Also set the static pointer to NULL for the channel.
1150 */
1151
1152 CheckForStdChannelsBeingClosed(chan);
1153
1154 /*
1155 * If the refCount reached zero, close the actual channel.
1156 */
1157
1158 if (chanPtr->refCount <= 0) {
1159
1160 /*
1161 * Ensure that if there is another buffer, it gets flushed
1162 * whether or not we are doing a background flush.
1163 */
1164
1165 if ((chanPtr->curOutPtr != NULL) &&
1166 (chanPtr->curOutPtr->nextAdded >
1167 chanPtr->curOutPtr->nextRemoved)) {
1168 chanPtr->flags |= BUFFER_READY;
1169 }
1170 chanPtr->flags |= CHANNEL_CLOSED;
1171 if (!(chanPtr->flags & BG_FLUSH_SCHEDULED)) {
1172 if (Tcl_Close(interp, chan) != TCL_OK) {
1173 return TCL_ERROR;
1174 }
1175 }
1176 }
1177 return TCL_OK;
1178 }
1179
1180 /*
1181 *---------------------------------------------------------------------------
1182 *
1183 * Tcl_GetChannel --
1184 *
1185 * Finds an existing Tcl_Channel structure by name in a given
1186 * interpreter. This function is public because it is used by
1187 * channel-type-specific functions.
1188 *
1189 * Results:
1190 * A Tcl_Channel or NULL on failure. If failed, interp's result
1191 * object contains an error message. *modePtr is filled with the
1192 * modes in which the channel was opened.
1193 *
1194 * Side effects:
1195 * None.
1196 *
1197 *---------------------------------------------------------------------------
1198 */
1199
1200 Tcl_Channel
Tcl_GetChannel(interp,chanName,modePtr)1201 Tcl_GetChannel(interp, chanName, modePtr)
1202 Tcl_Interp *interp; /* Interpreter in which to find or create
1203 * the channel. */
1204 char *chanName; /* The name of the channel. */
1205 int *modePtr; /* Where to store the mode in which the
1206 * channel was opened? Will contain an ORed
1207 * combination of TCL_READABLE and
1208 * TCL_WRITABLE, if non-NULL. */
1209 {
1210 Channel *chanPtr; /* The actual channel. */
1211 Tcl_HashTable *hTblPtr; /* Hash table of channels. */
1212 Tcl_HashEntry *hPtr; /* Search variable. */
1213 char *name; /* Translated name. */
1214
1215 /*
1216 * Substitute "stdin", etc. Note that even though we immediately
1217 * find the channel using Tcl_GetStdChannel, we still need to look
1218 * it up in the specified interpreter to ensure that it is present
1219 * in the channel table. Otherwise, safe interpreters would always
1220 * have access to the standard channels.
1221 */
1222
1223 name = chanName;
1224 if ((chanName[0] == 's') && (chanName[1] == 't')) {
1225 chanPtr = NULL;
1226 if (strcmp(chanName, "stdin") == 0) {
1227 chanPtr = (Channel *)Tcl_GetStdChannel(TCL_STDIN);
1228 } else if (strcmp(chanName, "stdout") == 0) {
1229 chanPtr = (Channel *)Tcl_GetStdChannel(TCL_STDOUT);
1230 } else if (strcmp(chanName, "stderr") == 0) {
1231 chanPtr = (Channel *)Tcl_GetStdChannel(TCL_STDERR);
1232 }
1233 if (chanPtr != NULL) {
1234 name = chanPtr->channelName;
1235 }
1236 }
1237
1238 hTblPtr = GetChannelTable(interp);
1239 hPtr = Tcl_FindHashEntry(hTblPtr, name);
1240 if (hPtr == (Tcl_HashEntry *) NULL) {
1241 Tcl_AppendResult(interp, "can not find channel named \"",
1242 chanName, "\"", (char *) NULL);
1243 return NULL;
1244 }
1245
1246 chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
1247 if (modePtr != NULL) {
1248 *modePtr = (chanPtr->flags & (TCL_READABLE|TCL_WRITABLE));
1249 }
1250
1251 return (Tcl_Channel) chanPtr;
1252 }
1253
1254 /*
1255 *----------------------------------------------------------------------
1256 *
1257 * Tcl_CreateChannel --
1258 *
1259 * Creates a new entry in the hash table for a Tcl_Channel
1260 * record.
1261 *
1262 * Results:
1263 * Returns the new Tcl_Channel.
1264 *
1265 * Side effects:
1266 * Creates a new Tcl_Channel instance and inserts it into the
1267 * hash table.
1268 *
1269 *----------------------------------------------------------------------
1270 */
1271
1272 Tcl_Channel
Tcl_CreateChannel(typePtr,chanName,instanceData,mask)1273 Tcl_CreateChannel(typePtr, chanName, instanceData, mask)
1274 Tcl_ChannelType *typePtr; /* The channel type record. */
1275 char *chanName; /* Name of channel to record. */
1276 ClientData instanceData; /* Instance specific data. */
1277 int mask; /* TCL_READABLE & TCL_WRITABLE to indicate
1278 * if the channel is readable, writable. */
1279 {
1280 Channel *chanPtr; /* The channel structure newly created. */
1281 CONST char *name;
1282 ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
1283
1284 /* Andreas Kupries <andreas_kupries@users.sourceforge.net>, 05/31/1997.
1285 * "Trf-Patch for channels with a switchable byteorder"
1286 * Location: Tcl_CreateChannel.
1287 */
1288 union {
1289 char c[sizeof(short)];
1290 short s;
1291 } order;
1292
1293 order.s = 1;
1294 if (order.c[0] == 1) {
1295 mask |= CHANNEL_IS_SMALLENDIAN;
1296 }
1297
1298 chanPtr = (Channel *) ckalloc((unsigned) sizeof(Channel));
1299
1300 if (chanName != (char *) NULL) {
1301 chanPtr->channelName = ckalloc((unsigned) (strlen(chanName) + 1));
1302 strcpy(chanPtr->channelName, chanName);
1303 } else {
1304 panic("Tcl_CreateChannel: NULL channel name");
1305 }
1306
1307 chanPtr->flags = mask;
1308
1309 /*
1310 * Set the channel to system default encoding.
1311 */
1312
1313 chanPtr->encoding = NULL;
1314 name = Tcl_GetEncodingName(NULL);
1315 if (strcmp(name, "binary") != 0) {
1316 chanPtr->encoding = Tcl_GetEncoding(NULL, name);
1317 }
1318 chanPtr->inputEncodingState = NULL;
1319 chanPtr->inputEncodingFlags = TCL_ENCODING_START;
1320 chanPtr->outputEncodingState = NULL;
1321 chanPtr->outputEncodingFlags = TCL_ENCODING_START;
1322
1323 /*
1324 * Set the channel up initially in AUTO input translation mode to
1325 * accept "\n", "\r" and "\r\n". Output translation mode is set to
1326 * a platform specific default value. The eofChar is set to 0 for both
1327 * input and output, so that Tcl does not look for an in-file EOF
1328 * indicator (e.g. ^Z) and does not append an EOF indicator to files.
1329 */
1330
1331 chanPtr->inputTranslation = TCL_TRANSLATE_AUTO;
1332 chanPtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
1333 chanPtr->inEofChar = 0;
1334 chanPtr->outEofChar = 0;
1335
1336 chanPtr->unreportedError = 0;
1337 chanPtr->instanceData = instanceData;
1338 chanPtr->typePtr = typePtr;
1339 chanPtr->refCount = 0;
1340 chanPtr->closeCbPtr = (CloseCallback *) NULL;
1341 chanPtr->curOutPtr = (ChannelBuffer *) NULL;
1342 chanPtr->outQueueHead = (ChannelBuffer *) NULL;
1343 chanPtr->outQueueTail = (ChannelBuffer *) NULL;
1344 chanPtr->saveInBufPtr = (ChannelBuffer *) NULL;
1345 chanPtr->inQueueHead = (ChannelBuffer *) NULL;
1346 chanPtr->inQueueTail = (ChannelBuffer *) NULL;
1347 chanPtr->chPtr = (ChannelHandler *) NULL;
1348 chanPtr->interestMask = 0;
1349 chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL;
1350 chanPtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE;
1351 chanPtr->timer = NULL;
1352 chanPtr->csPtr = NULL;
1353
1354 /* Andreas Kupries <andreas_kupries@users.sourceforge.net>, 12/13/1998
1355 * "Trf-Patch for filtering channels"
1356 *
1357 * This is the change to 'Tcl_CreateChannel'.
1358 *
1359 * Explanation:
1360 * It is of course necessary to initialize the new field
1361 * in the Channel structure. The chosen value indicates
1362 * that the created channel is a normal one, and not
1363 * stacked upon another.
1364 */
1365
1366 chanPtr->supercedes = (Channel*) NULL;
1367
1368 chanPtr->outputStage = NULL;
1369 if ((chanPtr->encoding != NULL) && (chanPtr->flags & TCL_WRITABLE)) {
1370 chanPtr->outputStage = (char *)
1371 ckalloc((unsigned) (chanPtr->bufSize + 2));
1372 }
1373
1374 /*
1375 * Link the channel into the list of all channels; create an on-exit
1376 * handler if there is not one already, to close off all the channels
1377 * in the list on exit.
1378 */
1379
1380 chanPtr->nextChanPtr = tsdPtr->firstChanPtr;
1381 tsdPtr->firstChanPtr = chanPtr;
1382
1383 /*
1384 * Install this channel in the first empty standard channel slot, if
1385 * the channel was previously closed explicitly.
1386 */
1387
1388 if ((tsdPtr->stdinChannel == NULL) && (tsdPtr->stdinInitialized == 1)) {
1389 Tcl_SetStdChannel((Tcl_Channel)chanPtr, TCL_STDIN);
1390 Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
1391 } else if ((tsdPtr->stdoutChannel == NULL) && (tsdPtr->stdoutInitialized == 1)) {
1392 Tcl_SetStdChannel((Tcl_Channel)chanPtr, TCL_STDOUT);
1393 Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
1394 } else if ((tsdPtr->stderrChannel == NULL) && (tsdPtr->stderrInitialized == 1)) {
1395 Tcl_SetStdChannel((Tcl_Channel)chanPtr, TCL_STDERR);
1396 Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
1397 }
1398 return (Tcl_Channel) chanPtr;
1399 }
1400
1401 /* Andreas Kupries <andreas_kupries@users.sourceforge.net>, 12/13/1998
1402 * "Trf-Patch for filtering channels"
1403 *
1404 * The following two procedures are the new, exported ones. They
1405 * - create a channel stacked upon an existing one and
1406 * - pop a stacked channel off, thus revealing the superceded one.
1407 *
1408 * Please read the following completely.
1409 */
1410
1411 /*
1412 *----------------------------------------------------------------------
1413 *
1414 * Tcl_ReplaceChannel --
1415 *
1416 * Replaces an entry in the hash table for a Tcl_Channel
1417 * record. The replacement is a new channel with same name,
1418 * it supercedes the replaced channel. Input and output of
1419 * the superceded channel is now going through the newly
1420 * created channel and allows the arbitrary filtering/manipulation
1421 * of the dataflow.
1422 *
1423 * Results:
1424 * Returns the new Tcl_Channel.
1425 *
1426 * Side effects:
1427 * See above.
1428 *
1429 *----------------------------------------------------------------------
1430 */
1431
1432 Tcl_Channel
Tcl_ReplaceChannel(interp,typePtr,instanceData,mask,prevChan)1433 Tcl_ReplaceChannel(interp, typePtr, instanceData, mask, prevChan)
1434 Tcl_Interp* interp; /* The interpreter we are working in */
1435 Tcl_ChannelType *typePtr; /* The channel type record for the new
1436 * channel. */
1437 ClientData instanceData; /* Instance specific data for the new
1438 * channel. */
1439 int mask; /* TCL_READABLE & TCL_WRITABLE to indicate
1440 * if the channel is readable, writable. */
1441 Tcl_Channel prevChan; /* The channel structure to replace */
1442 {
1443 ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
1444 Channel *chanPtr, *pt, *prevPt;
1445
1446 /*
1447 * Find the given channel in the list of all channels, compute enough
1448 * information to allow easy removal after the conditions are met.
1449 */
1450
1451 prevPt = (Channel*) NULL;
1452 pt = (Channel*) tsdPtr->firstChanPtr;
1453
1454 while (pt != (Channel *) prevChan) {
1455 prevPt = pt;
1456 pt = pt->nextChanPtr;
1457 }
1458
1459 /*
1460 * 'pt == prevChan' now
1461 */
1462
1463 if (!pt) {
1464 return (Tcl_Channel) NULL;
1465 }
1466
1467 /*
1468 * Here we check if the given "mask" matches the "flags"
1469 * of the already existing channel.
1470 *
1471 * | - | R | W | RW |
1472 * --+---+---+---+----+ <=> 0 != (chan->mask & prevChan->mask)
1473 * - | | | | |
1474 * R | | + | | + | The superceding channel is allowed to
1475 * W | | | + | + | restrict the capabilities of the
1476 * RW| | + | + | + | superceded one !
1477 * --+---+---+---+----+
1478 */
1479
1480 if ((mask & Tcl_GetChannelMode (prevChan)) == 0) {
1481 return (Tcl_Channel) NULL;
1482 }
1483
1484
1485 chanPtr = (Channel *) ckalloc((unsigned) sizeof(Channel));
1486 chanPtr->flags = mask;
1487
1488 /*
1489 * Set the channel up initially in no Input translation mode and
1490 * no Output translation mode.
1491 */
1492
1493 chanPtr->inputTranslation = TCL_TRANSLATE_LF;
1494 chanPtr->outputTranslation = TCL_TRANSLATE_LF;
1495 chanPtr->inEofChar = 0;
1496 chanPtr->outEofChar = 0;
1497
1498 chanPtr->unreportedError = 0;
1499 chanPtr->instanceData = instanceData;
1500 chanPtr->typePtr = typePtr;
1501 chanPtr->refCount = 0;
1502 chanPtr->closeCbPtr = (CloseCallback *) NULL;
1503 chanPtr->curOutPtr = (ChannelBuffer *) NULL;
1504 chanPtr->outQueueHead = (ChannelBuffer *) NULL;
1505 chanPtr->outQueueTail = (ChannelBuffer *) NULL;
1506 chanPtr->saveInBufPtr = (ChannelBuffer *) NULL;
1507 chanPtr->inQueueHead = (ChannelBuffer *) NULL;
1508 chanPtr->inQueueTail = (ChannelBuffer *) NULL;
1509 chanPtr->chPtr = (ChannelHandler *) NULL;
1510 chanPtr->interestMask = 0;
1511 chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL;
1512 chanPtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE;
1513 chanPtr->timer = NULL;
1514 chanPtr->csPtr = NULL;
1515
1516 /* 06/12/1998: New for Tcl 8.1
1517 *
1518 * Take over the encoding from the superceded channel, so that it will be
1519 * executed in the future despite the replacement, and at the proper time
1520 * (*after* / *before* our transformation, depending on the direction of
1521 * the dataflow).
1522 *
1523 * *Important*
1524 * The I/O functionality of the filtering channel has to use 'Tcl_Read' to
1525 * get at the underlying information. This will circumvent the de/encoder
1526 * stage [*] in the superceded channel and removes the need to trouble
1527 * ourselves with 'ByteArray's too.
1528 *
1529 * [*] I'm talking about the conversion between UNICODE and other
1530 * representations, like ASCII.
1531 */
1532
1533 chanPtr->encoding = pt->encoding;
1534 chanPtr->inputEncodingState = pt->inputEncodingState;
1535 chanPtr->inputEncodingFlags = pt->inputEncodingFlags;
1536 chanPtr->outputEncodingState = pt->outputEncodingState;
1537 chanPtr->outputEncodingFlags = pt->outputEncodingFlags;
1538
1539 chanPtr->outputStage = NULL;
1540
1541 if ((chanPtr->encoding != NULL) && (chanPtr->flags & TCL_WRITABLE)) {
1542 chanPtr->outputStage = (char *)
1543 ckalloc((unsigned) (chanPtr->bufSize + 2));
1544 }
1545
1546 chanPtr->supercedes = (Channel*) prevChan;
1547
1548 chanPtr->channelName = (char *) ckalloc (strlen(pt->channelName)+1);
1549 strcpy (chanPtr->channelName, pt->channelName);
1550
1551 if (prevPt) {
1552 prevPt->nextChanPtr = chanPtr;
1553 } else {
1554 tsdPtr->firstChanPtr = chanPtr;
1555 }
1556
1557 chanPtr->nextChanPtr = pt->nextChanPtr;
1558
1559 Tcl_RegisterChannel (interp, (Tcl_Channel) chanPtr);
1560
1561 /*
1562 * The superceded channel is effectively unregistered
1563 */
1564
1565 /*chanPtr->supercedes->refCount --;*/
1566
1567 return (Tcl_Channel) chanPtr;
1568 }
1569
1570 /*
1571 *----------------------------------------------------------------------
1572 *
1573 * Tcl_UndoReplaceChannel --
1574 *
1575 * Unstacks an entry in the hash table for a Tcl_Channel
1576 * record. This is the reverse to 'Tcl_ReplaceChannel'.
1577 * The old, superceded channel is uncovered and re-registered
1578 * in the appropriate datastructures.
1579 *
1580 * Results:
1581 * Returns the old Tcl_Channel, i.e. the one which was stacked over.
1582 *
1583 * Side effects:
1584 * See above.
1585 *
1586 *----------------------------------------------------------------------
1587 */
1588
1589 void
Tcl_UndoReplaceChannel(interp,chan)1590 Tcl_UndoReplaceChannel (interp, chan)
1591 Tcl_Interp* interp; /* The interpreter we are working in */
1592 Tcl_Channel chan; /* The channel to unstack */
1593 {
1594 ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
1595 Channel* chanPtr = (Channel*) chan;
1596
1597 if (chanPtr->supercedes != (Channel*) NULL) {
1598 Tcl_HashTable *hTblPtr; /* Hash table of channels. */
1599 Tcl_HashEntry *hPtr; /* Search variable. */
1600 int new; /* Is the hash entry new or does it exist? */
1601
1602 /*
1603 * Insert the channel we were stacked upon back into
1604 * the list of open channels. Place it back into the hashtable too.
1605 * Correct 'refCount', as this actually unregisters 'chan'.
1606 */
1607
1608 chanPtr->supercedes->nextChanPtr = tsdPtr->firstChanPtr;
1609 tsdPtr->firstChanPtr = chanPtr->supercedes;
1610
1611 hTblPtr = GetChannelTable (interp);
1612 hPtr = Tcl_CreateHashEntry (hTblPtr, chanPtr->channelName, &new);
1613
1614 Tcl_SetHashValue(hPtr, (ClientData) chanPtr->supercedes);
1615 chanPtr->refCount --;
1616
1617 /*
1618 * The superceded channel is effectively registered again
1619 */
1620
1621 /*chanPtr->supercedes->refCount ++;*/
1622 }
1623
1624 /*
1625 * Disconnect the channels, then do a regular close upon the
1626 * stacked one, the filtering channel. This may cause flushing
1627 * of data into the superceded channel (if the filtering channel
1628 * ('chan') remembered its parent in itself).
1629 */
1630
1631 chanPtr->supercedes = NULL;
1632
1633 if (chanPtr->refCount == 0) {
1634 Tcl_Close (interp, chan);
1635 }
1636 }
1637
1638 /*
1639 *----------------------------------------------------------------------
1640 *
1641 * Tcl_GetChannelMode --
1642 *
1643 * Computes a mask indicating whether the channel is open for
1644 * reading and writing.
1645 *
1646 * Results:
1647 * An OR-ed combination of TCL_READABLE and TCL_WRITABLE.
1648 *
1649 * Side effects:
1650 * None.
1651 *
1652 *----------------------------------------------------------------------
1653 */
1654
1655 int
Tcl_GetChannelMode(chan)1656 Tcl_GetChannelMode(chan)
1657 Tcl_Channel chan; /* The channel for which the mode is
1658 * being computed. */
1659 {
1660 Channel *chanPtr; /* The actual channel. */
1661
1662 chanPtr = (Channel *) chan;
1663 return (chanPtr->flags & (TCL_READABLE | TCL_WRITABLE));
1664 }
1665
1666 /*
1667 *----------------------------------------------------------------------
1668 *
1669 * Tcl_GetChannelName --
1670 *
1671 * Returns the string identifying the channel name.
1672 *
1673 * Results:
1674 * The string containing the channel name. This memory is
1675 * owned by the generic layer and should not be modified by
1676 * the caller.
1677 *
1678 * Side effects:
1679 * None.
1680 *
1681 *----------------------------------------------------------------------
1682 */
1683
1684 char *
Tcl_GetChannelName(chan)1685 Tcl_GetChannelName(chan)
1686 Tcl_Channel chan; /* The channel for which to return the name. */
1687 {
1688 Channel *chanPtr; /* The actual channel. */
1689
1690 chanPtr = (Channel *) chan;
1691 return chanPtr->channelName;
1692 }
1693
1694 /*
1695 *----------------------------------------------------------------------
1696 *
1697 * Tcl_GetChannelType --
1698 *
1699 * Given a channel structure, returns the channel type structure.
1700 *
1701 * Results:
1702 * Returns a pointer to the channel type structure.
1703 *
1704 * Side effects:
1705 * None.
1706 *
1707 *----------------------------------------------------------------------
1708 */
1709
1710 Tcl_ChannelType *
Tcl_GetChannelType(chan)1711 Tcl_GetChannelType(chan)
1712 Tcl_Channel chan; /* The channel to return type for. */
1713 {
1714 Channel *chanPtr; /* The actual channel. */
1715
1716 chanPtr = (Channel *) chan;
1717 return chanPtr->typePtr;
1718 }
1719
1720 /*
1721 *----------------------------------------------------------------------
1722 *
1723 * Tcl_GetChannelHandle --
1724 *
1725 * Returns an OS handle associated with a channel.
1726 *
1727 * Results:
1728 * Returns TCL_OK and places the handle in handlePtr, or returns
1729 * TCL_ERROR on failure.
1730 *
1731 * Side effects:
1732 * None.
1733 *
1734 *----------------------------------------------------------------------
1735 */
1736
1737 int
Tcl_GetChannelHandle(chan,direction,handlePtr)1738 Tcl_GetChannelHandle(chan, direction, handlePtr)
1739 Tcl_Channel chan; /* The channel to get file from. */
1740 int direction; /* TCL_WRITABLE or TCL_READABLE. */
1741 ClientData *handlePtr; /* Where to store handle */
1742 {
1743 Channel *chanPtr; /* The actual channel. */
1744 ClientData handle;
1745 int result;
1746
1747 chanPtr = (Channel *) chan;
1748 result = (chanPtr->typePtr->getHandleProc)(chanPtr->instanceData,
1749 direction, &handle);
1750 if (handlePtr) {
1751 *handlePtr = handle;
1752 }
1753 return result;
1754 }
1755
1756 /*
1757 *----------------------------------------------------------------------
1758 *
1759 * Tcl_GetChannelInstanceData --
1760 *
1761 * Returns the client data associated with a channel.
1762 *
1763 * Results:
1764 * The client data.
1765 *
1766 * Side effects:
1767 * None.
1768 *
1769 *----------------------------------------------------------------------
1770 */
1771
1772 ClientData
Tcl_GetChannelInstanceData(chan)1773 Tcl_GetChannelInstanceData(chan)
1774 Tcl_Channel chan; /* Channel for which to return client data. */
1775 {
1776 Channel *chanPtr; /* The actual channel. */
1777
1778 chanPtr = (Channel *) chan;
1779 return chanPtr->instanceData;
1780 }
1781
1782 /*
1783 *---------------------------------------------------------------------------
1784 *
1785 * AllocChannelBuffer --
1786 *
1787 * A channel buffer has BUFFER_PADDING bytes extra at beginning to
1788 * hold any bytes of a native-encoding character that got split by
1789 * the end of the previous buffer and need to be moved to the
1790 * beginning of the next buffer to make a contiguous string so it
1791 * can be converted to UTF-8.
1792 *
1793 * A channel buffer has BUFFER_PADDING bytes extra at the end to
1794 * hold any bytes of a native-encoding character (generated from a
1795 * UTF-8 character) that overflow past the end of the buffer and
1796 * need to be moved to the next buffer.
1797 *
1798 * Results:
1799 * A newly allocated channel buffer.
1800 *
1801 * Side effects:
1802 * None.
1803 *
1804 *---------------------------------------------------------------------------
1805 */
1806
1807 static ChannelBuffer *
AllocChannelBuffer(length)1808 AllocChannelBuffer(length)
1809 int length; /* Desired length of channel buffer. */
1810 {
1811 ChannelBuffer *bufPtr;
1812 int n;
1813
1814 n = length + CHANNELBUFFER_HEADER_SIZE + BUFFER_PADDING + BUFFER_PADDING;
1815 bufPtr = (ChannelBuffer *) ckalloc((unsigned) n);
1816 bufPtr->nextAdded = BUFFER_PADDING;
1817 bufPtr->nextRemoved = BUFFER_PADDING;
1818 bufPtr->bufLength = length + BUFFER_PADDING;
1819 bufPtr->nextPtr = (ChannelBuffer *) NULL;
1820 return bufPtr;
1821 }
1822
1823 /*
1824 *----------------------------------------------------------------------
1825 *
1826 * RecycleBuffer --
1827 *
1828 * Helper function to recycle input and output buffers. Ensures
1829 * that two input buffers are saved (one in the input queue and
1830 * another in the saveInBufPtr field) and that curOutPtr is set
1831 * to a buffer. Only if these conditions are met is the buffer
1832 * freed to the OS.
1833 *
1834 * Results:
1835 * None.
1836 *
1837 * Side effects:
1838 * May free a buffer to the OS.
1839 *
1840 *----------------------------------------------------------------------
1841 */
1842
1843 static void
RecycleBuffer(chanPtr,bufPtr,mustDiscard)1844 RecycleBuffer(chanPtr, bufPtr, mustDiscard)
1845 Channel *chanPtr; /* Channel for which to recycle buffers. */
1846 ChannelBuffer *bufPtr; /* The buffer to recycle. */
1847 int mustDiscard; /* If nonzero, free the buffer to the
1848 * OS, always. */
1849 {
1850 /*
1851 * Do we have to free the buffer to the OS?
1852 */
1853
1854 if (mustDiscard) {
1855 ckfree((char *) bufPtr);
1856 return;
1857 }
1858
1859 /*
1860 * Only save buffers for the input queue if the channel is readable.
1861 */
1862
1863 if (chanPtr->flags & TCL_READABLE) {
1864 if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
1865 chanPtr->inQueueHead = bufPtr;
1866 chanPtr->inQueueTail = bufPtr;
1867 goto keepit;
1868 }
1869 if (chanPtr->saveInBufPtr == (ChannelBuffer *) NULL) {
1870 chanPtr->saveInBufPtr = bufPtr;
1871 goto keepit;
1872 }
1873 }
1874
1875 /*
1876 * Only save buffers for the output queue if the channel is writable.
1877 */
1878
1879 if (chanPtr->flags & TCL_WRITABLE) {
1880 if (chanPtr->curOutPtr == (ChannelBuffer *) NULL) {
1881 chanPtr->curOutPtr = bufPtr;
1882 goto keepit;
1883 }
1884 }
1885
1886 /*
1887 * If we reached this code we return the buffer to the OS.
1888 */
1889
1890 ckfree((char *) bufPtr);
1891 return;
1892
1893 keepit:
1894 bufPtr->nextRemoved = BUFFER_PADDING;
1895 bufPtr->nextAdded = BUFFER_PADDING;
1896 bufPtr->nextPtr = (ChannelBuffer *) NULL;
1897 }
1898
1899 /*
1900 *----------------------------------------------------------------------
1901 *
1902 * DiscardOutputQueued --
1903 *
1904 * Discards all output queued in the output queue of a channel.
1905 *
1906 * Results:
1907 * None.
1908 *
1909 * Side effects:
1910 * Recycles buffers.
1911 *
1912 *----------------------------------------------------------------------
1913 */
1914
1915 static void
DiscardOutputQueued(chanPtr)1916 DiscardOutputQueued(chanPtr)
1917 Channel *chanPtr; /* The channel for which to discard output. */
1918 {
1919 ChannelBuffer *bufPtr;
1920
1921 while (chanPtr->outQueueHead != (ChannelBuffer *) NULL) {
1922 bufPtr = chanPtr->outQueueHead;
1923 chanPtr->outQueueHead = bufPtr->nextPtr;
1924 RecycleBuffer(chanPtr, bufPtr, 0);
1925 }
1926 chanPtr->outQueueHead = (ChannelBuffer *) NULL;
1927 chanPtr->outQueueTail = (ChannelBuffer *) NULL;
1928 }
1929
1930 /*
1931 *----------------------------------------------------------------------
1932 *
1933 * CheckForDeadChannel --
1934 *
1935 * This function checks is a given channel is Dead.
1936 * (A channel that has been closed but not yet deallocated.)
1937 *
1938 * Results:
1939 * True (1) if channel is Dead, False (0) if channel is Ok
1940 *
1941 * Side effects:
1942 * None
1943 *
1944 *----------------------------------------------------------------------
1945 */
1946
1947 static int
CheckForDeadChannel(interp,chanPtr)1948 CheckForDeadChannel(interp, chanPtr)
1949 Tcl_Interp *interp; /* For error reporting (can be NULL) */
1950 Channel *chanPtr; /* The channel to check. */
1951 {
1952 if (chanPtr->flags & CHANNEL_DEAD) {
1953 Tcl_SetErrno(EINVAL);
1954 if (interp) {
1955 Tcl_AppendResult(interp,
1956 "unable to access channel: invalid channel",
1957 (char *) NULL);
1958 }
1959 return 1;
1960 }
1961 return 0;
1962 }
1963
1964 /*
1965 *----------------------------------------------------------------------
1966 *
1967 * FlushChannel --
1968 *
1969 * This function flushes as much of the queued output as is possible
1970 * now. If calledFromAsyncFlush is nonzero, it is being called in an
1971 * event handler to flush channel output asynchronously.
1972 *
1973 * Results:
1974 * 0 if successful, else the error code that was returned by the
1975 * channel type operation.
1976 *
1977 * Side effects:
1978 * May produce output on a channel. May block indefinitely if the
1979 * channel is synchronous. May schedule an async flush on the channel.
1980 * May recycle memory for buffers in the output queue.
1981 *
1982 *----------------------------------------------------------------------
1983 */
1984
1985 static int
FlushChannel(interp,chanPtr,calledFromAsyncFlush)1986 FlushChannel(interp, chanPtr, calledFromAsyncFlush)
1987 Tcl_Interp *interp; /* For error reporting during close. */
1988 Channel *chanPtr; /* The channel to flush on. */
1989 int calledFromAsyncFlush; /* If nonzero then we are being
1990 * called from an asynchronous
1991 * flush callback. */
1992 {
1993 ChannelBuffer *bufPtr; /* Iterates over buffered output
1994 * queue. */
1995 int toWrite; /* Amount of output data in current
1996 * buffer available to be written. */
1997 int written; /* Amount of output data actually
1998 * written in current round. */
1999 int errorCode = 0; /* Stores POSIX error codes from
2000 * channel driver operations. */
2001 int wroteSome = 0; /* Set to one if any data was
2002 * written to the driver. */
2003
2004 /*
2005 * Prevent writing on a dead channel -- a channel that has been closed
2006 * but not yet deallocated. This can occur if the exit handler for the
2007 * channel deallocation runs before all channels are deregistered in
2008 * all interpreters.
2009 */
2010
2011 if (CheckForDeadChannel(interp,chanPtr)) return -1;
2012
2013 /*
2014 * Loop over the queued buffers and attempt to flush as
2015 * much as possible of the queued output to the channel.
2016 */
2017
2018 while (1) {
2019
2020 /*
2021 * If the queue is empty and there is a ready current buffer, OR if
2022 * the current buffer is full, then move the current buffer to the
2023 * queue.
2024 */
2025
2026 if (((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&
2027 (chanPtr->curOutPtr->nextAdded == chanPtr->curOutPtr->bufLength))
2028 || ((chanPtr->flags & BUFFER_READY) &&
2029 (chanPtr->outQueueHead == (ChannelBuffer *) NULL))) {
2030 chanPtr->flags &= (~(BUFFER_READY));
2031 chanPtr->curOutPtr->nextPtr = (ChannelBuffer *) NULL;
2032 if (chanPtr->outQueueHead == (ChannelBuffer *) NULL) {
2033 chanPtr->outQueueHead = chanPtr->curOutPtr;
2034 } else {
2035 chanPtr->outQueueTail->nextPtr = chanPtr->curOutPtr;
2036 }
2037 chanPtr->outQueueTail = chanPtr->curOutPtr;
2038 chanPtr->curOutPtr = (ChannelBuffer *) NULL;
2039 }
2040 bufPtr = chanPtr->outQueueHead;
2041
2042 /*
2043 * If we are not being called from an async flush and an async
2044 * flush is active, we just return without producing any output.
2045 */
2046
2047 if ((!calledFromAsyncFlush) &&
2048 (chanPtr->flags & BG_FLUSH_SCHEDULED)) {
2049 return 0;
2050 }
2051
2052 /*
2053 * If the output queue is still empty, break out of the while loop.
2054 */
2055
2056 if (bufPtr == (ChannelBuffer *) NULL) {
2057 break; /* Out of the "while (1)". */
2058 }
2059
2060 /*
2061 * Produce the output on the channel.
2062 */
2063
2064 toWrite = bufPtr->nextAdded - bufPtr->nextRemoved;
2065 written = (chanPtr->typePtr->outputProc) (chanPtr->instanceData,
2066 (char *) bufPtr->buf + bufPtr->nextRemoved, toWrite,
2067 &errorCode);
2068
2069 /*
2070 * If the write failed completely attempt to start the asynchronous
2071 * flush mechanism and break out of this loop - do not attempt to
2072 * write any more output at this time.
2073 */
2074
2075 if (written < 0) {
2076
2077 /*
2078 * If the last attempt to write was interrupted, simply retry.
2079 */
2080
2081 if (errorCode == EINTR) {
2082 errorCode = 0;
2083 continue;
2084 }
2085
2086 /*
2087 * If the channel is non-blocking and we would have blocked,
2088 * start a background flushing handler and break out of the loop.
2089 */
2090
2091 if ((errorCode == EWOULDBLOCK) || (errorCode == EAGAIN)) {
2092 if (chanPtr->flags & CHANNEL_NONBLOCKING) {
2093 if (!(chanPtr->flags & BG_FLUSH_SCHEDULED)) {
2094 chanPtr->flags |= BG_FLUSH_SCHEDULED;
2095 UpdateInterest(chanPtr);
2096 }
2097 errorCode = 0;
2098 break;
2099 } else {
2100 panic("Blocking channel driver did not block on output");
2101 }
2102 }
2103
2104 /*
2105 * Decide whether to report the error upwards or defer it.
2106 */
2107
2108 if (calledFromAsyncFlush) {
2109 if (chanPtr->unreportedError == 0) {
2110 chanPtr->unreportedError = errorCode;
2111 }
2112 } else {
2113 Tcl_SetErrno(errorCode);
2114 if (interp != NULL) {
2115 Tcl_SetResult(interp,
2116 Tcl_PosixError(interp), TCL_VOLATILE);
2117 }
2118 }
2119
2120 /*
2121 * When we get an error we throw away all the output
2122 * currently queued.
2123 */
2124
2125 DiscardOutputQueued(chanPtr);
2126 continue;
2127 } else {
2128 wroteSome = 1;
2129 }
2130
2131 bufPtr->nextRemoved += written;
2132
2133 /*
2134 * If this buffer is now empty, recycle it.
2135 */
2136
2137 if (bufPtr->nextRemoved == bufPtr->nextAdded) {
2138 chanPtr->outQueueHead = bufPtr->nextPtr;
2139 if (chanPtr->outQueueHead == (ChannelBuffer *) NULL) {
2140 chanPtr->outQueueTail = (ChannelBuffer *) NULL;
2141 }
2142 RecycleBuffer(chanPtr, bufPtr, 0);
2143 }
2144 } /* Closes "while (1)". */
2145
2146 /*
2147 * If we wrote some data while flushing in the background, we are done.
2148 * We can't finish the background flush until we run out of data and
2149 * the channel becomes writable again. This ensures that all of the
2150 * pending data has been flushed at the system level.
2151 */
2152
2153 if (chanPtr->flags & BG_FLUSH_SCHEDULED) {
2154 if (wroteSome) {
2155 return errorCode;
2156 } else if (chanPtr->outQueueHead == (ChannelBuffer *) NULL) {
2157 chanPtr->flags &= (~(BG_FLUSH_SCHEDULED));
2158 (chanPtr->typePtr->watchProc)(chanPtr->instanceData,
2159 chanPtr->interestMask);
2160 }
2161 }
2162
2163 /*
2164 * If the channel is flagged as closed, delete it when the refCount
2165 * drops to zero, the output queue is empty and there is no output
2166 * in the current output buffer.
2167 */
2168
2169 if ((chanPtr->flags & CHANNEL_CLOSED) && (chanPtr->refCount <= 0) &&
2170 (chanPtr->outQueueHead == (ChannelBuffer *) NULL) &&
2171 ((chanPtr->curOutPtr == (ChannelBuffer *) NULL) ||
2172 (chanPtr->curOutPtr->nextAdded ==
2173 chanPtr->curOutPtr->nextRemoved))) {
2174 return CloseChannel(interp, chanPtr, errorCode);
2175 }
2176 return errorCode;
2177 }
2178
2179 /*
2180 *----------------------------------------------------------------------
2181 *
2182 * CloseChannel --
2183 *
2184 * Utility procedure to close a channel and free its associated
2185 * resources.
2186 *
2187 * Results:
2188 * 0 on success or a POSIX error code if the operation failed.
2189 *
2190 * Side effects:
2191 * May close the actual channel; may free memory.
2192 *
2193 *----------------------------------------------------------------------
2194 */
2195
2196 static int
CloseChannel(interp,chanPtr,errorCode)2197 CloseChannel(interp, chanPtr, errorCode)
2198 Tcl_Interp *interp; /* For error reporting. */
2199 Channel *chanPtr; /* The channel to close. */
2200 int errorCode; /* Status of operation so far. */
2201 {
2202 int result = 0; /* Of calling driver close
2203 * operation. */
2204 Channel *prevChanPtr; /* Preceding channel in list of
2205 * all channels - used to splice a
2206 * channel out of the list on close. */
2207 ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
2208
2209 if (chanPtr == NULL) {
2210 return result;
2211 }
2212
2213 /*
2214 * No more input can be consumed so discard any leftover input.
2215 */
2216
2217 DiscardInputQueued(chanPtr, 1);
2218
2219 /*
2220 * Discard a leftover buffer in the current output buffer field.
2221 */
2222
2223 if (chanPtr->curOutPtr != (ChannelBuffer *) NULL) {
2224 ckfree((char *) chanPtr->curOutPtr);
2225 chanPtr->curOutPtr = (ChannelBuffer *) NULL;
2226 }
2227
2228 /*
2229 * The caller guarantees that there are no more buffers
2230 * queued for output.
2231 */
2232
2233 if (chanPtr->outQueueHead != (ChannelBuffer *) NULL) {
2234 panic("TclFlush, closed channel: queued output left");
2235 }
2236
2237 /*
2238 * If the EOF character is set in the channel, append that to the
2239 * output device.
2240 */
2241
2242 if ((chanPtr->outEofChar != 0) && (chanPtr->flags & TCL_WRITABLE)) {
2243 int dummy;
2244 char c;
2245
2246 c = (char) chanPtr->outEofChar;
2247 (chanPtr->typePtr->outputProc) (chanPtr->instanceData, &c, 1, &dummy);
2248 }
2249
2250 /*
2251 * Remove TCL_READABLE and TCL_WRITABLE from chanPtr->flags, so
2252 * that close callbacks can not do input or output (assuming they
2253 * squirreled the channel away in their clientData). This also
2254 * prevents infinite loops if the callback calls any C API that
2255 * could call FlushChannel.
2256 */
2257
2258 chanPtr->flags &= (~(TCL_READABLE|TCL_WRITABLE));
2259
2260 /*
2261 * Splice this channel out of the list of all channels.
2262 */
2263
2264 if (chanPtr == tsdPtr->firstChanPtr) {
2265 tsdPtr->firstChanPtr = chanPtr->nextChanPtr;
2266 } else {
2267 for (prevChanPtr = tsdPtr->firstChanPtr;
2268 (prevChanPtr != (Channel *) NULL) &&
2269 (prevChanPtr->nextChanPtr != chanPtr);
2270 prevChanPtr = prevChanPtr->nextChanPtr) {
2271 /* Empty loop body. */
2272 }
2273 if (prevChanPtr == (Channel *) NULL) {
2274 panic("FlushChannel: damaged channel list");
2275 }
2276 prevChanPtr->nextChanPtr = chanPtr->nextChanPtr;
2277 }
2278
2279 /*
2280 * Close and free the channel driver state.
2281 */
2282
2283 if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {
2284 result = (chanPtr->typePtr->closeProc)(chanPtr->instanceData, interp);
2285 } else {
2286 result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData, interp,
2287 0);
2288 }
2289
2290 if (chanPtr->channelName != (char *) NULL) {
2291 ckfree(chanPtr->channelName);
2292 }
2293 Tcl_FreeEncoding(chanPtr->encoding);
2294 if (chanPtr->outputStage != NULL) {
2295 ckfree((char *) chanPtr->outputStage);
2296 }
2297
2298 /*
2299 * If we are being called synchronously, report either
2300 * any latent error on the channel or the current error.
2301 */
2302
2303 if (chanPtr->unreportedError != 0) {
2304 errorCode = chanPtr->unreportedError;
2305 }
2306 if (errorCode == 0) {
2307 errorCode = result;
2308 if (errorCode != 0) {
2309 Tcl_SetErrno(errorCode);
2310 }
2311 }
2312
2313 /* Andreas Kupries <andreas_kupries@users.sourceforge.net>, 12/13/1998
2314 * "Trf-Patch for filtering channels"
2315 *
2316 * This is the change to 'CloseChannel'.
2317 *
2318 * Explanation
2319 * Closing a filtering channel closes the one it
2320 * superceded too. This basically ripples through
2321 * the whole chain of filters until it reaches
2322 * the underlying normal channel.
2323 *
2324 * This is done by reintegrating the superceded
2325 * channel into the (thread) global list of open
2326 * channels and then invoking a regular close.
2327 * There is no need to handle the complexities of
2328 * this process by ourselves.
2329 *
2330 * *Note*
2331 * This has to be done after the call to the
2332 * 'closeProc' of the filtering channel to allow
2333 * that one the flushing of internal buffers into
2334 * the underlying channel.
2335 */
2336
2337 if (chanPtr->supercedes != (Channel*) NULL) {
2338 /* Insert the channel we were stacked upon back into
2339 * the list of open channels, then do a regular close.
2340 */
2341
2342 chanPtr->supercedes->nextChanPtr = tsdPtr->firstChanPtr;
2343 tsdPtr->firstChanPtr = chanPtr->supercedes;
2344 chanPtr->supercedes->refCount --; /* is deregistered */
2345 Tcl_Close (interp, (Tcl_Channel) chanPtr->supercedes);
2346 }
2347
2348 /*
2349 * Cancel any outstanding timer.
2350 */
2351
2352 Tcl_DeleteTimerHandler(chanPtr->timer);
2353
2354 /*
2355 * Mark the channel as deleted by clearing the type structure.
2356 */
2357
2358 chanPtr->typePtr = NULL;
2359
2360 Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC);
2361
2362 return errorCode;
2363 }
2364
2365 /*
2366 *----------------------------------------------------------------------
2367 *
2368 * Tcl_Close --
2369 *
2370 * Closes a channel.
2371 *
2372 * Results:
2373 * A standard Tcl result.
2374 *
2375 * Side effects:
2376 * Closes the channel if this is the last reference.
2377 *
2378 * NOTE:
2379 * Tcl_Close removes the channel as far as the user is concerned.
2380 * However, it may continue to exist for a while longer if it has
2381 * a background flush scheduled. The device itself is eventually
2382 * closed and the channel record removed, in CloseChannel, above.
2383 *
2384 *----------------------------------------------------------------------
2385 */
2386
2387 /* ARGSUSED */
2388 int
Tcl_Close(interp,chan)2389 Tcl_Close(interp, chan)
2390 Tcl_Interp *interp; /* Interpreter for errors. */
2391 Tcl_Channel chan; /* The channel being closed. Must
2392 * not be referenced in any
2393 * interpreter. */
2394 {
2395 ChannelHandler *chPtr, *chNext; /* Iterate over channel handlers. */
2396 CloseCallback *cbPtr; /* Iterate over close callbacks
2397 * for this channel. */
2398 EventScriptRecord *ePtr, *eNextPtr; /* Iterate over eventscript records. */
2399 Channel *chanPtr; /* The real IO channel. */
2400 int result; /* Of calling FlushChannel. */
2401 ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
2402 NextChannelHandler *nhPtr;
2403
2404 if (chan == (Tcl_Channel) NULL) {
2405 return TCL_OK;
2406 }
2407
2408 /*
2409 * Perform special handling for standard channels being closed. If the
2410 * refCount is now 1 it means that the last reference to the standard
2411 * channel is being explicitly closed, so bump the refCount down
2412 * artificially to 0. This will ensure that the channel is actually
2413 * closed, below. Also set the static pointer to NULL for the channel.
2414 */
2415
2416 CheckForStdChannelsBeingClosed(chan);
2417
2418 chanPtr = (Channel *) chan;
2419 if (chanPtr->refCount > 0) {
2420 panic("called Tcl_Close on channel with refCount > 0");
2421 }
2422
2423 /*
2424 * Remove any references to channel handlers for this channel that
2425 * may be about to be invoked.
2426 */
2427
2428 for (nhPtr = tsdPtr->nestedHandlerPtr;
2429 nhPtr != (NextChannelHandler *) NULL;
2430 nhPtr = nhPtr->nestedHandlerPtr) {
2431 if (nhPtr->nextHandlerPtr &&
2432 (nhPtr->nextHandlerPtr->chanPtr == chanPtr)) {
2433 nhPtr->nextHandlerPtr = NULL;
2434 }
2435 }
2436
2437 /*
2438 * Remove all the channel handler records attached to the channel
2439 * itself.
2440 */
2441
2442 for (chPtr = chanPtr->chPtr;
2443 chPtr != (ChannelHandler *) NULL;
2444 chPtr = chNext) {
2445 chNext = chPtr->nextPtr;
2446 ckfree((char *) chPtr);
2447 }
2448 chanPtr->chPtr = (ChannelHandler *) NULL;
2449
2450
2451 /*
2452 * Cancel any pending copy operation.
2453 */
2454
2455 StopCopy(chanPtr->csPtr);
2456
2457 /*
2458 * Must set the interest mask now to 0, otherwise infinite loops
2459 * will occur if Tcl_DoOneEvent is called before the channel is
2460 * finally deleted in FlushChannel. This can happen if the channel
2461 * has a background flush active.
2462 */
2463
2464 chanPtr->interestMask = 0;
2465
2466 /*
2467 * Remove any EventScript records for this channel.
2468 */
2469
2470 for (ePtr = chanPtr->scriptRecordPtr;
2471 ePtr != (EventScriptRecord *) NULL;
2472 ePtr = eNextPtr) {
2473 eNextPtr = ePtr->nextPtr;
2474 Tcl_DecrRefCount(ePtr->scriptPtr);
2475 ckfree((char *) ePtr);
2476 }
2477 chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL;
2478
2479 /*
2480 * Invoke the registered close callbacks and delete their records.
2481 */
2482
2483 while (chanPtr->closeCbPtr != (CloseCallback *) NULL) {
2484 cbPtr = chanPtr->closeCbPtr;
2485 chanPtr->closeCbPtr = cbPtr->nextPtr;
2486 (cbPtr->proc) (cbPtr->clientData);
2487 ckfree((char *) cbPtr);
2488 }
2489
2490 /*
2491 * Ensure that the last output buffer will be flushed.
2492 */
2493
2494 if ((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&
2495 (chanPtr->curOutPtr->nextAdded > chanPtr->curOutPtr->nextRemoved)) {
2496 chanPtr->flags |= BUFFER_READY;
2497 }
2498
2499 /*
2500 * If this channel supports it, close the read side, since we don't need it
2501 * anymore and this will help avoid deadlocks on some channel types.
2502 */
2503
2504 if (chanPtr->typePtr->closeProc == TCL_CLOSE2PROC) {
2505 result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData, interp,
2506 TCL_CLOSE_READ);
2507 } else {
2508 result = 0;
2509 }
2510
2511 /*
2512 * The call to FlushChannel will flush any queued output and invoke
2513 * the close function of the channel driver, or it will set up the
2514 * channel to be flushed and closed asynchronously.
2515 */
2516
2517 chanPtr->flags |= CHANNEL_CLOSED;
2518 if ((FlushChannel(interp, chanPtr, 0) != 0) || (result != 0)) {
2519 return TCL_ERROR;
2520 }
2521 return TCL_OK;
2522 }
2523
2524 /*
2525 *----------------------------------------------------------------------
2526 *
2527 * Tcl_Write --
2528 *
2529 * Puts a sequence of bytes into an output buffer, may queue the
2530 * buffer for output if it gets full, and also remembers whether the
2531 * current buffer is ready e.g. if it contains a newline and we are in
2532 * line buffering mode.
2533 *
2534 * Results:
2535 * The number of bytes written or -1 in case of error. If -1,
2536 * Tcl_GetErrno will return the error code.
2537 *
2538 * Side effects:
2539 * May buffer up output and may cause output to be produced on the
2540 * channel.
2541 *
2542 *----------------------------------------------------------------------
2543 */
2544
2545 int
Tcl_Write(chan,src,srcLen)2546 Tcl_Write(chan, src, srcLen)
2547 Tcl_Channel chan; /* The channel to buffer output for. */
2548 char *src; /* Data to queue in output buffer. */
2549 int srcLen; /* Length of data in bytes, or < 0 for
2550 * strlen(). */
2551 {
2552 Channel *chanPtr;
2553
2554 chanPtr = (Channel *) chan;
2555 if (CheckChannelErrors(chanPtr, TCL_WRITABLE) != 0) {
2556 return -1;
2557 }
2558 if (srcLen < 0) {
2559 srcLen = strlen(src);
2560 }
2561 return DoWrite(chanPtr, src, srcLen);
2562 }
2563
2564 /*
2565 *---------------------------------------------------------------------------
2566 *
2567 * Tcl_WriteChars --
2568 *
2569 * Takes a sequence of UTF-8 characters and converts them for output
2570 * using the channel's current encoding, may queue the buffer for
2571 * output if it gets full, and also remembers whether the current
2572 * buffer is ready e.g. if it contains a newline and we are in
2573 * line buffering mode.
2574 *
2575 * Results:
2576 * The number of bytes written or -1 in case of error. If -1,
2577 * Tcl_GetErrno will return the error code.
2578 *
2579 * Side effects:
2580 * May buffer up output and may cause output to be produced on the
2581 * channel.
2582 *
2583 *----------------------------------------------------------------------
2584 */
2585
2586 int
Tcl_WriteChars(chan,src,len)2587 Tcl_WriteChars(chan, src, len)
2588 Tcl_Channel chan; /* The channel to buffer output for. */
2589 CONST char *src; /* UTF-8 characters to queue in output buffer. */
2590 int len; /* Length of string in bytes, or < 0 for
2591 * strlen(). */
2592 {
2593 Channel *chanPtr;
2594
2595 chanPtr = (Channel *) chan;
2596 if (CheckChannelErrors(chanPtr, TCL_WRITABLE) != 0) {
2597 return -1;
2598 }
2599 if (len < 0) {
2600 len = strlen(src);
2601 }
2602 if (chanPtr->encoding == NULL) {
2603 /*
2604 * Inefficient way to convert UTF-8 to byte-array, but the
2605 * code parallels the way it is done for objects.
2606 */
2607
2608 Tcl_Obj *objPtr;
2609 int result;
2610
2611 objPtr = Tcl_NewStringObj(src, len);
2612 src = (char *) Tcl_GetByteArrayFromObj(objPtr, &len);
2613 result = WriteBytes(chanPtr, src, len);
2614 Tcl_DecrRefCount(objPtr);
2615 return result;
2616 }
2617 return WriteChars(chanPtr, src, len);
2618 }
2619
2620 /*
2621 *---------------------------------------------------------------------------
2622 *
2623 * Tcl_WriteObj --
2624 *
2625 * Takes the Tcl object and queues its contents for output. If the
2626 * encoding of the channel is NULL, takes the byte-array representation
2627 * of the object and queues those bytes for output. Otherwise, takes
2628 * the characters in the UTF-8 (string) representation of the object
2629 * and converts them for output using the channel's current encoding.
2630 * May flush internal buffers to output if one becomes full or is ready
2631 * for some other reason, e.g. if it contains a newline and the channel
2632 * is in line buffering mode.
2633 *
2634 * Results:
2635 * The number of bytes written or -1 in case of error. If -1,
2636 * Tcl_GetErrno() will return the error code.
2637 *
2638 * Side effects:
2639 * May buffer up output and may cause output to be produced on the
2640 * channel.
2641 *
2642 *----------------------------------------------------------------------
2643 */
2644
2645 int
Tcl_WriteObj(chan,objPtr)2646 Tcl_WriteObj(chan, objPtr)
2647 Tcl_Channel chan; /* The channel to buffer output for. */
2648 Tcl_Obj *objPtr; /* The object to write. */
2649 {
2650 Channel *chanPtr;
2651 char *src;
2652 int srcLen;
2653
2654 chanPtr = (Channel *) chan;
2655 if (CheckChannelErrors(chanPtr, TCL_WRITABLE) != 0) {
2656 return -1;
2657 }
2658 if (chanPtr->encoding == NULL) {
2659 src = (char *) Tcl_GetByteArrayFromObj(objPtr, &srcLen);
2660 return WriteBytes(chanPtr, src, srcLen);
2661 } else {
2662 src = Tcl_GetStringFromObj(objPtr, &srcLen);
2663 return WriteChars(chanPtr, src, srcLen);
2664 }
2665 }
2666
2667 /*
2668 *----------------------------------------------------------------------
2669 *
2670 * WriteBytes --
2671 *
2672 * Write a sequence of bytes into an output buffer, may queue the
2673 * buffer for output if it gets full, and also remembers whether the
2674 * current buffer is ready e.g. if it contains a newline and we are in
2675 * line buffering mode.
2676 *
2677 * Results:
2678 * The number of bytes written or -1 in case of error. If -1,
2679 * Tcl_GetErrno will return the error code.
2680 *
2681 * Side effects:
2682 * May buffer up output and may cause output to be produced on the
2683 * channel.
2684 *
2685 *----------------------------------------------------------------------
2686 */
2687
2688 static int
WriteBytes(chanPtr,src,srcLen)2689 WriteBytes(chanPtr, src, srcLen)
2690 Channel *chanPtr; /* The channel to buffer output for. */
2691 CONST char *src; /* Bytes to write. */
2692 int srcLen; /* Number of bytes to write. */
2693 {
2694 ChannelBuffer *bufPtr;
2695 char *dst;
2696 int dstLen, dstMax, sawLF, savedLF, total, toWrite;
2697
2698 total = 0;
2699 sawLF = 0;
2700 savedLF = 0;
2701
2702 /*
2703 * Loop over all bytes in src, storing them in output buffer with
2704 * proper EOL translation.
2705 */
2706
2707 while (srcLen + savedLF > 0) {
2708 bufPtr = chanPtr->curOutPtr;
2709 if (bufPtr == NULL) {
2710 bufPtr = AllocChannelBuffer(chanPtr->bufSize);
2711 chanPtr->curOutPtr = bufPtr;
2712 }
2713 dst = bufPtr->buf + bufPtr->nextAdded;
2714 dstMax = bufPtr->bufLength - bufPtr->nextAdded;
2715 dstLen = dstMax;
2716
2717 toWrite = dstLen;
2718 if (toWrite > srcLen) {
2719 toWrite = srcLen;
2720 }
2721
2722 if (savedLF) {
2723 /*
2724 * A '\n' was left over from last call to TranslateOutputEOL()
2725 * and we need to store it in this buffer. If the channel is
2726 * line-based, we will need to flush it.
2727 */
2728
2729 *dst++ = '\n';
2730 dstLen--;
2731 sawLF++;
2732 }
2733 sawLF += TranslateOutputEOL(chanPtr, dst, src, &dstLen, &toWrite);
2734 dstLen += savedLF;
2735 savedLF = 0;
2736
2737 if (dstLen > dstMax) {
2738 savedLF = 1;
2739 dstLen = dstMax;
2740 }
2741 bufPtr->nextAdded += dstLen;
2742 if (CheckFlush(chanPtr, bufPtr, sawLF) != 0) {
2743 return -1;
2744 }
2745 total += dstLen;
2746 src += toWrite;
2747 srcLen -= toWrite;
2748 sawLF = 0;
2749 }
2750 return total;
2751 }
2752
2753 /*
2754 *----------------------------------------------------------------------
2755 *
2756 * WriteChars --
2757 *
2758 * Convert UTF-8 bytes to the channel's external encoding and
2759 * write the produced bytes into an output buffer, may queue the
2760 * buffer for output if it gets full, and also remembers whether the
2761 * current buffer is ready e.g. if it contains a newline and we are in
2762 * line buffering mode.
2763 *
2764 * Results:
2765 * The number of bytes written or -1 in case of error. If -1,
2766 * Tcl_GetErrno will return the error code.
2767 *
2768 * Side effects:
2769 * May buffer up output and may cause output to be produced on the
2770 * channel.
2771 *
2772 *----------------------------------------------------------------------
2773 */
2774
2775 static int
WriteChars(chanPtr,src,srcLen)2776 WriteChars(chanPtr, src, srcLen)
2777 Channel *chanPtr; /* The channel to buffer output for. */
2778 CONST char *src; /* UTF-8 string to write. */
2779 int srcLen; /* Length of UTF-8 string in bytes. */
2780 {
2781 ChannelBuffer *bufPtr;
2782 char *dst, *stage;
2783 int saved, savedLF, sawLF, total, toWrite, flags;
2784 int dstWrote, dstLen, stageLen, stageMax, stageRead;
2785 Tcl_Encoding encoding;
2786 char safe[BUFFER_PADDING];
2787
2788 total = 0;
2789 sawLF = 0;
2790 savedLF = 0;
2791 saved = 0;
2792 encoding = chanPtr->encoding;
2793
2794 /*
2795 * Loop over all UTF-8 characters in src, storing them in staging buffer
2796 * with proper EOL translation.
2797 */
2798
2799 while (srcLen + savedLF > 0) {
2800 stage = chanPtr->outputStage;
2801 stageMax = chanPtr->bufSize;
2802 stageLen = stageMax;
2803
2804 toWrite = stageLen;
2805 if (toWrite > srcLen) {
2806 toWrite = srcLen;
2807 }
2808
2809 if (savedLF) {
2810 /*
2811 * A '\n' was left over from last call to TranslateOutputEOL()
2812 * and we need to store it in the staging buffer. If the
2813 * channel is line-based, we will need to flush the output
2814 * buffer (after translating the staging buffer).
2815 */
2816
2817 *stage++ = '\n';
2818 stageLen--;
2819 sawLF++;
2820 }
2821 sawLF += TranslateOutputEOL(chanPtr, stage, src, &stageLen, &toWrite);
2822
2823 stage -= savedLF;
2824 stageLen += savedLF;
2825 savedLF = 0;
2826
2827 if (stageLen > stageMax) {
2828 savedLF = 1;
2829 stageLen = stageMax;
2830 }
2831 src += toWrite;
2832 srcLen -= toWrite;
2833
2834 flags = chanPtr->outputEncodingFlags;
2835 if (srcLen == 0) {
2836 flags |= TCL_ENCODING_END;
2837 }
2838
2839 /*
2840 * Loop over all UTF-8 characters in staging buffer, converting them
2841 * to external encoding, storing them in output buffer.
2842 */
2843
2844 while (stageLen + saved > 0) {
2845 bufPtr = chanPtr->curOutPtr;
2846 if (bufPtr == NULL) {
2847 bufPtr = AllocChannelBuffer(chanPtr->bufSize);
2848 chanPtr->curOutPtr = bufPtr;
2849 }
2850 dst = bufPtr->buf + bufPtr->nextAdded;
2851 dstLen = bufPtr->bufLength - bufPtr->nextAdded;
2852
2853 if (saved != 0) {
2854 /*
2855 * Here's some translated bytes left over from the last
2856 * buffer that we need to stick at the beginning of this
2857 * buffer.
2858 */
2859
2860 memcpy((VOID *) dst, (VOID *) safe, (size_t) saved);
2861 bufPtr->nextAdded += saved;
2862 dst += saved;
2863 dstLen -= saved;
2864 saved = 0;
2865 }
2866
2867 Tcl_UtfToExternal(NULL, encoding, stage, stageLen, flags,
2868 &chanPtr->outputEncodingState, dst,
2869 dstLen + BUFFER_PADDING, &stageRead, &dstWrote, NULL);
2870 if (stageRead + dstWrote == 0) {
2871 /*
2872 * We have an incomplete UTF-8 character at the end of the
2873 * staging buffer. It will get moved to the beginning of the
2874 * staging buffer followed by more bytes from src.
2875 */
2876
2877 src -= stageLen;
2878 srcLen += stageLen;
2879 stageLen = 0;
2880 savedLF = 0;
2881 break;
2882 }
2883 bufPtr->nextAdded += dstWrote;
2884 if (bufPtr->nextAdded > bufPtr->bufLength) {
2885 /*
2886 * When translating from UTF-8 to external encoding, we
2887 * allowed the translation to produce a character that
2888 * crossed the end of the output buffer, so that we would
2889 * get a completely full buffer before flushing it. The
2890 * extra bytes will be moved to the beginning of the next
2891 * buffer.
2892 */
2893
2894 saved = bufPtr->nextAdded - bufPtr->bufLength;
2895 memcpy((VOID *) safe, (VOID *) (dst + dstLen), (size_t) saved);
2896 bufPtr->nextAdded = bufPtr->bufLength;
2897 }
2898 if (CheckFlush(chanPtr, bufPtr, sawLF) != 0) {
2899 return -1;
2900 }
2901
2902 total += dstWrote;
2903 stage += stageRead;
2904 stageLen -= stageRead;
2905 sawLF = 0;
2906 }
2907 }
2908 return total;
2909 }
2910
2911 /*
2912 *---------------------------------------------------------------------------
2913 *
2914 * TranslateOutputEOL --
2915 *
2916 * Helper function for WriteBytes() and WriteChars(). Converts the
2917 * '\n' characters in the source buffer into the appropriate EOL
2918 * form specified by the output translation mode.
2919 *
2920 * EOL translation stops either when the source buffer is empty
2921 * or the output buffer is full.
2922 *
2923 * When converting to CRLF mode and there is only 1 byte left in
2924 * the output buffer, this routine stores the '\r' in the last
2925 * byte and then stores the '\n' in the byte just past the end of the
2926 * buffer. The caller is responsible for passing in a buffer that
2927 * is large enough to hold the extra byte.
2928 *
2929 * Results:
2930 * The return value is 1 if a '\n' was translated from the source
2931 * buffer, or 0 otherwise -- this can be used by the caller to
2932 * decide to flush a line-based channel even though the channel
2933 * buffer is not full.
2934 *
2935 * *dstLenPtr is filled with how many bytes of the output buffer
2936 * were used. As mentioned above, this can be one more that
2937 * the output buffer's specified length if a CRLF was stored.
2938 *
2939 * *srcLenPtr is filled with how many bytes of the source buffer
2940 * were consumed.
2941 *
2942 * Side effects:
2943 * It may be obvious, but bears mentioning that when converting
2944 * in CRLF mode (which requires two bytes of storage in the output
2945 * buffer), the number of bytes consumed from the source buffer
2946 * will be less than the number of bytes stored in the output buffer.
2947 *
2948 *---------------------------------------------------------------------------
2949 */
2950
2951 static int
TranslateOutputEOL(chanPtr,dst,src,dstLenPtr,srcLenPtr)2952 TranslateOutputEOL(chanPtr, dst, src, dstLenPtr, srcLenPtr)
2953 Channel *chanPtr; /* Channel being read, for translation and
2954 * buffering modes. */
2955 char *dst; /* Output buffer filled with UTF-8 chars by
2956 * applying appropriate EOL translation to
2957 * source characters. */
2958 CONST char *src; /* Source UTF-8 characters. */
2959 int *dstLenPtr; /* On entry, the maximum length of output
2960 * buffer in bytes. On exit, the number of
2961 * bytes actually used in output buffer. */
2962 int *srcLenPtr; /* On entry, the length of source buffer.
2963 * On exit, the number of bytes read from
2964 * the source buffer. */
2965 {
2966 char *dstEnd;
2967 int srcLen, newlineFound;
2968
2969 newlineFound = 0;
2970 srcLen = *srcLenPtr;
2971
2972 switch (chanPtr->outputTranslation) {
2973 case TCL_TRANSLATE_LF: {
2974 for (dstEnd = dst + srcLen; dst < dstEnd; ) {
2975 if (*src == '\n') {
2976 newlineFound = 1;
2977 }
2978 *dst++ = *src++;
2979 }
2980 *dstLenPtr = srcLen;
2981 break;
2982 }
2983 case TCL_TRANSLATE_CR: {
2984 for (dstEnd = dst + srcLen; dst < dstEnd;) {
2985 if (*src == '\n') {
2986 *dst++ = '\r';
2987 newlineFound = 1;
2988 src++;
2989 } else {
2990 *dst++ = *src++;
2991 }
2992 }
2993 *dstLenPtr = srcLen;
2994 break;
2995 }
2996 case TCL_TRANSLATE_CRLF: {
2997 /*
2998 * Since this causes the number of bytes to grow, we
2999 * start off trying to put 'srcLen' bytes into the
3000 * output buffer, but allow it to store more bytes, as
3001 * long as there's still source bytes and room in the
3002 * output buffer.
3003 */
3004
3005 char *dstStart, *dstMax;
3006 CONST char *srcStart;
3007
3008 dstStart = dst;
3009 dstMax = dst + *dstLenPtr;
3010
3011 srcStart = src;
3012
3013 if (srcLen < *dstLenPtr) {
3014 dstEnd = dst + srcLen;
3015 } else {
3016 dstEnd = dst + *dstLenPtr;
3017 }
3018 while (dst < dstEnd) {
3019 if (*src == '\n') {
3020 if (dstEnd < dstMax) {
3021 dstEnd++;
3022 }
3023 *dst++ = '\r';
3024 newlineFound = 1;
3025 }
3026 *dst++ = *src++;
3027 }
3028 *srcLenPtr = src - srcStart;
3029 *dstLenPtr = dst - dstStart;
3030 break;
3031 }
3032 default: {
3033 break;
3034 }
3035 }
3036 return newlineFound;
3037 }
3038
3039 /*
3040 *---------------------------------------------------------------------------
3041 *
3042 * CheckFlush --
3043 *
3044 * Helper function for WriteBytes() and WriteChars(). If the
3045 * channel buffer is ready to be flushed, flush it.
3046 *
3047 * Results:
3048 * The return value is -1 if there was a problem flushing the
3049 * channel buffer, or 0 otherwise.
3050 *
3051 * Side effects:
3052 * The buffer will be recycled if it is flushed.
3053 *
3054 *---------------------------------------------------------------------------
3055 */
3056
3057 static int
CheckFlush(chanPtr,bufPtr,newlineFlag)3058 CheckFlush(chanPtr, bufPtr, newlineFlag)
3059 Channel *chanPtr; /* Channel being read, for buffering mode. */
3060 ChannelBuffer *bufPtr; /* Channel buffer to possibly flush. */
3061 int newlineFlag; /* Non-zero if a the channel buffer
3062 * contains a newline. */
3063 {
3064 /*
3065 * The current buffer is ready for output:
3066 * 1. if it is full.
3067 * 2. if it contains a newline and this channel is line-buffered.
3068 * 3. if it contains any output and this channel is unbuffered.
3069 */
3070
3071 if ((chanPtr->flags & BUFFER_READY) == 0) {
3072 if (bufPtr->nextAdded == bufPtr->bufLength) {
3073 chanPtr->flags |= BUFFER_READY;
3074 } else if (chanPtr->flags & CHANNEL_LINEBUFFERED) {
3075 if (newlineFlag != 0) {
3076 chanPtr->flags |= BUFFER_READY;
3077 }
3078 } else if (chanPtr->flags & CHANNEL_UNBUFFERED) {
3079 chanPtr->flags |= BUFFER_READY;
3080 }
3081 }
3082 if (chanPtr->flags & BUFFER_READY) {
3083 if (FlushChannel(NULL, chanPtr, 0) != 0) {
3084 return -1;
3085 }
3086 }
3087 return 0;
3088 }
3089
3090 /*
3091 *---------------------------------------------------------------------------
3092 *
3093 * Tcl_Gets --
3094 *
3095 * Reads a complete line of input from the channel into a Tcl_DString.
3096 *
3097 * Results:
3098 * Length of line read (in characters) or -1 if error, EOF, or blocked.
3099 * If -1, use Tcl_GetErrno() to retrieve the POSIX error code for the
3100 * error or condition that occurred.
3101 *
3102 * Side effects:
3103 * May flush output on the channel. May cause input to be consumed
3104 * from the channel.
3105 *
3106 *---------------------------------------------------------------------------
3107 */
3108
3109 int
Tcl_Gets(chan,lineRead)3110 Tcl_Gets(chan, lineRead)
3111 Tcl_Channel chan; /* Channel from which to read. */
3112 Tcl_DString *lineRead; /* The line read will be appended to this
3113 * DString as UTF-8 characters. The caller
3114 * must have initialized it and is responsible
3115 * for managing the storage. */
3116 {
3117 Tcl_Obj *objPtr;
3118 int charsStored, length;
3119 char *string;
3120
3121 objPtr = Tcl_NewObj();
3122 charsStored = Tcl_GetsObj(chan, objPtr);
3123 if (charsStored > 0) {
3124 string = Tcl_GetStringFromObj(objPtr, &length);
3125 Tcl_DStringAppend(lineRead, string, length);
3126 }
3127 Tcl_DecrRefCount(objPtr);
3128 return charsStored;
3129 }
3130
3131 /*
3132 *---------------------------------------------------------------------------
3133 *
3134 * Tcl_GetsObj --
3135 *
3136 * Accumulate input from the input channel until end-of-line or
3137 * end-of-file has been seen. Bytes read from the input channel
3138 * are converted to UTF-8 using the encoding specified by the
3139 * channel.
3140 *
3141 * Results:
3142 * Number of characters accumulated in the object or -1 if error,
3143 * blocked, or EOF. If -1, use Tcl_GetErrno() to retrieve the
3144 * POSIX error code for the error or condition that occurred.
3145 *
3146 * Side effects:
3147 * Consumes input from the channel.
3148 *
3149 * On reading EOF, leave channel pointing at EOF char.
3150 * On reading EOL, leave channel pointing after EOL, but don't
3151 * return EOL in dst buffer.
3152 *
3153 *---------------------------------------------------------------------------
3154 */
3155
3156 int
Tcl_GetsObj(chan,objPtr)3157 Tcl_GetsObj(chan, objPtr)
3158 Tcl_Channel chan; /* Channel from which to read. */
3159 Tcl_Obj *objPtr; /* The line read will be appended to this
3160 * object as UTF-8 characters. */
3161 {
3162 GetsState gs;
3163 Channel *chanPtr;
3164 int inEofChar, skip, copiedTotal;
3165 ChannelBuffer *bufPtr;
3166 Tcl_Encoding encoding;
3167 char *dst, *dstEnd, *eol, *eof;
3168 Tcl_EncodingState oldState;
3169 int oldLength, oldFlags, oldRemoved;
3170
3171 chanPtr = (Channel *) chan;
3172 if (CheckChannelErrors(chanPtr, TCL_READABLE) != 0) {
3173 copiedTotal = -1;
3174 goto done;
3175 }
3176
3177 bufPtr = chanPtr->inQueueHead;
3178 encoding = chanPtr->encoding;
3179
3180 /*
3181 * Preserved so we can restore the channel's state in case we don't
3182 * find a newline in the available input.
3183 */
3184
3185 Tcl_GetStringFromObj(objPtr, &oldLength);
3186 oldFlags = chanPtr->inputEncodingFlags;
3187 oldState = chanPtr->inputEncodingState;
3188 oldRemoved = BUFFER_PADDING;
3189 if (bufPtr != NULL) {
3190 oldRemoved = bufPtr->nextRemoved;
3191 }
3192
3193 /*
3194 * If there is no encoding, use "iso8859-1" -- Tcl_GetsObj() doesn't
3195 * produce ByteArray objects. To avoid circularity problems,
3196 * "iso8859-1" is builtin to Tcl.
3197 */
3198
3199 if (encoding == NULL) {
3200 encoding = Tcl_GetEncoding(NULL, "iso8859-1");
3201 }
3202
3203 /*
3204 * Object used by FilterInputBytes to keep track of how much data has
3205 * been consumed from the channel buffers.
3206 */
3207
3208 gs.objPtr = objPtr;
3209 gs.dstPtr = &dst;
3210 gs.encoding = encoding;
3211 gs.bufPtr = bufPtr;
3212 gs.state = oldState;
3213 gs.rawRead = 0;
3214 gs.bytesWrote = 0;
3215 gs.charsWrote = 0;
3216 gs.totalChars = 0;
3217
3218 dst = objPtr->bytes + oldLength;
3219 dstEnd = dst;
3220
3221 skip = 0;
3222 eof = NULL;
3223 inEofChar = chanPtr->inEofChar;
3224
3225 while (1) {
3226 if (dst >= dstEnd) {
3227 if (FilterInputBytes(chanPtr, &gs) != 0) {
3228 goto restore;
3229 }
3230 dstEnd = dst + gs.bytesWrote;
3231 }
3232
3233 /*
3234 * Remember if EOF char is seen, then look for EOL anyhow, because
3235 * the EOL might be before the EOF char.
3236 */
3237
3238 if (inEofChar != '\0') {
3239 for (eol = dst; eol < dstEnd; eol++) {
3240 if (*eol == inEofChar) {
3241 dstEnd = eol;
3242 eof = eol;
3243 break;
3244 }
3245 }
3246 }
3247
3248 /*
3249 * On EOL, leave current file position pointing after the EOL, but
3250 * don't store the EOL in the output string.
3251 */
3252
3253 eol = dst;
3254 switch (chanPtr->inputTranslation) {
3255 case TCL_TRANSLATE_LF: {
3256 for (eol = dst; eol < dstEnd; eol++) {
3257 if (*eol == '\n') {
3258 skip = 1;
3259 goto goteol;
3260 }
3261 }
3262 break;
3263 }
3264 case TCL_TRANSLATE_CR: {
3265 for (eol = dst; eol < dstEnd; eol++) {
3266 if (*eol == '\r') {
3267 skip = 1;
3268 goto goteol;
3269 }
3270 }
3271 break;
3272 }
3273 case TCL_TRANSLATE_CRLF: {
3274 for (eol = dst; eol < dstEnd; eol++) {
3275 if (*eol == '\r') {
3276 eol++;
3277 if (eol >= dstEnd) {
3278 int offset;
3279
3280 offset = eol - objPtr->bytes;
3281 dst = dstEnd;
3282 if (FilterInputBytes(chanPtr, &gs) != 0) {
3283 goto restore;
3284 }
3285 dstEnd = dst + gs.bytesWrote;
3286 eol = objPtr->bytes + offset;
3287 if (eol >= dstEnd) {
3288 skip = 0;
3289 goto goteol;
3290 }
3291 }
3292 if (*eol == '\n') {
3293 eol--;
3294 skip = 2;
3295 goto goteol;
3296 }
3297 }
3298 }
3299 break;
3300 }
3301 case TCL_TRANSLATE_AUTO: {
3302 skip = 1;
3303 if (chanPtr->flags & INPUT_SAW_CR) {
3304 chanPtr->flags &= ~INPUT_SAW_CR;
3305 if (*eol == '\n') {
3306 /*
3307 * Skip the raw bytes that make up the '\n'.
3308 */
3309
3310 char tmp[1 + TCL_UTF_MAX];
3311 int rawRead;
3312
3313 bufPtr = gs.bufPtr;
3314 Tcl_ExternalToUtf(NULL, gs.encoding,
3315 bufPtr->buf + bufPtr->nextRemoved,
3316 gs.rawRead, chanPtr->inputEncodingFlags,
3317 &gs.state, tmp, 1 + TCL_UTF_MAX, &rawRead,
3318 NULL, NULL);
3319 bufPtr->nextRemoved += rawRead;
3320 gs.rawRead -= rawRead;
3321 gs.bytesWrote--;
3322 gs.charsWrote--;
3323 memmove(dst, dst + 1, (size_t) (dstEnd - dst));
3324 dstEnd--;
3325 }
3326 }
3327 for (eol = dst; eol < dstEnd; eol++) {
3328 if (*eol == '\r') {
3329 eol++;
3330 if (eol == dstEnd) {
3331 /*
3332 * If buffer ended on \r, peek ahead to see if a
3333 * \n is available.
3334 */
3335
3336 int offset;
3337
3338 offset = eol - objPtr->bytes;
3339 dst = dstEnd;
3340 PeekAhead(chanPtr, &dstEnd, &gs);
3341 eol = objPtr->bytes + offset;
3342 if (eol >= dstEnd) {
3343 eol--;
3344 chanPtr->flags |= INPUT_SAW_CR;
3345 goto goteol;
3346 }
3347 }
3348 if (*eol == '\n') {
3349 skip++;
3350 }
3351 eol--;
3352 goto goteol;
3353 } else if (*eol == '\n') {
3354 goto goteol;
3355 }
3356 }
3357 }
3358 }
3359 if (eof != NULL) {
3360 /*
3361 * EOF character was seen. On EOF, leave current file position
3362 * pointing at the EOF character, but don't store the EOF
3363 * character in the output string.
3364 */
3365
3366 dstEnd = eof;
3367 chanPtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
3368 chanPtr->inputEncodingFlags |= TCL_ENCODING_END;
3369 }
3370 if (chanPtr->flags & CHANNEL_EOF) {
3371 skip = 0;
3372 eol = dstEnd;
3373 if (eol == objPtr->bytes) {
3374 /*
3375 * If we didn't produce any bytes before encountering EOF,
3376 * caller needs to see -1.
3377 */
3378
3379 Tcl_SetObjLength(objPtr, 0);
3380 CommonGetsCleanup(chanPtr, encoding);
3381 copiedTotal = -1;
3382 goto done;
3383 }
3384 goto goteol;
3385 }
3386 dst = dstEnd;
3387 }
3388
3389 /*
3390 * Found EOL or EOF, but the output buffer may now contain too many
3391 * UTF-8 characters. We need to know how many raw bytes correspond to
3392 * the number of UTF-8 characters we want, plus how many raw bytes
3393 * correspond to the character(s) making up EOL (if any), so we can
3394 * remove the correct number of bytes from the channel buffer.
3395 */
3396
3397 goteol:
3398 bufPtr = gs.bufPtr;
3399 chanPtr->inputEncodingState = gs.state;
3400 Tcl_ExternalToUtf(NULL, gs.encoding, bufPtr->buf + bufPtr->nextRemoved,
3401 gs.rawRead, chanPtr->inputEncodingFlags,
3402 &chanPtr->inputEncodingState, dst, eol - dst + skip + TCL_UTF_MAX,
3403 &gs.rawRead, NULL, &gs.charsWrote);
3404 bufPtr->nextRemoved += gs.rawRead;
3405
3406 /*
3407 * Recycle all the emptied buffers.
3408 */
3409
3410 Tcl_SetObjLength(objPtr, eol - objPtr->bytes);
3411 CommonGetsCleanup(chanPtr, encoding);
3412 chanPtr->flags &= ~CHANNEL_BLOCKED;
3413 copiedTotal = gs.totalChars + gs.charsWrote - skip;
3414 goto done;
3415
3416 /*
3417 * Couldn't get a complete line. This only happens if we get a error
3418 * reading from the channel or we are non-blocking and there wasn't
3419 * an EOL or EOF in the data available.
3420 */
3421
3422 restore:
3423 bufPtr = chanPtr->inQueueHead;
3424 bufPtr->nextRemoved = oldRemoved;
3425
3426 for (bufPtr = bufPtr->nextPtr; bufPtr != NULL; bufPtr = bufPtr->nextPtr) {
3427 bufPtr->nextRemoved = BUFFER_PADDING;
3428 }
3429 CommonGetsCleanup(chanPtr, encoding);
3430
3431 chanPtr->inputEncodingState = oldState;
3432 chanPtr->inputEncodingFlags = oldFlags;
3433 Tcl_SetObjLength(objPtr, oldLength);
3434
3435 /*
3436 * We didn't get a complete line so we need to indicate to UpdateInterest
3437 * that the gets blocked. It will wait for more data instead of firing
3438 * a timer, avoiding a busy wait. This is where we are assuming that the
3439 * next operation is a gets. No more file events will be delivered on
3440 * this channel until new data arrives or some operation is performed
3441 * on the channel (e.g. gets, read, fconfigure) that changes the blocking
3442 * state. Note that this means a file event will not be delivered even
3443 * though a read would be able to consume the buffered data.
3444 */
3445
3446 chanPtr->flags |= CHANNEL_NEED_MORE_DATA;
3447 copiedTotal = -1;
3448
3449 done:
3450 /*
3451 * Update the notifier state so we don't block while there is still
3452 * data in the buffers.
3453 */
3454
3455 UpdateInterest(chanPtr);
3456 return copiedTotal;
3457 }
3458
3459 /*
3460 *---------------------------------------------------------------------------
3461 *
3462 * FilterInputBytes --
3463 *
3464 * Helper function for Tcl_GetsObj. Produces UTF-8 characters from
3465 * raw bytes read from the channel.
3466 *
3467 * Consumes available bytes from channel buffers. When channel
3468 * buffers are exhausted, reads more bytes from channel device into
3469 * a new channel buffer. It is the caller's responsibility to
3470 * free the channel buffers that have been exhausted.
3471 *
3472 * Results:
3473 * The return value is -1 if there was an error reading from the
3474 * channel, 0 otherwise.
3475 *
3476 * Side effects:
3477 * Status object keeps track of how much data from channel buffers
3478 * has been consumed and where UTF-8 bytes should be stored.
3479 *
3480 *---------------------------------------------------------------------------
3481 */
3482
3483 static int
FilterInputBytes(chanPtr,gsPtr)3484 FilterInputBytes(chanPtr, gsPtr)
3485 Channel *chanPtr; /* Channel to read. */
3486 GetsState *gsPtr; /* Current state of gets operation. */
3487 {
3488 ChannelBuffer *bufPtr;
3489 char *raw, *rawStart, *rawEnd;
3490 char *dst;
3491 int offset, toRead, dstNeeded, spaceLeft, result, rawLen, length;
3492 Tcl_Obj *objPtr;
3493 #define ENCODING_LINESIZE 30 /* Lower bound on how many bytes to convert
3494 * at a time. Since we don't know a priori
3495 * how many bytes of storage this many source
3496 * bytes will use, we actually need at least
3497 * ENCODING_LINESIZE * TCL_MAX_UTF bytes of
3498 * room. */
3499
3500 objPtr = gsPtr->objPtr;
3501
3502 /*
3503 * Subtract the number of bytes that were removed from channel buffer
3504 * during last call.
3505 */
3506
3507 bufPtr = gsPtr->bufPtr;
3508 if (bufPtr != NULL) {
3509 bufPtr->nextRemoved += gsPtr->rawRead;
3510 if (bufPtr->nextRemoved >= bufPtr->nextAdded) {
3511 bufPtr = bufPtr->nextPtr;
3512 }
3513 }
3514 gsPtr->totalChars += gsPtr->charsWrote;
3515
3516 if ((bufPtr == NULL) || (bufPtr->nextAdded == BUFFER_PADDING)) {
3517 /*
3518 * All channel buffers were exhausted and the caller still hasn't
3519 * seen EOL. Need to read more bytes from the channel device.
3520 * Side effect is to allocate another channel buffer.
3521 */
3522
3523 read:
3524 if (chanPtr->flags & CHANNEL_BLOCKED) {
3525 if (chanPtr->flags & CHANNEL_NONBLOCKING) {
3526 gsPtr->charsWrote = 0;
3527 gsPtr->rawRead = 0;
3528 return -1;
3529 }
3530 chanPtr->flags &= ~CHANNEL_BLOCKED;
3531 }
3532 if (GetInput(chanPtr) != 0) {
3533 gsPtr->charsWrote = 0;
3534 gsPtr->rawRead = 0;
3535 return -1;
3536 }
3537 bufPtr = chanPtr->inQueueTail;
3538 gsPtr->bufPtr = bufPtr;
3539 }
3540
3541 /*
3542 * Convert some of the bytes from the channel buffer to UTF-8. Space in
3543 * objPtr's string rep is used to hold the UTF-8 characters. Grow the
3544 * string rep if we need more space.
3545 */
3546
3547 rawStart = bufPtr->buf + bufPtr->nextRemoved;
3548 raw = rawStart;
3549 rawEnd = bufPtr->buf + bufPtr->nextAdded;
3550 rawLen = rawEnd - rawStart;
3551
3552 dst = *gsPtr->dstPtr;
3553 offset = dst - objPtr->bytes;
3554 toRead = ENCODING_LINESIZE;
3555 if (toRead > rawLen) {
3556 toRead = rawLen;
3557 }
3558 dstNeeded = toRead * TCL_UTF_MAX + 1;
3559 spaceLeft = objPtr->length - offset - TCL_UTF_MAX - 1;
3560 if (dstNeeded > spaceLeft) {
3561 length = offset * 2;
3562 if (offset < dstNeeded) {
3563 length = offset + dstNeeded;
3564 }
3565 length += TCL_UTF_MAX + 1;
3566 Tcl_SetObjLength(objPtr, length);
3567 spaceLeft = length - offset;
3568 dst = objPtr->bytes + offset;
3569 *gsPtr->dstPtr = dst;
3570 }
3571 gsPtr->state = chanPtr->inputEncodingState;
3572 result = Tcl_ExternalToUtf(NULL, gsPtr->encoding, raw, rawLen,
3573 chanPtr->inputEncodingFlags, &chanPtr->inputEncodingState,
3574 dst, spaceLeft, &gsPtr->rawRead, &gsPtr->bytesWrote,
3575 &gsPtr->charsWrote);
3576 if (result == TCL_CONVERT_MULTIBYTE) {
3577 /*
3578 * The last few bytes in this channel buffer were the start of a
3579 * multibyte sequence. If this buffer was full, then move them to
3580 * the next buffer so the bytes will be contiguous.
3581 */
3582
3583 ChannelBuffer *nextPtr;
3584 int extra;
3585
3586 nextPtr = bufPtr->nextPtr;
3587 if (bufPtr->nextAdded < bufPtr->bufLength) {
3588 if (gsPtr->rawRead > 0) {
3589 /*
3590 * Some raw bytes were converted to UTF-8. Fall through,
3591 * returning those UTF-8 characters because a EOL might be
3592 * present in them.
3593 */
3594 } else if (chanPtr->flags & CHANNEL_EOF) {
3595 /*
3596 * There was a partial character followed by EOF on the
3597 * device. Fall through, returning that nothing was found.
3598 */
3599
3600 bufPtr->nextRemoved = bufPtr->nextAdded;
3601 } else {
3602 /*
3603 * There are no more cached raw bytes left. See if we can
3604 * get some more.
3605 */
3606
3607 goto read;
3608 }
3609 } else {
3610 if (nextPtr == NULL) {
3611 nextPtr = AllocChannelBuffer(chanPtr->bufSize);
3612 bufPtr->nextPtr = nextPtr;
3613 chanPtr->inQueueTail = nextPtr;
3614 }
3615 extra = rawLen - gsPtr->rawRead;
3616 memcpy((VOID *) (nextPtr->buf + BUFFER_PADDING - extra),
3617 (VOID *) (raw + gsPtr->rawRead), (size_t) extra);
3618 nextPtr->nextRemoved -= extra;
3619 bufPtr->nextAdded -= extra;
3620 }
3621 }
3622
3623 gsPtr->bufPtr = bufPtr;
3624 return 0;
3625 }
3626
3627 /*
3628 *---------------------------------------------------------------------------
3629 *
3630 * PeekAhead --
3631 *
3632 * Helper function used by Tcl_GetsObj(). Called when we've seen a
3633 * \r at the end of the UTF-8 string and want to look ahead one
3634 * character to see if it is a \n.
3635 *
3636 * Results:
3637 * *gsPtr->dstPtr is filled with a pointer to the start of the range of
3638 * UTF-8 characters that were found by peeking and *dstEndPtr is filled
3639 * with a pointer to the bytes just after the end of the range.
3640 *
3641 * Side effects:
3642 * If no more raw bytes were available in one of the channel buffers,
3643 * tries to perform a non-blocking read to get more bytes from the
3644 * channel device.
3645 *
3646 *---------------------------------------------------------------------------
3647 */
3648
3649 static void
PeekAhead(chanPtr,dstEndPtr,gsPtr)3650 PeekAhead(chanPtr, dstEndPtr, gsPtr)
3651 Channel *chanPtr; /* The channel to read. */
3652 char **dstEndPtr; /* Filled with pointer to end of new range
3653 * of UTF-8 characters. */
3654 GetsState *gsPtr; /* Current state of gets operation. */
3655 {
3656 ChannelBuffer *bufPtr;
3657 Tcl_DriverBlockModeProc *blockModeProc;
3658 int bytesLeft;
3659
3660 bufPtr = gsPtr->bufPtr;
3661
3662 /*
3663 * If there's any more raw input that's still buffered, we'll peek into
3664 * that. Otherwise, only get more data from the channel driver if it
3665 * looks like there might actually be more data. The assumption is that
3666 * if the channel buffer is filled right up to the end, then there
3667 * might be more data to read.
3668 */
3669
3670 blockModeProc = NULL;
3671 if (bufPtr->nextPtr == NULL) {
3672 bytesLeft = bufPtr->nextAdded - (bufPtr->nextRemoved + gsPtr->rawRead);
3673 if (bytesLeft == 0) {
3674 if (bufPtr->nextAdded < bufPtr->bufLength) {
3675 /*
3676 * Don't peek ahead if last read was short read.
3677 */
3678
3679 goto cleanup;
3680 }
3681 if ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0) {
3682 blockModeProc = chanPtr->typePtr->blockModeProc;
3683 if (blockModeProc == NULL) {
3684 /*
3685 * Don't peek ahead if cannot set non-blocking mode.
3686 */
3687
3688 goto cleanup;
3689 }
3690 (*blockModeProc)(chanPtr->instanceData, TCL_MODE_NONBLOCKING);
3691 }
3692 }
3693 }
3694 if (FilterInputBytes(chanPtr, gsPtr) == 0) {
3695 *dstEndPtr = *gsPtr->dstPtr + gsPtr->bytesWrote;
3696 }
3697 if (blockModeProc != NULL) {
3698 (*blockModeProc)(chanPtr->instanceData, TCL_MODE_BLOCKING);
3699 }
3700 return;
3701
3702 cleanup:
3703 bufPtr->nextRemoved += gsPtr->rawRead;
3704 gsPtr->rawRead = 0;
3705 gsPtr->totalChars += gsPtr->charsWrote;
3706 gsPtr->bytesWrote = 0;
3707 gsPtr->charsWrote = 0;
3708 }
3709
3710 /*
3711 *---------------------------------------------------------------------------
3712 *
3713 * CommonGetsCleanup --
3714 *
3715 * Helper function for Tcl_GetsObj() to restore the channel after
3716 * a "gets" operation.
3717 *
3718 * Results:
3719 * None.
3720 *
3721 * Side effects:
3722 * Encoding may be freed.
3723 *
3724 *---------------------------------------------------------------------------
3725 */
3726
3727 static void
CommonGetsCleanup(chanPtr,encoding)3728 CommonGetsCleanup(chanPtr, encoding)
3729 Channel *chanPtr;
3730 Tcl_Encoding encoding;
3731 {
3732 ChannelBuffer *bufPtr, *nextPtr;
3733
3734 bufPtr = chanPtr->inQueueHead;
3735 for ( ; bufPtr != NULL; bufPtr = nextPtr) {
3736 nextPtr = bufPtr->nextPtr;
3737 if (bufPtr->nextRemoved < bufPtr->nextAdded) {
3738 break;
3739 }
3740 RecycleBuffer(chanPtr, bufPtr, 0);
3741 }
3742 chanPtr->inQueueHead = bufPtr;
3743 if (bufPtr == NULL) {
3744 chanPtr->inQueueTail = NULL;
3745 } else {
3746 /*
3747 * If any multi-byte characters were split across channel buffer
3748 * boundaries, the split-up bytes were moved to the next channel
3749 * buffer by FilterInputBytes(). Move the bytes back to their
3750 * original buffer because the caller could change the channel's
3751 * encoding which could change the interpretation of whether those
3752 * bytes really made up multi-byte characters after all.
3753 */
3754
3755 nextPtr = bufPtr->nextPtr;
3756 for ( ; nextPtr != NULL; nextPtr = bufPtr->nextPtr) {
3757 int extra;
3758
3759 extra = bufPtr->bufLength - bufPtr->nextAdded;
3760 if (extra > 0) {
3761 memcpy((VOID *) (bufPtr->buf + bufPtr->nextAdded),
3762 (VOID *) (nextPtr->buf + BUFFER_PADDING - extra),
3763 (size_t) extra);
3764 bufPtr->nextAdded += extra;
3765 nextPtr->nextRemoved = BUFFER_PADDING;
3766 }
3767 bufPtr = nextPtr;
3768 }
3769 }
3770 if (chanPtr->encoding == NULL) {
3771 Tcl_FreeEncoding(encoding);
3772 }
3773 }
3774
3775 /*
3776 *----------------------------------------------------------------------
3777 *
3778 * Tcl_Read --
3779 *
3780 * Reads a given number of bytes from a channel. EOL and EOF
3781 * translation is done on the bytes being read, so the the number
3782 * of bytes consumed from the channel may not be equal to the
3783 * number of bytes stored in the destination buffer.
3784 *
3785 * No encoding conversions are applied to the bytes being read.
3786 *
3787 * Results:
3788 * The number of bytes read, or -1 on error. Use Tcl_GetErrno()
3789 * to retrieve the error code for the error that occurred.
3790 *
3791 * Side effects:
3792 * May cause input to be buffered.
3793 *
3794 *----------------------------------------------------------------------
3795 */
3796
3797 int
Tcl_Read(chan,dst,bytesToRead)3798 Tcl_Read(chan, dst, bytesToRead)
3799 Tcl_Channel chan; /* The channel from which to read. */
3800 char *dst; /* Where to store input read. */
3801 int bytesToRead; /* Maximum number of bytes to read. */
3802 {
3803 Channel *chanPtr;
3804
3805 chanPtr = (Channel *) chan;
3806 if (CheckChannelErrors(chanPtr, TCL_READABLE) != 0) {
3807 return -1;
3808 }
3809
3810 return DoRead(chanPtr, dst, bytesToRead);
3811 }
3812
3813 /*
3814 *---------------------------------------------------------------------------
3815 *
3816 * Tcl_ReadChars --
3817 *
3818 * Reads from the channel until the requested number of characters
3819 * have been seen, EOF is seen, or the channel would block. EOL
3820 * and EOF translation is done. If reading binary data, the raw
3821 * bytes are wrapped in a Tcl byte array object. Otherwise, the raw
3822 * bytes are converted to UTF-8 using the channel's current encoding
3823 * and stored in a Tcl string object.
3824 *
3825 * Results:
3826 * The number of characters read, or -1 on error. Use Tcl_GetErrno()
3827 * to retrieve the error code for the error that occurred.
3828 *
3829 * Side effects:
3830 * May cause input to be buffered.
3831 *
3832 *---------------------------------------------------------------------------
3833 */
3834
3835 int
Tcl_ReadChars(chan,objPtr,toRead,appendFlag)3836 Tcl_ReadChars(chan, objPtr, toRead, appendFlag)
3837 Tcl_Channel chan; /* The channel to read. */
3838 Tcl_Obj *objPtr; /* Input data is stored in this object. */
3839 int toRead; /* Maximum number of characters to store,
3840 * or -1 to read all available data (up to EOF
3841 * or when channel blocks). */
3842 int appendFlag; /* If non-zero, data read from the channel
3843 * will be appended to the object. Otherwise,
3844 * the data will replace the existing contents
3845 * of the object. */
3846
3847 {
3848 Channel *chanPtr;
3849 int offset, factor, copied, copiedNow, result;
3850 ChannelBuffer *bufPtr;
3851 Tcl_Encoding encoding;
3852 #define UTF_EXPANSION_FACTOR 1024
3853
3854 chanPtr = (Channel *) chan;
3855 if (CheckChannelErrors(chanPtr, TCL_READABLE) != 0) {
3856 copied = -1;
3857 goto done;
3858 }
3859
3860 encoding = chanPtr->encoding;
3861 factor = UTF_EXPANSION_FACTOR;
3862
3863 if (appendFlag == 0) {
3864 if (encoding == NULL) {
3865 Tcl_SetByteArrayLength(objPtr, 0);
3866 } else {
3867 Tcl_SetObjLength(objPtr, 0);
3868 }
3869 offset = 0;
3870 } else {
3871 if (encoding == NULL) {
3872 Tcl_GetByteArrayFromObj(objPtr, &offset);
3873 } else {
3874 Tcl_GetStringFromObj(objPtr, &offset);
3875 }
3876 }
3877
3878 for (copied = 0; (unsigned) toRead > 0; ) {
3879 copiedNow = -1;
3880 if (chanPtr->inQueueHead != NULL) {
3881 if (encoding == NULL) {
3882 copiedNow = ReadBytes(chanPtr, objPtr, toRead, &offset);
3883 } else {
3884 copiedNow = ReadChars(chanPtr, objPtr, toRead, &offset,
3885 &factor);
3886 }
3887
3888 /*
3889 * If the current buffer is empty recycle it.
3890 */
3891
3892 bufPtr = chanPtr->inQueueHead;
3893 if (bufPtr->nextRemoved == bufPtr->nextAdded) {
3894 ChannelBuffer *nextPtr;
3895
3896 nextPtr = bufPtr->nextPtr;
3897 RecycleBuffer(chanPtr, bufPtr, 0);
3898 chanPtr->inQueueHead = nextPtr;
3899 if (nextPtr == NULL) {
3900 chanPtr->inQueueTail = nextPtr;
3901 }
3902 }
3903 }
3904 if (copiedNow < 0) {
3905 if (chanPtr->flags & CHANNEL_EOF) {
3906 break;
3907 }
3908 if (chanPtr->flags & CHANNEL_BLOCKED) {
3909 if (chanPtr->flags & CHANNEL_NONBLOCKING) {
3910 break;
3911 }
3912 chanPtr->flags &= ~CHANNEL_BLOCKED;
3913 }
3914 result = GetInput(chanPtr);
3915 if (result != 0) {
3916 if (result == EAGAIN) {
3917 break;
3918 }
3919 copied = -1;
3920 goto done;
3921 }
3922 } else {
3923 copied += copiedNow;
3924 toRead -= copiedNow;
3925 }
3926 }
3927 chanPtr->flags &= ~CHANNEL_BLOCKED;
3928 if (encoding == NULL) {
3929 Tcl_SetByteArrayLength(objPtr, offset);
3930 } else {
3931 Tcl_SetObjLength(objPtr, offset);
3932 }
3933
3934 done:
3935 /*
3936 * Update the notifier state so we don't block while there is still
3937 * data in the buffers.
3938 */
3939
3940 UpdateInterest(chanPtr);
3941 return copied;
3942 }
3943 /*
3944 *---------------------------------------------------------------------------
3945 *
3946 * ReadBytes --
3947 *
3948 * Reads from the channel until the requested number of bytes have
3949 * been seen, EOF is seen, or the channel would block. Bytes from
3950 * the channel are stored in objPtr as a ByteArray object. EOL
3951 * and EOF translation are done.
3952 *
3953 * 'bytesToRead' can safely be a very large number because
3954 * space is only allocated to hold data read from the channel
3955 * as needed.
3956 *
3957 * Results:
3958 * The return value is the number of bytes appended to the object
3959 * and *offsetPtr is filled with the total number of bytes in the
3960 * object (greater than the return value if there were already bytes
3961 * in the object).
3962 *
3963 * Side effects:
3964 * None.
3965 *
3966 *---------------------------------------------------------------------------
3967 */
3968
3969 static int
ReadBytes(chanPtr,objPtr,bytesToRead,offsetPtr)3970 ReadBytes(chanPtr, objPtr, bytesToRead, offsetPtr)
3971 Channel *chanPtr; /* The channel to read. */
3972 int bytesToRead; /* Maximum number of characters to store,
3973 * or < 0 to get all available characters.
3974 * Characters are obtained from the first
3975 * buffer in the queue -- even if this number
3976 * is larger than the number of characters
3977 * available in the first buffer, only the
3978 * characters from the first buffer are
3979 * returned. */
3980 Tcl_Obj *objPtr; /* Input data is appended to this ByteArray
3981 * object. Its length is how much space
3982 * has been allocated to hold data, not how
3983 * many bytes of data have been stored in the
3984 * object. */
3985 int *offsetPtr; /* On input, contains how many bytes of
3986 * objPtr have been used to hold data. On
3987 * output, filled with how many bytes are now
3988 * being used. */
3989 {
3990 int toRead, srcLen, srcRead, dstWrote, offset, length;
3991 ChannelBuffer *bufPtr;
3992 char *src, *dst;
3993
3994 offset = *offsetPtr;
3995
3996 bufPtr = chanPtr->inQueueHead;
3997 src = bufPtr->buf + bufPtr->nextRemoved;
3998 srcLen = bufPtr->nextAdded - bufPtr->nextRemoved;
3999
4000 toRead = bytesToRead;
4001 if ((unsigned) toRead > (unsigned) srcLen) {
4002 toRead = srcLen;
4003 }
4004
4005 dst = (char *) Tcl_GetByteArrayFromObj(objPtr, &length);
4006 if (toRead > length - offset - 1) {
4007 /*
4008 * Double the existing size of the object or make enough room to
4009 * hold all the characters we may get from the source buffer,
4010 * whichever is larger.
4011 */
4012
4013 length = offset * 2;
4014 if (offset < toRead) {
4015 length = offset + toRead + 1;
4016 }
4017 dst = (char *) Tcl_SetByteArrayLength(objPtr, length);
4018 }
4019 dst += offset;
4020
4021 if (chanPtr->flags & INPUT_NEED_NL) {
4022 chanPtr->flags &= ~INPUT_NEED_NL;
4023 if ((srcLen == 0) || (*src != '\n')) {
4024 *dst = '\r';
4025 *offsetPtr += 1;
4026 return 1;
4027 }
4028 *dst++ = '\n';
4029 src++;
4030 srcLen--;
4031 toRead--;
4032 }
4033
4034 srcRead = srcLen;
4035 dstWrote = toRead;
4036 if (TranslateInputEOL(chanPtr, dst, src, &dstWrote, &srcRead) != 0) {
4037 if (dstWrote == 0) {
4038 return -1;
4039 }
4040 }
4041 bufPtr->nextRemoved += srcRead;
4042 *offsetPtr += dstWrote;
4043 return dstWrote;
4044 }
4045
4046 /*
4047 *---------------------------------------------------------------------------
4048 *
4049 * ReadChars --
4050 *
4051 * Reads from the channel until the requested number of UTF-8
4052 * characters have been seen, EOF is seen, or the channel would
4053 * block. Raw bytes from the channel are converted to UTF-8
4054 * and stored in objPtr. EOL and EOF translation is done.
4055 *
4056 * 'charsToRead' can safely be a very large number because
4057 * space is only allocated to hold data read from the channel
4058 * as needed.
4059 *
4060 * Results:
4061 * The return value is the number of characters appended to
4062 * the object, *offsetPtr is filled with the number of bytes that
4063 * were appended, and *factorPtr is filled with the expansion
4064 * factor used to guess how many bytes of UTF-8 to allocate to
4065 * hold N source bytes.
4066 *
4067 * Side effects:
4068 * None.
4069 *
4070 *---------------------------------------------------------------------------
4071 */
4072
4073 static int
ReadChars(chanPtr,objPtr,charsToRead,offsetPtr,factorPtr)4074 ReadChars(chanPtr, objPtr, charsToRead, offsetPtr, factorPtr)
4075 Channel *chanPtr; /* The channel to read. */
4076 int charsToRead; /* Maximum number of characters to store,
4077 * or -1 to get all available characters.
4078 * Characters are obtained from the first
4079 * buffer in the queue -- even if this number
4080 * is larger than the number of characters
4081 * available in the first buffer, only the
4082 * characters from the first buffer are
4083 * returned. */
4084 Tcl_Obj *objPtr; /* Input data is appended to this object.
4085 * objPtr->length is how much space has been
4086 * allocated to hold data, not how many bytes
4087 * of data have been stored in the object. */
4088 int *offsetPtr; /* On input, contains how many bytes of
4089 * objPtr have been used to hold data. On
4090 * output, filled with how many bytes are now
4091 * being used. */
4092 int *factorPtr; /* On input, contains a guess of how many
4093 * bytes need to be allocated to hold the
4094 * result of converting N source bytes to
4095 * UTF-8. On output, contains another guess
4096 * based on the data seen so far. */
4097 {
4098 int toRead, factor, offset, spaceLeft, length;
4099 int srcLen, srcRead, dstNeeded, dstRead, dstWrote, numChars;
4100 ChannelBuffer *bufPtr;
4101 char *src, *dst;
4102 Tcl_EncodingState oldState;
4103
4104 factor = *factorPtr;
4105 offset = *offsetPtr;
4106
4107 bufPtr = chanPtr->inQueueHead;
4108 src = bufPtr->buf + bufPtr->nextRemoved;
4109 srcLen = bufPtr->nextAdded - bufPtr->nextRemoved;
4110
4111 toRead = charsToRead;
4112 if ((unsigned) toRead > (unsigned) srcLen) {
4113 toRead = srcLen;
4114 }
4115
4116 /*
4117 * 'factor' is how much we guess that the bytes in the source buffer
4118 * will expand when converted to UTF-8 chars. This guess comes from
4119 * analyzing how many characters were produced by the previous
4120 * pass.
4121 */
4122
4123 dstNeeded = toRead * factor / UTF_EXPANSION_FACTOR;
4124 spaceLeft = objPtr->length - offset - TCL_UTF_MAX - 1;
4125
4126 if (dstNeeded > spaceLeft) {
4127 /*
4128 * Double the existing size of the object or make enough room to
4129 * hold all the characters we want from the source buffer,
4130 * whichever is larger.
4131 */
4132
4133 length = offset * 2;
4134 if (offset < dstNeeded) {
4135 length = offset + dstNeeded;
4136 }
4137 spaceLeft = length - offset;
4138 length += TCL_UTF_MAX + 1;
4139 Tcl_SetObjLength(objPtr, length);
4140 }
4141 if (toRead == srcLen) {
4142 /*
4143 * Want to convert the whole buffer in one pass. If we have
4144 * enough space, convert it using all available space in object
4145 * rather than using the factor.
4146 */
4147
4148 dstNeeded = spaceLeft;
4149 }
4150 dst = objPtr->bytes + offset;
4151
4152 oldState = chanPtr->inputEncodingState;
4153 if (chanPtr->flags & INPUT_NEED_NL) {
4154 /*
4155 * We want a '\n' because the last character we saw was '\r'.
4156 */
4157
4158 chanPtr->flags &= ~INPUT_NEED_NL;
4159 Tcl_ExternalToUtf(NULL, chanPtr->encoding, src, srcLen,
4160 chanPtr->inputEncodingFlags, &chanPtr->inputEncodingState,
4161 dst, TCL_UTF_MAX + 1, &srcRead, &dstWrote, &numChars);
4162 if ((dstWrote > 0) && (*dst == '\n')) {
4163 /*
4164 * The next char was a '\n'. Consume it and produce a '\n'.
4165 */
4166
4167 bufPtr->nextRemoved += srcRead;
4168 } else {
4169 /*
4170 * The next char was not a '\n'. Produce a '\r'.
4171 */
4172
4173 *dst = '\r';
4174 }
4175 chanPtr->inputEncodingFlags &= ~TCL_ENCODING_START;
4176 *offsetPtr += 1;
4177 return 1;
4178 }
4179
4180 Tcl_ExternalToUtf(NULL, chanPtr->encoding, src, srcLen,
4181 chanPtr->inputEncodingFlags, &chanPtr->inputEncodingState, dst,
4182 dstNeeded + TCL_UTF_MAX, &srcRead, &dstWrote, &numChars);
4183 if (srcRead == 0) {
4184 /*
4185 * Not enough bytes in src buffer to make a complete char. Copy
4186 * the bytes to the next buffer to make a new contiguous string,
4187 * then tell the caller to fill the buffer with more bytes.
4188 */
4189
4190 ChannelBuffer *nextPtr;
4191
4192 nextPtr = bufPtr->nextPtr;
4193 if (nextPtr == NULL) {
4194 /*
4195 * There isn't enough data in the buffers to complete the next
4196 * character, so we need to wait for more data before the next
4197 * file event can be delivered.
4198 */
4199
4200 chanPtr->flags |= CHANNEL_NEED_MORE_DATA;
4201 return -1;
4202 }
4203 nextPtr->nextRemoved -= srcLen;
4204 memcpy((VOID *) (nextPtr->buf + nextPtr->nextRemoved), (VOID *) src,
4205 (size_t) srcLen);
4206 RecycleBuffer(chanPtr, bufPtr, 0);
4207 chanPtr->inQueueHead = nextPtr;
4208 return ReadChars(chanPtr, objPtr, charsToRead, offsetPtr, factorPtr);
4209 }
4210
4211 dstRead = dstWrote;
4212 if (TranslateInputEOL(chanPtr, dst, dst, &dstWrote, &dstRead) != 0) {
4213 /*
4214 * Hit EOF char. How many bytes of src correspond to where the
4215 * EOF was located in dst?
4216 */
4217
4218 if (dstWrote == 0) {
4219 return -1;
4220 }
4221 chanPtr->inputEncodingState = oldState;
4222 Tcl_ExternalToUtf(NULL, chanPtr->encoding, src, srcLen,
4223 chanPtr->inputEncodingFlags, &chanPtr->inputEncodingState,
4224 dst, dstRead + TCL_UTF_MAX, &srcRead, &dstWrote, &numChars);
4225 TranslateInputEOL(chanPtr, dst, dst, &dstWrote, &dstRead);
4226 }
4227
4228 /*
4229 * The number of characters that we got may be less than the number
4230 * that we started with because "\r\n" sequences may have been
4231 * turned into just '\n' in dst.
4232 */
4233
4234 numChars -= (dstRead - dstWrote);
4235
4236 if ((unsigned) numChars > (unsigned) toRead) {
4237 /*
4238 * Got too many chars.
4239 */
4240
4241 char *eof;
4242
4243 eof = Tcl_UtfAtIndex(dst, toRead);
4244 chanPtr->inputEncodingState = oldState;
4245 Tcl_ExternalToUtf(NULL, chanPtr->encoding, src, srcLen,
4246 chanPtr->inputEncodingFlags, &chanPtr->inputEncodingState,
4247 dst, eof - dst + TCL_UTF_MAX, &srcRead, &dstWrote, &numChars);
4248 dstRead = dstWrote;
4249 TranslateInputEOL(chanPtr, dst, dst, &dstWrote, &dstRead);
4250 numChars -= (dstRead - dstWrote);
4251 }
4252 chanPtr->inputEncodingFlags &= ~TCL_ENCODING_START;
4253
4254 bufPtr->nextRemoved += srcRead;
4255 if (dstWrote > srcRead + 1) {
4256 *factorPtr = dstWrote * UTF_EXPANSION_FACTOR / srcRead;
4257 }
4258 *offsetPtr += dstWrote;
4259 return numChars;
4260 }
4261
4262 /*
4263 *---------------------------------------------------------------------------
4264 *
4265 * TranslateInputEOL --
4266 *
4267 * Perform input EOL and EOF translation on the source buffer,
4268 * leaving the translated result in the destination buffer.
4269 *
4270 * Results:
4271 * The return value is 1 if the EOF character was found when copying
4272 * bytes to the destination buffer, 0 otherwise.
4273 *
4274 * Side effects:
4275 * None.
4276 *
4277 *---------------------------------------------------------------------------
4278 */
4279
4280 static int
TranslateInputEOL(chanPtr,dstStart,srcStart,dstLenPtr,srcLenPtr)4281 TranslateInputEOL(chanPtr, dstStart, srcStart, dstLenPtr, srcLenPtr)
4282 Channel *chanPtr; /* Channel being read, for EOL translation
4283 * and EOF character. */
4284 char *dstStart; /* Output buffer filled with chars by
4285 * applying appropriate EOL translation to
4286 * source characters. */
4287 CONST char *srcStart; /* Source characters. */
4288 int *dstLenPtr; /* On entry, the maximum length of output
4289 * buffer in bytes; must be <= *srcLenPtr. On
4290 * exit, the number of bytes actually used in
4291 * output buffer. */
4292 int *srcLenPtr; /* On entry, the length of source buffer.
4293 * On exit, the number of bytes read from
4294 * the source buffer. */
4295 {
4296 int dstLen, srcLen, inEofChar;
4297 CONST char *eof;
4298
4299 dstLen = *dstLenPtr;
4300
4301 eof = NULL;
4302 inEofChar = chanPtr->inEofChar;
4303 if (inEofChar != '\0') {
4304 /*
4305 * Find EOF in translated buffer then compress out the EOL. The
4306 * source buffer may be much longer than the destination buffer --
4307 * we only want to return EOF if the EOF has been copied to the
4308 * destination buffer.
4309 */
4310
4311 CONST char *src, *srcMax;
4312
4313 srcMax = srcStart + *srcLenPtr;
4314 for (src = srcStart; src < srcMax; src++) {
4315 if (*src == inEofChar) {
4316 eof = src;
4317 srcLen = src - srcStart;
4318 if (srcLen < dstLen) {
4319 dstLen = srcLen;
4320 }
4321 *srcLenPtr = srcLen;
4322 break;
4323 }
4324 }
4325 }
4326 switch (chanPtr->inputTranslation) {
4327 case TCL_TRANSLATE_LF: {
4328 if (dstStart != srcStart) {
4329 memcpy((VOID *) dstStart, (VOID *) srcStart, (size_t) dstLen);
4330 }
4331 srcLen = dstLen;
4332 break;
4333 }
4334 case TCL_TRANSLATE_CR: {
4335 char *dst, *dstEnd;
4336
4337 if (dstStart != srcStart) {
4338 memcpy((VOID *) dstStart, (VOID *) srcStart, (size_t) dstLen);
4339 }
4340 dstEnd = dstStart + dstLen;
4341 for (dst = dstStart; dst < dstEnd; dst++) {
4342 if (*dst == '\r') {
4343 *dst = '\n';
4344 }
4345 }
4346 srcLen = dstLen;
4347 break;
4348 }
4349 case TCL_TRANSLATE_CRLF: {
4350 char *dst;
4351 CONST char *src, *srcEnd, *srcMax;
4352
4353 dst = dstStart;
4354 src = srcStart;
4355 srcEnd = srcStart + dstLen;
4356 srcMax = srcStart + *srcLenPtr;
4357
4358 for ( ; src < srcEnd; ) {
4359 if (*src == '\r') {
4360 src++;
4361 if (src >= srcMax) {
4362 chanPtr->flags |= INPUT_NEED_NL;
4363 } else if (*src == '\n') {
4364 *dst++ = *src++;
4365 } else {
4366 *dst++ = '\r';
4367 }
4368 } else {
4369 *dst++ = *src++;
4370 }
4371 }
4372 srcLen = src - srcStart;
4373 dstLen = dst - dstStart;
4374 break;
4375 }
4376 case TCL_TRANSLATE_AUTO: {
4377 char *dst;
4378 CONST char *src, *srcEnd, *srcMax;
4379
4380 dst = dstStart;
4381 src = srcStart;
4382 srcEnd = srcStart + dstLen;
4383 srcMax = srcStart + *srcLenPtr;
4384
4385 if ((chanPtr->flags & INPUT_SAW_CR) && (src < srcMax)) {
4386 if (*src == '\n') {
4387 src++;
4388 }
4389 chanPtr->flags &= ~INPUT_SAW_CR;
4390 }
4391 for ( ; src < srcEnd; ) {
4392 if (*src == '\r') {
4393 src++;
4394 if (src >= srcMax) {
4395 chanPtr->flags |= INPUT_SAW_CR;
4396 } else if (*src == '\n') {
4397 if (srcEnd < srcMax) {
4398 srcEnd++;
4399 }
4400 src++;
4401 }
4402 *dst++ = '\n';
4403 } else {
4404 *dst++ = *src++;
4405 }
4406 }
4407 srcLen = src - srcStart;
4408 dstLen = dst - dstStart;
4409 break;
4410 }
4411 default: { /* lint. */
4412 return 0;
4413 }
4414 }
4415 *dstLenPtr = dstLen;
4416
4417 if ((eof != NULL) && (srcStart + srcLen >= eof)) {
4418 /*
4419 * EOF character was seen in EOL translated range. Leave current
4420 * file position pointing at the EOF character, but don't store the
4421 * EOF character in the output string.
4422 */
4423
4424 chanPtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
4425 chanPtr->inputEncodingFlags |= TCL_ENCODING_END;
4426 chanPtr->flags &= ~(INPUT_SAW_CR | INPUT_NEED_NL);
4427 return 1;
4428 }
4429
4430 *srcLenPtr = srcLen;
4431 return 0;
4432 }
4433
4434 /*
4435 *----------------------------------------------------------------------
4436 *
4437 * Tcl_Ungets --
4438 *
4439 * Causes the supplied string to be added to the input queue of
4440 * the channel, at either the head or tail of the queue.
4441 *
4442 * Results:
4443 * The number of bytes stored in the channel, or -1 on error.
4444 *
4445 * Side effects:
4446 * Adds input to the input queue of a channel.
4447 *
4448 *----------------------------------------------------------------------
4449 */
4450
4451 int
Tcl_Ungets(chan,str,len,atEnd)4452 Tcl_Ungets(chan, str, len, atEnd)
4453 Tcl_Channel chan; /* The channel for which to add the input. */
4454 char *str; /* The input itself. */
4455 int len; /* The length of the input. */
4456 int atEnd; /* If non-zero, add at end of queue; otherwise
4457 * add at head of queue. */
4458 {
4459 Channel *chanPtr; /* The real IO channel. */
4460 ChannelBuffer *bufPtr; /* Buffer to contain the data. */
4461 int i, flags;
4462
4463 chanPtr = (Channel *) chan;
4464
4465 /*
4466 * CheckChannelErrors clears too many flag bits in this one case.
4467 */
4468
4469 flags = chanPtr->flags;
4470 if (CheckChannelErrors(chanPtr, TCL_READABLE) != 0) {
4471 len = -1;
4472 goto done;
4473 }
4474 chanPtr->flags = flags;
4475
4476 /*
4477 * If we have encountered a sticky EOF, just punt without storing.
4478 * (sticky EOF is set if we have seen the input eofChar, to prevent
4479 * reading beyond the eofChar). Otherwise, clear the EOF flags, and
4480 * clear the BLOCKED bit. We want to discover these conditions anew
4481 * in each operation.
4482 */
4483
4484 if (chanPtr->flags & CHANNEL_STICKY_EOF) {
4485 goto done;
4486 }
4487 chanPtr->flags &= (~(CHANNEL_BLOCKED | CHANNEL_EOF));
4488
4489 bufPtr = AllocChannelBuffer(len);
4490 for (i = 0; i < len; i++) {
4491 bufPtr->buf[i] = str[i];
4492 }
4493 bufPtr->nextAdded += len;
4494
4495 if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
4496 bufPtr->nextPtr = (ChannelBuffer *) NULL;
4497 chanPtr->inQueueHead = bufPtr;
4498 chanPtr->inQueueTail = bufPtr;
4499 } else if (atEnd) {
4500 bufPtr->nextPtr = (ChannelBuffer *) NULL;
4501 chanPtr->inQueueTail->nextPtr = bufPtr;
4502 chanPtr->inQueueTail = bufPtr;
4503 } else {
4504 bufPtr->nextPtr = chanPtr->inQueueHead;
4505 chanPtr->inQueueHead = bufPtr;
4506 }
4507
4508 done:
4509 /*
4510 * Update the notifier state so we don't block while there is still
4511 * data in the buffers.
4512 */
4513
4514 UpdateInterest(chanPtr);
4515 return len;
4516 }
4517
4518 /*
4519 *----------------------------------------------------------------------
4520 *
4521 * Tcl_Flush --
4522 *
4523 * Flushes output data on a channel.
4524 *
4525 * Results:
4526 * A standard Tcl result.
4527 *
4528 * Side effects:
4529 * May flush output queued on this channel.
4530 *
4531 *----------------------------------------------------------------------
4532 */
4533
4534 int
Tcl_Flush(chan)4535 Tcl_Flush(chan)
4536 Tcl_Channel chan; /* The Channel to flush. */
4537 {
4538 int result; /* Of calling FlushChannel. */
4539 Channel *chanPtr; /* The actual channel. */
4540
4541 chanPtr = (Channel *) chan;
4542 if (CheckChannelErrors(chanPtr, TCL_WRITABLE) != 0) {
4543 return -1;
4544 }
4545
4546 /*
4547 * Force current output buffer to be output also.
4548 */
4549
4550 if ((chanPtr->curOutPtr != NULL)
4551 && (chanPtr->curOutPtr->nextAdded > 0)) {
4552 chanPtr->flags |= BUFFER_READY;
4553 }
4554
4555 result = FlushChannel(NULL, chanPtr, 0);
4556 if (result != 0) {
4557 return TCL_ERROR;
4558 }
4559
4560 return TCL_OK;
4561 }
4562
4563 /*
4564 *----------------------------------------------------------------------
4565 *
4566 * DiscardInputQueued --
4567 *
4568 * Discards any input read from the channel but not yet consumed
4569 * by Tcl reading commands.
4570 *
4571 * Results:
4572 * None.
4573 *
4574 * Side effects:
4575 * May discard input from the channel. If discardLastBuffer is zero,
4576 * leaves one buffer in place for back-filling.
4577 *
4578 *----------------------------------------------------------------------
4579 */
4580
4581 static void
DiscardInputQueued(chanPtr,discardSavedBuffers)4582 DiscardInputQueued(chanPtr, discardSavedBuffers)
4583 Channel *chanPtr; /* Channel on which to discard
4584 * the queued input. */
4585 int discardSavedBuffers; /* If non-zero, discard all buffers including
4586 * last one. */
4587 {
4588 ChannelBuffer *bufPtr, *nxtPtr; /* Loop variables. */
4589
4590 bufPtr = chanPtr->inQueueHead;
4591 chanPtr->inQueueHead = (ChannelBuffer *) NULL;
4592 chanPtr->inQueueTail = (ChannelBuffer *) NULL;
4593 for (; bufPtr != (ChannelBuffer *) NULL; bufPtr = nxtPtr) {
4594 nxtPtr = bufPtr->nextPtr;
4595 RecycleBuffer(chanPtr, bufPtr, discardSavedBuffers);
4596 }
4597
4598 /*
4599 * If discardSavedBuffers is nonzero, must also discard any previously
4600 * saved buffer in the saveInBufPtr field.
4601 */
4602
4603 if (discardSavedBuffers) {
4604 if (chanPtr->saveInBufPtr != (ChannelBuffer *) NULL) {
4605 ckfree((char *) chanPtr->saveInBufPtr);
4606 chanPtr->saveInBufPtr = (ChannelBuffer *) NULL;
4607 }
4608 }
4609 }
4610
4611 /*
4612 *---------------------------------------------------------------------------
4613 *
4614 * GetInput --
4615 *
4616 * Reads input data from a device into a channel buffer.
4617 *
4618 * Results:
4619 * The return value is the Posix error code if an error occurred while
4620 * reading from the file, or 0 otherwise.
4621 *
4622 * Side effects:
4623 * Reads from the underlying device.
4624 *
4625 *---------------------------------------------------------------------------
4626 */
4627
4628 static int
GetInput(chanPtr)4629 GetInput(chanPtr)
4630 Channel *chanPtr; /* Channel to read input from. */
4631 {
4632 int toRead; /* How much to read? */
4633 int result; /* Of calling driver. */
4634 int nread; /* How much was read from channel? */
4635 ChannelBuffer *bufPtr; /* New buffer to add to input queue. */
4636
4637 /*
4638 * Prevent reading from a dead channel -- a channel that has been closed
4639 * but not yet deallocated, which can happen if the exit handler for
4640 * channel cleanup has run but the channel is still registered in some
4641 * interpreter.
4642 */
4643
4644 if (CheckForDeadChannel(NULL, chanPtr)) {
4645 return EINVAL;
4646 }
4647
4648 /*
4649 * See if we can fill an existing buffer. If we can, read only
4650 * as much as will fit in it. Otherwise allocate a new buffer,
4651 * add it to the input queue and attempt to fill it to the max.
4652 */
4653
4654 bufPtr = chanPtr->inQueueTail;
4655 if ((bufPtr != NULL) && (bufPtr->nextAdded < bufPtr->bufLength)) {
4656 toRead = bufPtr->bufLength - bufPtr->nextAdded;
4657 } else {
4658 bufPtr = chanPtr->saveInBufPtr;
4659 chanPtr->saveInBufPtr = NULL;
4660 if (bufPtr == NULL) {
4661 bufPtr = AllocChannelBuffer(chanPtr->bufSize);
4662 }
4663 bufPtr->nextPtr = (ChannelBuffer *) NULL;
4664
4665 toRead = chanPtr->bufSize;
4666 if (chanPtr->inQueueTail == NULL) {
4667 chanPtr->inQueueHead = bufPtr;
4668 } else {
4669 chanPtr->inQueueTail->nextPtr = bufPtr;
4670 }
4671 chanPtr->inQueueTail = bufPtr;
4672 }
4673
4674 /*
4675 * If EOF is set, we should avoid calling the driver because on some
4676 * platforms it is impossible to read from a device after EOF.
4677 */
4678
4679 if (chanPtr->flags & CHANNEL_EOF) {
4680 return 0;
4681 }
4682
4683 nread = (*chanPtr->typePtr->inputProc)(chanPtr->instanceData,
4684 bufPtr->buf + bufPtr->nextAdded, toRead, &result);
4685
4686 if (nread > 0) {
4687 bufPtr->nextAdded += nread;
4688
4689 /*
4690 * If we get a short read, signal up that we may be BLOCKED. We
4691 * should avoid calling the driver because on some platforms we
4692 * will block in the low level reading code even though the
4693 * channel is set into nonblocking mode.
4694 */
4695
4696 if (nread < toRead) {
4697 chanPtr->flags |= CHANNEL_BLOCKED;
4698 }
4699 } else if (nread == 0) {
4700 chanPtr->flags |= CHANNEL_EOF;
4701 chanPtr->inputEncodingFlags |= TCL_ENCODING_END;
4702 } else if (nread < 0) {
4703 if ((result == EWOULDBLOCK) || (result == EAGAIN)) {
4704 chanPtr->flags |= CHANNEL_BLOCKED;
4705 result = EAGAIN;
4706 }
4707 Tcl_SetErrno(result);
4708 return result;
4709 }
4710 return 0;
4711 }
4712
4713 /*
4714 *----------------------------------------------------------------------
4715 *
4716 * Tcl_Seek --
4717 *
4718 * Implements seeking on Tcl Channels. This is a public function
4719 * so that other C facilities may be implemented on top of it.
4720 *
4721 * Results:
4722 * The new access point or -1 on error. If error, use Tcl_GetErrno()
4723 * to retrieve the POSIX error code for the error that occurred.
4724 *
4725 * Side effects:
4726 * May flush output on the channel. May discard queued input.
4727 *
4728 *----------------------------------------------------------------------
4729 */
4730
4731 int
Tcl_Seek(chan,offset,mode)4732 Tcl_Seek(chan, offset, mode)
4733 Tcl_Channel chan; /* The channel on which to seek. */
4734 int offset; /* Offset to seek to. */
4735 int mode; /* Relative to which location to seek? */
4736 {
4737 Channel *chanPtr; /* The real IO channel. */
4738 ChannelBuffer *bufPtr;
4739 int inputBuffered, outputBuffered;
4740 int result; /* Of device driver operations. */
4741 int curPos; /* Position on the device. */
4742 int wasAsync; /* Was the channel nonblocking before the
4743 * seek operation? If so, must restore to
4744 * nonblocking mode after the seek. */
4745
4746 chanPtr = (Channel *) chan;
4747 if (CheckChannelErrors(chanPtr, TCL_WRITABLE | TCL_READABLE) != 0) {
4748 return -1;
4749 }
4750
4751 /*
4752 * Disallow seek on dead channels -- channels that have been closed but
4753 * not yet been deallocated. Such channels can be found if the exit
4754 * handler for channel cleanup has run but the channel is still
4755 * registered in an interpreter.
4756 */
4757
4758 if (CheckForDeadChannel(NULL,chanPtr)) return -1;
4759
4760 /*
4761 * Disallow seek on channels whose type does not have a seek procedure
4762 * defined. This means that the channel does not support seeking.
4763 */
4764
4765 if (chanPtr->typePtr->seekProc == (Tcl_DriverSeekProc *) NULL) {
4766 Tcl_SetErrno(EINVAL);
4767 return -1;
4768 }
4769
4770 /*
4771 * Compute how much input and output is buffered. If both input and
4772 * output is buffered, cannot compute the current position.
4773 */
4774
4775 for (bufPtr = chanPtr->inQueueHead, inputBuffered = 0;
4776 bufPtr != (ChannelBuffer *) NULL;
4777 bufPtr = bufPtr->nextPtr) {
4778 inputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
4779 }
4780 for (bufPtr = chanPtr->outQueueHead, outputBuffered = 0;
4781 bufPtr != (ChannelBuffer *) NULL;
4782 bufPtr = bufPtr->nextPtr) {
4783 outputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
4784 }
4785 if ((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&
4786 (chanPtr->curOutPtr->nextAdded > chanPtr->curOutPtr->nextRemoved)) {
4787 chanPtr->flags |= BUFFER_READY;
4788 outputBuffered +=
4789 (chanPtr->curOutPtr->nextAdded - chanPtr->curOutPtr->nextRemoved);
4790 }
4791
4792 if ((inputBuffered != 0) && (outputBuffered != 0)) {
4793 Tcl_SetErrno(EFAULT);
4794 return -1;
4795 }
4796
4797 /*
4798 * If we are seeking relative to the current position, compute the
4799 * corrected offset taking into account the amount of unread input.
4800 */
4801
4802 if (mode == SEEK_CUR) {
4803 offset -= inputBuffered;
4804 }
4805
4806 /*
4807 * Discard any queued input - this input should not be read after
4808 * the seek.
4809 */
4810
4811 DiscardInputQueued(chanPtr, 0);
4812
4813 /*
4814 * Reset EOF and BLOCKED flags. We invalidate them by moving the
4815 * access point. Also clear CR related flags.
4816 */
4817
4818 chanPtr->flags &=
4819 (~(CHANNEL_EOF | CHANNEL_STICKY_EOF | CHANNEL_BLOCKED | INPUT_SAW_CR));
4820
4821 /*
4822 * If the channel is in asynchronous output mode, switch it back
4823 * to synchronous mode and cancel any async flush that may be
4824 * scheduled. After the flush, the channel will be put back into
4825 * asynchronous output mode.
4826 */
4827
4828 wasAsync = 0;
4829 if (chanPtr->flags & CHANNEL_NONBLOCKING) {
4830 wasAsync = 1;
4831 result = 0;
4832 if (chanPtr->typePtr->blockModeProc != NULL) {
4833 result = (chanPtr->typePtr->blockModeProc) (chanPtr->instanceData,
4834 TCL_MODE_BLOCKING);
4835 }
4836 if (result != 0) {
4837 Tcl_SetErrno(result);
4838 return -1;
4839 }
4840 chanPtr->flags &= (~(CHANNEL_NONBLOCKING));
4841 if (chanPtr->flags & BG_FLUSH_SCHEDULED) {
4842 chanPtr->flags &= (~(BG_FLUSH_SCHEDULED));
4843 }
4844 }
4845
4846 /*
4847 * If the flush fails we cannot recover the original position. In
4848 * that case the seek is not attempted because we do not know where
4849 * the access position is - instead we return the error. FlushChannel
4850 * has already called Tcl_SetErrno() to report the error upwards.
4851 * If the flush succeeds we do the seek also.
4852 */
4853
4854 if (FlushChannel(NULL, chanPtr, 0) != 0) {
4855 curPos = -1;
4856 } else {
4857
4858 /*
4859 * Now seek to the new position in the channel as requested by the
4860 * caller.
4861 */
4862
4863 curPos = (chanPtr->typePtr->seekProc) (chanPtr->instanceData,
4864 (long) offset, mode, &result);
4865 if (curPos == -1) {
4866 Tcl_SetErrno(result);
4867 }
4868 }
4869
4870 /*
4871 * Restore to nonblocking mode if that was the previous behavior.
4872 *
4873 * NOTE: Even if there was an async flush active we do not restore
4874 * it now because we already flushed all the queued output, above.
4875 */
4876
4877 if (wasAsync) {
4878 chanPtr->flags |= CHANNEL_NONBLOCKING;
4879 result = 0;
4880 if (chanPtr->typePtr->blockModeProc != NULL) {
4881 result = (chanPtr->typePtr->blockModeProc) (chanPtr->instanceData,
4882 TCL_MODE_NONBLOCKING);
4883 }
4884 if (result != 0) {
4885 Tcl_SetErrno(result);
4886 return -1;
4887 }
4888 }
4889
4890 return curPos;
4891 }
4892
4893 /*
4894 *----------------------------------------------------------------------
4895 *
4896 * Tcl_Tell --
4897 *
4898 * Returns the position of the next character to be read/written on
4899 * this channel.
4900 *
4901 * Results:
4902 * A nonnegative integer on success, -1 on failure. If failed,
4903 * use Tcl_GetErrno() to retrieve the POSIX error code for the
4904 * error that occurred.
4905 *
4906 * Side effects:
4907 * None.
4908 *
4909 *----------------------------------------------------------------------
4910 */
4911
4912 int
Tcl_Tell(chan)4913 Tcl_Tell(chan)
4914 Tcl_Channel chan; /* The channel to return pos for. */
4915 {
4916 Channel *chanPtr; /* The actual channel to tell on. */
4917 ChannelBuffer *bufPtr;
4918 int inputBuffered, outputBuffered;
4919 int result; /* Of calling device driver. */
4920 int curPos; /* Position on device. */
4921
4922 chanPtr = (Channel *) chan;
4923 if (CheckChannelErrors(chanPtr, TCL_WRITABLE | TCL_READABLE) != 0) {
4924 return -1;
4925 }
4926
4927 /*
4928 * Disallow tell on dead channels -- channels that have been closed but
4929 * not yet been deallocated. Such channels can be found if the exit
4930 * handler for channel cleanup has run but the channel is still
4931 * registered in an interpreter.
4932 */
4933
4934 if (CheckForDeadChannel(NULL,chanPtr)) {
4935 return -1;
4936 }
4937
4938 /*
4939 * Disallow tell on channels whose type does not have a seek procedure
4940 * defined. This means that the channel does not support seeking.
4941 */
4942
4943 if (chanPtr->typePtr->seekProc == (Tcl_DriverSeekProc *) NULL) {
4944 Tcl_SetErrno(EINVAL);
4945 return -1;
4946 }
4947
4948 /*
4949 * Compute how much input and output is buffered. If both input and
4950 * output is buffered, cannot compute the current position.
4951 */
4952
4953 for (bufPtr = chanPtr->inQueueHead, inputBuffered = 0;
4954 bufPtr != (ChannelBuffer *) NULL;
4955 bufPtr = bufPtr->nextPtr) {
4956 inputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
4957 }
4958 for (bufPtr = chanPtr->outQueueHead, outputBuffered = 0;
4959 bufPtr != (ChannelBuffer *) NULL;
4960 bufPtr = bufPtr->nextPtr) {
4961 outputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
4962 }
4963 if ((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&
4964 (chanPtr->curOutPtr->nextAdded > chanPtr->curOutPtr->nextRemoved)) {
4965 chanPtr->flags |= BUFFER_READY;
4966 outputBuffered +=
4967 (chanPtr->curOutPtr->nextAdded - chanPtr->curOutPtr->nextRemoved);
4968 }
4969
4970 if ((inputBuffered != 0) && (outputBuffered != 0)) {
4971 Tcl_SetErrno(EFAULT);
4972 return -1;
4973 }
4974
4975 /*
4976 * Get the current position in the device and compute the position
4977 * where the next character will be read or written.
4978 */
4979
4980 curPos = (chanPtr->typePtr->seekProc) (chanPtr->instanceData,
4981 (long) 0, SEEK_CUR, &result);
4982 if (curPos == -1) {
4983 Tcl_SetErrno(result);
4984 return -1;
4985 }
4986 if (inputBuffered != 0) {
4987 return (curPos - inputBuffered);
4988 }
4989 return (curPos + outputBuffered);
4990 }
4991
4992 /*
4993 *---------------------------------------------------------------------------
4994 *
4995 * CheckChannelErrors --
4996 *
4997 * See if the channel is in an ready state and can perform the
4998 * desired operation.
4999 *
5000 * Results:
5001 * The return value is 0 if the channel is OK, otherwise the
5002 * return value is -1 and errno is set to indicate the error.
5003 *
5004 * Side effects:
5005 * May clear the EOF and/or BLOCKED bits if reading from channel.
5006 *
5007 *---------------------------------------------------------------------------
5008 */
5009
5010 static int
CheckChannelErrors(chanPtr,direction)5011 CheckChannelErrors(chanPtr, direction)
5012 Channel *chanPtr; /* Channel to check. */
5013 int direction; /* Test if channel supports desired operation:
5014 * TCL_READABLE, TCL_WRITABLE. */
5015 {
5016 /*
5017 * Check for unreported error.
5018 */
5019
5020 if (chanPtr->unreportedError != 0) {
5021 Tcl_SetErrno(chanPtr->unreportedError);
5022 chanPtr->unreportedError = 0;
5023 return -1;
5024 }
5025
5026 /*
5027 * Fail if the channel is not opened for desired operation.
5028 */
5029
5030 if ((chanPtr->flags & direction) == 0) {
5031 Tcl_SetErrno(EACCES);
5032 return -1;
5033 }
5034
5035 /*
5036 * Fail if the channel is in the middle of a background copy.
5037 */
5038
5039 if (chanPtr->csPtr != NULL) {
5040 Tcl_SetErrno(EBUSY);
5041 return -1;
5042 }
5043
5044 if (direction == TCL_READABLE) {
5045 /*
5046 * If we have not encountered a sticky EOF, clear the EOF bit
5047 * (sticky EOF is set if we have seen the input eofChar, to prevent
5048 * reading beyond the eofChar). Also, always clear the BLOCKED bit.
5049 * We want to discover these conditions anew in each operation.
5050 */
5051
5052 if ((chanPtr->flags & CHANNEL_STICKY_EOF) == 0) {
5053 chanPtr->flags &= ~CHANNEL_EOF;
5054 }
5055 chanPtr->flags &= ~(CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA);
5056 }
5057
5058 return 0;
5059 }
5060
5061 /*
5062 *----------------------------------------------------------------------
5063 *
5064 * Tcl_Eof --
5065 *
5066 * Returns 1 if the channel is at EOF, 0 otherwise.
5067 *
5068 * Results:
5069 * 1 or 0, always.
5070 *
5071 * Side effects:
5072 * None.
5073 *
5074 *----------------------------------------------------------------------
5075 */
5076
5077 int
Tcl_Eof(chan)5078 Tcl_Eof(chan)
5079 Tcl_Channel chan; /* Does this channel have EOF? */
5080 {
5081 Channel *chanPtr; /* The real channel structure. */
5082
5083 chanPtr = (Channel *) chan;
5084 return ((chanPtr->flags & CHANNEL_STICKY_EOF) ||
5085 ((chanPtr->flags & CHANNEL_EOF) && (Tcl_InputBuffered(chan) == 0)))
5086 ? 1 : 0;
5087 }
5088
5089 /*
5090 *----------------------------------------------------------------------
5091 *
5092 * Tcl_InputBlocked --
5093 *
5094 * Returns 1 if input is blocked on this channel, 0 otherwise.
5095 *
5096 * Results:
5097 * 0 or 1, always.
5098 *
5099 * Side effects:
5100 * None.
5101 *
5102 *----------------------------------------------------------------------
5103 */
5104
5105 int
Tcl_InputBlocked(chan)5106 Tcl_InputBlocked(chan)
5107 Tcl_Channel chan; /* Is this channel blocked? */
5108 {
5109 Channel *chanPtr; /* The real channel structure. */
5110
5111 chanPtr = (Channel *) chan;
5112 return (chanPtr->flags & CHANNEL_BLOCKED) ? 1 : 0;
5113 }
5114
5115 /*
5116 *----------------------------------------------------------------------
5117 *
5118 * Tcl_InputBuffered --
5119 *
5120 * Returns the number of bytes of input currently buffered in the
5121 * internal buffer of a channel.
5122 *
5123 * Results:
5124 * The number of input bytes buffered, or zero if the channel is not
5125 * open for reading.
5126 *
5127 * Side effects:
5128 * None.
5129 *
5130 *----------------------------------------------------------------------
5131 */
5132
5133 int
Tcl_InputBuffered(chan)5134 Tcl_InputBuffered(chan)
5135 Tcl_Channel chan; /* The channel to query. */
5136 {
5137 Channel *chanPtr;
5138 int bytesBuffered;
5139 ChannelBuffer *bufPtr;
5140
5141 chanPtr = (Channel *) chan;
5142 for (bytesBuffered = 0, bufPtr = chanPtr->inQueueHead;
5143 bufPtr != (ChannelBuffer *) NULL;
5144 bufPtr = bufPtr->nextPtr) {
5145 bytesBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
5146 }
5147 return bytesBuffered;
5148 }
5149
5150 /*
5151 *----------------------------------------------------------------------
5152 *
5153 * Tcl_SetChannelBufferSize --
5154 *
5155 * Sets the size of buffers to allocate to store input or output
5156 * in the channel. The size must be between 10 bytes and 1 MByte.
5157 *
5158 * Results:
5159 * None.
5160 *
5161 * Side effects:
5162 * Sets the size of buffers subsequently allocated for this channel.
5163 *
5164 *----------------------------------------------------------------------
5165 */
5166
5167 void
Tcl_SetChannelBufferSize(chan,sz)5168 Tcl_SetChannelBufferSize(chan, sz)
5169 Tcl_Channel chan; /* The channel whose buffer size
5170 * to set. */
5171 int sz; /* The size to set. */
5172 {
5173 Channel *chanPtr;
5174
5175 /*
5176 * If the buffer size is smaller than 10 bytes or larger than one MByte,
5177 * do not accept the requested size and leave the current buffer size.
5178 */
5179
5180 if (sz < 10) {
5181 return;
5182 }
5183 if (sz > (1024 * 1024)) {
5184 return;
5185 }
5186
5187 chanPtr = (Channel *) chan;
5188 chanPtr->bufSize = sz;
5189
5190 if (chanPtr->outputStage != NULL) {
5191 ckfree((char *) chanPtr->outputStage);
5192 chanPtr->outputStage = NULL;
5193 }
5194 if ((chanPtr->encoding != NULL) && (chanPtr->flags & TCL_WRITABLE)) {
5195 chanPtr->outputStage = (char *)
5196 ckalloc((unsigned) (chanPtr->bufSize + 2));
5197 }
5198 }
5199
5200 /*
5201 *----------------------------------------------------------------------
5202 *
5203 * Tcl_GetChannelBufferSize --
5204 *
5205 * Retrieves the size of buffers to allocate for this channel.
5206 *
5207 * Results:
5208 * The size.
5209 *
5210 * Side effects:
5211 * None.
5212 *
5213 *----------------------------------------------------------------------
5214 */
5215
5216 int
Tcl_GetChannelBufferSize(chan)5217 Tcl_GetChannelBufferSize(chan)
5218 Tcl_Channel chan; /* The channel for which to find the
5219 * buffer size. */
5220 {
5221 Channel *chanPtr;
5222
5223 chanPtr = (Channel *) chan;
5224 return chanPtr->bufSize;
5225 }
5226
5227 /*
5228 *----------------------------------------------------------------------
5229 *
5230 * Tcl_BadChannelOption --
5231 *
5232 * This procedure generates a "bad option" error message in an
5233 * (optional) interpreter. It is used by channel drivers when
5234 * a invalid Set/Get option is requested. Its purpose is to concatenate
5235 * the generic options list to the specific ones and factorize
5236 * the generic options error message string.
5237 *
5238 * Results:
5239 * TCL_ERROR.
5240 *
5241 * Side effects:
5242 * An error message is generated in interp's result object to
5243 * indicate that a command was invoked with the a bad option
5244 * The message has the form
5245 * bad option "blah": should be one of
5246 * <...generic options...>+<...specific options...>
5247 * "blah" is the optionName argument and "<specific options>"
5248 * is a space separated list of specific option words.
5249 * The function takes good care of inserting minus signs before
5250 * each option, commas after, and an "or" before the last option.
5251 *
5252 *----------------------------------------------------------------------
5253 */
5254
5255 int
Tcl_BadChannelOption(interp,optionName,optionList)5256 Tcl_BadChannelOption(interp, optionName, optionList)
5257 Tcl_Interp *interp; /* Current interpreter. (can be NULL)*/
5258 char *optionName; /* 'bad option' name */
5259 char *optionList; /* Specific options list to append
5260 * to the standard generic options.
5261 * can be NULL for generic options
5262 * only.
5263 */
5264 {
5265 if (interp) {
5266 CONST char *genericopt =
5267 "blocking buffering buffersize byteorder eofchar translation";
5268 char **argv;
5269 int argc, i;
5270 Tcl_DString ds;
5271
5272 Tcl_DStringInit(&ds);
5273 Tcl_DStringAppend(&ds, (char *) genericopt, -1);
5274 if (optionList && (*optionList)) {
5275 Tcl_DStringAppend(&ds, " ", 1);
5276 Tcl_DStringAppend(&ds, optionList, -1);
5277 }
5278 if (Tcl_SplitList(interp, Tcl_DStringValue(&ds),
5279 &argc, &argv) != TCL_OK) {
5280 panic("malformed option list in channel driver");
5281 }
5282 Tcl_ResetResult(interp);
5283 Tcl_AppendResult(interp, "bad option \"", optionName,
5284 "\": should be one of ", (char *) NULL);
5285 argc--;
5286 for (i = 0; i < argc; i++) {
5287 Tcl_AppendResult(interp, "-", argv[i], ", ", (char *) NULL);
5288 }
5289 Tcl_AppendResult(interp, "or -", argv[i], (char *) NULL);
5290 Tcl_DStringFree(&ds);
5291 ckfree((char *) argv);
5292 }
5293 Tcl_SetErrno(EINVAL);
5294 return TCL_ERROR;
5295 }
5296
5297 /* Andreas Kupries <andreas_kupries@users.sourceforge.net>, 05/31/1997.
5298 * "Trf-Patch for channels with a switchable byteorder"
5299 * Exported functionality.
5300 */
5301
5302 /*
5303 *----------------------------------------------------------------------
5304 *
5305 * Tcl_GetChannelByteorder --
5306 *
5307 * Retrieves the byteorder set for this channel.
5308 *
5309 * Results:
5310 * The size.
5311 *
5312 * Side effects:
5313 * None.
5314 *
5315 *----------------------------------------------------------------------
5316 */
5317
5318 int
Tcl_GetChannelByteorder(chan)5319 Tcl_GetChannelByteorder(chan)
5320 Tcl_Channel chan; /* The channel for which to find the
5321 * buffer size. */
5322 {
5323 Channel *chanPtr;
5324
5325 chanPtr = (Channel *) chan;
5326 return ((chanPtr->flags & CHANNEL_IS_SMALLENDIAN) != 0);
5327 }
5328
5329 /*
5330 *----------------------------------------------------------------------
5331 *
5332 * Tcl_GetChannelOption --
5333 *
5334 * Gets a mode associated with an IO channel. If the optionName arg
5335 * is non NULL, retrieves the value of that option. If the optionName
5336 * arg is NULL, retrieves a list of alternating option names and
5337 * values for the given channel.
5338 *
5339 * Results:
5340 * A standard Tcl result. Also sets the supplied DString to the
5341 * string value of the option(s) returned.
5342 *
5343 * Side effects:
5344 * None.
5345 *
5346 *----------------------------------------------------------------------
5347 */
5348
5349 int
Tcl_GetChannelOption(interp,chan,optionName,dsPtr)5350 Tcl_GetChannelOption(interp, chan, optionName, dsPtr)
5351 Tcl_Interp *interp; /* For error reporting - can be NULL. */
5352 Tcl_Channel chan; /* Channel on which to get option. */
5353 char *optionName; /* Option to get. */
5354 Tcl_DString *dsPtr; /* Where to store value(s). */
5355 {
5356 size_t len; /* Length of optionName string. */
5357 char optionVal[128]; /* Buffer for sprintf. */
5358 Channel *chanPtr = (Channel *) chan;
5359 int flags;
5360
5361 /*
5362 * If we are in the middle of a background copy, use the saved flags.
5363 */
5364
5365 if (chanPtr->csPtr) {
5366 if (chanPtr == chanPtr->csPtr->readPtr) {
5367 flags = chanPtr->csPtr->readFlags;
5368 } else {
5369 flags = chanPtr->csPtr->writeFlags;
5370 }
5371 } else {
5372 flags = chanPtr->flags;
5373 }
5374
5375 /*
5376 * Disallow options on dead channels -- channels that have been closed but
5377 * not yet been deallocated. Such channels can be found if the exit
5378 * handler for channel cleanup has run but the channel is still
5379 * registered in an interpreter.
5380 */
5381
5382 if (CheckForDeadChannel(interp,chanPtr)) return TCL_ERROR;
5383
5384 /*
5385 * If the optionName is NULL it means that we want a list of all
5386 * options and values.
5387 */
5388
5389 if (optionName == (char *) NULL) {
5390 len = 0;
5391 } else {
5392 len = strlen(optionName);
5393 }
5394
5395 if ((len == 0) || ((len > 2) && (optionName[1] == 'b') &&
5396 (strncmp(optionName, "-blocking", len) == 0))) {
5397 if (len == 0) {
5398 Tcl_DStringAppendElement(dsPtr, "-blocking");
5399 }
5400 Tcl_DStringAppendElement(dsPtr,
5401 (flags & CHANNEL_NONBLOCKING) ? "0" : "1");
5402 if (len > 0) {
5403 return TCL_OK;
5404 }
5405 }
5406 if ((len == 0) || ((len > 7) && (optionName[1] == 'b') &&
5407 (strncmp(optionName, "-buffering", len) == 0))) {
5408 if (len == 0) {
5409 Tcl_DStringAppendElement(dsPtr, "-buffering");
5410 }
5411 if (flags & CHANNEL_LINEBUFFERED) {
5412 Tcl_DStringAppendElement(dsPtr, "line");
5413 } else if (flags & CHANNEL_UNBUFFERED) {
5414 Tcl_DStringAppendElement(dsPtr, "none");
5415 } else {
5416 Tcl_DStringAppendElement(dsPtr, "full");
5417 }
5418 if (len > 0) {
5419 return TCL_OK;
5420 }
5421 }
5422 if ((len == 0) || ((len > 7) && (optionName[1] == 'b') &&
5423 (strncmp(optionName, "-buffersize", len) == 0))) {
5424 if (len == 0) {
5425 Tcl_DStringAppendElement(dsPtr, "-buffersize");
5426 }
5427 TclFormatInt(optionVal, chanPtr->bufSize);
5428 Tcl_DStringAppendElement(dsPtr, optionVal);
5429 if (len > 0) {
5430 return TCL_OK;
5431 }
5432 }
5433 if ((len == 0) ||
5434 ((len > 2) && (optionName[1] == 'e') &&
5435 (strncmp(optionName, "-encoding", len) == 0))) {
5436 if (len == 0) {
5437 Tcl_DStringAppendElement(dsPtr, "-encoding");
5438 }
5439 if (chanPtr->encoding == NULL) {
5440 Tcl_DStringAppendElement(dsPtr, "binary");
5441 } else {
5442 Tcl_DStringAppendElement(dsPtr,
5443 Tcl_GetEncodingName(chanPtr->encoding));
5444 }
5445 if (len > 0) {
5446 return TCL_OK;
5447 }
5448 }
5449
5450 /* Andreas Kupries <andreas_kupries@users.sourceforge.net>, 05/31/1997.
5451 * "Trf-Patch for channels with a switchable byteorder"
5452 * Location: Tcl_GetChannelOption
5453 */
5454
5455 if ((len == 0) || ((len > 2) && (optionName[1] == 'b') &&
5456 (strncmp(optionName, "-byteorder", len) == 0))) {
5457 if (len == 0) {
5458 Tcl_DStringAppendElement(dsPtr, "-byteorder");
5459 }
5460 Tcl_DStringAppendElement(dsPtr,
5461 (chanPtr->flags & CHANNEL_IS_SMALLENDIAN) ?
5462 "smallendian" : "bigendian");
5463 if (len > 0) {
5464 return TCL_OK;
5465 }
5466 }
5467
5468 if ((len == 0) ||
5469 ((len > 2) && (optionName[1] == 'e') &&
5470 (strncmp(optionName, "-eofchar", len) == 0))) {
5471 if (len == 0) {
5472 Tcl_DStringAppendElement(dsPtr, "-eofchar");
5473 }
5474 if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==
5475 (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {
5476 Tcl_DStringStartSublist(dsPtr);
5477 }
5478 if (flags & TCL_READABLE) {
5479 if (chanPtr->inEofChar == 0) {
5480 Tcl_DStringAppendElement(dsPtr, "");
5481 } else {
5482 char buf[4];
5483
5484 sprintf(buf, "%c", chanPtr->inEofChar);
5485 Tcl_DStringAppendElement(dsPtr, buf);
5486 }
5487 }
5488 if (flags & TCL_WRITABLE) {
5489 if (chanPtr->outEofChar == 0) {
5490 Tcl_DStringAppendElement(dsPtr, "");
5491 } else {
5492 char buf[4];
5493
5494 sprintf(buf, "%c", chanPtr->outEofChar);
5495 Tcl_DStringAppendElement(dsPtr, buf);
5496 }
5497 }
5498 if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==
5499 (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {
5500 Tcl_DStringEndSublist(dsPtr);
5501 }
5502 if (len > 0) {
5503 return TCL_OK;
5504 }
5505 }
5506 if ((len == 0) ||
5507 ((len > 1) && (optionName[1] == 't') &&
5508 (strncmp(optionName, "-translation", len) == 0))) {
5509 if (len == 0) {
5510 Tcl_DStringAppendElement(dsPtr, "-translation");
5511 }
5512 if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==
5513 (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {
5514 Tcl_DStringStartSublist(dsPtr);
5515 }
5516 if (flags & TCL_READABLE) {
5517 if (chanPtr->inputTranslation == TCL_TRANSLATE_AUTO) {
5518 Tcl_DStringAppendElement(dsPtr, "auto");
5519 } else if (chanPtr->inputTranslation == TCL_TRANSLATE_CR) {
5520 Tcl_DStringAppendElement(dsPtr, "cr");
5521 } else if (chanPtr->inputTranslation == TCL_TRANSLATE_CRLF) {
5522 Tcl_DStringAppendElement(dsPtr, "crlf");
5523 } else {
5524 Tcl_DStringAppendElement(dsPtr, "lf");
5525 }
5526 }
5527 if (flags & TCL_WRITABLE) {
5528 if (chanPtr->outputTranslation == TCL_TRANSLATE_AUTO) {
5529 Tcl_DStringAppendElement(dsPtr, "auto");
5530 } else if (chanPtr->outputTranslation == TCL_TRANSLATE_CR) {
5531 Tcl_DStringAppendElement(dsPtr, "cr");
5532 } else if (chanPtr->outputTranslation == TCL_TRANSLATE_CRLF) {
5533 Tcl_DStringAppendElement(dsPtr, "crlf");
5534 } else {
5535 Tcl_DStringAppendElement(dsPtr, "lf");
5536 }
5537 }
5538 if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==
5539 (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {
5540 Tcl_DStringEndSublist(dsPtr);
5541 }
5542 if (len > 0) {
5543 return TCL_OK;
5544 }
5545 }
5546 if (chanPtr->typePtr->getOptionProc != (Tcl_DriverGetOptionProc *) NULL) {
5547 /*
5548 * let the driver specific handle additional options
5549 * and result code and message.
5550 */
5551
5552 return (chanPtr->typePtr->getOptionProc) (chanPtr->instanceData,
5553 interp, optionName, dsPtr);
5554 } else {
5555 /*
5556 * no driver specific options case.
5557 */
5558
5559 if (len == 0) {
5560 return TCL_OK;
5561 }
5562 return Tcl_BadChannelOption(interp, optionName, NULL);
5563 }
5564 }
5565
5566 /*
5567 *---------------------------------------------------------------------------
5568 *
5569 * Tcl_SetChannelOption --
5570 *
5571 * Sets an option on a channel.
5572 *
5573 * Results:
5574 * A standard Tcl result. On error, sets interp's result object
5575 * if interp is not NULL.
5576 *
5577 * Side effects:
5578 * May modify an option on a device.
5579 *
5580 *---------------------------------------------------------------------------
5581 */
5582
5583 int
Tcl_SetChannelOption(interp,chan,optionName,newValue)5584 Tcl_SetChannelOption(interp, chan, optionName, newValue)
5585 Tcl_Interp *interp; /* For error reporting - can be NULL. */
5586 Tcl_Channel chan; /* Channel on which to set mode. */
5587 char *optionName; /* Which option to set? */
5588 char *newValue; /* New value for option. */
5589 {
5590 int newMode; /* New (numeric) mode to sert. */
5591 Channel *chanPtr; /* The real IO channel. */
5592 size_t len; /* Length of optionName string. */
5593 int argc;
5594 char **argv;
5595
5596 chanPtr = (Channel *) chan;
5597
5598 /*
5599 * If the channel is in the middle of a background copy, fail.
5600 */
5601
5602 if (chanPtr->csPtr) {
5603 if (interp) {
5604 Tcl_AppendResult(interp,
5605 "unable to set channel options: background copy in progress",
5606 (char *) NULL);
5607 }
5608 return TCL_ERROR;
5609 }
5610
5611
5612 /*
5613 * Disallow options on dead channels -- channels that have been closed but
5614 * not yet been deallocated. Such channels can be found if the exit
5615 * handler for channel cleanup has run but the channel is still
5616 * registered in an interpreter.
5617 */
5618
5619 if (CheckForDeadChannel(NULL,chanPtr)) return TCL_ERROR;
5620
5621 len = strlen(optionName);
5622
5623 if ((len > 2) && (optionName[1] == 'b') &&
5624 (strncmp(optionName, "-blocking", len) == 0)) {
5625 if (Tcl_GetBoolean(interp, newValue, &newMode) == TCL_ERROR) {
5626 return TCL_ERROR;
5627 }
5628 if (newMode) {
5629 newMode = TCL_MODE_BLOCKING;
5630 } else {
5631 newMode = TCL_MODE_NONBLOCKING;
5632 }
5633 return SetBlockMode(interp, chanPtr, newMode);
5634 } else if ((len > 7) && (optionName[1] == 'b') &&
5635 (strncmp(optionName, "-buffering", len) == 0)) {
5636 len = strlen(newValue);
5637 if ((newValue[0] == 'f') && (strncmp(newValue, "full", len) == 0)) {
5638 chanPtr->flags &=
5639 (~(CHANNEL_UNBUFFERED|CHANNEL_LINEBUFFERED));
5640 } else if ((newValue[0] == 'l') &&
5641 (strncmp(newValue, "line", len) == 0)) {
5642 chanPtr->flags &= (~(CHANNEL_UNBUFFERED));
5643 chanPtr->flags |= CHANNEL_LINEBUFFERED;
5644 } else if ((newValue[0] == 'n') &&
5645 (strncmp(newValue, "none", len) == 0)) {
5646 chanPtr->flags &= (~(CHANNEL_LINEBUFFERED));
5647 chanPtr->flags |= CHANNEL_UNBUFFERED;
5648 } else {
5649 if (interp) {
5650 Tcl_AppendResult(interp, "bad value for -buffering: ",
5651 "must be one of full, line, or none",
5652 (char *) NULL);
5653 return TCL_ERROR;
5654 }
5655 }
5656 return TCL_OK;
5657 } else if ((len > 7) && (optionName[1] == 'b') &&
5658 (strncmp(optionName, "-buffersize", len) == 0)) {
5659 chanPtr->bufSize = atoi(newValue); /* INTL: "C", UTF safe. */
5660 if ((chanPtr->bufSize < 10) || (chanPtr->bufSize > (1024 * 1024))) {
5661 chanPtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE;
5662 }
5663
5664 /* Andreas Kupries <andreas_kupries@users.sourceforge.net>, 05/31/1997.
5665 * "Trf-Patch for channels with a switchable byteorder"
5666 * Location: Tcl_SetChannelOption.
5667 */
5668
5669 } else if ((len > 2) && (optionName[1] == 'b') &&
5670 (strncmp(optionName, "-byteorder", len) == 0)) {
5671 int nv_len = strlen (newValue);
5672
5673 if ((nv_len > 0) &&
5674 (strncmp (newValue, "smallendian", nv_len) == 0)) {
5675 chanPtr->flags |= CHANNEL_IS_SMALLENDIAN;
5676 return TCL_OK;
5677 } else if ((nv_len > 0) &&
5678 (strncmp (newValue, "littleendian", nv_len) == 0)) {
5679 chanPtr->flags |= CHANNEL_IS_SMALLENDIAN;
5680 return TCL_OK;
5681 } else if ((nv_len > 0) &&
5682 (strncmp (newValue, "network", nv_len) == 0)) {
5683 chanPtr->flags &= ~CHANNEL_IS_SMALLENDIAN;
5684 return TCL_OK;
5685 } else if ((nv_len > 0) &&
5686 (strncmp (newValue, "bigendian", nv_len) == 0)) {
5687 chanPtr->flags &= ~CHANNEL_IS_SMALLENDIAN;
5688 return TCL_OK;
5689 }
5690
5691 if (interp != (Tcl_Interp *) NULL) {
5692 Tcl_AppendResult(interp,
5693 "bad value for -byteorder: ",
5694 "must be one of smallendian, littleendian, bigendian or network",
5695 (char *) NULL);
5696 }
5697 return TCL_ERROR;
5698 } else if ((len > 2) && (optionName[1] == 'e') &&
5699 (strncmp(optionName, "-encoding", len) == 0)) {
5700 Tcl_Encoding encoding;
5701
5702 if ((newValue[0] == '\0') || (strcmp(newValue, "binary") == 0)) {
5703 encoding = NULL;
5704 } else {
5705 encoding = Tcl_GetEncoding(interp, newValue);
5706 if (encoding == NULL) {
5707 return TCL_ERROR;
5708 }
5709 }
5710 Tcl_FreeEncoding(chanPtr->encoding);
5711 chanPtr->encoding = encoding;
5712 chanPtr->inputEncodingState = NULL;
5713 chanPtr->inputEncodingFlags = TCL_ENCODING_START;
5714 chanPtr->outputEncodingState = NULL;
5715 chanPtr->outputEncodingFlags = TCL_ENCODING_START;
5716 chanPtr->flags &= ~CHANNEL_NEED_MORE_DATA;
5717 UpdateInterest(chanPtr);
5718 } else if ((len > 2) && (optionName[1] == 'e') &&
5719 (strncmp(optionName, "-eofchar", len) == 0)) {
5720 if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) {
5721 return TCL_ERROR;
5722 }
5723 if (argc == 0) {
5724 chanPtr->inEofChar = 0;
5725 chanPtr->outEofChar = 0;
5726 } else if (argc == 1) {
5727 if (chanPtr->flags & TCL_WRITABLE) {
5728 chanPtr->outEofChar = (int) argv[0][0];
5729 }
5730 if (chanPtr->flags & TCL_READABLE) {
5731 chanPtr->inEofChar = (int) argv[0][0];
5732 }
5733 } else if (argc != 2) {
5734 if (interp) {
5735 Tcl_AppendResult(interp,
5736 "bad value for -eofchar: should be a list of one or",
5737 " two elements", (char *) NULL);
5738 }
5739 ckfree((char *) argv);
5740 return TCL_ERROR;
5741 } else {
5742 if (chanPtr->flags & TCL_READABLE) {
5743 chanPtr->inEofChar = (int) argv[0][0];
5744 }
5745 if (chanPtr->flags & TCL_WRITABLE) {
5746 chanPtr->outEofChar = (int) argv[1][0];
5747 }
5748 }
5749 if (argv != (char **) NULL) {
5750 ckfree((char *) argv);
5751 }
5752 return TCL_OK;
5753 } else if ((len > 1) && (optionName[1] == 't') &&
5754 (strncmp(optionName, "-translation", len) == 0)) {
5755 char *readMode, *writeMode;
5756
5757 if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) {
5758 return TCL_ERROR;
5759 }
5760
5761 if (argc == 1) {
5762 readMode = (chanPtr->flags & TCL_READABLE) ? argv[0] : NULL;
5763 writeMode = (chanPtr->flags & TCL_WRITABLE) ? argv[0] : NULL;
5764 } else if (argc == 2) {
5765 readMode = (chanPtr->flags & TCL_READABLE) ? argv[0] : NULL;
5766 writeMode = (chanPtr->flags & TCL_WRITABLE) ? argv[1] : NULL;
5767 } else {
5768 if (interp) {
5769 Tcl_AppendResult(interp,
5770 "bad value for -translation: must be a one or two",
5771 " element list", (char *) NULL);
5772 }
5773 ckfree((char *) argv);
5774 return TCL_ERROR;
5775 }
5776
5777 if (readMode) {
5778 if (*readMode == '\0') {
5779 newMode = chanPtr->inputTranslation;
5780 } else if (strcmp(readMode, "auto") == 0) {
5781 newMode = TCL_TRANSLATE_AUTO;
5782 } else if (strcmp(readMode, "binary") == 0) {
5783 newMode = TCL_TRANSLATE_LF;
5784 chanPtr->inEofChar = 0;
5785 Tcl_FreeEncoding(chanPtr->encoding);
5786 chanPtr->encoding = NULL;
5787 } else if (strcmp(readMode, "lf") == 0) {
5788 newMode = TCL_TRANSLATE_LF;
5789 } else if (strcmp(readMode, "cr") == 0) {
5790 newMode = TCL_TRANSLATE_CR;
5791 } else if (strcmp(readMode, "crlf") == 0) {
5792 newMode = TCL_TRANSLATE_CRLF;
5793 } else if (strcmp(readMode, "platform") == 0) {
5794 newMode = TCL_PLATFORM_TRANSLATION;
5795 } else {
5796 if (interp) {
5797 Tcl_AppendResult(interp,
5798 "bad value for -translation: ",
5799 "must be one of auto, binary, cr, lf, crlf,",
5800 " or platform", (char *) NULL);
5801 }
5802 ckfree((char *) argv);
5803 return TCL_ERROR;
5804 }
5805
5806 /*
5807 * Reset the EOL flags since we need to look at any buffered
5808 * data to see if the new translation mode allows us to
5809 * complete the line.
5810 */
5811
5812 if (newMode != chanPtr->inputTranslation) {
5813 chanPtr->inputTranslation = (Tcl_EolTranslation) newMode;
5814 chanPtr->flags &= ~(INPUT_SAW_CR);
5815 chanPtr->flags &= ~(CHANNEL_NEED_MORE_DATA);
5816 UpdateInterest(chanPtr);
5817 }
5818 }
5819 if (writeMode) {
5820 if (*writeMode == '\0') {
5821 /* Do nothing. */
5822 } else if (strcmp(writeMode, "auto") == 0) {
5823 /*
5824 * This is a hack to get TCP sockets to produce output
5825 * in CRLF mode if they are being set into AUTO mode.
5826 * A better solution for achieving this effect will be
5827 * coded later.
5828 */
5829
5830 if (strcmp(chanPtr->typePtr->typeName, "tcp") == 0) {
5831 chanPtr->outputTranslation = TCL_TRANSLATE_CRLF;
5832 } else {
5833 chanPtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
5834 }
5835 } else if (strcmp(writeMode, "binary") == 0) {
5836 chanPtr->outEofChar = 0;
5837 chanPtr->outputTranslation = TCL_TRANSLATE_LF;
5838 Tcl_FreeEncoding(chanPtr->encoding);
5839 chanPtr->encoding = NULL;
5840 } else if (strcmp(writeMode, "lf") == 0) {
5841 chanPtr->outputTranslation = TCL_TRANSLATE_LF;
5842 } else if (strcmp(writeMode, "cr") == 0) {
5843 chanPtr->outputTranslation = TCL_TRANSLATE_CR;
5844 } else if (strcmp(writeMode, "crlf") == 0) {
5845 chanPtr->outputTranslation = TCL_TRANSLATE_CRLF;
5846 } else if (strcmp(writeMode, "platform") == 0) {
5847 chanPtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
5848 } else {
5849 if (interp) {
5850 Tcl_AppendResult(interp,
5851 "bad value for -translation: ",
5852 "must be one of auto, binary, cr, lf, crlf,",
5853 " or platform", (char *) NULL);
5854 }
5855 ckfree((char *) argv);
5856 return TCL_ERROR;
5857 }
5858 }
5859 ckfree((char *) argv);
5860 return TCL_OK;
5861 } else if (chanPtr->typePtr->setOptionProc != NULL) {
5862 return (*chanPtr->typePtr->setOptionProc)(chanPtr->instanceData,
5863 interp, optionName, newValue);
5864 } else {
5865 return Tcl_BadChannelOption(interp, optionName, (char *) NULL);
5866 }
5867
5868 /*
5869 * If bufsize changes, need to get rid of old utility buffer.
5870 */
5871
5872 if (chanPtr->saveInBufPtr != NULL) {
5873 RecycleBuffer(chanPtr, chanPtr->saveInBufPtr, 1);
5874 chanPtr->saveInBufPtr = NULL;
5875 }
5876 if (chanPtr->inQueueHead != NULL) {
5877 if ((chanPtr->inQueueHead->nextPtr == NULL)
5878 && (chanPtr->inQueueHead->nextAdded ==
5879 chanPtr->inQueueHead->nextRemoved)) {
5880 RecycleBuffer(chanPtr, chanPtr->inQueueHead, 1);
5881 chanPtr->inQueueHead = NULL;
5882 chanPtr->inQueueTail = NULL;
5883 }
5884 }
5885
5886 /*
5887 * If encoding or bufsize changes, need to update output staging buffer.
5888 */
5889
5890 if (chanPtr->outputStage != NULL) {
5891 ckfree((char *) chanPtr->outputStage);
5892 chanPtr->outputStage = NULL;
5893 }
5894 if ((chanPtr->encoding != NULL) && (chanPtr->flags & TCL_WRITABLE)) {
5895 chanPtr->outputStage = (char *)
5896 ckalloc((unsigned) (chanPtr->bufSize + 2));
5897 }
5898 return TCL_OK;
5899 }
5900
5901 /*
5902 *----------------------------------------------------------------------
5903 *
5904 * CleanupChannelHandlers --
5905 *
5906 * Removes channel handlers that refer to the supplied interpreter,
5907 * so that if the actual channel is not closed now, these handlers
5908 * will not run on subsequent events on the channel. This would be
5909 * erroneous, because the interpreter no longer has a reference to
5910 * this channel.
5911 *
5912 * Results:
5913 * None.
5914 *
5915 * Side effects:
5916 * Removes channel handlers.
5917 *
5918 *----------------------------------------------------------------------
5919 */
5920
5921 static void
CleanupChannelHandlers(interp,chanPtr)5922 CleanupChannelHandlers(interp, chanPtr)
5923 Tcl_Interp *interp;
5924 Channel *chanPtr;
5925 {
5926 EventScriptRecord *sPtr, *prevPtr, *nextPtr;
5927
5928 /*
5929 * Remove fileevent records on this channel that refer to the
5930 * given interpreter.
5931 */
5932
5933 for (sPtr = chanPtr->scriptRecordPtr,
5934 prevPtr = (EventScriptRecord *) NULL;
5935 sPtr != (EventScriptRecord *) NULL;
5936 sPtr = nextPtr) {
5937 nextPtr = sPtr->nextPtr;
5938 if (sPtr->interp == interp) {
5939 if (prevPtr == (EventScriptRecord *) NULL) {
5940 chanPtr->scriptRecordPtr = nextPtr;
5941 } else {
5942 prevPtr->nextPtr = nextPtr;
5943 }
5944
5945 Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
5946 ChannelEventScriptInvoker, (ClientData) sPtr);
5947
5948 Tcl_DecrRefCount(sPtr->scriptPtr);
5949 ckfree((char *) sPtr);
5950 } else {
5951 prevPtr = sPtr;
5952 }
5953 }
5954 }
5955
5956 /*
5957 *----------------------------------------------------------------------
5958 *
5959 * Tcl_NotifyChannel --
5960 *
5961 * This procedure is called by a channel driver when a driver
5962 * detects an event on a channel. This procedure is responsible
5963 * for actually handling the event by invoking any channel
5964 * handler callbacks.
5965 *
5966 * Results:
5967 * None.
5968 *
5969 * Side effects:
5970 * Whatever the channel handler callback procedure does.
5971 *
5972 *----------------------------------------------------------------------
5973 */
5974
5975 void
Tcl_NotifyChannel(channel,mask)5976 Tcl_NotifyChannel(channel, mask)
5977 Tcl_Channel channel; /* Channel that detected an event. */
5978 int mask; /* OR'ed combination of TCL_READABLE,
5979 * TCL_WRITABLE, or TCL_EXCEPTION: indicates
5980 * which events were detected. */
5981 {
5982 Channel *chanPtr = (Channel *) channel;
5983 ChannelHandler *chPtr;
5984 ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
5985 NextChannelHandler nh;
5986
5987 /*
5988 * Preserve the channel struct in case the script closes it.
5989 */
5990
5991 Tcl_Preserve((ClientData) channel);
5992
5993 /*
5994 * If we are flushing in the background, be sure to call FlushChannel
5995 * for writable events. Note that we have to discard the writable
5996 * event so we don't call any write handlers before the flush is
5997 * complete.
5998 */
5999
6000 if ((chanPtr->flags & BG_FLUSH_SCHEDULED) && (mask & TCL_WRITABLE)) {
6001 FlushChannel(NULL, chanPtr, 1);
6002 mask &= ~TCL_WRITABLE;
6003 }
6004
6005 /*
6006 * Add this invocation to the list of recursive invocations of
6007 * ChannelHandlerEventProc.
6008 */
6009
6010 nh.nextHandlerPtr = (ChannelHandler *) NULL;
6011 nh.nestedHandlerPtr = tsdPtr->nestedHandlerPtr;
6012 tsdPtr->nestedHandlerPtr = &nh;
6013
6014 for (chPtr = chanPtr->chPtr; chPtr != (ChannelHandler *) NULL; ) {
6015
6016 /*
6017 * If this channel handler is interested in any of the events that
6018 * have occurred on the channel, invoke its procedure.
6019 */
6020
6021 if ((chPtr->mask & mask) != 0) {
6022 nh.nextHandlerPtr = chPtr->nextPtr;
6023 (*(chPtr->proc))(chPtr->clientData, mask);
6024 chPtr = nh.nextHandlerPtr;
6025 } else {
6026 chPtr = chPtr->nextPtr;
6027 }
6028 }
6029
6030 /*
6031 * Update the notifier interest, since it may have changed after
6032 * invoking event handlers.
6033 */
6034
6035 if (chanPtr->typePtr != NULL) {
6036 UpdateInterest(chanPtr);
6037 }
6038
6039 Tcl_Release((ClientData) channel);
6040
6041 tsdPtr->nestedHandlerPtr = nh.nestedHandlerPtr;
6042 }
6043
6044 /*
6045 *----------------------------------------------------------------------
6046 *
6047 * UpdateInterest --
6048 *
6049 * Arrange for the notifier to call us back at appropriate times
6050 * based on the current state of the channel.
6051 *
6052 * Results:
6053 * None.
6054 *
6055 * Side effects:
6056 * May schedule a timer or driver handler.
6057 *
6058 *----------------------------------------------------------------------
6059 */
6060
6061 static void
UpdateInterest(chanPtr)6062 UpdateInterest(chanPtr)
6063 Channel *chanPtr; /* Channel to update. */
6064 {
6065 int mask = chanPtr->interestMask;
6066
6067 /*
6068 * If there are flushed buffers waiting to be written, then
6069 * we need to watch for the channel to become writable.
6070 */
6071
6072 if (chanPtr->flags & BG_FLUSH_SCHEDULED) {
6073 mask |= TCL_WRITABLE;
6074 }
6075
6076 /*
6077 * If there is data in the input queue, and we aren't waiting for more
6078 * data, then we need to schedule a timer so we don't block in the
6079 * notifier. Also, cancel the read interest so we don't get duplicate
6080 * events.
6081 */
6082
6083 if (mask & TCL_READABLE) {
6084 if (!(chanPtr->flags & CHANNEL_NEED_MORE_DATA)
6085 && (chanPtr->inQueueHead != (ChannelBuffer *) NULL)
6086 && (chanPtr->inQueueHead->nextRemoved <
6087 chanPtr->inQueueHead->nextAdded)) {
6088 mask &= ~TCL_READABLE;
6089 if (!chanPtr->timer) {
6090 chanPtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,
6091 (ClientData) chanPtr);
6092 }
6093 }
6094 }
6095 (chanPtr->typePtr->watchProc)(chanPtr->instanceData, mask);
6096 }
6097
6098 /*
6099 *----------------------------------------------------------------------
6100 *
6101 * ChannelTimerProc --
6102 *
6103 * Timer handler scheduled by UpdateInterest to monitor the
6104 * channel buffers until they are empty.
6105 *
6106 * Results:
6107 * None.
6108 *
6109 * Side effects:
6110 * May invoke channel handlers.
6111 *
6112 *----------------------------------------------------------------------
6113 */
6114
6115 static void
ChannelTimerProc(clientData)6116 ChannelTimerProc(clientData)
6117 ClientData clientData;
6118 {
6119 Channel *chanPtr = (Channel *) clientData;
6120
6121 if (!(chanPtr->flags & CHANNEL_NEED_MORE_DATA)
6122 && (chanPtr->interestMask & TCL_READABLE)
6123 && (chanPtr->inQueueHead != (ChannelBuffer *) NULL)
6124 && (chanPtr->inQueueHead->nextRemoved <
6125 chanPtr->inQueueHead->nextAdded)) {
6126 /*
6127 * Restart the timer in case a channel handler reenters the
6128 * event loop before UpdateInterest gets called by Tcl_NotifyChannel.
6129 */
6130
6131 chanPtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,
6132 (ClientData) chanPtr);
6133 Tcl_NotifyChannel((Tcl_Channel)chanPtr, TCL_READABLE);
6134
6135 } else {
6136 chanPtr->timer = NULL;
6137 UpdateInterest(chanPtr);
6138 }
6139 }
6140
6141 /*
6142 *----------------------------------------------------------------------
6143 *
6144 * Tcl_CreateChannelHandler --
6145 *
6146 * Arrange for a given procedure to be invoked whenever the
6147 * channel indicated by the chanPtr arg becomes readable or
6148 * writable.
6149 *
6150 * Results:
6151 * None.
6152 *
6153 * Side effects:
6154 * From now on, whenever the I/O channel given by chanPtr becomes
6155 * ready in the way indicated by mask, proc will be invoked.
6156 * See the manual entry for details on the calling sequence
6157 * to proc. If there is already an event handler for chan, proc
6158 * and clientData, then the mask will be updated.
6159 *
6160 *----------------------------------------------------------------------
6161 */
6162
6163 void
Tcl_CreateChannelHandler(chan,mask,proc,clientData)6164 Tcl_CreateChannelHandler(chan, mask, proc, clientData)
6165 Tcl_Channel chan; /* The channel to create the handler for. */
6166 int mask; /* OR'ed combination of TCL_READABLE,
6167 * TCL_WRITABLE, and TCL_EXCEPTION:
6168 * indicates conditions under which
6169 * proc should be called. Use 0 to
6170 * disable a registered handler. */
6171 Tcl_ChannelProc *proc; /* Procedure to call for each
6172 * selected event. */
6173 ClientData clientData; /* Arbitrary data to pass to proc. */
6174 {
6175 ChannelHandler *chPtr;
6176 Channel *chanPtr;
6177
6178 chanPtr = (Channel *) chan;
6179
6180 /*
6181 * Check whether this channel handler is not already registered. If
6182 * it is not, create a new record, else reuse existing record (smash
6183 * current values).
6184 */
6185
6186 for (chPtr = chanPtr->chPtr;
6187 chPtr != (ChannelHandler *) NULL;
6188 chPtr = chPtr->nextPtr) {
6189 if ((chPtr->chanPtr == chanPtr) && (chPtr->proc == proc) &&
6190 (chPtr->clientData == clientData)) {
6191 break;
6192 }
6193 }
6194 if (chPtr == (ChannelHandler *) NULL) {
6195 chPtr = (ChannelHandler *) ckalloc((unsigned) sizeof(ChannelHandler));
6196 chPtr->mask = 0;
6197 chPtr->proc = proc;
6198 chPtr->clientData = clientData;
6199 chPtr->chanPtr = chanPtr;
6200 chPtr->nextPtr = chanPtr->chPtr;
6201 chanPtr->chPtr = chPtr;
6202 }
6203
6204 /*
6205 * The remainder of the initialization below is done regardless of
6206 * whether or not this is a new record or a modification of an old
6207 * one.
6208 */
6209
6210 chPtr->mask = mask;
6211
6212 /*
6213 * Recompute the interest mask for the channel - this call may actually
6214 * be disabling an existing handler.
6215 */
6216
6217 chanPtr->interestMask = 0;
6218 for (chPtr = chanPtr->chPtr;
6219 chPtr != (ChannelHandler *) NULL;
6220 chPtr = chPtr->nextPtr) {
6221 chanPtr->interestMask |= chPtr->mask;
6222 }
6223
6224 UpdateInterest(chanPtr);
6225 }
6226
6227 /*
6228 *----------------------------------------------------------------------
6229 *
6230 * Tcl_DeleteChannelHandler --
6231 *
6232 * Cancel a previously arranged callback arrangement for an IO
6233 * channel.
6234 *
6235 * Results:
6236 * None.
6237 *
6238 * Side effects:
6239 * If a callback was previously registered for this chan, proc and
6240 * clientData , it is removed and the callback will no longer be called
6241 * when the channel becomes ready for IO.
6242 *
6243 *----------------------------------------------------------------------
6244 */
6245
6246 void
Tcl_DeleteChannelHandler(chan,proc,clientData)6247 Tcl_DeleteChannelHandler(chan, proc, clientData)
6248 Tcl_Channel chan; /* The channel for which to remove the
6249 * callback. */
6250 Tcl_ChannelProc *proc; /* The procedure in the callback to delete. */
6251 ClientData clientData; /* The client data in the callback
6252 * to delete. */
6253
6254 {
6255 ChannelHandler *chPtr, *prevChPtr;
6256 Channel *chanPtr;
6257 ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
6258 NextChannelHandler *nhPtr;
6259
6260 chanPtr = (Channel *) chan;
6261
6262 /*
6263 * Find the entry and the previous one in the list.
6264 */
6265
6266 for (prevChPtr = (ChannelHandler *) NULL, chPtr = chanPtr->chPtr;
6267 chPtr != (ChannelHandler *) NULL;
6268 chPtr = chPtr->nextPtr) {
6269 if ((chPtr->chanPtr == chanPtr) && (chPtr->clientData == clientData)
6270 && (chPtr->proc == proc)) {
6271 break;
6272 }
6273 prevChPtr = chPtr;
6274 }
6275
6276 /*
6277 * If not found, return without doing anything.
6278 */
6279
6280 if (chPtr == (ChannelHandler *) NULL) {
6281 return;
6282 }
6283
6284 /*
6285 * If ChannelHandlerEventProc is about to process this handler, tell it to
6286 * process the next one instead - we are going to delete *this* one.
6287 */
6288
6289 for (nhPtr = tsdPtr->nestedHandlerPtr;
6290 nhPtr != (NextChannelHandler *) NULL;
6291 nhPtr = nhPtr->nestedHandlerPtr) {
6292 if (nhPtr->nextHandlerPtr == chPtr) {
6293 nhPtr->nextHandlerPtr = chPtr->nextPtr;
6294 }
6295 }
6296
6297 /*
6298 * Splice it out of the list of channel handlers.
6299 */
6300
6301 if (prevChPtr == (ChannelHandler *) NULL) {
6302 chanPtr->chPtr = chPtr->nextPtr;
6303 } else {
6304 prevChPtr->nextPtr = chPtr->nextPtr;
6305 }
6306 ckfree((char *) chPtr);
6307
6308 /*
6309 * Recompute the interest list for the channel, so that infinite loops
6310 * will not result if Tcl_DeleteChanelHandler is called inside an event.
6311 */
6312
6313 chanPtr->interestMask = 0;
6314 for (chPtr = chanPtr->chPtr;
6315 chPtr != (ChannelHandler *) NULL;
6316 chPtr = chPtr->nextPtr) {
6317 chanPtr->interestMask |= chPtr->mask;
6318 }
6319
6320 UpdateInterest(chanPtr);
6321 }
6322
6323 /*
6324 *----------------------------------------------------------------------
6325 *
6326 * DeleteScriptRecord --
6327 *
6328 * Delete a script record for this combination of channel, interp
6329 * and mask.
6330 *
6331 * Results:
6332 * None.
6333 *
6334 * Side effects:
6335 * Deletes a script record and cancels a channel event handler.
6336 *
6337 *----------------------------------------------------------------------
6338 */
6339
6340 static void
DeleteScriptRecord(interp,chanPtr,mask)6341 DeleteScriptRecord(interp, chanPtr, mask)
6342 Tcl_Interp *interp; /* Interpreter in which script was to be
6343 * executed. */
6344 Channel *chanPtr; /* The channel for which to delete the
6345 * script record (if any). */
6346 int mask; /* Events in mask must exactly match mask
6347 * of script to delete. */
6348 {
6349 EventScriptRecord *esPtr, *prevEsPtr;
6350
6351 for (esPtr = chanPtr->scriptRecordPtr,
6352 prevEsPtr = (EventScriptRecord *) NULL;
6353 esPtr != (EventScriptRecord *) NULL;
6354 prevEsPtr = esPtr, esPtr = esPtr->nextPtr) {
6355 if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
6356 if (esPtr == chanPtr->scriptRecordPtr) {
6357 chanPtr->scriptRecordPtr = esPtr->nextPtr;
6358 } else {
6359 prevEsPtr->nextPtr = esPtr->nextPtr;
6360 }
6361
6362 Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
6363 ChannelEventScriptInvoker, (ClientData) esPtr);
6364
6365 Tcl_DecrRefCount(esPtr->scriptPtr);
6366 ckfree((char *) esPtr);
6367
6368 break;
6369 }
6370 }
6371 }
6372
6373 /*
6374 *----------------------------------------------------------------------
6375 *
6376 * CreateScriptRecord --
6377 *
6378 * Creates a record to store a script to be executed when a specific
6379 * event fires on a specific channel.
6380 *
6381 * Results:
6382 * None.
6383 *
6384 * Side effects:
6385 * Causes the script to be stored for later execution.
6386 *
6387 *----------------------------------------------------------------------
6388 */
6389
6390 static void
CreateScriptRecord(interp,chanPtr,mask,scriptPtr)6391 CreateScriptRecord(interp, chanPtr, mask, scriptPtr)
6392 Tcl_Interp *interp; /* Interpreter in which to execute
6393 * the stored script. */
6394 Channel *chanPtr; /* Channel for which script is to
6395 * be stored. */
6396 int mask; /* Set of events for which script
6397 * will be invoked. */
6398 Tcl_Obj *scriptPtr; /* Pointer to script object. */
6399 {
6400 EventScriptRecord *esPtr;
6401
6402 for (esPtr = chanPtr->scriptRecordPtr;
6403 esPtr != (EventScriptRecord *) NULL;
6404 esPtr = esPtr->nextPtr) {
6405 if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
6406 Tcl_DecrRefCount(esPtr->scriptPtr);
6407 esPtr->scriptPtr = (Tcl_Obj *) NULL;
6408 break;
6409 }
6410 }
6411 if (esPtr == (EventScriptRecord *) NULL) {
6412 esPtr = (EventScriptRecord *) ckalloc((unsigned)
6413 sizeof(EventScriptRecord));
6414 Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
6415 ChannelEventScriptInvoker, (ClientData) esPtr);
6416 esPtr->nextPtr = chanPtr->scriptRecordPtr;
6417 chanPtr->scriptRecordPtr = esPtr;
6418 }
6419 esPtr->chanPtr = chanPtr;
6420 esPtr->interp = interp;
6421 esPtr->mask = mask;
6422 Tcl_IncrRefCount(scriptPtr);
6423 esPtr->scriptPtr = scriptPtr;
6424 }
6425
6426 /*
6427 *----------------------------------------------------------------------
6428 *
6429 * ChannelEventScriptInvoker --
6430 *
6431 * Invokes a script scheduled by "fileevent" for when the channel
6432 * becomes ready for IO. This function is invoked by the channel
6433 * handler which was created by the Tcl "fileevent" command.
6434 *
6435 * Results:
6436 * None.
6437 *
6438 * Side effects:
6439 * Whatever the script does.
6440 *
6441 *----------------------------------------------------------------------
6442 */
6443
6444 static void
ChannelEventScriptInvoker(clientData,mask)6445 ChannelEventScriptInvoker(clientData, mask)
6446 ClientData clientData; /* The script+interp record. */
6447 int mask; /* Not used. */
6448 {
6449 Tcl_Interp *interp; /* Interpreter in which to eval the script. */
6450 Channel *chanPtr; /* The channel for which this handler is
6451 * registered. */
6452 EventScriptRecord *esPtr; /* The event script + interpreter to eval it
6453 * in. */
6454 int result; /* Result of call to eval script. */
6455
6456 esPtr = (EventScriptRecord *) clientData;
6457
6458 chanPtr = esPtr->chanPtr;
6459 mask = esPtr->mask;
6460 interp = esPtr->interp;
6461
6462 /*
6463 * We must preserve the interpreter so we can report errors on it
6464 * later. Note that we do not need to preserve the channel because
6465 * that is done by Tcl_NotifyChannel before calling channel handlers.
6466 */
6467
6468 Tcl_Preserve((ClientData) interp);
6469 result = Tcl_EvalObj(interp, esPtr->scriptPtr, TCL_EVAL_GLOBAL);
6470
6471 /*
6472 * On error, cause a background error and remove the channel handler
6473 * and the script record.
6474 *
6475 * NOTE: Must delete channel handler before causing the background error
6476 * because the background error may want to reinstall the handler.
6477 */
6478
6479 if (result != TCL_OK) {
6480 if (chanPtr->typePtr != NULL) {
6481 DeleteScriptRecord(interp, chanPtr, mask);
6482 }
6483 Tcl_BackgroundError(interp);
6484 }
6485 Tcl_Release((ClientData) interp);
6486 }
6487
6488 /*
6489 *----------------------------------------------------------------------
6490 *
6491 * Tcl_FileEventObjCmd --
6492 *
6493 * This procedure implements the "fileevent" Tcl command. See the
6494 * user documentation for details on what it does. This command is
6495 * based on the Tk command "fileevent" which in turn is based on work
6496 * contributed by Mark Diekhans.
6497 *
6498 * Results:
6499 * A standard Tcl result.
6500 *
6501 * Side effects:
6502 * May create a channel handler for the specified channel.
6503 *
6504 *----------------------------------------------------------------------
6505 */
6506
6507 /* ARGSUSED */
6508 int
Tcl_FileEventObjCmd(clientData,interp,objc,objv)6509 Tcl_FileEventObjCmd(clientData, interp, objc, objv)
6510 ClientData clientData; /* Not used. */
6511 Tcl_Interp *interp; /* Interpreter in which the channel
6512 * for which to create the handler
6513 * is found. */
6514 int objc; /* Number of arguments. */
6515 Tcl_Obj *CONST objv[]; /* Argument objects. */
6516 {
6517 Channel *chanPtr; /* The channel to create
6518 * the handler for. */
6519 Tcl_Channel chan; /* The opaque type for the channel. */
6520 char *chanName;
6521 int modeIndex; /* Index of mode argument. */
6522 int mask;
6523 static char *modeOptions[] = {"readable", "writable", NULL};
6524 static int maskArray[] = {TCL_READABLE, TCL_WRITABLE};
6525
6526 if ((objc != 3) && (objc != 4)) {
6527 Tcl_WrongNumArgs(interp, 1, objv, "channelId event ?script?");
6528 return TCL_ERROR;
6529 }
6530 if (Tcl_GetIndexFromObj(interp, objv[2], modeOptions, "event name", 0,
6531 &modeIndex) != TCL_OK) {
6532 return TCL_ERROR;
6533 }
6534 mask = maskArray[modeIndex];
6535
6536 chanName = Tcl_GetString(objv[1]);
6537 chan = Tcl_GetChannel(interp, chanName, NULL);
6538 if (chan == (Tcl_Channel) NULL) {
6539 return TCL_ERROR;
6540 }
6541 chanPtr = (Channel *) chan;
6542 if ((chanPtr->flags & mask) == 0) {
6543 Tcl_AppendResult(interp, "channel is not ",
6544 (mask == TCL_READABLE) ? "readable" : "writable",
6545 (char *) NULL);
6546 return TCL_ERROR;
6547 }
6548
6549 /*
6550 * If we are supposed to return the script, do so.
6551 */
6552
6553 if (objc == 3) {
6554 EventScriptRecord *esPtr;
6555 for (esPtr = chanPtr->scriptRecordPtr;
6556 esPtr != (EventScriptRecord *) NULL;
6557 esPtr = esPtr->nextPtr) {
6558 if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
6559 Tcl_SetObjResult(interp, esPtr->scriptPtr);
6560 break;
6561 }
6562 }
6563 return TCL_OK;
6564 }
6565
6566 /*
6567 * If we are supposed to delete a stored script, do so.
6568 */
6569
6570 if (*(Tcl_GetString(objv[3])) == '\0') {
6571 DeleteScriptRecord(interp, chanPtr, mask);
6572 return TCL_OK;
6573 }
6574
6575 /*
6576 * Make the script record that will link between the event and the
6577 * script to invoke. This also creates a channel event handler which
6578 * will evaluate the script in the supplied interpreter.
6579 */
6580
6581 CreateScriptRecord(interp, chanPtr, mask, objv[3]);
6582
6583 return TCL_OK;
6584 }
6585
6586 /*
6587 *----------------------------------------------------------------------
6588 *
6589 * TclTestChannelCmd --
6590 *
6591 * Implements the Tcl "testchannel" debugging command and its
6592 * subcommands. This is part of the testing environment but must be
6593 * in this file instead of tclTest.c because it needs access to the
6594 * fields of struct Channel.
6595 *
6596 * Results:
6597 * A standard Tcl result.
6598 *
6599 * Side effects:
6600 * None.
6601 *
6602 *----------------------------------------------------------------------
6603 */
6604
6605 /* ARGSUSED */
6606 int
TclTestChannelCmd(clientData,interp,argc,argv)6607 TclTestChannelCmd(clientData, interp, argc, argv)
6608 ClientData clientData; /* Not used. */
6609 Tcl_Interp *interp; /* Interpreter for result. */
6610 int argc; /* Count of additional args. */
6611 char **argv; /* Additional arg strings. */
6612 {
6613 char *cmdName; /* Sub command. */
6614 Tcl_HashTable *hTblPtr; /* Hash table of channels. */
6615 Tcl_HashSearch hSearch; /* Search variable. */
6616 Tcl_HashEntry *hPtr; /* Search variable. */
6617 Channel *chanPtr; /* The actual channel. */
6618 Tcl_Channel chan; /* The opaque type. */
6619 size_t len; /* Length of subcommand string. */
6620 int IOQueued; /* How much IO is queued inside channel? */
6621 ChannelBuffer *bufPtr; /* For iterating over queued IO. */
6622 char buf[TCL_INTEGER_SPACE];/* For sprintf. */
6623
6624 if (argc < 2) {
6625 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
6626 " subcommand ?additional args..?\"", (char *) NULL);
6627 return TCL_ERROR;
6628 }
6629 cmdName = argv[1];
6630 len = strlen(cmdName);
6631
6632 chanPtr = (Channel *) NULL;
6633
6634 if (argc > 2) {
6635 chan = Tcl_GetChannel(interp, argv[2], NULL);
6636 if (chan == (Tcl_Channel) NULL) {
6637 return TCL_ERROR;
6638 }
6639 chanPtr = (Channel *) chan;
6640 }
6641
6642
6643 if ((cmdName[0] == 'i') && (strncmp(cmdName, "info", len) == 0)) {
6644 if (argc != 3) {
6645 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
6646 " info channelName\"", (char *) NULL);
6647 return TCL_ERROR;
6648 }
6649 Tcl_AppendElement(interp, argv[2]);
6650 Tcl_AppendElement(interp, chanPtr->typePtr->typeName);
6651 if (chanPtr->flags & TCL_READABLE) {
6652 Tcl_AppendElement(interp, "read");
6653 } else {
6654 Tcl_AppendElement(interp, "");
6655 }
6656 if (chanPtr->flags & TCL_WRITABLE) {
6657 Tcl_AppendElement(interp, "write");
6658 } else {
6659 Tcl_AppendElement(interp, "");
6660 }
6661 if (chanPtr->flags & CHANNEL_NONBLOCKING) {
6662 Tcl_AppendElement(interp, "nonblocking");
6663 } else {
6664 Tcl_AppendElement(interp, "blocking");
6665 }
6666 if (chanPtr->flags & CHANNEL_LINEBUFFERED) {
6667 Tcl_AppendElement(interp, "line");
6668 } else if (chanPtr->flags & CHANNEL_UNBUFFERED) {
6669 Tcl_AppendElement(interp, "none");
6670 } else {
6671 Tcl_AppendElement(interp, "full");
6672 }
6673 if (chanPtr->flags & BG_FLUSH_SCHEDULED) {
6674 Tcl_AppendElement(interp, "async_flush");
6675 } else {
6676 Tcl_AppendElement(interp, "");
6677 }
6678 if (chanPtr->flags & CHANNEL_EOF) {
6679 Tcl_AppendElement(interp, "eof");
6680 } else {
6681 Tcl_AppendElement(interp, "");
6682 }
6683 if (chanPtr->flags & CHANNEL_BLOCKED) {
6684 Tcl_AppendElement(interp, "blocked");
6685 } else {
6686 Tcl_AppendElement(interp, "unblocked");
6687 }
6688 if (chanPtr->inputTranslation == TCL_TRANSLATE_AUTO) {
6689 Tcl_AppendElement(interp, "auto");
6690 if (chanPtr->flags & INPUT_SAW_CR) {
6691 Tcl_AppendElement(interp, "saw_cr");
6692 } else {
6693 Tcl_AppendElement(interp, "");
6694 }
6695 } else if (chanPtr->inputTranslation == TCL_TRANSLATE_LF) {
6696 Tcl_AppendElement(interp, "lf");
6697 Tcl_AppendElement(interp, "");
6698 } else if (chanPtr->inputTranslation == TCL_TRANSLATE_CR) {
6699 Tcl_AppendElement(interp, "cr");
6700 Tcl_AppendElement(interp, "");
6701 } else if (chanPtr->inputTranslation == TCL_TRANSLATE_CRLF) {
6702 Tcl_AppendElement(interp, "crlf");
6703 if (chanPtr->flags & INPUT_SAW_CR) {
6704 Tcl_AppendElement(interp, "queued_cr");
6705 } else {
6706 Tcl_AppendElement(interp, "");
6707 }
6708 }
6709 if (chanPtr->outputTranslation == TCL_TRANSLATE_AUTO) {
6710 Tcl_AppendElement(interp, "auto");
6711 } else if (chanPtr->outputTranslation == TCL_TRANSLATE_LF) {
6712 Tcl_AppendElement(interp, "lf");
6713 } else if (chanPtr->outputTranslation == TCL_TRANSLATE_CR) {
6714 Tcl_AppendElement(interp, "cr");
6715 } else if (chanPtr->outputTranslation == TCL_TRANSLATE_CRLF) {
6716 Tcl_AppendElement(interp, "crlf");
6717 }
6718 for (IOQueued = 0, bufPtr = chanPtr->inQueueHead;
6719 bufPtr != (ChannelBuffer *) NULL;
6720 bufPtr = bufPtr->nextPtr) {
6721 IOQueued += bufPtr->nextAdded - bufPtr->nextRemoved;
6722 }
6723 TclFormatInt(buf, IOQueued);
6724 Tcl_AppendElement(interp, buf);
6725
6726 IOQueued = 0;
6727 if (chanPtr->curOutPtr != (ChannelBuffer *) NULL) {
6728 IOQueued = chanPtr->curOutPtr->nextAdded -
6729 chanPtr->curOutPtr->nextRemoved;
6730 }
6731 for (bufPtr = chanPtr->outQueueHead;
6732 bufPtr != (ChannelBuffer *) NULL;
6733 bufPtr = bufPtr->nextPtr) {
6734 IOQueued += (bufPtr->nextAdded - bufPtr->nextRemoved);
6735 }
6736 TclFormatInt(buf, IOQueued);
6737 Tcl_AppendElement(interp, buf);
6738
6739 TclFormatInt(buf, Tcl_Tell((Tcl_Channel) chanPtr));
6740 Tcl_AppendElement(interp, buf);
6741
6742 TclFormatInt(buf, chanPtr->refCount);
6743 Tcl_AppendElement(interp, buf);
6744
6745 return TCL_OK;
6746 }
6747
6748 if ((cmdName[0] == 'i') &&
6749 (strncmp(cmdName, "inputbuffered", len) == 0)) {
6750 if (argc != 3) {
6751 Tcl_AppendResult(interp, "channel name required",
6752 (char *) NULL);
6753 return TCL_ERROR;
6754 }
6755
6756 for (IOQueued = 0, bufPtr = chanPtr->inQueueHead;
6757 bufPtr != (ChannelBuffer *) NULL;
6758 bufPtr = bufPtr->nextPtr) {
6759 IOQueued += bufPtr->nextAdded - bufPtr->nextRemoved;
6760 }
6761 TclFormatInt(buf, IOQueued);
6762 Tcl_AppendResult(interp, buf, (char *) NULL);
6763 return TCL_OK;
6764 }
6765
6766 if ((cmdName[0] == 'm') && (strncmp(cmdName, "mode", len) == 0)) {
6767 if (argc != 3) {
6768 Tcl_AppendResult(interp, "channel name required",
6769 (char *) NULL);
6770 return TCL_ERROR;
6771 }
6772
6773 if (chanPtr->flags & TCL_READABLE) {
6774 Tcl_AppendElement(interp, "read");
6775 } else {
6776 Tcl_AppendElement(interp, "");
6777 }
6778 if (chanPtr->flags & TCL_WRITABLE) {
6779 Tcl_AppendElement(interp, "write");
6780 } else {
6781 Tcl_AppendElement(interp, "");
6782 }
6783 return TCL_OK;
6784 }
6785
6786 if ((cmdName[0] == 'n') && (strncmp(cmdName, "name", len) == 0)) {
6787 if (argc != 3) {
6788 Tcl_AppendResult(interp, "channel name required",
6789 (char *) NULL);
6790 return TCL_ERROR;
6791 }
6792 Tcl_AppendResult(interp, chanPtr->channelName, (char *) NULL);
6793 return TCL_OK;
6794 }
6795
6796 if ((cmdName[0] == 'o') && (strncmp(cmdName, "open", len) == 0)) {
6797 hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
6798 if (hTblPtr == (Tcl_HashTable *) NULL) {
6799 return TCL_OK;
6800 }
6801 for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
6802 hPtr != (Tcl_HashEntry *) NULL;
6803 hPtr = Tcl_NextHashEntry(&hSearch)) {
6804 Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
6805 }
6806 return TCL_OK;
6807 }
6808
6809 if ((cmdName[0] == 'o') &&
6810 (strncmp(cmdName, "outputbuffered", len) == 0)) {
6811 if (argc != 3) {
6812 Tcl_AppendResult(interp, "channel name required",
6813 (char *) NULL);
6814 return TCL_ERROR;
6815 }
6816
6817 IOQueued = 0;
6818 if (chanPtr->curOutPtr != (ChannelBuffer *) NULL) {
6819 IOQueued = chanPtr->curOutPtr->nextAdded -
6820 chanPtr->curOutPtr->nextRemoved;
6821 }
6822 for (bufPtr = chanPtr->outQueueHead;
6823 bufPtr != (ChannelBuffer *) NULL;
6824 bufPtr = bufPtr->nextPtr) {
6825 IOQueued += (bufPtr->nextAdded - bufPtr->nextRemoved);
6826 }
6827 TclFormatInt(buf, IOQueued);
6828 Tcl_AppendResult(interp, buf, (char *) NULL);
6829 return TCL_OK;
6830 }
6831
6832 if ((cmdName[0] == 'q') &&
6833 (strncmp(cmdName, "queuedcr", len) == 0)) {
6834 if (argc != 3) {
6835 Tcl_AppendResult(interp, "channel name required",
6836 (char *) NULL);
6837 return TCL_ERROR;
6838 }
6839
6840 Tcl_AppendResult(interp,
6841 (chanPtr->flags & INPUT_SAW_CR) ? "1" : "0",
6842 (char *) NULL);
6843 return TCL_OK;
6844 }
6845
6846 if ((cmdName[0] == 'r') && (strncmp(cmdName, "readable", len) == 0)) {
6847 hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
6848 if (hTblPtr == (Tcl_HashTable *) NULL) {
6849 return TCL_OK;
6850 }
6851 for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
6852 hPtr != (Tcl_HashEntry *) NULL;
6853 hPtr = Tcl_NextHashEntry(&hSearch)) {
6854 chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
6855 if (chanPtr->flags & TCL_READABLE) {
6856 Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
6857 }
6858 }
6859 return TCL_OK;
6860 }
6861
6862 if ((cmdName[0] == 'r') && (strncmp(cmdName, "refcount", len) == 0)) {
6863 if (argc != 3) {
6864 Tcl_AppendResult(interp, "channel name required",
6865 (char *) NULL);
6866 return TCL_ERROR;
6867 }
6868
6869 TclFormatInt(buf, chanPtr->refCount);
6870 Tcl_AppendResult(interp, buf, (char *) NULL);
6871 return TCL_OK;
6872 }
6873
6874 if ((cmdName[0] == 't') && (strncmp(cmdName, "type", len) == 0)) {
6875 if (argc != 3) {
6876 Tcl_AppendResult(interp, "channel name required",
6877 (char *) NULL);
6878 return TCL_ERROR;
6879 }
6880 Tcl_AppendResult(interp, chanPtr->typePtr->typeName, (char *) NULL);
6881 return TCL_OK;
6882 }
6883
6884 if ((cmdName[0] == 'w') && (strncmp(cmdName, "writable", len) == 0)) {
6885 hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
6886 if (hTblPtr == (Tcl_HashTable *) NULL) {
6887 return TCL_OK;
6888 }
6889 for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
6890 hPtr != (Tcl_HashEntry *) NULL;
6891 hPtr = Tcl_NextHashEntry(&hSearch)) {
6892 chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
6893 if (chanPtr->flags & TCL_WRITABLE) {
6894 Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
6895 }
6896 }
6897 return TCL_OK;
6898 }
6899
6900 Tcl_AppendResult(interp, "bad option \"", cmdName, "\": should be ",
6901 "info, open, readable, or writable",
6902 (char *) NULL);
6903 return TCL_ERROR;
6904 }
6905
6906 /*
6907 *----------------------------------------------------------------------
6908 *
6909 * TclTestChannelEventCmd --
6910 *
6911 * This procedure implements the "testchannelevent" command. It is
6912 * used to test the Tcl channel event mechanism. It is present in
6913 * this file instead of tclTest.c because it needs access to the
6914 * internal structure of the channel.
6915 *
6916 * Results:
6917 * A standard Tcl result.
6918 *
6919 * Side effects:
6920 * Creates, deletes and returns channel event handlers.
6921 *
6922 *----------------------------------------------------------------------
6923 */
6924
6925 /* ARGSUSED */
6926 int
TclTestChannelEventCmd(dummy,interp,argc,argv)6927 TclTestChannelEventCmd(dummy, interp, argc, argv)
6928 ClientData dummy; /* Not used. */
6929 Tcl_Interp *interp; /* Current interpreter. */
6930 int argc; /* Number of arguments. */
6931 char **argv; /* Argument strings. */
6932 {
6933 Tcl_Obj *resultListPtr;
6934 Channel *chanPtr;
6935 EventScriptRecord *esPtr, *prevEsPtr, *nextEsPtr;
6936 char *cmd;
6937 int index, i, mask, len;
6938
6939 if ((argc < 3) || (argc > 5)) {
6940 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
6941 " channelName cmd ?arg1? ?arg2?\"", (char *) NULL);
6942 return TCL_ERROR;
6943 }
6944 chanPtr = (Channel *) Tcl_GetChannel(interp, argv[1], NULL);
6945 if (chanPtr == (Channel *) NULL) {
6946 return TCL_ERROR;
6947 }
6948 cmd = argv[2];
6949 len = strlen(cmd);
6950 if ((cmd[0] == 'a') && (strncmp(cmd, "add", (unsigned) len) == 0)) {
6951 if (argc != 5) {
6952 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
6953 " channelName add eventSpec script\"", (char *) NULL);
6954 return TCL_ERROR;
6955 }
6956 if (strcmp(argv[3], "readable") == 0) {
6957 mask = TCL_READABLE;
6958 } else if (strcmp(argv[3], "writable") == 0) {
6959 mask = TCL_WRITABLE;
6960 } else if (strcmp(argv[3], "none") == 0) {
6961 mask = 0;
6962 } else {
6963 Tcl_AppendResult(interp, "bad event name \"", argv[3],
6964 "\": must be readable, writable, or none", (char *) NULL);
6965 return TCL_ERROR;
6966 }
6967
6968 esPtr = (EventScriptRecord *) ckalloc((unsigned)
6969 sizeof(EventScriptRecord));
6970 esPtr->nextPtr = chanPtr->scriptRecordPtr;
6971 chanPtr->scriptRecordPtr = esPtr;
6972
6973 esPtr->chanPtr = chanPtr;
6974 esPtr->interp = interp;
6975 esPtr->mask = mask;
6976 esPtr->scriptPtr = Tcl_NewStringObj(argv[4], -1);
6977 Tcl_IncrRefCount(esPtr->scriptPtr);
6978
6979 Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
6980 ChannelEventScriptInvoker, (ClientData) esPtr);
6981
6982 return TCL_OK;
6983 }
6984
6985 if ((cmd[0] == 'd') && (strncmp(cmd, "delete", (unsigned) len) == 0)) {
6986 if (argc != 4) {
6987 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
6988 " channelName delete index\"", (char *) NULL);
6989 return TCL_ERROR;
6990 }
6991 if (Tcl_GetInt(interp, argv[3], &index) == TCL_ERROR) {
6992 return TCL_ERROR;
6993 }
6994 if (index < 0) {
6995 Tcl_AppendResult(interp, "bad event index: ", argv[3],
6996 ": must be nonnegative", (char *) NULL);
6997 return TCL_ERROR;
6998 }
6999 for (i = 0, esPtr = chanPtr->scriptRecordPtr;
7000 (i < index) && (esPtr != (EventScriptRecord *) NULL);
7001 i++, esPtr = esPtr->nextPtr) {
7002 /* Empty loop body. */
7003 }
7004 if (esPtr == (EventScriptRecord *) NULL) {
7005 Tcl_AppendResult(interp, "bad event index ", argv[3],
7006 ": out of range", (char *) NULL);
7007 return TCL_ERROR;
7008 }
7009 if (esPtr == chanPtr->scriptRecordPtr) {
7010 chanPtr->scriptRecordPtr = esPtr->nextPtr;
7011 } else {
7012 for (prevEsPtr = chanPtr->scriptRecordPtr;
7013 (prevEsPtr != (EventScriptRecord *) NULL) &&
7014 (prevEsPtr->nextPtr != esPtr);
7015 prevEsPtr = prevEsPtr->nextPtr) {
7016 /* Empty loop body. */
7017 }
7018 if (prevEsPtr == (EventScriptRecord *) NULL) {
7019 panic("TclTestChannelEventCmd: damaged event script list");
7020 }
7021 prevEsPtr->nextPtr = esPtr->nextPtr;
7022 }
7023 Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
7024 ChannelEventScriptInvoker, (ClientData) esPtr);
7025 Tcl_DecrRefCount(esPtr->scriptPtr);
7026 ckfree((char *) esPtr);
7027
7028 return TCL_OK;
7029 }
7030
7031 if ((cmd[0] == 'l') && (strncmp(cmd, "list", (unsigned) len) == 0)) {
7032 if (argc != 3) {
7033 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
7034 " channelName list\"", (char *) NULL);
7035 return TCL_ERROR;
7036 }
7037 resultListPtr = Tcl_GetObjResult(interp);
7038 for (esPtr = chanPtr->scriptRecordPtr;
7039 esPtr != (EventScriptRecord *) NULL;
7040 esPtr = esPtr->nextPtr) {
7041 if (esPtr->mask) {
7042 Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj(
7043 (esPtr->mask == TCL_READABLE) ? "readable" : "writable", -1));
7044 } else {
7045 Tcl_ListObjAppendElement(interp, resultListPtr,
7046 Tcl_NewStringObj("none", -1));
7047 }
7048 Tcl_ListObjAppendElement(interp, resultListPtr, esPtr->scriptPtr);
7049 }
7050 Tcl_SetObjResult(interp, resultListPtr);
7051 return TCL_OK;
7052 }
7053
7054 if ((cmd[0] == 'r') && (strncmp(cmd, "removeall", (unsigned) len) == 0)) {
7055 if (argc != 3) {
7056 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
7057 " channelName removeall\"", (char *) NULL);
7058 return TCL_ERROR;
7059 }
7060 for (esPtr = chanPtr->scriptRecordPtr;
7061 esPtr != (EventScriptRecord *) NULL;
7062 esPtr = nextEsPtr) {
7063 nextEsPtr = esPtr->nextPtr;
7064 Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
7065 ChannelEventScriptInvoker, (ClientData) esPtr);
7066 Tcl_DecrRefCount(esPtr->scriptPtr);
7067 ckfree((char *) esPtr);
7068 }
7069 chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL;
7070 return TCL_OK;
7071 }
7072
7073 if ((cmd[0] == 's') && (strncmp(cmd, "set", (unsigned) len) == 0)) {
7074 if (argc != 5) {
7075 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
7076 " channelName delete index event\"", (char *) NULL);
7077 return TCL_ERROR;
7078 }
7079 if (Tcl_GetInt(interp, argv[3], &index) == TCL_ERROR) {
7080 return TCL_ERROR;
7081 }
7082 if (index < 0) {
7083 Tcl_AppendResult(interp, "bad event index: ", argv[3],
7084 ": must be nonnegative", (char *) NULL);
7085 return TCL_ERROR;
7086 }
7087 for (i = 0, esPtr = chanPtr->scriptRecordPtr;
7088 (i < index) && (esPtr != (EventScriptRecord *) NULL);
7089 i++, esPtr = esPtr->nextPtr) {
7090 /* Empty loop body. */
7091 }
7092 if (esPtr == (EventScriptRecord *) NULL) {
7093 Tcl_AppendResult(interp, "bad event index ", argv[3],
7094 ": out of range", (char *) NULL);
7095 return TCL_ERROR;
7096 }
7097
7098 if (strcmp(argv[4], "readable") == 0) {
7099 mask = TCL_READABLE;
7100 } else if (strcmp(argv[4], "writable") == 0) {
7101 mask = TCL_WRITABLE;
7102 } else if (strcmp(argv[4], "none") == 0) {
7103 mask = 0;
7104 } else {
7105 Tcl_AppendResult(interp, "bad event name \"", argv[4],
7106 "\": must be readable, writable, or none", (char *) NULL);
7107 return TCL_ERROR;
7108 }
7109 esPtr->mask = mask;
7110 Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
7111 ChannelEventScriptInvoker, (ClientData) esPtr);
7112 return TCL_OK;
7113 }
7114 Tcl_AppendResult(interp, "bad command ", cmd, ", must be one of ",
7115 "add, delete, list, set, or removeall", (char *) NULL);
7116 return TCL_ERROR;
7117 }
7118
7119 /*
7120 *----------------------------------------------------------------------
7121 *
7122 * TclCopyChannel --
7123 *
7124 * This routine copies data from one channel to another, either
7125 * synchronously or asynchronously. If a command script is
7126 * supplied, the operation runs in the background. The script
7127 * is invoked when the copy completes. Otherwise the function
7128 * waits until the copy is completed before returning.
7129 *
7130 * Results:
7131 * A standard Tcl result.
7132 *
7133 * Side effects:
7134 * May schedule a background copy operation that causes both
7135 * channels to be marked busy.
7136 *
7137 *----------------------------------------------------------------------
7138 */
7139
7140 int
TclCopyChannel(interp,inChan,outChan,toRead,cmdPtr)7141 TclCopyChannel(interp, inChan, outChan, toRead, cmdPtr)
7142 Tcl_Interp *interp; /* Current interpreter. */
7143 Tcl_Channel inChan; /* Channel to read from. */
7144 Tcl_Channel outChan; /* Channel to write to. */
7145 int toRead; /* Amount of data to copy, or -1 for all. */
7146 Tcl_Obj *cmdPtr; /* Pointer to script to execute or NULL. */
7147 {
7148 Channel *inPtr = (Channel *) inChan;
7149 Channel *outPtr = (Channel *) outChan;
7150 int readFlags, writeFlags;
7151 CopyState *csPtr;
7152 int nonBlocking = (cmdPtr) ? CHANNEL_NONBLOCKING : 0;
7153
7154 if (inPtr->csPtr) {
7155 Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"",
7156 Tcl_GetChannelName(inChan), "\" is busy", NULL);
7157 return TCL_ERROR;
7158 }
7159 if (outPtr->csPtr) {
7160 Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"",
7161 Tcl_GetChannelName(outChan), "\" is busy", NULL);
7162 return TCL_ERROR;
7163 }
7164
7165 readFlags = inPtr->flags;
7166 writeFlags = outPtr->flags;
7167
7168 /*
7169 * Set up the blocking mode appropriately. Background copies need
7170 * non-blocking channels. Foreground copies need blocking channels.
7171 * If there is an error, restore the old blocking mode.
7172 */
7173
7174 if (nonBlocking != (readFlags & CHANNEL_NONBLOCKING)) {
7175 if (SetBlockMode(interp, inPtr,
7176 nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING)
7177 != TCL_OK) {
7178 return TCL_ERROR;
7179 }
7180 }
7181 if (inPtr != outPtr) {
7182 if (nonBlocking != (writeFlags & CHANNEL_NONBLOCKING)) {
7183 if (SetBlockMode(NULL, outPtr,
7184 nonBlocking ? TCL_MODE_BLOCKING : TCL_MODE_NONBLOCKING)
7185 != TCL_OK) {
7186 if (nonBlocking != (readFlags & CHANNEL_NONBLOCKING)) {
7187 SetBlockMode(NULL, inPtr,
7188 (readFlags & CHANNEL_NONBLOCKING)
7189 ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING);
7190 return TCL_ERROR;
7191 }
7192 }
7193 }
7194 }
7195
7196 /*
7197 * Make sure the output side is unbuffered.
7198 */
7199
7200 outPtr->flags = (outPtr->flags & ~(CHANNEL_LINEBUFFERED))
7201 | CHANNEL_UNBUFFERED;
7202
7203 /*
7204 * Allocate a new CopyState to maintain info about the current copy in
7205 * progress. This structure will be deallocated when the copy is
7206 * completed.
7207 */
7208
7209 csPtr = (CopyState*) ckalloc(sizeof(CopyState) + inPtr->bufSize);
7210 csPtr->bufSize = inPtr->bufSize;
7211 csPtr->readPtr = inPtr;
7212 csPtr->writePtr = outPtr;
7213 csPtr->readFlags = readFlags;
7214 csPtr->writeFlags = writeFlags;
7215 csPtr->toRead = toRead;
7216 csPtr->total = 0;
7217 csPtr->interp = interp;
7218 if (cmdPtr) {
7219 Tcl_IncrRefCount(cmdPtr);
7220 }
7221 csPtr->cmdPtr = cmdPtr;
7222 inPtr->csPtr = csPtr;
7223 outPtr->csPtr = csPtr;
7224
7225 /*
7226 * Start copying data between the channels.
7227 */
7228
7229 return CopyData(csPtr, 0);
7230 }
7231
7232 /*
7233 *----------------------------------------------------------------------
7234 *
7235 * CopyData --
7236 *
7237 * This function implements the lowest level of the copying
7238 * mechanism for TclCopyChannel.
7239 *
7240 * Results:
7241 * Returns TCL_OK on success, else TCL_ERROR.
7242 *
7243 * Side effects:
7244 * Moves data between channels, may create channel handlers.
7245 *
7246 *----------------------------------------------------------------------
7247 */
7248
7249 static int
CopyData(csPtr,mask)7250 CopyData(csPtr, mask)
7251 CopyState *csPtr; /* State of copy operation. */
7252 int mask; /* Current channel event flags. */
7253 {
7254 Tcl_Interp *interp;
7255 Tcl_Obj *cmdPtr, *errObj = NULL;
7256 Tcl_Channel inChan, outChan;
7257 int result = TCL_OK;
7258 int size;
7259 int total;
7260
7261 inChan = (Tcl_Channel)csPtr->readPtr;
7262 outChan = (Tcl_Channel)csPtr->writePtr;
7263 interp = csPtr->interp;
7264 cmdPtr = csPtr->cmdPtr;
7265
7266 /*
7267 * Copy the data the slow way, using the translation mechanism.
7268 */
7269
7270 while (csPtr->toRead != 0) {
7271
7272 /*
7273 * Check for unreported background errors.
7274 */
7275
7276 if (csPtr->readPtr->unreportedError != 0) {
7277 Tcl_SetErrno(csPtr->readPtr->unreportedError);
7278 csPtr->readPtr->unreportedError = 0;
7279 goto readError;
7280 }
7281 if (csPtr->writePtr->unreportedError != 0) {
7282 Tcl_SetErrno(csPtr->writePtr->unreportedError);
7283 csPtr->writePtr->unreportedError = 0;
7284 goto writeError;
7285 }
7286
7287 /*
7288 * Read up to bufSize bytes.
7289 */
7290
7291 if ((csPtr->toRead == -1)
7292 || (csPtr->toRead > csPtr->bufSize)) {
7293 size = csPtr->bufSize;
7294 } else {
7295 size = csPtr->toRead;
7296 }
7297 size = DoRead(csPtr->readPtr, csPtr->buffer, size);
7298
7299 if (size < 0) {
7300 readError:
7301 errObj = Tcl_NewObj();
7302 Tcl_AppendStringsToObj(errObj, "error reading \"",
7303 Tcl_GetChannelName(inChan), "\": ",
7304 Tcl_PosixError(interp), (char *) NULL);
7305 break;
7306 } else if (size == 0) {
7307 /*
7308 * We had an underflow on the read side. If we are at EOF,
7309 * then the copying is done, otherwise set up a channel
7310 * handler to detect when the channel becomes readable again.
7311 */
7312
7313 if (Tcl_Eof(inChan)) {
7314 break;
7315 } else if (!(mask & TCL_READABLE)) {
7316 if (mask & TCL_WRITABLE) {
7317 Tcl_DeleteChannelHandler(outChan, CopyEventProc,
7318 (ClientData) csPtr);
7319 }
7320 Tcl_CreateChannelHandler(inChan, TCL_READABLE,
7321 CopyEventProc, (ClientData) csPtr);
7322 }
7323 return TCL_OK;
7324 }
7325
7326 /*
7327 * Now write the buffer out.
7328 */
7329
7330 size = DoWrite(csPtr->writePtr, csPtr->buffer, size);
7331 if (size < 0) {
7332 writeError:
7333 errObj = Tcl_NewObj();
7334 Tcl_AppendStringsToObj(errObj, "error writing \"",
7335 Tcl_GetChannelName(outChan), "\": ",
7336 Tcl_PosixError(interp), (char *) NULL);
7337 break;
7338 }
7339
7340 /*
7341 * Check to see if the write is happening in the background. If so,
7342 * stop copying and wait for the channel to become writable again.
7343 */
7344
7345 if (csPtr->writePtr->flags & BG_FLUSH_SCHEDULED) {
7346 if (!(mask & TCL_WRITABLE)) {
7347 if (mask & TCL_READABLE) {
7348 Tcl_DeleteChannelHandler(outChan, CopyEventProc,
7349 (ClientData) csPtr);
7350 }
7351 Tcl_CreateChannelHandler(outChan, TCL_WRITABLE,
7352 CopyEventProc, (ClientData) csPtr);
7353 }
7354 return TCL_OK;
7355 }
7356
7357 /*
7358 * Update the current byte count if we care.
7359 */
7360
7361 if (csPtr->toRead != -1) {
7362 csPtr->toRead -= size;
7363 }
7364 csPtr->total += size;
7365
7366 /*
7367 * For background copies, we only do one buffer per invocation so
7368 * we don't starve the rest of the system.
7369 */
7370
7371 if (cmdPtr) {
7372 /*
7373 * The first time we enter this code, there won't be a
7374 * channel handler established yet, so do it here.
7375 */
7376
7377 if (mask == 0) {
7378 Tcl_CreateChannelHandler(outChan, TCL_WRITABLE,
7379 CopyEventProc, (ClientData) csPtr);
7380 }
7381 return TCL_OK;
7382 }
7383 }
7384
7385 /*
7386 * Make the callback or return the number of bytes transferred.
7387 * The local total is used because StopCopy frees csPtr.
7388 */
7389
7390 total = csPtr->total;
7391 if (cmdPtr) {
7392 /*
7393 * Get a private copy of the command so we can mutate it
7394 * by adding arguments. Note that StopCopy frees our saved
7395 * reference to the original command obj.
7396 */
7397
7398 cmdPtr = Tcl_DuplicateObj(cmdPtr);
7399 Tcl_IncrRefCount(cmdPtr);
7400 StopCopy(csPtr);
7401 Tcl_Preserve((ClientData) interp);
7402
7403 Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewIntObj(total));
7404 if (errObj) {
7405 Tcl_ListObjAppendElement(interp, cmdPtr, errObj);
7406 }
7407 if (Tcl_EvalObj(interp, cmdPtr, TCL_EVAL_GLOBAL) != TCL_OK) {
7408 Tcl_BackgroundError(interp);
7409 result = TCL_ERROR;
7410 }
7411 Tcl_DecrRefCount(cmdPtr);
7412 Tcl_Release((ClientData) interp);
7413 } else {
7414 StopCopy(csPtr);
7415 if (errObj) {
7416 Tcl_SetObjResult(interp, errObj);
7417 result = TCL_ERROR;
7418 } else {
7419 Tcl_ResetResult(interp);
7420 Tcl_SetIntObj(Tcl_GetObjResult(interp), total);
7421 }
7422 }
7423 return result;
7424 }
7425
7426 /*
7427 *----------------------------------------------------------------------
7428 *
7429 * DoRead --
7430 *
7431 * Reads a given number of bytes from a channel.
7432 *
7433 * Results:
7434 * The number of characters read, or -1 on error. Use Tcl_GetErrno()
7435 * to retrieve the error code for the error that occurred.
7436 *
7437 * Side effects:
7438 * May cause input to be buffered.
7439 *
7440 *----------------------------------------------------------------------
7441 */
7442
7443 static int
DoRead(chanPtr,bufPtr,toRead)7444 DoRead(chanPtr, bufPtr, toRead)
7445 Channel *chanPtr; /* The channel from which to read. */
7446 char *bufPtr; /* Where to store input read. */
7447 int toRead; /* Maximum number of bytes to read. */
7448 {
7449 int copied; /* How many characters were copied into
7450 * the result string? */
7451 int copiedNow; /* How many characters were copied from
7452 * the current input buffer? */
7453 int result; /* Of calling GetInput. */
7454
7455 /*
7456 * If we have not encountered a sticky EOF, clear the EOF bit. Either
7457 * way clear the BLOCKED bit. We want to discover these anew during
7458 * each operation.
7459 */
7460
7461 if (!(chanPtr->flags & CHANNEL_STICKY_EOF)) {
7462 chanPtr->flags &= ~CHANNEL_EOF;
7463 }
7464 chanPtr->flags &= ~(CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA);
7465
7466 for (copied = 0; copied < toRead; copied += copiedNow) {
7467 copiedNow = CopyAndTranslateBuffer(chanPtr, bufPtr + copied,
7468 toRead - copied);
7469 if (copiedNow == 0) {
7470 if (chanPtr->flags & CHANNEL_EOF) {
7471 goto done;
7472 }
7473 if (chanPtr->flags & CHANNEL_BLOCKED) {
7474 if (chanPtr->flags & CHANNEL_NONBLOCKING) {
7475 goto done;
7476 }
7477 chanPtr->flags &= (~(CHANNEL_BLOCKED));
7478 }
7479 result = GetInput(chanPtr);
7480 if (result != 0) {
7481 if (result != EAGAIN) {
7482 copied = -1;
7483 }
7484 goto done;
7485 }
7486 }
7487 }
7488
7489 chanPtr->flags &= (~(CHANNEL_BLOCKED));
7490
7491 done:
7492 /*
7493 * Update the notifier state so we don't block while there is still
7494 * data in the buffers.
7495 */
7496
7497 UpdateInterest(chanPtr);
7498 return copied;
7499 }
7500
7501 /*
7502 *----------------------------------------------------------------------
7503 *
7504 * CopyAndTranslateBuffer --
7505 *
7506 * Copy at most one buffer of input to the result space, doing
7507 * eol translations according to mode in effect currently.
7508 *
7509 * Results:
7510 * Number of bytes stored in the result buffer (as opposed to the
7511 * number of bytes read from the channel). May return
7512 * zero if no input is available to be translated.
7513 *
7514 * Side effects:
7515 * Consumes buffered input. May deallocate one buffer.
7516 *
7517 *----------------------------------------------------------------------
7518 */
7519
7520 static int
CopyAndTranslateBuffer(chanPtr,result,space)7521 CopyAndTranslateBuffer(chanPtr, result, space)
7522 Channel *chanPtr; /* The channel from which to read input. */
7523 char *result; /* Where to store the copied input. */
7524 int space; /* How many bytes are available in result
7525 * to store the copied input? */
7526 {
7527 int bytesInBuffer; /* How many bytes are available to be
7528 * copied in the current input buffer? */
7529 int copied; /* How many characters were already copied
7530 * into the destination space? */
7531 ChannelBuffer *bufPtr; /* The buffer from which to copy bytes. */
7532 int i; /* Iterates over the copied input looking
7533 * for the input eofChar. */
7534
7535 /*
7536 * If there is no input at all, return zero. The invariant is that either
7537 * there is no buffer in the queue, or if the first buffer is empty, it
7538 * is also the last buffer (and thus there is no input in the queue).
7539 * Note also that if the buffer is empty, we leave it in the queue.
7540 */
7541
7542 if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
7543 return 0;
7544 }
7545 bufPtr = chanPtr->inQueueHead;
7546 bytesInBuffer = bufPtr->nextAdded - bufPtr->nextRemoved;
7547
7548 copied = 0;
7549 switch (chanPtr->inputTranslation) {
7550 case TCL_TRANSLATE_LF: {
7551 if (bytesInBuffer == 0) {
7552 return 0;
7553 }
7554
7555 /*
7556 * Copy the current chunk into the result buffer.
7557 */
7558
7559 if (bytesInBuffer < space) {
7560 space = bytesInBuffer;
7561 }
7562 memcpy((VOID *) result,
7563 (VOID *) (bufPtr->buf + bufPtr->nextRemoved),
7564 (size_t) space);
7565 bufPtr->nextRemoved += space;
7566 copied = space;
7567 break;
7568 }
7569 case TCL_TRANSLATE_CR: {
7570 char *end;
7571
7572 if (bytesInBuffer == 0) {
7573 return 0;
7574 }
7575
7576 /*
7577 * Copy the current chunk into the result buffer, then
7578 * replace all \r with \n.
7579 */
7580
7581 if (bytesInBuffer < space) {
7582 space = bytesInBuffer;
7583 }
7584 memcpy((VOID *) result,
7585 (VOID *) (bufPtr->buf + bufPtr->nextRemoved),
7586 (size_t) space);
7587 bufPtr->nextRemoved += space;
7588 copied = space;
7589
7590 for (end = result + copied; result < end; result++) {
7591 if (*result == '\r') {
7592 *result = '\n';
7593 }
7594 }
7595 break;
7596 }
7597 case TCL_TRANSLATE_CRLF: {
7598 char *src, *end, *dst;
7599 int curByte;
7600
7601 /*
7602 * If there is a held-back "\r" at EOF, produce it now.
7603 */
7604
7605 if (bytesInBuffer == 0) {
7606 if ((chanPtr->flags & (INPUT_SAW_CR | CHANNEL_EOF)) ==
7607 (INPUT_SAW_CR | CHANNEL_EOF)) {
7608 result[0] = '\r';
7609 chanPtr->flags &= ~INPUT_SAW_CR;
7610 return 1;
7611 }
7612 return 0;
7613 }
7614
7615 /*
7616 * Copy the current chunk and replace "\r\n" with "\n"
7617 * (but not standalone "\r"!).
7618 */
7619
7620 if (bytesInBuffer < space) {
7621 space = bytesInBuffer;
7622 }
7623 memcpy((VOID *) result,
7624 (VOID *) (bufPtr->buf + bufPtr->nextRemoved),
7625 (size_t) space);
7626 bufPtr->nextRemoved += space;
7627 copied = space;
7628
7629 end = result + copied;
7630 dst = result;
7631 for (src = result; src < end; src++) {
7632 curByte = *src;
7633 if (curByte == '\n') {
7634 chanPtr->flags &= ~INPUT_SAW_CR;
7635 } else if (chanPtr->flags & INPUT_SAW_CR) {
7636 chanPtr->flags &= ~INPUT_SAW_CR;
7637 *dst = '\r';
7638 dst++;
7639 }
7640 if (curByte == '\r') {
7641 chanPtr->flags |= INPUT_SAW_CR;
7642 } else {
7643 *dst = (char) curByte;
7644 dst++;
7645 }
7646 }
7647 copied = dst - result;
7648 break;
7649 }
7650 case TCL_TRANSLATE_AUTO: {
7651 char *src, *end, *dst;
7652 int curByte;
7653
7654 if (bytesInBuffer == 0) {
7655 return 0;
7656 }
7657
7658 /*
7659 * Loop over the current buffer, converting "\r" and "\r\n"
7660 * to "\n".
7661 */
7662
7663 if (bytesInBuffer < space) {
7664 space = bytesInBuffer;
7665 }
7666 memcpy((VOID *) result,
7667 (VOID *) (bufPtr->buf + bufPtr->nextRemoved),
7668 (size_t) space);
7669 bufPtr->nextRemoved += space;
7670 copied = space;
7671
7672 end = result + copied;
7673 dst = result;
7674 for (src = result; src < end; src++) {
7675 curByte = *src;
7676 if (curByte == '\r') {
7677 chanPtr->flags |= INPUT_SAW_CR;
7678 *dst = '\n';
7679 dst++;
7680 } else {
7681 if ((curByte != '\n') ||
7682 !(chanPtr->flags & INPUT_SAW_CR)) {
7683 *dst = (char) curByte;
7684 dst++;
7685 }
7686 chanPtr->flags &= ~INPUT_SAW_CR;
7687 }
7688 }
7689 copied = dst - result;
7690 break;
7691 }
7692 default: {
7693 panic("unknown eol translation mode");
7694 }
7695 }
7696
7697 /*
7698 * If an in-stream EOF character is set for this channel, check that
7699 * the input we copied so far does not contain the EOF char. If it does,
7700 * copy only up to and excluding that character.
7701 */
7702
7703 if (chanPtr->inEofChar != 0) {
7704 for (i = 0; i < copied; i++) {
7705 if (result[i] == (char) chanPtr->inEofChar) {
7706 /*
7707 * Set sticky EOF so that no further input is presented
7708 * to the caller.
7709 */
7710
7711 chanPtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
7712 chanPtr->inputEncodingFlags |= TCL_ENCODING_END;
7713 copied = i;
7714 break;
7715 }
7716 }
7717 }
7718
7719 /*
7720 * If the current buffer is empty recycle it.
7721 */
7722
7723 if (bufPtr->nextRemoved == bufPtr->nextAdded) {
7724 chanPtr->inQueueHead = bufPtr->nextPtr;
7725 if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
7726 chanPtr->inQueueTail = (ChannelBuffer *) NULL;
7727 }
7728 RecycleBuffer(chanPtr, bufPtr, 0);
7729 }
7730
7731 /*
7732 * Return the number of characters copied into the result buffer.
7733 * This may be different from the number of bytes consumed, because
7734 * of EOL translations.
7735 */
7736
7737 return copied;
7738 }
7739
7740 /*
7741 *----------------------------------------------------------------------
7742 *
7743 * DoWrite --
7744 *
7745 * Puts a sequence of characters into an output buffer, may queue the
7746 * buffer for output if it gets full, and also remembers whether the
7747 * current buffer is ready e.g. if it contains a newline and we are in
7748 * line buffering mode.
7749 *
7750 * Results:
7751 * The number of bytes written or -1 in case of error. If -1,
7752 * Tcl_GetErrno will return the error code.
7753 *
7754 * Side effects:
7755 * May buffer up output and may cause output to be produced on the
7756 * channel.
7757 *
7758 *----------------------------------------------------------------------
7759 */
7760
7761 static int
DoWrite(chanPtr,src,srcLen)7762 DoWrite(chanPtr, src, srcLen)
7763 Channel *chanPtr; /* The channel to buffer output for. */
7764 char *src; /* Data to write. */
7765 int srcLen; /* Number of bytes to write. */
7766 {
7767 ChannelBuffer *outBufPtr; /* Current output buffer. */
7768 int foundNewline; /* Did we find a newline in output? */
7769 char *dPtr;
7770 char *sPtr; /* Search variables for newline. */
7771 int crsent; /* In CRLF eol translation mode,
7772 * remember the fact that a CR was
7773 * output to the channel without
7774 * its following NL. */
7775 int i; /* Loop index for newline search. */
7776 int destCopied; /* How many bytes were used in this
7777 * destination buffer to hold the
7778 * output? */
7779 int totalDestCopied; /* How many bytes total were
7780 * copied to the channel buffer? */
7781 int srcCopied; /* How many bytes were copied from
7782 * the source string? */
7783 char *destPtr; /* Where in line to copy to? */
7784
7785 /*
7786 * If we are in network (or windows) translation mode, record the fact
7787 * that we have not yet sent a CR to the channel.
7788 */
7789
7790 crsent = 0;
7791
7792 /*
7793 * Loop filling buffers and flushing them until all output has been
7794 * consumed.
7795 */
7796
7797 srcCopied = 0;
7798 totalDestCopied = 0;
7799
7800 while (srcLen > 0) {
7801
7802 /*
7803 * Make sure there is a current output buffer to accept output.
7804 */
7805
7806 if (chanPtr->curOutPtr == (ChannelBuffer *) NULL) {
7807 chanPtr->curOutPtr = AllocChannelBuffer(chanPtr->bufSize);
7808 }
7809
7810 outBufPtr = chanPtr->curOutPtr;
7811
7812 destCopied = outBufPtr->bufLength - outBufPtr->nextAdded;
7813 if (destCopied > srcLen) {
7814 destCopied = srcLen;
7815 }
7816
7817 destPtr = outBufPtr->buf + outBufPtr->nextAdded;
7818 switch (chanPtr->outputTranslation) {
7819 case TCL_TRANSLATE_LF:
7820 srcCopied = destCopied;
7821 memcpy((VOID *) destPtr, (VOID *) src, (size_t) destCopied);
7822 break;
7823 case TCL_TRANSLATE_CR:
7824 srcCopied = destCopied;
7825 memcpy((VOID *) destPtr, (VOID *) src, (size_t) destCopied);
7826 for (dPtr = destPtr; dPtr < destPtr + destCopied; dPtr++) {
7827 if (*dPtr == '\n') {
7828 *dPtr = '\r';
7829 }
7830 }
7831 break;
7832 case TCL_TRANSLATE_CRLF:
7833 for (srcCopied = 0, dPtr = destPtr, sPtr = src;
7834 dPtr < destPtr + destCopied;
7835 dPtr++, sPtr++, srcCopied++) {
7836 if (*sPtr == '\n') {
7837 if (crsent) {
7838 *dPtr = '\n';
7839 crsent = 0;
7840 } else {
7841 *dPtr = '\r';
7842 crsent = 1;
7843 sPtr--, srcCopied--;
7844 }
7845 } else {
7846 *dPtr = *sPtr;
7847 }
7848 }
7849 break;
7850 case TCL_TRANSLATE_AUTO:
7851 panic("Tcl_Write: AUTO output translation mode not supported");
7852 default:
7853 panic("Tcl_Write: unknown output translation mode");
7854 }
7855
7856 /*
7857 * The current buffer is ready for output if it is full, or if it
7858 * contains a newline and this channel is line-buffered, or if it
7859 * contains any output and this channel is unbuffered.
7860 */
7861
7862 outBufPtr->nextAdded += destCopied;
7863 if (!(chanPtr->flags & BUFFER_READY)) {
7864 if (outBufPtr->nextAdded == outBufPtr->bufLength) {
7865 chanPtr->flags |= BUFFER_READY;
7866 } else if (chanPtr->flags & CHANNEL_LINEBUFFERED) {
7867 for (sPtr = src, i = 0, foundNewline = 0;
7868 (i < srcCopied) && (!foundNewline);
7869 i++, sPtr++) {
7870 if (*sPtr == '\n') {
7871 foundNewline = 1;
7872 break;
7873 }
7874 }
7875 if (foundNewline) {
7876 chanPtr->flags |= BUFFER_READY;
7877 }
7878 } else if (chanPtr->flags & CHANNEL_UNBUFFERED) {
7879 chanPtr->flags |= BUFFER_READY;
7880 }
7881 }
7882
7883 totalDestCopied += srcCopied;
7884 src += srcCopied;
7885 srcLen -= srcCopied;
7886
7887 if (chanPtr->flags & BUFFER_READY) {
7888 if (FlushChannel(NULL, chanPtr, 0) != 0) {
7889 return -1;
7890 }
7891 }
7892 } /* Closes "while" */
7893
7894 return totalDestCopied;
7895 }
7896
7897 /*
7898 *----------------------------------------------------------------------
7899 *
7900 * CopyEventProc --
7901 *
7902 * This routine is invoked as a channel event handler for
7903 * the background copy operation. It is just a trivial wrapper
7904 * around the CopyData routine.
7905 *
7906 * Results:
7907 * None.
7908 *
7909 * Side effects:
7910 * None.
7911 *
7912 *----------------------------------------------------------------------
7913 */
7914
7915 static void
CopyEventProc(clientData,mask)7916 CopyEventProc(clientData, mask)
7917 ClientData clientData;
7918 int mask;
7919 {
7920 (void) CopyData((CopyState *)clientData, mask);
7921 }
7922
7923 /*
7924 *----------------------------------------------------------------------
7925 *
7926 * StopCopy --
7927 *
7928 * This routine halts a copy that is in progress.
7929 *
7930 * Results:
7931 * None.
7932 *
7933 * Side effects:
7934 * Removes any pending channel handlers and restores the blocking
7935 * and buffering modes of the channels. The CopyState is freed.
7936 *
7937 *----------------------------------------------------------------------
7938 */
7939
7940 static void
StopCopy(csPtr)7941 StopCopy(csPtr)
7942 CopyState *csPtr; /* State for bg copy to stop . */
7943 {
7944 int nonBlocking;
7945
7946 if (!csPtr) {
7947 return;
7948 }
7949
7950 /*
7951 * Restore the old blocking mode and output buffering mode.
7952 */
7953
7954 nonBlocking = (csPtr->readFlags & CHANNEL_NONBLOCKING);
7955 if (nonBlocking != (csPtr->readPtr->flags & CHANNEL_NONBLOCKING)) {
7956 SetBlockMode(NULL, csPtr->readPtr,
7957 nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING);
7958 }
7959 if (csPtr->writePtr != csPtr->writePtr) {
7960 if (nonBlocking != (csPtr->writePtr->flags & CHANNEL_NONBLOCKING)) {
7961 SetBlockMode(NULL, csPtr->writePtr,
7962 nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING);
7963 }
7964 }
7965 csPtr->writePtr->flags &= ~(CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED);
7966 csPtr->writePtr->flags |=
7967 csPtr->writeFlags & (CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED);
7968
7969
7970 if (csPtr->cmdPtr) {
7971 Tcl_DeleteChannelHandler((Tcl_Channel)csPtr->readPtr, CopyEventProc,
7972 (ClientData)csPtr);
7973 if (csPtr->readPtr != csPtr->writePtr) {
7974 Tcl_DeleteChannelHandler((Tcl_Channel)csPtr->writePtr,
7975 CopyEventProc, (ClientData)csPtr);
7976 }
7977 Tcl_DecrRefCount(csPtr->cmdPtr);
7978 }
7979 csPtr->readPtr->csPtr = NULL;
7980 csPtr->writePtr->csPtr = NULL;
7981 ckfree((char*) csPtr);
7982 }
7983
7984 /*
7985 *----------------------------------------------------------------------
7986 *
7987 * SetBlockMode --
7988 *
7989 * This function sets the blocking mode for a channel and updates
7990 * the state flags.
7991 *
7992 * Results:
7993 * A standard Tcl result.
7994 *
7995 * Side effects:
7996 * Modifies the blocking mode of the channel and possibly generates
7997 * an error.
7998 *
7999 *----------------------------------------------------------------------
8000 */
8001
8002 static int
SetBlockMode(interp,chanPtr,mode)8003 SetBlockMode(interp, chanPtr, mode)
8004 Tcl_Interp *interp; /* Interp for error reporting. */
8005 Channel *chanPtr; /* Channel to modify. */
8006 int mode; /* One of TCL_MODE_BLOCKING or
8007 * TCL_MODE_NONBLOCKING. */
8008 {
8009 int result = 0;
8010 if (chanPtr->typePtr->blockModeProc != NULL) {
8011 result = (chanPtr->typePtr->blockModeProc) (chanPtr->instanceData,
8012 mode);
8013 }
8014 if (result != 0) {
8015 Tcl_SetErrno(result);
8016 if (interp != (Tcl_Interp *) NULL) {
8017 Tcl_AppendResult(interp, "error setting blocking mode: ",
8018 Tcl_PosixError(interp), (char *) NULL);
8019 }
8020 return TCL_ERROR;
8021 }
8022 if (mode == TCL_MODE_BLOCKING) {
8023 chanPtr->flags &= (~(CHANNEL_NONBLOCKING | BG_FLUSH_SCHEDULED));
8024 } else {
8025 chanPtr->flags |= CHANNEL_NONBLOCKING;
8026 }
8027 return TCL_OK;
8028 }
8029