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