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