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