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