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