* generic/tclIORChan.c (ReflectClose, ReflectInput, ReflectOutput,

	ReflectSeekWide, ReflectWatch, ReflectBlock, ReflectSetOption,
	ReflectGetOption, ForwardProc): [Bug 2978773]: Preserve
	ReflectedChannel* structures across handler invokations, to avoid
	crashes when the handler implementation induces nested callbacks
	and destruction of the channel deep inside such a nesting.

2 files changed, 107 insertions, 59 deletions

diff --git a/ChangeLog b/ChangeLog
index 63a71b2..1a49b1d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,12 @@
+2010-03-30  Andreas Kupries  <andreask@activestate.com>
+
+	* generic/tclIORChan.c (ReflectClose, ReflectInput, ReflectOutput,
+	ReflectSeekWide, ReflectWatch, ReflectBlock, ReflectSetOption,
+	ReflectGetOption, ForwardProc): [Bug 2978773]: Preserve
+	ReflectedChannel* structures across handler invokations, to avoid
+	crashes when the handler implementation induces nested callbacks
+	and destruction of the channel deep inside such a nesting.
+
 2010-03-30  Don Porter  <dgp@users.sourceforge.net>
 
 	* generic/tclObj.c (Tcl_GetCommandFromObj):     [Bug 2979402]: Reorder
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index 50374a5..95a488e 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -15,7 +15,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclIORChan.c,v 1.46 2010/03/09 21:15:19 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclIORChan.c,v 1.47 2010/03/30 21:17:13 andreas_kupries Exp $
  */
 
 #include <tclInt.h>
@@ -1086,7 +1086,7 @@ ReflectClose(
 	}
 #endif
 
-	FreeReflectedChannel(rcPtr);
+        Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
 	return EOK;
     }
 
@@ -1098,7 +1098,7 @@ ReflectClose(
      */
 
     if (rcPtr->methods == 0) {
-	FreeReflectedChannel(rcPtr);
+        Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
 	return EOK;
     }
 
@@ -1161,7 +1161,7 @@ ReflectClose(
 	}
 #endif
 
-	FreeReflectedChannel(rcPtr);
+        Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
 #ifdef TCL_THREADS
     }
 #endif
@@ -1242,29 +1242,26 @@ ReflectInput(
     /* ASSERT: rcPtr->method & FLAG(METH_READ) */
     /* ASSERT: rcPtr->mode & TCL_READABLE */
 
+    Tcl_Preserve(rcPtr);
+
     toReadObj = Tcl_NewIntObj(toRead);
     if (InvokeTclMethod(rcPtr, "read", toReadObj, NULL, &resObj)!=TCL_OK) {
 	int code = ErrnoReturn(rcPtr, resObj);
 
 	if (code < 0) {
-	    Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
 	    *errorCodePtr = -code;
-	    return -1;
+            goto error;
 	}
 
 	Tcl_SetChannelError(rcPtr->chan, resObj);
-	Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
-	*errorCodePtr = EINVAL;
-	return -1;
+        goto invalid;
     }
 
     bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
 
     if (toRead < bytec) {
-	Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
 	SetChannelErrorStr(rcPtr->chan, msg_read_toomuch);
-	*errorCodePtr = EINVAL;
-	return -1;
+        goto invalid;
     }
 
     *errorCodePtr = EOK;
@@ -1273,8 +1270,15 @@ ReflectInput(
 	memcpy(buf, bytev, (size_t)bytec);
     }
 
+ stop:
     Tcl_DecrRefCount(resObj);		/* Remove reference held from invoke */
+    Tcl_Release(rcPtr);
     return bytec;
+ invalid:
+    *errorCodePtr = EINVAL;
+ error:
+    bytec = -1;
+    goto stop;
 }
 
 /*
@@ -1350,31 +1354,26 @@ ReflectOutput(
     /* ASSERT: rcPtr->method & FLAG(METH_WRITE) */
     /* ASSERT: rcPtr->mode & TCL_WRITABLE */
 
+    Tcl_Preserve(rcPtr);
+
     bufObj = Tcl_NewByteArrayObj((unsigned char *) buf, toWrite);
     if (InvokeTclMethod(rcPtr, "write", bufObj, NULL, &resObj) != TCL_OK) {
 	int code = ErrnoReturn(rcPtr, resObj);
 
 	if (code < 0) {
-	    Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
 	    *errorCodePtr = -code;
-	    return -1;
+            goto error;
 	}
 
 	Tcl_SetChannelError(rcPtr->chan, resObj);
-	Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
-	*errorCodePtr = EINVAL;
-	return -1;
+        goto invalid;
     }
 
     if (Tcl_GetIntFromObj(rcPtr->interp, resObj, &written) != TCL_OK) {
-	Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
 	Tcl_SetChannelError(rcPtr->chan, MarshallError(rcPtr->interp));
-	*errorCodePtr = EINVAL;
-	return -1;
+        goto invalid;
     }
 
-    Tcl_DecrRefCount(resObj);		/* Remove reference held from invoke */
-
     if ((written == 0) && (toWrite > 0)) {
 	/*
 	 * The handler claims to have written nothing of what it was
@@ -1382,8 +1381,7 @@ ReflectOutput(
 	 */
 
 	SetChannelErrorStr(rcPtr->chan, msg_write_nothing);
-	*errorCodePtr = EINVAL;
-	return -1;
+        goto invalid;
     }
     if (toWrite < written) {
 	/*
@@ -1393,12 +1391,19 @@ ReflectOutput(
 	 */
 
 	SetChannelErrorStr(rcPtr->chan, msg_write_toomuch);
-	*errorCodePtr = EINVAL;
-	return -1;
+        goto invalid;
     }
 
     *errorCodePtr = EOK;
+ stop:
+    Tcl_DecrRefCount(resObj);		/* Remove reference held from invoke */
+    Tcl_Release(rcPtr);
     return written;
+ invalid:
+    *errorCodePtr = EINVAL;
+ error:
+    written = -1;
+    goto stop;
 }
 
 /*
@@ -1456,33 +1461,35 @@ ReflectSeekWide(
 
     /* ASSERT: rcPtr->method & FLAG(METH_SEEK) */
 
+    Tcl_Preserve(rcPtr);
+
     offObj = Tcl_NewWideIntObj(offset);
     baseObj = Tcl_NewStringObj((seekMode == SEEK_SET) ? "start" :
-	    ((seekMode == SEEK_CUR) ? "current" : "end"), -1);
+                               ((seekMode == SEEK_CUR) ? "current" : "end"), -1);
     if (InvokeTclMethod(rcPtr, "seek", offObj, baseObj, &resObj)!=TCL_OK) {
 	Tcl_SetChannelError(rcPtr->chan, resObj);
-	Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
-	*errorCodePtr = EINVAL;
-	return -1;
+        goto invalid;
     }
 
     if (Tcl_GetWideIntFromObj(rcPtr->interp, resObj, &newLoc) != TCL_OK) {
-	Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
 	Tcl_SetChannelError(rcPtr->chan, MarshallError(rcPtr->interp));
-	*errorCodePtr = EINVAL;
-	return -1;
+        goto invalid;
     }
 
-    Tcl_DecrRefCount(resObj);		/* Remove reference held from invoke */
-
     if (newLoc < Tcl_LongAsWide(0)) {
 	SetChannelErrorStr(rcPtr->chan, msg_seek_beforestart);
-	*errorCodePtr = EINVAL;
-	return -1;
+        goto invalid;
     }
 
     *errorCodePtr = EOK;
+ stop:
+    Tcl_DecrRefCount(resObj);		/* Remove reference held from invoke */
+    Tcl_Release(rcPtr);
     return newLoc;
+ invalid:
+    *errorCodePtr = EINVAL;
+    newLoc = -1;
+    goto stop;
 }
 
 static int
@@ -1568,9 +1575,13 @@ ReflectWatch(
     }
 #endif
 
+    Tcl_Preserve(rcPtr);
+
     maskObj = DecodeEventMask(mask);
     (void) InvokeTclMethod(rcPtr, "watch", maskObj, NULL, NULL);
     Tcl_DecrRefCount(maskObj);
+
+    Tcl_Release(rcPtr);
 }
 
 /*
@@ -1623,6 +1634,8 @@ ReflectBlock(
 
     blockObj = Tcl_NewBooleanObj(!nonblocking);
 
+    Tcl_Preserve(rcPtr);
+
     if (InvokeTclMethod(rcPtr, "blocking", blockObj, NULL, &resObj)!=TCL_OK) {
 	Tcl_SetChannelError(rcPtr->chan, resObj);
 	errorNum = EINVAL;
@@ -1631,6 +1644,8 @@ ReflectBlock(
     }
 
     Tcl_DecrRefCount(resObj);		/* Remove reference held from invoke */
+
+    Tcl_Release(rcPtr);
     return errorNum;
 }
 
@@ -1686,6 +1701,7 @@ ReflectSetOption(
 	return p.base.code;
     }
 #endif
+    Tcl_Preserve(rcPtr);
 
     optionObj = Tcl_NewStringObj(optionName, -1);
     valueObj = Tcl_NewStringObj(newValue, -1);
@@ -1695,6 +1711,7 @@ ReflectSetOption(
     }
 
     Tcl_DecrRefCount(resObj);		/* Remove reference held from invoke */
+    Tcl_Release(rcPtr);
     return result;
 }
 
@@ -1781,10 +1798,11 @@ ReflectGetOption(
 	optionObj = Tcl_NewStringObj(optionName, -1);
     }
 
+    Tcl_Preserve(rcPtr);
+
     if (InvokeTclMethod(rcPtr, method, optionObj, NULL, &resObj)!=TCL_OK) {
 	UnmarshallErrorResult(interp, resObj);
-	Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
-	return TCL_ERROR;
+        goto error;
     }
 
     /*
@@ -1794,8 +1812,7 @@ ReflectGetOption(
 
     if (optionObj != NULL) {
 	Tcl_DStringAppend(dsPtr, TclGetString(resObj), -1);
-	Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
-	return TCL_OK;
+        goto ok;
     }
 
     /*
@@ -1810,8 +1827,7 @@ ReflectGetOption(
      */
 
     if (Tcl_ListObjGetElements(interp, resObj, &listc, &listv) != TCL_OK) {
-	Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
-	return TCL_ERROR;
+        goto error;
     }
 
     if ((listc % 2) == 1) {
@@ -1824,8 +1840,7 @@ ReflectGetOption(
 		"Expected list with even number of "
 		"elements, got %d element%s instead", listc,
 		(listc == 1 ? "" : "s")));
-	Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
-	return TCL_ERROR;
+        goto error;
     } else {
 	int len;
 	const char *str = Tcl_GetStringFromObj(resObj, &len);
@@ -1834,9 +1849,17 @@ ReflectGetOption(
 	    Tcl_DStringAppend(dsPtr, " ", 1);
 	    Tcl_DStringAppend(dsPtr, str, len);
 	}
-	Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
-	return TCL_OK;
+        goto ok;
     }
+
+ ok:
+    Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
+    Tcl_Release(rcPtr);
+    return TCL_OK;
+ error:
+    Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
+    Tcl_Release(rcPtr);
+    return TCL_ERROR;
 }
 
 /*
@@ -2775,8 +2798,8 @@ ForwardProc(
     ForwardParam *paramPtr = evPtr->param;
     Tcl_Obj *resObj = NULL;	/* Interp result of InvokeTclMethod */
     ReflectedChannelMap *rcmPtr;
-				/* Map of reflected channels with handlers in
-				 * this interp. */
+    /* Map of reflected channels with handlers in
+     * this interp. */
     Tcl_HashEntry *hPtr;	/* Entry in the above map */
 
     /*
@@ -2819,20 +2842,21 @@ ForwardProc(
 
 	rcmPtr = GetReflectedChannelMap(interp);
 	hPtr = Tcl_FindHashEntry(&rcmPtr->map,
-		Tcl_GetChannelName(rcPtr->chan));
+                                 Tcl_GetChannelName(rcPtr->chan));
 	Tcl_DeleteHashEntry(hPtr);
 
 	rcmPtr = GetThreadReflectedChannelMap();
 	hPtr = Tcl_FindHashEntry(&rcmPtr->map,
-		Tcl_GetChannelName(rcPtr->chan));
+                                 Tcl_GetChannelName(rcPtr->chan));
 	Tcl_DeleteHashEntry(hPtr);
 
-	FreeReflectedChannel(rcPtr);
+        Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
 	break;
 
     case ForwardedInput: {
 	Tcl_Obj *toReadObj = Tcl_NewIntObj(paramPtr->input.toRead);
 
+        Tcl_Preserve(rcPtr);
 	if (InvokeTclMethod(rcPtr, "read", toReadObj, NULL, &resObj)!=TCL_OK){
 	    int code = ErrnoReturn(rcPtr, resObj);
 
@@ -2862,13 +2886,15 @@ ForwardProc(
 		paramPtr->input.toRead = bytec;
 	    }
 	}
+        Tcl_Release(rcPtr);
 	break;
     }
 
     case ForwardedOutput: {
 	Tcl_Obj *bufObj = Tcl_NewByteArrayObj((unsigned char *)
-		paramPtr->output.buf, paramPtr->output.toWrite);
+                                              paramPtr->output.buf, paramPtr->output.toWrite);
 
+        Tcl_Preserve(rcPtr);
 	if (InvokeTclMethod(rcPtr, "write", bufObj, NULL, &resObj) != TCL_OK) {
 	    int code = ErrnoReturn(rcPtr, resObj);
 
@@ -2895,15 +2921,17 @@ ForwardProc(
 		paramPtr->output.toWrite = written;
 	    }
 	}
+        Tcl_Release(rcPtr);
 	break;
     }
 
     case ForwardedSeek: {
 	Tcl_Obj *offObj = Tcl_NewWideIntObj(paramPtr->seek.offset);
 	Tcl_Obj *baseObj = Tcl_NewStringObj(
-		(paramPtr->seek.seekMode==SEEK_SET) ? "start" :
-		(paramPtr->seek.seekMode==SEEK_CUR) ? "current" : "end", -1);
+                                            (paramPtr->seek.seekMode==SEEK_SET) ? "start" :
+                                            (paramPtr->seek.seekMode==SEEK_CUR) ? "current" : "end", -1);
 
+        Tcl_Preserve(rcPtr);
 	if (InvokeTclMethod(rcPtr, "seek", offObj, baseObj, &resObj)!=TCL_OK){
 	    ForwardSetObjError(paramPtr, resObj);
 	    paramPtr->seek.offset = -1;
@@ -2927,24 +2955,29 @@ ForwardProc(
 		paramPtr->seek.offset = -1;
 	    }
 	}
+        Tcl_Release(rcPtr);
 	break;
     }
 
     case ForwardedWatch: {
 	Tcl_Obj *maskObj = DecodeEventMask(paramPtr->watch.mask);
 
+        Tcl_Preserve(rcPtr);
 	(void) InvokeTclMethod(rcPtr, "watch", maskObj, NULL, NULL);
 	Tcl_DecrRefCount(maskObj);
+        Tcl_Release(rcPtr);
 	break;
     }
 
     case ForwardedBlock: {
 	Tcl_Obj *blockObj = Tcl_NewBooleanObj(!paramPtr->block.nonblocking);
 
+        Tcl_Preserve(rcPtr);
 	if (InvokeTclMethod(rcPtr, "blocking", blockObj, NULL,
-		&resObj) != TCL_OK) {
+                            &resObj) != TCL_OK) {
 	    ForwardSetObjError(paramPtr, resObj);
 	}
+        Tcl_Release(rcPtr);
 	break;
     }
 
@@ -2952,10 +2985,12 @@ ForwardProc(
 	Tcl_Obj *optionObj = Tcl_NewStringObj(paramPtr->setOpt.name, -1);
 	Tcl_Obj *valueObj = Tcl_NewStringObj(paramPtr->setOpt.value, -1);
 
+        Tcl_Preserve(rcPtr);
 	if (InvokeTclMethod(rcPtr, "configure", optionObj, valueObj,
-		&resObj) != TCL_OK) {
+                            &resObj) != TCL_OK) {
 	    ForwardSetObjError(paramPtr, resObj);
 	}
+        Tcl_Release(rcPtr);
 	break;
     }
 
@@ -2966,12 +3001,14 @@ ForwardProc(
 
 	Tcl_Obj *optionObj = Tcl_NewStringObj(paramPtr->getOpt.name, -1);
 
+        Tcl_Preserve(rcPtr);
 	if (InvokeTclMethod(rcPtr, "cget", optionObj, NULL, &resObj)!=TCL_OK){
 	    ForwardSetObjError(paramPtr, resObj);
 	} else {
 	    Tcl_DStringAppend(paramPtr->getOpt.value,
-		    TclGetString(resObj), -1);
+                              TclGetString(resObj), -1);
 	}
+        Tcl_Release(rcPtr);
 	break;
     }
 
@@ -2980,6 +3017,7 @@ ForwardProc(
 	 * Retrieve all options.
 	 */
 
+        Tcl_Preserve(rcPtr);
 	if (InvokeTclMethod(rcPtr, "cgetall", NULL, NULL, &resObj) != TCL_OK){
 	    ForwardSetObjError(paramPtr, resObj);
 	} else {
@@ -2992,7 +3030,7 @@ ForwardProc(
 	    Tcl_Obj **listv;
 
 	    if (Tcl_ListObjGetElements(interp, resObj, &listc,
-		    &listv) != TCL_OK) {
+                                       &listv) != TCL_OK) {
 		ForwardSetObjError(paramPtr, MarshallError(interp));
 	    } else if ((listc % 2) == 1) {
 		/*
@@ -3015,6 +3053,7 @@ ForwardProc(
 		}
 	    }
 	}
+        Tcl_Release(rcPtr);
 	break;
 
     default: