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