/[dtapublic]/to_be_filed/sf_code/esrgpcpj/shared/tcl_base/tclio.c
ViewVC logotype

Contents of /to_be_filed/sf_code/esrgpcpj/shared/tcl_base/tclio.c

Parent Directory Parent Directory | Revision Log Revision Log


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

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25