Tcl Source Code

 * copy.  Note that the data buffer for the copy will be appended to this
 * structure.
 */

typedef struct CopyState {
    struct Channel *readPtr;	/* Pointer to input channel. */
    struct Channel *writePtr;	/* Pointer to output channel. */
    int refCount;		/* Reference counter. */
    int readFlags;		/* Original read channel flags. */
    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. */

			    int charsLeft, int *factorPtr);
static void		RecycleBuffer(ChannelState *statePtr,
			    ChannelBuffer *bufPtr, int mustDiscard);
static int		StackSetBlockMode(Channel *chanPtr, int mode);
static int		SetBlockMode(Tcl_Interp *interp, Channel *chanPtr,
			    int mode);
static void		StopCopy(CopyState *csPtr);
static void		CopyDecrRefCount(CopyState *csPtr);
static void		TranslateInputEOL(ChannelState *statePtr, char *dst,
			    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);

		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "could not flush channel \"%s\"",
			    Tcl_GetChannelName((Tcl_Channel) chanPtr)));
		}
		return TCL_ERROR;
	    }

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

	/*
	 * Anything in the input queue and the push-back buffers of the
	 * transformation going away is transformed data, but not yet read. As
	 * unstacking means that the caller does not want to see transformed

	goto done;
    }

  done:
    TclChannelRelease((Tcl_Channel)chanPtr);
    return errorCode;
}

static void
FreeChannelState(
    char *blockPtr)		/* Channel state to free. */
{
    ChannelState *statePtr = (ChannelState *)blockPtr;
    /*
     * Even after close some members can be filled again (in events etc).
     * Test in bug [79474c588] illustrates one leak (on remaining chanMsg).
     * Possible other fields need freeing on some constellations.
     */

    DiscardInputQueued(statePtr, 1);
    if (statePtr->curOutPtr != NULL) {
	ReleaseChannelBuffer(statePtr->curOutPtr);
    }
    DiscardOutputQueued(statePtr);
    
    DeleteTimerHandler(statePtr);

    if (statePtr->chanMsg) {
	Tcl_DecrRefCount(statePtr->chanMsg);
    }
    if (statePtr->unreportedMsg) {
	Tcl_DecrRefCount(statePtr->unreportedMsg);
    }
    ckfree(statePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * CloseChannel --
 *
 *	Utility procedure to close a channel and free associated resources.

     * There is only the TOP Channel, so we free the remaining pointers we
     * have and then ourselves. Since this is the last of the channels in the
     * stack, make sure to free the ChannelState structure associated with it.
     */

    ChannelFree(chanPtr);

    Tcl_EventuallyFree(statePtr, FreeChannelState);

    return errorCode;
}

/*
 *----------------------------------------------------------------------
 *

    }
    statePtr->chPtr = NULL;

    /*
     * Cancel any pending copy operation.
     */

    if (statePtr->csPtrR) {
	StopCopy(statePtr->csPtrR);
	statePtr->csPtrR = NULL;
    }
    if (statePtr->csPtrW) {
	StopCopy(statePtr->csPtrW);
	statePtr->csPtrW = NULL;
    }

    /*
     * Must set the interest mask now to 0, otherwise infinite loops will
     * occur if Tcl_DoOneEvent is called before the channel is finally deleted
     * in FlushChannel. This can happen if the channel has a background flush
     * active.
     */

     * completed.
     */

    csPtr = (CopyState *)ckalloc(offsetof(CopyState, buffer) + 1U + !moveBytes * inStatePtr->bufSize);
    csPtr->bufSize = !moveBytes * inStatePtr->bufSize;
    csPtr->readPtr = inPtr;
    csPtr->writePtr = outPtr;
    csPtr->refCount = 2; /* two references below (inStatePtr, outStatePtr) */
    csPtr->readFlags = readFlags;
    csPtr->writeFlags = writeFlags;
    csPtr->toRead = toRead;
    csPtr->total = (Tcl_WideInt) 0;
    csPtr->interp = interp;
    if (cmdPtr) {
	Tcl_IncrRefCount(cmdPtr);
    }
    csPtr->cmdPtr = cmdPtr;

    TclChannelPreserve(inChan);
    TclChannelPreserve(outChan);

    inStatePtr->csPtrR = csPtr;
    outStatePtr->csPtrW = csPtr;

    if (moveBytes) {
	return MoveBytes(csPtr);
    }

    /*
     * 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 TCL_OK;
    }

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

    return CopyData(csPtr, 0);

    Tcl_WideInt total;
    int size;
    const char *buffer;
    int inBinary, outBinary, sameEncoding;
				/* Encoding control */
    int underflow;		/* Input underflow */

    csPtr->refCount++;		/* avoid freeing during handling */

    inChan	= (Tcl_Channel) csPtr->readPtr;
    outChan	= (Tcl_Channel) csPtr->writePtr;
    inStatePtr	= csPtr->readPtr->state;
    outStatePtr	= csPtr->writePtr->state;
    interp	= csPtr->interp;
    cmdPtr	= csPtr->cmdPtr;

		    continue;
		}
		if (bufObj != NULL) {
		    TclDecrRefCount(bufObj);
		    bufObj = NULL;
		}
		goto done;
	    }
	}

	/*
	 * Now write the buffer out.
	 */

		Tcl_CreateChannelHandler(outChan, TCL_WRITABLE,
			CopyEventProc, csPtr);
	    }
	    if (bufObj != NULL) {
		TclDecrRefCount(bufObj);
		bufObj = NULL;
	    }
	    goto done;
	}

	/*
	 * For background copies, we only do one buffer per invocation so we
	 * don't starve the rest of the system.
	 */

		Tcl_CreateChannelHandler(outChan, TCL_WRITABLE, CopyEventProc,
			csPtr);
	    }
	    if (bufObj != NULL) {
		TclDecrRefCount(bufObj);
		bufObj = NULL;
	    }
	    goto done;
	}
    } /* while */

    if (bufObj != NULL) {
	TclDecrRefCount(bufObj);
	bufObj = NULL;
    }

		result = TCL_ERROR;
	    } else {
		Tcl_ResetResult(interp);
		Tcl_SetObjResult(interp, Tcl_NewWideIntObj(total));
	    }
	}
    }

  done:
    CopyDecrRefCount(csPtr);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * DoRead --

						 * to fill the dst */
	    int code;

	moreData:
	    code = GetInput(chanPtr);
	    bufPtr = statePtr->inQueueHead;



	    if (GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)) {
		/*
		 * Further reads cannot do any more.
		 */

		break;
	    }

	    if (code || !bufPtr) {

		/* Read error (or channel dead/closed) */

		goto readErr;



	    }

	    assert(IsBufferFull(bufPtr));
	}

	if (!bufPtr) {
	  readErr:

	    UpdateInterest(chanPtr);
	    TclChannelRelease((Tcl_Channel)chanPtr);
	    return -1;
	}

	bytesRead = BytesLeft(bufPtr);
	bytesWritten = bytesToRead;

	TranslateInputEOL(statePtr, p, RemovePoint(bufPtr),
		&bytesWritten, &bytesRead);
	bufPtr->nextRemoved += bytesRead;

	Tcl_DeleteChannelHandler(inChan, CopyEventProc, csPtr);
	if (inChan != outChan) {
	    Tcl_DeleteChannelHandler(outChan, CopyEventProc, csPtr);
	}
	Tcl_DeleteChannelHandler(inChan, MBEvent, csPtr);
	Tcl_DeleteChannelHandler(outChan, MBEvent, csPtr);
	TclDecrRefCount(csPtr->cmdPtr);
	csPtr->cmdPtr = NULL;
    }

    if (inStatePtr->csPtrR) {
	assert(inStatePtr->csPtrR == csPtr);
	inStatePtr->csPtrR = NULL;
	CopyDecrRefCount(csPtr);
    }
    if (outStatePtr->csPtrW) {
	assert(outStatePtr->csPtrW == csPtr);
	outStatePtr->csPtrW = NULL;
	CopyDecrRefCount(csPtr);
    }
}

static void
CopyDecrRefCount(
    CopyState *csPtr)
{
    if (csPtr->refCount-- > 1) {
	return;
    }

    TclChannelRelease((Tcl_Channel)csPtr->readPtr);
    TclChannelRelease((Tcl_Channel)csPtr->writePtr);

    ckfree(csPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * StackSetBlockMode --

    resObj = Tcl_ObjPrintf("rc%lu", rcCounter);
    rcCounter++;
    Tcl_MutexUnlock(&rcCounterMutex);

    return resObj;
}

static inline void
CleanRefChannelInstance(
    ReflectedChannel *rcPtr)
{
    if (rcPtr->name) {
	/* 
	 * Reset obj-type (channel is deleted or dead anyway) to avoid leakage
	 * by cyclic references (see bug [79474c58800cdf94]).
	 */
	TclFreeIntRep(rcPtr->name);
	Tcl_DecrRefCount(rcPtr->name);
	rcPtr->name = NULL;
    }
    if (rcPtr->methods) {
	Tcl_DecrRefCount(rcPtr->methods);
	rcPtr->methods = NULL;
    }
    if (rcPtr->cmd) {
	Tcl_DecrRefCount(rcPtr->cmd);
	rcPtr->cmd = NULL;
    }
}
static void
FreeReflectedChannel(
    char *blockPtr)
{
    ReflectedChannel *rcPtr = (ReflectedChannel *) blockPtr;
    Channel *chanPtr = (Channel *) rcPtr->chan;

    TclChannelRelease((Tcl_Channel)chanPtr);
    CleanRefChannelInstance(rcPtr);








    ckfree(rcPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * InvokeTclMethod --

static void
MarkDead(
    ReflectedChannel *rcPtr)
{
    if (rcPtr->dead) {
	return;
    }
    CleanRefChannelInstance(rcPtr);











    rcPtr->dead = 1;
}

static void
DeleteReflectedChannelMap(
    void *clientData,	/* The per-interpreter data structure. */
    Tcl_Interp *interp)		/* The interpreter being deleted. */

    child eval {
        proc no-op args {}
        proc driver {sub args} {return {initialize finalize watch read}}
        chan event [chan create read driver] readable no-op
    }
    interp delete child
} {}

# 1st attempt without error in write, another with error in write:
foreach ::writeErr {0 1} {
test iocmd-32.3.$::writeErr {prevent copy-state against segfault by finalize, bug [79474c58800cdf94]} -setup {
    proc test_chan {args} {
      set rest [lassign $args mode chan]
      lappend ::ret $mode
      switch -exact $mode {
        read {puts $chan "Test" ; close $chan}
        write {if {$::writeErr} {return "boom"}; set data [lindex $rest 0]; string length $data}
        finalize {after 20 {set ::done done}}
        initialize {return "initialize watch finalize read write"}
      }
    }
    set clchlst {}
    set toev [after 5000 {set ::done tout}]
} -body {
    set ::ret {}
    set ch [chan create "read write" test_chan]
    lappend clchlst $ch

    lassign [chan pipe] in1 out1
    lappend clchlst $in1 $out1
    lassign [chan pipe] in2 out2
    lappend clchlst $in2 $out2
    lassign [chan pipe] in3 out3
    lappend clchlst $in3 $out3

    # simulate exec: echo test >@ $out2 2>@ $out3 <@ $in1 &:
    fileevent $out2 writable [list apply {{cho che} {
	puts $cho test; close $cho; close $che
    }} $out2 $out3]
    # recopy to given chans in handler
    fileevent $in2 readable [list apply {{in out} {
	if {[catch {
	    chan copy $in $out
	} msg]} {
	    #puts err:$msg
	    fileevent $in readable {}
	}
    }} $in2 $ch]
    fileevent $in3 readable [list apply {{in out} {
	if {[catch {
	    chan copy $in $out
	} msg]} {
	    #puts err:$msg
	    fileevent $in readable {}
	}
    }} $in3 $ch]
    fileevent $out1 writable [list apply {{in out} {
	if {[catch {
	    chan copy $in $out
	} msg]} {
	    #puts err:$msg
	    fileevent $out writable {}
	}
    }} $ch $out1]

    vwait ::done
    lappend ::ret $::done
} -cleanup {
    foreach ch $clchlst {
	catch {close $ch}
    }
    after cancel $toev
    unset -nocomplain ::done ::ret ch in1 in2 in3 out1 out2 out3 toev clchlst
} -result {initialize read write finalize done}
}; unset ::writeErr

# ### ### ### ######### ######### #########
## Same tests as above, but exercising the code forwarding and
## receiving driver operations to the originator thread.

# -*- tcl -*-
# ### ### ### ######### ######### #########