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