Tcl Source Code

    int writeFlags;		/* Original write channel flags. */
    Tcl_WideInt toRead;		/* Number of bytes to copy, or -1. */
    Tcl_WideInt total;		/* Total bytes transferred (written). */
    Tcl_Interp *interp;		/* Interp that started the copy. */
    Tcl_Obj *cmdPtr;		/* Command to be invoked at completion. */
    Tcl_Size bufSize;		/* Size of appended buffer. */
    char buffer[TCLFLEXARRAY];	/* Copy buffer, this must be the last
                                 * field. */
} CopyState;

/*
 * All static variables used in this file are collected into a single instance
 * of the following structure. For multi-threaded implementations, there is
 * one instance of this structure for each thread.
 *

			    const char *src, int *dstLenPtr, int *srcLenPtr);
static void		UpdateInterest(Channel *chanPtr);
static Tcl_Size		Write(Channel *chanPtr, const char *src,
			    Tcl_Size srcLen, Tcl_Encoding encoding);
static Tcl_Obj *	FixLevelCode(Tcl_Obj *msg);
static void		SpliceChannel(Tcl_Channel chan);
static void		CutChannel(Tcl_Channel chan);
static int              WillRead(Channel *chanPtr);

#define WriteChars(chanPtr, src, srcLen) \
			Write(chanPtr, src, srcLen, chanPtr->state->encoding)
#define WriteBytes(chanPtr, src, srcLen) \
			Write(chanPtr, src, srcLen, tclIdentityEncoding)

/*

    /*
     * Each read op must set the blocked and eof states anew, not let
     * the effect of prior reads leak through.
     */

    if (GotFlag(chanPtr->state, CHANNEL_EOF)) {
        chanPtr->state->inputEncodingFlags |= TCL_ENCODING_START;
    }
    ResetFlag(chanPtr->state, CHANNEL_BLOCKED | CHANNEL_EOF);
    chanPtr->state->inputEncodingFlags &= ~TCL_ENCODING_END;
    if (WillRead(chanPtr) == -1) {
        return -1;
    }

    bytesRead = chanPtr->typePtr->inputProc(chanPtr->instanceData,
	    dst, dstSize, &result);

    /*
     * Stop any flag leakage through stacked channel levels.
     */

    if (GotFlag(chanPtr->state, CHANNEL_EOF)) {
        chanPtr->state->inputEncodingFlags |= TCL_ENCODING_START;
    }
    ResetFlag(chanPtr->state, CHANNEL_BLOCKED | CHANNEL_EOF);
    chanPtr->state->inputEncodingFlags &= ~TCL_ENCODING_END;
    if (bytesRead == -1) {
	if ((result == EWOULDBLOCK) || (result == EAGAIN)) {
	    SetFlag(chanPtr->state, CHANNEL_BLOCKED);
	    result = EAGAIN;

    int doflushnb;

    /*
     * Fetch the pre-TIP#398 compatibility flag.
     */

    {
        const char *s;
        Tcl_DString ds;

        s = TclGetEnv("TCL_FLUSH_NONBLOCKING_ON_EXIT", &ds);
        doflushnb = ((s != NULL) && strcmp(s, "0"));
        if (s != NULL) {
            Tcl_DStringFree(&ds);
        }
    }

    /*
     * Walk all channel state structures known to this thread and close
     * corresponding channels.
     */

    while (active) {
	/*
	 * Iterate through the open channel list, and find the first channel
	 * that isn't dead. We start from the head of the list each time,
	 * because the close action on one channel can close others.
	 */

	active = 0;
	for (statePtr = tsdPtr->firstCSPtr;
		statePtr != NULL;
		statePtr = statePtr->nextCSPtr) {
	    chanPtr = statePtr->topChanPtr;
            if (GotFlag(statePtr, CHANNEL_DEAD)) {
                continue;
            }
	    if (!GotFlag(statePtr, CHANNEL_INCLOSE | CHANNEL_CLOSED )
		    || GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
                ResetFlag(statePtr, BG_FLUSH_SCHEDULED);
		active = 1;
		break;
	    }
	}

	/*
	 * We've found a live (or bg-closing) channel. Close it.
	 */

	if (active) {
	    TclChannelPreserve((Tcl_Channel)chanPtr);

	    /*
	     * TIP #398: by default, we no longer set the channel back into
             * blocking mode.  To restore the old blocking behavior, the
             * environment variable TCL_FLUSH_NONBLOCKING_ON_EXIT must be set
             * and not be "0".
	     */

            if (doflushnb) {
                /*
                 * Set the channel back into blocking mode to ensure that we
                 * wait for all data to flush out.
                 */

                (void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr,
                        "-blocking", "on");
            }

	    if ((chanPtr == (Channel *) tsdPtr->stdinChannel) ||
		    (chanPtr == (Channel *) tsdPtr->stdoutChannel) ||
		    (chanPtr == (Channel *) tsdPtr->stderrChannel)) {
		/*
		 * Decrement the refcount which was earlier artificially
		 * bumped up to keep the channel from being closed.

    ChannelState *statePtr;	/* State of the real channel. */

    statePtr = ((Channel *) chan)->state->bottomChanPtr->state;

    if (GotFlag(statePtr, CHANNEL_INCLOSE)) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
                    "illegal recursive call to close through close-handler"
                    " of channel", -1));
	}
	return TCL_ERROR;
    }

    if (DetachChannel(interp, chan) != TCL_OK) {
	return TCL_OK;
    }

	}
    }

    hTblPtr = GetChannelTable(interp);
    hPtr = Tcl_FindHashEntry(hTblPtr, name);
    if (hPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "can not find channel named \"%s\"", chanName));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CHANNEL", chanName, (char *)NULL);
	return NULL;
    }

    /*
     * Always return bottom-most channel in the stack. This one lives the
     * longest - other channels may go away unnoticed. The other APIs

     * information for the channel.
     */

    if (chanName != NULL) {
	unsigned len = strlen(chanName) + 1;

	/*
         * Make sure we allocate at least 7 bytes, so it fits for "stdout"
         * later.
         */

	tmp = (char *)Tcl_Alloc((len < 7) ? 7 : len);
	strcpy(tmp, chanName);
    } else {
	tmp = (char *)Tcl_Alloc(7);
	tmp[0] = '\0';
    }

    while ((statePtr != NULL) && (statePtr->topChanPtr != prevChanPtr)) {
	statePtr = statePtr->nextCSPtr;
    }

    if (statePtr == NULL) {
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                    "couldn't find state for channel \"%s\"",
		    Tcl_GetChannelName(prevChan)));
	}
	return NULL;
    }

    /*
     * Here we check if the given "mask" matches the "flags" of the already

	 * the stacking state of this channel during its operations.
	 */
	if (Tcl_Flush((Tcl_Channel) prevChanPtr) != TCL_OK) {
	    statePtr->csPtrR = csPtrR;
	    statePtr->csPtrW = csPtrW;
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                        "could not flush channel \"%s\"",
			Tcl_GetChannelName(prevChan)));
	    }
	    return NULL;
	}

	statePtr->csPtrR = csPtrR;
	statePtr->csPtrW = csPtrW;

		 * bypass area into the regular interpreter result. Fall back
		 * to the regular message if nothing was found in the
		 * bypasses.
		 */

		if (!TclChanCaughtErrorBypass(interp, chan) && interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                            "could not flush channel \"%s\"",
			    Tcl_GetChannelName((Tcl_Channel) chanPtr)));
		}
		return TCL_ERROR;
	    }

	    statePtr->csPtrR  = csPtrR;
	    statePtr->csPtrW = csPtrW;

{
    Channel *chanPtr;		/* The actual channel. */
    void *handle;
    int result;

    chanPtr = ((Channel *) chan)->state->bottomChanPtr;
    if (!chanPtr->typePtr->getHandleProc) {
        Tcl_SetChannelError(chan, Tcl_ObjPrintf(
                "channel \"%s\" does not support OS handles",
                Tcl_GetChannelName(chan)));
	return TCL_ERROR;
    }
    result = chanPtr->typePtr->getHandleProc(chanPtr->instanceData, direction,
	    &handle);
    if (handlePtr) {
	*handlePtr = handle;
    }

 *	May leave an error message in the interp.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_RemoveChannelMode(
     Tcl_Interp *interp,        /* The interp for an error message. Allowed to be NULL. */
     Tcl_Channel chan,		/* The channel which is modified. */
     int mode)			/* The access mode to drop from the channel */
{
    const char* emsg;
    ChannelState *statePtr = ((Channel *) chan)->state;
				/* State of actual channel. */

    if ((mode != TCL_READABLE) && (mode != TCL_WRITABLE)) {
        emsg = "Illegal mode value.";
	goto error;
    }
    if (0 == (GotFlag(statePtr, TCL_READABLE|TCL_WRITABLE) & ~mode)) {
        emsg = "Bad mode, would make channel inacessible";
	goto error;
    }

    ResetFlag(statePtr, mode);
    return TCL_OK;

 error:

    if (!GotFlag(statePtr, CHANNEL_DEAD)) {
	return 0;
    }

    Tcl_SetErrno(EINVAL);
    if (interp) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
                "unable to access channel: invalid channel", -1));
    }
    return 1;
}

/*
 *----------------------------------------------------------------------
 *

     */

    if (GotFlag(statePtr, CHANNEL_CLOSEDWRITE) &&
	    (statePtr->outQueueHead == NULL) &&
	    ((statePtr->curOutPtr == NULL) ||
	    IsBufferEmpty(statePtr->curOutPtr))) {
	errorCode = CloseChannelPart(interp, chanPtr, errorCode,
                TCL_CLOSE_WRITE);
	goto done;
    }

  done:
    TclChannelRelease((Tcl_Channel)chanPtr);
    return errorCode;
}

    if (statePtr->refCount > 0) {
	Tcl_Panic("called Tcl_Close on channel with refCount > 0");
    }

    if (GotFlag(statePtr, CHANNEL_INCLOSE)) {
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
                    "illegal recursive call to close through close-handler"
                    " of channel", -1));
	}
	return TCL_ERROR;
    }
    SetFlag(statePtr, CHANNEL_INCLOSE);

    /*
     * When the channel has an escape sequence driven encoding such as

	if (flags & TCL_CLOSE_READ) {
	    msg = "read";
	} else {
	    msg = "write";
	}
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "Half-close of %s-side not possible, side not opened or"
                " already closed", msg));
	return TCL_ERROR;
    }

    /*
     * A user may try to call half-close from within a channel close handler.
     * That won't do.
     */

    if (GotFlag(statePtr, CHANNEL_INCLOSE)) {
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
                    "illegal recursive call to close through close-handler"
                    " of channel", -1));
	}
	return TCL_ERROR;
    }

    if (flags & TCL_CLOSE_READ) {
	/*
	 * Call the finalization code directly. There are no events to handle,

 *----------------------------------------------------------------------
 */

static int
CloseWrite(
    Tcl_Interp *interp,		/* Interpreter for errors. */
    Channel *chanPtr)		/* The channel whose write side is being
                                 * closed. May still be used by some
                                 * interpreter */
{
    /*
     * Notes: clear-channel-handlers - write side only ? or keep around, just
     * not called.
     *
     * No close callbacks are run - channel is still open (read side)
     */

    ChannelState *statePtr = chanPtr->state;
                                /* State of real IO channel. */
    int flushcode;
    int result = 0;

    /*
     * The call to FlushChannel will flush any queued output and invoke the
     * close function of the channel driver, or it will set up the channel to
     * be flushed and closed asynchronously.

 *----------------------------------------------------------------------
 */

static Tcl_Size
Write(
    Channel *chanPtr,		/* The channel to buffer output for. */
    const char *src,		/* UTF-8 string to write. */
    Tcl_Size srcLen,            /* Length of UTF-8 string in bytes. */
    Tcl_Encoding encoding)
{
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */
    char *nextNewLine = NULL;
    int endEncoding, needNlFlush = 0;
    Tcl_Size saved = 0, total = 0, flushed = 0;
    char safe[BUFFER_PADDING];
    int encodingError = 0;

    if (srcLen) {
        WillWrite(chanPtr);
    }

    /*
     * Write the terminated escape sequence even if srcLen is 0.
     */

    endEncoding = ((statePtr->outputEncodingFlags & TCL_ENCODING_END) != 0);

	} else {
	    /*
	     * Incoming CHANNEL_STICKY_EOF is filtered out on entry.  A new
	     * CHANNEL_STICKY_EOF set in this routine leads to return before
	     * coming back here.  When we are not dealing with
	     * CHANNEL_STICKY_EOF, a CHANNEL_EOF implies an empty buffer.
	     * Here the buffer is non-empty so we know we're a non-EOF.
             */

	    assert(!GotFlag(statePtr, CHANNEL_STICKY_EOF));
	    assert(!GotFlag(statePtr, CHANNEL_EOF));
	}

	dst = (unsigned char *) RemovePoint(bufPtr);
	dstEnd = dst + BytesLeft(bufPtr);

    } else {
	/*
	 * Incoming CHANNEL_STICKY_EOF is filtered out on entry.  A new
	 * CHANNEL_STICKY_EOF set in this routine leads to return before
	 * coming back here.  When we are not dealing with CHANNEL_STICKY_EOF,
	 * a CHANNEL_EOF implies an empty buffer.  Here the buffer is
	 * non-empty so we know we're a non-EOF.
         */

	assert(!GotFlag(statePtr, CHANNEL_STICKY_EOF));
	assert(!GotFlag(statePtr, CHANNEL_EOF));
    }

    /*
     * Convert some of the bytes from the channel buffer to UTF-8. Space in

	memcpy(readBuf, RemovePoint(bufPtr), toCopy);
	bufPtr->nextRemoved += toCopy;
	copied += toCopy;
	readBuf += toCopy;
	bytesToRead -= toCopy;

	/*
         * If the current buffer is empty recycle it.
         */

	if (IsBufferEmpty(bufPtr)) {
	    chanPtr->inQueueHead = bufPtr->nextPtr;
	    if (chanPtr->inQueueHead == NULL) {
		chanPtr->inQueueTail = NULL;
	    }
	    RecycleBuffer(chanPtr->state, bufPtr, 0);

     */

    assert(!GotFlag(statePtr, CHANNEL_EOF)
	    || GotFlag(statePtr, CHANNEL_STICKY_EOF)
	    || GotFlag(statePtr, CHANNEL_ENCODING_ERROR)
	    || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0);
    assert(!(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)
            == (CHANNEL_EOF|CHANNEL_BLOCKED)));
    UpdateInterest(chanPtr);

    /* This must comes after UpdateInterest(), which may set errno */
    if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR)
	    && (!copied || !GotFlag(statePtr, CHANNEL_NONBLOCKING))) {
	/* Channel either is blocking or is nonblocking with no data
	 * succesfully red before the error.  Return an error so that callers

	bufPtr = statePtr->saveInBufPtr;
	statePtr->saveInBufPtr = NULL;

	/*
	 * Check the actual buffersize against the requested buffersize.
	 * Saved buffers of the wrong size are squashed. This is done to honor
	 * dynamic changes of the buffersize made by the user.
         *
	 * TODO: Tests to cover this.
	 */

	if ((bufPtr != NULL)
		&& (bufPtr->bufLength != statePtr->bufSize + BUFFER_PADDING)) {
	    ReleaseChannelBuffer(bufPtr);
	    bufPtr = NULL;

     * Seek first to force a total flush of all pending buffers and ditch any
     * preread input data.
     */

    WillWrite(chanPtr);

    if (WillRead(chanPtr) == -1) {
        return TCL_ERROR;
    }

    /*
     * We're all flushed to disk now and we also don't have any unfortunate
     * input baggage around either; can truncate with impunity.
     */

{
    if (interp != NULL) {
	const char *genericopt =
		"blocking buffering buffersize encoding eofchar profile translation";
	const char **argv;
	Tcl_Size argc, i;
	Tcl_DString ds;
        Tcl_Obj *errObj;

	Tcl_DStringInit(&ds);
	Tcl_DStringAppend(&ds, genericopt, -1);
	if (optionList && (*optionList)) {
	    TclDStringAppendLiteral(&ds, " ");
	    Tcl_DStringAppend(&ds, optionList, -1);
	}
	if (Tcl_SplitList(interp, Tcl_DStringValue(&ds),
		&argc, &argv) != TCL_OK) {
	    Tcl_Panic("malformed option list in channel driver");
	}
	Tcl_ResetResult(interp);
	errObj = Tcl_ObjPrintf("bad option \"%s\": should be one of ",
                optionName ? optionName : "");
	argc--;
	for (i = 0; i < argc; i++) {
	    Tcl_AppendPrintfToObj(errObj, "-%s, ", argv[i]);
	}
	Tcl_AppendPrintfToObj(errObj, "or -%s", argv[i]);
        Tcl_SetObjResult(interp, errObj);
	Tcl_DStringFree(&ds);
	Tcl_Free((void *)argv);
    }
    Tcl_SetErrno(EINVAL);
    return TCL_ERROR;
}


    /*
     * If the channel is in the middle of a background copy, fail.
     */

    if (statePtr->csPtrR || statePtr->csPtrW) {
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
                    "unable to set channel options: background copy in"
                    " progress", -1));
	}
	return TCL_ERROR;
    }

    /*
     * Disallow options on dead channels -- channels that have been closed but
     * not yet been deallocated. Such channels can be found if the exit

	    ResetFlag(statePtr, CHANNEL_UNBUFFERED);
	    SetFlag(statePtr, CHANNEL_LINEBUFFERED);
	} else if ((newValue[0] == 'n') &&
		(strncmp(newValue, "none", len) == 0)) {
	    ResetFlag(statePtr, CHANNEL_LINEBUFFERED);
	    SetFlag(statePtr, CHANNEL_UNBUFFERED);
	} else if (interp) {
            Tcl_SetObjResult(interp, Tcl_NewStringObj(
                    "bad value for -buffering: must be one of"
                    " full, line, or none", -1));
            return TCL_ERROR;
	}
	return TCL_OK;
    } else if (HaveOpt(7, "-buffersize")) {
	Tcl_WideInt newBufferSize;
	Tcl_Obj obj;
	int code;

		translation = TCL_TRANSLATE_CRLF;
	    } else if (strcmp(readMode, "platform") == 0) {
		translation = TCL_PLATFORM_TRANSLATION;
	    } else {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "bad value for -translation: must be one of "
                            "auto, binary, cr, lf, crlf, or platform", -1));
		}
		Tcl_Free((void *)argv);
		return TCL_ERROR;
	    }

	    /*
	     * Reset the EOL flags since we need to look at any buffered data

		statePtr->outputTranslation = TCL_TRANSLATE_CRLF;
	    } else if (strcmp(writeMode, "platform") == 0) {
		statePtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
	    } else {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "bad value for -translation: must be one of "
                            "auto, binary, cr, lf, crlf, or platform", -1));
		}
		Tcl_Free((void *)argv);
		return TCL_ERROR;
	    }
	}
	Tcl_Free((void *)argv);
	return TCL_OK;

    inStatePtr = inPtr->state;
    outStatePtr = outPtr->state;

    if (BUSY_STATE(inStatePtr, TCL_READABLE)) {
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                    "channel \"%s\" is busy", Tcl_GetChannelName(inChan)));
	}
	return TCL_ERROR;
    }
    if (BUSY_STATE(outStatePtr, TCL_WRITABLE)) {
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                    "channel \"%s\" is busy", Tcl_GetChannelName(outChan)));
	}
	return TCL_ERROR;
    }

    readFlags = inStatePtr->flags;
    writeFlags = outStatePtr->flags;

    /*
     * Special handling of -size 0 async transfers, so that the -command is
     * still called asynchronously.
     */

    if ((nonBlocking == CHANNEL_NONBLOCKING) && (toRead == 0)) {
        Tcl_CreateTimerHandler(0, ZeroTransferTimerProc, csPtr);
        return 0;
    }

    /*
     * Start copying data between the channels.
     */

    return CopyData(csPtr, 0);

	    underflow = 1;
	} else {
	    /*
	     * Read up to bufSize characters.
	     */

	    if ((csPtr->toRead == (Tcl_WideInt) -1)
                    || (csPtr->toRead > (Tcl_WideInt) csPtr->bufSize)) {
		sizeb = csPtr->bufSize;
	    } else {
		sizeb = csPtr->toRead;
	    }

	    if (moveBytes) {
		size = DoRead(inStatePtr->topChanPtr, csPtr->buffer, sizeb,
                              !GotFlag(inStatePtr, CHANNEL_NONBLOCKING));
	    } else {
		size = DoReadChars(inStatePtr->topChanPtr, bufObj, sizeb,
			!GotFlag(inStatePtr, CHANNEL_NONBLOCKING)
			,0 /* No append */);
		/*
		 * In case of a recoverable encoding error, any data before
		 * the error should be written. This data is in the bufObj.

	     * Note that we cannot have a message in the interpreter bypass
	     * area, StackSetBlockMode is restricted to the channel bypass.
	     * We still need the interp as the destination of the move.
	     */

	    if (!TclChanCaughtErrorBypass(interp, (Tcl_Channel) chanPtr)) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                        "error setting blocking mode: %s",
			Tcl_PosixError(interp)));
	    }
	} else {
	    /*
	     * TIP #219.
	     * If we have no interpreter to put a bypass message into we have
	     * to clear it, to prevent its propagation and use in other places

	iPtr->chanMsg = FixLevelCode(msg);
	Tcl_IncrRefCount(iPtr->chanMsg);
    } else {
	iPtr->chanMsg = NULL;
    }

    if (disposePtr != NULL) {
        TclDecrRefCount(disposePtr);
    }
    return;
}

/*
 *----------------------------------------------------------------------
 *

	statePtr->chanMsg = FixLevelCode(msg);
	Tcl_IncrRefCount(statePtr->chanMsg);
    } else {
	statePtr->chanMsg = NULL;
    }

    if (disposePtr != NULL) {
        TclDecrRefCount(disposePtr);
    }
    return;
}

/*
 *----------------------------------------------------------------------
 *