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