Backport fix for [Bug 1028264]: WSACleanup() too early. The fix introduces "late exit handlers" for similar late process-wide cleanups.

4 files changed, 119 insertions, 10 deletions

diff --git a/ChangeLog b/ChangeLog
index 6addf27..1e4ca6a 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,11 @@
 2009-04-27  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>
 
+	* generic/tclInt.h:   Backport fix for [Bug 1028264]: WSACleanup() too early.
+	* generic/tclEvent.c: The fix introduces "late exit handlers"
+	* win/tclWinSock.c:   for similar late process-wide cleanups.
+
+2009-04-27  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>
+
 	* win/tclWinSock.c: Backport fix for [Bug 2446662]: resync Win
 	behavior on RST with that of unix (EOF).
 
diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index 2cdae51..554b8ee 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclEvent.c,v 1.28.2.15 2007/03/19 17:06:25 dgp Exp $
+ * RCS: @(#) $Id: tclEvent.c,v 1.28.2.16 2009/04/27 22:10:28 ferrieux Exp $
  */
 
 #include "tclInt.h"
@@ -56,8 +56,8 @@ typedef struct ErrAssocData {
 } ErrAssocData;
 
 /*
- * For each exit handler created with a call to Tcl_CreateExitHandler
- * there is a structure of the following type:
+ * For each exit handler created with a call to Tcl_Create(Late)ExitHandler there is
+ * a structure of the following type:
  */
 
 typedef struct ExitHandler {
@@ -76,6 +76,9 @@ typedef struct ExitHandler {
 static ExitHandler *firstExitPtr = NULL;
 				/* First in list of all exit handlers for
 				 * application. */
+static ExitHandler *firstLateExitPtr = NULL;
+				/* First in list of all late exit handlers for
+				 * application. */
 TCL_DECLARE_MUTEX(exitMutex)
 
 /*
@@ -435,6 +438,39 @@ Tcl_CreateExitHandler(proc, clientData)
 /*
  *----------------------------------------------------------------------
  *
+ * TclCreateLateExitHandler --
+ *
+ *	Arrange for a given function to be invoked after all pre-thread cleanups
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Proc will be invoked with clientData as argument when the application
+ *	exits.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclCreateLateExitHandler(
+    Tcl_ExitProc *proc,		/* Function to invoke. */
+    ClientData clientData)	/* Arbitrary value to pass to proc. */
+{
+    ExitHandler *exitPtr;
+
+    exitPtr = (ExitHandler *) ckalloc(sizeof(ExitHandler));
+    exitPtr->proc = proc;
+    exitPtr->clientData = clientData;
+    Tcl_MutexLock(&exitMutex);
+    exitPtr->nextPtr = firstLateExitPtr;
+    firstLateExitPtr = exitPtr;
+    Tcl_MutexUnlock(&exitMutex);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_DeleteExitHandler --
  *
  *	This procedure cancels an existing exit handler matching proc
@@ -479,6 +515,49 @@ Tcl_DeleteExitHandler(proc, clientData)
 /*
  *----------------------------------------------------------------------
  *
+ * TclDeleteLateExitHandler --
+ *
+ *	This function cancels an existing late exit handler matching proc and
+ *	clientData, if such a handler exits.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	If there is a late exit handler corresponding to proc and clientData then
+ *	it is canceled; if no such handler exists then nothing happens.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclDeleteLateExitHandler(
+    Tcl_ExitProc *proc,		/* Function that was previously registered. */
+    ClientData clientData)	/* Arbitrary value to pass to proc. */
+{
+    ExitHandler *exitPtr, *prevPtr;
+
+    Tcl_MutexLock(&exitMutex);
+    for (prevPtr = NULL, exitPtr = firstLateExitPtr; exitPtr != NULL;
+	    prevPtr = exitPtr, exitPtr = exitPtr->nextPtr) {
+	if ((exitPtr->proc == proc)
+		&& (exitPtr->clientData == clientData)) {
+	    if (prevPtr == NULL) {
+		firstLateExitPtr = exitPtr->nextPtr;
+	    } else {
+		prevPtr->nextPtr = exitPtr->nextPtr;
+	    }
+	    ckfree((char *) exitPtr);
+	    break;
+	}
+    }
+    Tcl_MutexUnlock(&exitMutex);
+    return;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_CreateThreadExitHandler --
  *
  *	Arrange for a given procedure to be invoked just before the
@@ -825,14 +904,34 @@ Tcl_Finalize()
 	 * Note that there is no thread-local storage after this call.
 	 */
 
-	Tcl_FinalizeThread();
+    Tcl_FinalizeThread();
 
+    /*
+     * Now invoke late (process-wide) exit handlers.
+     */
+
+    Tcl_MutexLock(&exitMutex);
+    for (exitPtr = firstLateExitPtr; exitPtr != NULL; exitPtr = firstLateExitPtr) {
 	/*
-	 * Now finalize the Tcl execution environment.  Note that this
-	 * must be done after the exit handlers, because there are
-	 * order dependencies.
+	 * Be careful to remove the handler from the list before invoking its
+	 * callback. This protects us against double-freeing if the callback
+	 * should call Tcl_DeleteLateExitHandler on itself.
 	 */
 
+	firstLateExitPtr = exitPtr->nextPtr;
+	Tcl_MutexUnlock(&exitMutex);
+	exitPtr->proc(exitPtr->clientData);
+	ckfree((char *) exitPtr);
+	Tcl_MutexLock(&exitMutex);
+    }
+    firstLateExitPtr = NULL;
+    Tcl_MutexUnlock(&exitMutex);
+
+    /*
+     * Now finalize the Tcl execution environment. Note that this must be done
+     * after the exit handlers, because there are order dependencies.
+     */
+
 	TclFinalizeCompilation();
 	TclFinalizeExecution();
 	TclFinalizeEnvironment();
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 7de3d01..43870e7 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclInt.h,v 1.118.2.32 2008/07/22 21:40:32 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.118.2.33 2009/04/27 22:10:28 ferrieux Exp $
  */
 
 #ifndef _TCLINT
@@ -1893,6 +1893,10 @@ EXTERN int		TclFileMakeDirsCmd _ANSI_ARGS_((Tcl_Interp *interp,
 			    int objc, Tcl_Obj *CONST objv[])) ;
 EXTERN int		TclFileRenameCmd _ANSI_ARGS_((Tcl_Interp *interp,
 			    int objc, Tcl_Obj *CONST objv[])) ;
+EXTERN void		TclCreateLateExitHandler (Tcl_ExitProc * proc,
+						   ClientData clientData);
+EXTERN void		TclDeleteLateExitHandler (Tcl_ExitProc * proc,
+						   ClientData clientData);
 EXTERN void		TclFinalizeAllocSubsystem _ANSI_ARGS_((void));
 EXTERN void		TclFinalizeAsync _ANSI_ARGS_((void));
 EXTERN void		TclFinalizeCompilation _ANSI_ARGS_((void));
diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 1053d4d..329b57f 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclWinSock.c,v 1.36.2.9 2009/04/27 21:25:18 ferrieux Exp $
+ * RCS: @(#) $Id: tclWinSock.c,v 1.36.2.10 2009/04/27 22:10:28 ferrieux Exp $
  */
 
 #include "tclWinInt.h"
@@ -326,7 +326,7 @@ InitSockets()
 
     if (!initialized) {
 	initialized = 1;
-	Tcl_CreateExitHandler(SocketExitHandler, (ClientData) NULL);
+	TclCreateLateExitHandler(SocketExitHandler, (ClientData) NULL);
 
 	winSock.hModule = LoadLibraryA("wsock32.dll");