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