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