* doc/dde.n: Committed TIP #120 which provides the

	* win/tclWinDde.c:           dde package for safe interpreters.
	* tests/winDde.test:         Incremented package version to 1.2.4
	* library/dde/pkgIndex.tcl:

5 files changed, 442 insertions, 47 deletions

diff --git a/ChangeLog b/ChangeLog
index e50f9da..9110c81 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2003-06-23  Pat Thoyts  <patthoyts@users.sourceforge.net>
+
+	* doc/dde.n:                 Committed TIP #120 which provides the
+	* win/tclWinDde.c:           dde package for safe interpreters.
+	* tests/winDde.test:         Incremented package version to 1.2.4
+	* library/dde/pkgIndex.tcl:
+
 2003-06-23  Vince Darley  <vincentdarley@users.sourceforge.net>
 
 	* generic/tclFCmd.c: fix to bad error message when trying to
diff --git a/doc/dde.n b/doc/dde.n
index c28c26f..b826732 100644
--- a/doc/dde.n
+++ b/doc/dde.n
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" RCS: @(#) $Id: dde.n,v 1.9 2003/05/16 22:00:47 patthoyts Exp $
+'\" RCS: @(#) $Id: dde.n,v 1.10 2003/06/23 21:27:56 patthoyts Exp $
 '\" 
 .so man.macros
 .TH dde n 1.2 dde "Tcl Bundled Packages"
@@ -17,7 +17,7 @@ dde \- Execute a Dynamic Data Exchange command
 .sp
 \fBpackage require dde 1.2\fR
 .sp
-\fBdde \fIservername\fR ?\fI-exact\fR? ?\fI--\fR? ?\fItopic\fR?
+\fBdde \fIservername\fR ?\fI-exact\fR? ?\fI-handler proc\fR? ?\fI--\fR? ?\fItopic\fR?
 .sp
 \fBdde \fIexecute\fR ?\fI\-async\fR? \fIservice topic \fR?\fIdata\fR?
 .sp
@@ -50,7 +50,7 @@ The \fBeval\fR and \fBexecute\fR commands accept the option \fB\-async\fR:
 The following commands are a subset of the full Dynamic Data Exchange
 set of commands.
 .TP
-\fBdde servername \fR?\fI-exact\fR? ?\fI--\fR? ?\fItopic\fR?
+\fBdde servername \fR?\fI-exact\fR? ?\fI-handler proc\fR? ?\fI--\fR? ?\fItopic\fR?
 \fBdde servername\fR registers the interpreter as a DDE server with
 the service name \fBTclEval\fR and the topic name specified by \fItopic\fR.
 If no \fItopic\fR is given, \fBdde servername\fR returns the name
@@ -60,6 +60,12 @@ suffix of the form ' #2' or ' #3' is appended to the name to make it
 unique. The command's result will be the name actually used. The
 \fI-exact\fR option is used to force registration of precisely the
 given \fItopic\fR name.
+.IP
+The \fI-handler\fR option specifies a tcl procedure that will be called to
+process calls to the dde server. If the package has been loaded into a
+safe interpreter then a \fI-handler\fR procedure must be defined. The
+procedure is called with all the arguments provided by the remote
+call.
 .TP
 \fBdde execute\fR ?\fI\-async\fR? \fIservice topic data\fR
 \fBdde execute\fR takes the \fIdata\fR and sends it to the server indicated
diff --git a/library/dde/pkgIndex.tcl b/library/dde/pkgIndex.tcl
index c12e3a1..b5d65a5 100644
--- a/library/dde/pkgIndex.tcl
+++ b/library/dde/pkgIndex.tcl
@@ -1,6 +1,6 @@
 if {![package vsatisfies [package provide Tcl] 8]} {return}
 if {[info exists ::tcl_platform(debug)]} {
-    package ifneeded dde 1.2.3 [list load [file join $dir tcldde12g.dll] dde]
+    package ifneeded dde 1.2.4 [list load [file join $dir tcldde12g.dll] dde]
 } else {
-    package ifneeded dde 1.2.3 [list load [file join $dir tcldde12.dll] dde]
+    package ifneeded dde 1.2.4 [list load [file join $dir tcldde12.dll] dde]
 }
diff --git a/tests/winDde.test b/tests/winDde.test
index 06dab25..a23650d 100644
--- a/tests/winDde.test
+++ b/tests/winDde.test
@@ -2,17 +2,18 @@
 #
 # This file contains a collection of tests for one or more of the Tcl
 # built-in commands.  Sourcing this file into Tcl runs the tests and
-# generates output for errors.  No output means no errors were found.
+# generates output for errors. No output means no errors were found.
 #
 # Copyright (c) 1999 by Scriptics Corporation.
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: winDde.test,v 1.16 2003/05/16 22:00:47 patthoyts Exp $
+# RCS: @(#) $Id: winDde.test,v 1.17 2003/06/23 21:27:56 patthoyts Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
+    #tcltest::configure -verbose {pass start}
     namespace import -force ::tcltest::*
 }
 
@@ -34,10 +35,11 @@ if {$tcl_platform(platform) == "windows"} {
 
 set scriptName [makeFile {} script1.tcl]
 
-proc createChildProcess { ddeServerName } {
+proc createChildProcess { ddeServerName {handler {}}} {
     file delete -force $::scriptName
 
     set f [open $::scriptName w+]
+    puts $f [list set ddeServerName $ddeServerName]
     puts $f {
         # DDE child server -
         #
@@ -59,15 +61,37 @@ proc createChildProcess { ddeServerName } {
         
         # If an error occurs during the tests, this process may end up not
         # being closed down. To deal with this we create a 30s timeout.
-        proc DoTimeout {} {
-            global done
-            puts stderr "winDde.test child process $ddeServerName timed out."
+        proc ::DoTimeout {} {
+            global done ddeServerName
             set done 1
+            puts "winDde.test child process $ddeServerName timed out."
+            flush stdout
+        }
+        set timeout [after 30000 ::DoTimeout]
+        
+        # Define a restricted handler.
+        proc Handler1 {cmd} {
+            if {$cmd eq "stop"} {set ::done 1}
+            puts $cmd ; flush stdout 
+            return
+        }
+        proc Handler2 {cmd} {
+            if {$cmd eq "stop"} {set ::done 1}
+            puts [uplevel \#0 $cmd] ; flush stdout 
+            return
+        }
+        proc Handler3 {prefix cmd} {
+            if {$cmd eq "stop"} {set ::done 1}
+            puts [list $prefix $cmd] ; flush stdout
+            return
         }
-        set timeout [after 30000 DoTimeout]
     }
     # set the dde server name to the supplied argument.
-    puts $f [list dde servername $ddeServerName]
+    if {$handler == {}} {
+        puts $f [list dde servername $ddeServerName]
+    } else {
+        puts $f [list dde servername -handler $handler -- $ddeServerName]
+    }        
     puts $f {
         # run the server and handle final cleanup.
         after 200;# give dde a chance to get going.
@@ -212,7 +236,7 @@ test winDde-5.4 {DDE eval bad arguments} {pcOnly} {
 test winDde-6.1 {DDE servername bad arguments} \
     -constraints pcOnly \
     -body {list [catch {dde servername -z -z -z} msg] $msg} \
-    -result {1 {wrong # args: should be "dde servername ?-exact? ?--? ?serverName?"}}
+    -result {1 {wrong # args: should be "dde servername ?-exact? ?-handler proc? ?--? ?serverName?"}}
 
 test winDde-6.2 {DDE servername set name} \
     -constraints pcOnly \
@@ -338,11 +362,231 @@ test winDde-7.5 {interp name collision without -exact} \
     } \
     -result "dde-interp-7.5 #2"
 
+# -------------------------------------------------------------------------
+
+test winDde-8.1 {Safe DDE load} \
+    -constraints pcOnly \
+    -setup {
+        interp create -safe slave
+        slave invokehidden load $lib dde
+    } \
+    -body {
+        list [catch {slave eval dde servername slave} msg] $msg
+    } \
+    -cleanup {interp delete slave} \
+    -result {1 {invalid command name "dde"}}
+
+test winDde-8.2 {Safe DDE set servername} \
+    -constraints pcOnly \
+    -setup {
+        interp create -safe slave
+        slave invokehidden load $lib dde
+    } \
+    -body {
+        slave invokehidden dde servername slave
+    } \
+    -cleanup {interp delete slave} \
+    -result {slave}
+
+test winDde-8.3 {Safe DDE check handler required for eval} \
+    -constraints pcOnly \
+    -setup {
+        interp create -safe slave
+        slave invokehidden load $lib dde
+        slave invokehidden dde servername slave
+    } \
+    -body {
+        catch {dde eval slave set a 1} msg
+    } \
+    -cleanup {interp delete slave} \
+    -result {1}
+
+test winDde-8.4 {Safe DDE check that execute is denied} \
+    -constraints pcOnly \
+    -setup {
+        interp create -safe slave
+        slave invokehidden load $lib dde
+        slave invokehidden dde servername slave
+    } \
+    -body {
+        slave eval set a 1
+        list [catch {
+            dde execute TclEval slave {set a 2}
+            slave eval set a
+        } msg] $msg
+    } \
+    -cleanup {interp delete slave} \
+    -result {0 1}
+
+test winDde-8.5 {Safe DDE check that request is denied} \
+    -constraints pcOnly \
+    -setup {
+        interp create -safe slave
+        slave invokehidden load $lib dde
+        slave invokehidden dde servername slave
+    } \
+    -body {
+        slave eval set a 1
+        list [catch {dde request TclEval slave a} msg] $msg
+    } \
+    -cleanup {interp delete slave} \
+    -result {1 {remote server cannot handle this command}}
+
+test winDde-8.6 {Safe DDE assign handler procedure} \
+    -constraints pcOnly \
+    -setup {
+        interp create -safe slave
+        slave invokehidden load $lib dde
+        slave eval {proc DDEACCEPT {cmd} {set ::DDECMD $cmd}}
+    } \
+    -body {
+        slave invokehidden dde servername -handler DDEACCEPT slave
+    } \
+    -cleanup {interp delete slave} \
+    -result slave
+
+test winDde-8.7 {Safe DDE check simple command} \
+    -constraints pcOnly \
+    -setup {
+        interp create -safe slave
+        slave invokehidden load $lib dde
+        slave eval {proc DDEACCEPT {cmd} {set ::DDECMD $cmd}}
+        slave invokehidden dde servername -handler DDEACCEPT slave
+    } \
+    -body {
+        list [catch {
+            dde eval slave set x 1
+        } msg] $msg        
+    } \
+    -cleanup {interp delete slave} \
+    -result {0 {set x 1}}
+
+test winDde-8.8 {Safe DDE check non-list command} \
+    -constraints pcOnly \
+    -setup {
+        interp create -safe slave
+        slave invokehidden load $lib dde
+        slave eval {proc DDEACCEPT {cmd} {set ::DDECMD $cmd}}
+        slave invokehidden dde servername -handler DDEACCEPT slave
+    } \
+    -body {
+        list [catch {
+            set s "c:\\Program Files\\Microsoft Visual Studio\\"
+            dde eval slave $s
+            string compare [slave eval set DDECMD] $s
+        } msg] $msg        
+    } \
+    -cleanup {interp delete slave} \
+    -result {0 0}
+
+test winDde-8.9 {Safe DDE check command evaluation} \
+    -constraints pcOnly \
+    -setup {
+        interp create -safe slave
+        slave invokehidden load $lib dde
+        slave eval {proc DDEACCEPT {cmd} {set ::DDECMD [uplevel #0 $cmd]}}
+        slave invokehidden dde servername -handler DDEACCEPT slave
+    } \
+    -body {
+        list [catch {
+            dde eval slave set x 1
+            slave eval set x
+        } msg] $msg        
+    } \
+    -cleanup {interp delete slave} \
+    -result {0 1}
+
+test winDde-8.10 {Safe DDE check command evaluation (2)} \
+    -constraints pcOnly \
+    -setup {
+        interp create -safe slave
+        slave invokehidden load $lib dde
+        slave eval {proc DDEACCEPT {cmd} {set ::DDECMD [uplevel #0 $cmd]}}
+        slave invokehidden dde servername -handler DDEACCEPT slave
+    } \
+    -body {
+        list [catch {
+            dde eval slave [list set x 1]
+            slave eval set x
+        } msg] $msg        
+    } \
+    -cleanup {interp delete slave} \
+    -result {0 1}
+
+test winDde-8.11 {Safe DDE check command evaluation (3)} \
+    -constraints pcOnly \
+    -setup {
+        interp create -safe slave
+        slave invokehidden load $lib dde
+        slave eval {proc DDEACCEPT {cmd} {set ::DDECMD [uplevel #0 $cmd]}}
+        slave invokehidden dde servername -handler DDEACCEPT slave
+    } \
+    -body {
+        list [catch {
+            dde eval slave [list [list set x 1]]
+            slave eval set x
+        } msg] $msg
+    } \
+    -cleanup {interp delete slave} \
+    -result {1 {invalid command name "set x 1"}}
+
+# -------------------------------------------------------------------------
+
+test winDde-9.1 {External safe DDE check string passing} \
+    -constraints {pcOnly stdio} \
+    -setup {
+        set name child-9.1
+        set child [createChildProcess $name Handler1]
+        file copy -force script1.tcl dde-script.tcl
+    } \
+    -body {
+        list [catch {
+            dde eval $name set x 1
+            gets $child line
+            set line
+        } msg] $msg
+    } \
+    -cleanup {dde execute TclEval $name stop ; update} \
+    -result {0 {set x 1}}
+
+test winDde-9.2 {External safe DDE check command evaluation} \
+    -constraints {pcOnly stdio} \
+    -setup {
+        set name child-9.2
+        set child [createChildProcess $name Handler2]
+        file copy -force script1.tcl dde-script.tcl
+    } \
+    -body {
+        list [catch {
+            dde eval $name set x 1
+            gets $child line
+            set line
+        } msg] $msg
+    } \
+    -cleanup {dde execute TclEval $name stop ; update} \
+    -result {0 1}
+
+test winDde-9.3 {External safe DDE check prefixed arguments} \
+    -constraints {pcOnly stdio} \
+    -setup {
+        set name child-9.3
+        set child [createChildProcess $name [list Handler3 ARG]]
+        file copy -force script1.tcl dde-script.tcl
+    } \
+    -body {
+        list [catch {
+            dde eval $name set x 1
+            gets $child line
+            set line
+        } msg] $msg
+    } \
+    -cleanup {dde execute TclEval $name stop ; update} \
+    -result {0 {ARG {set x 1}}}
 
 # -------------------------------------------------------------------------
 
 #cleanup
-catch {interp delete $slave};           # ensure we clean up the slave.
+#catch {interp delete $slave};           # ensure we clean up the slave.
 file delete -force $::scriptName
 ::tcltest::cleanupTests
 return
diff --git a/win/tclWinDde.c b/win/tclWinDde.c
index def845b..d6d36cf 100644
--- a/win/tclWinDde.c
+++ b/win/tclWinDde.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclWinDde.c,v 1.15 2003/05/16 17:29:49 patthoyts Exp $
+ * RCS: @(#) $Id: tclWinDde.c,v 1.16 2003/06/23 21:27:56 patthoyts Exp $
  */
 
 #include "tclPort.h"
@@ -36,6 +36,7 @@ typedef struct RegisteredInterp {
 				/* The next interp this application knows
 				 * about. */
     char *name;			/* Interpreter's name (malloc-ed). */
+    Tcl_Obj *handlerPtr;	/* The server handler command */
     Tcl_Interp *interp;		/* The interpreter attached to this name. */
 } RegisteredInterp;
 
@@ -70,7 +71,7 @@ static DWORD ddeInstance;       /* The application instance handle given
 				 * to us by DdeInitialize. */
 static int ddeIsServer = 0;
 
-#define TCL_DDE_VERSION "1.2.3"
+#define TCL_DDE_VERSION "1.2.4"
 #define TCL_DDE_PACKAGE_NAME "dde"
 #define TCL_DDE_SERVICE_NAME "TclEval"
 
@@ -102,6 +103,7 @@ int Tcl_DdeObjCmd(ClientData clientData,	/* Used only for deletion */
 	Tcl_Obj *CONST objv[]);	/* The arguments */
 
 EXTERN int Dde_Init(Tcl_Interp *interp);
+EXTERN int Dde_SafeInit(Tcl_Interp *interp);
 
 /*
  *----------------------------------------------------------------------
@@ -141,6 +143,33 @@ Dde_Init(
 /*
  *----------------------------------------------------------------------
  *
+ * Dde_SafeInit --
+ *
+ *	This procedure initializes the dde command within a safe interp
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Dde_SafeInit(
+    Tcl_Interp *interp)
+{
+    int result = Dde_Init(interp);
+    if (result == TCL_OK) {
+	Tcl_HideCommand(interp, "dde", "dde");
+    }
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Initialize --
  *
  *	Initialize the global DDE instance.
@@ -235,7 +264,9 @@ DdeSetServerName(
 				 * refer to the interpreter in later
 				 * "send" commands.  Must be globally
 				 * unique. */
-    int exactName		/* Should we make a unique name? 0 = unique */
+    int exactName,		/* Should we make a unique name? 0 = unique */
+    Tcl_Obj *handlerPtr		/* Name of the optional proc/command to handle
+				 * incoming Dde eval's */
     )
 {
     int suffix, offset;
@@ -348,9 +379,16 @@ DdeSetServerName(
     riPtr->interp = interp;
     riPtr->name = ckalloc(strlen(actualName) + 1);
     riPtr->nextPtr = tsdPtr->interpListPtr;
+    riPtr->handlerPtr = handlerPtr;
+    if (riPtr->handlerPtr != NULL)
+	Tcl_IncrRefCount(riPtr->handlerPtr);
     tsdPtr->interpListPtr = riPtr;
     strcpy(riPtr->name, actualName);
 
+    if (Tcl_IsSafe(interp)) {
+	Tcl_ExposeCommand(interp, "dde", "dde");
+    }
+
     Tcl_CreateObjCommand(interp, "dde", Tcl_DdeObjCmd,
 	    (ClientData) riPtr, DeleteProc);
     if (Tcl_IsSafe(interp)) {
@@ -369,6 +407,39 @@ DdeSetServerName(
 /*
  *--------------------------------------------------------------
  *
+ * DdeGetRegistrationPtr
+ *
+ *	Retrieve the registration info for an interpreter.
+ *
+ * Results:
+ *	Returns a pointer to the registration structure or NULL
+ *
+ * Side effects:
+ *	None
+ *
+ *--------------------------------------------------------------
+ */
+
+static RegisteredInterp *
+DdeGetRegistrationPtr(
+    Tcl_Interp *interp
+    )
+{
+    RegisteredInterp *riPtr;
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+    for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; 
+	    riPtr = riPtr->nextPtr) {
+	if (riPtr->interp == interp) {
+	    break;
+	}
+    }
+    return riPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
  * DeleteProc
  *
  *	This procedure is called when the command "dde" is destroyed.
@@ -407,6 +478,8 @@ DeleteProc(clientData)
 	}
     }
     ckfree(riPtr->name);
+    if (riPtr->handlerPtr)
+	Tcl_DecrRefCount(riPtr->handlerPtr);
     Tcl_EventuallyFree(clientData, TCL_DYNAMIC);
 }
 
@@ -441,9 +514,27 @@ ExecuteRemoteObject(
 {
     Tcl_Obj *errorObjPtr;
     Tcl_Obj *returnPackagePtr;
-    int result;
+    int result = TCL_OK;
+
+    if (riPtr->handlerPtr == NULL && Tcl_IsSafe(riPtr->interp)) {
+	Tcl_SetObjResult(riPtr->interp, Tcl_NewStringObj("permission denied:"
+		" a handler procedure must be defined for use in a safe interp", -1));
+	result = TCL_ERROR;
+    }
+
+    if (riPtr->handlerPtr != NULL) {
+	/* add the dde request data to the handler proc list */
+	Tcl_Obj *cmdPtr = Tcl_DuplicateObj(riPtr->handlerPtr);
+	result = Tcl_ListObjAppendElement(riPtr->interp, cmdPtr, ddeObjectPtr);
+	if (result == TCL_OK) {
+	    ddeObjectPtr = cmdPtr;
+	}
+    }
+
+    if (result == TCL_OK) {
+	result = Tcl_EvalObjEx(riPtr->interp, ddeObjectPtr, TCL_EVAL_GLOBAL);
+    }
 
-    result = Tcl_EvalObjEx(riPtr->interp, ddeObjectPtr, TCL_EVAL_GLOBAL);
     returnPackagePtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
     Tcl_ListObjAppendElement(NULL, returnPackagePtr,
 	    Tcl_NewIntObj(result));
@@ -452,10 +543,12 @@ ExecuteRemoteObject(
     if (result == TCL_ERROR) {
 	errorObjPtr = Tcl_GetVar2Ex(riPtr->interp, "errorCode", NULL,
 		TCL_GLOBAL_ONLY);
-	Tcl_ListObjAppendElement(NULL, returnPackagePtr, errorObjPtr);
+	if (errorObjPtr)
+	    Tcl_ListObjAppendElement(NULL, returnPackagePtr, errorObjPtr);
 	errorObjPtr = Tcl_GetVar2Ex(riPtr->interp, "errorInfo", NULL,
 		TCL_GLOBAL_ONLY);
-        Tcl_ListObjAppendElement(NULL, returnPackagePtr, errorObjPtr);
+	if (errorObjPtr)
+	    Tcl_ListObjAppendElement(NULL, returnPackagePtr, errorObjPtr);
     }
 
     return returnPackagePtr;
@@ -625,17 +718,21 @@ DdeServerProc (
 			    returnString, (DWORD) len+1, 0, ddeItem, CF_TEXT,
 			    0);
 		} else {
-		    Tcl_Obj *variableObjPtr = Tcl_GetVar2Ex(
-			    convPtr->riPtr->interp, utilString, NULL, 
-			    TCL_GLOBAL_ONLY);
-		    if (variableObjPtr != NULL) {
-			returnString = Tcl_GetStringFromObj(variableObjPtr,
-				&len);
-			ddeReturn = DdeCreateDataHandle(ddeInstance,
-				returnString, (DWORD) len+1, 0, ddeItem,
-				CF_TEXT, 0);
-		    } else {
+		    if (Tcl_IsSafe(convPtr->riPtr->interp)) {
 			ddeReturn = NULL;
+		    } else {
+			Tcl_Obj *variableObjPtr = Tcl_GetVar2Ex(
+				convPtr->riPtr->interp, utilString, NULL, 
+				TCL_GLOBAL_ONLY);
+			if (variableObjPtr != NULL) {
+			    returnString = Tcl_GetStringFromObj(variableObjPtr,
+				    &len);
+			    ddeReturn = DdeCreateDataHandle(ddeInstance,
+				    returnString, (DWORD) len+1, 0, ddeItem, 
+				    CF_TEXT, 0);
+			} else {
+			    ddeReturn = NULL;
+			}
 		    }
 		}
 		Tcl_DStringFree(&dString);
@@ -1041,6 +1138,7 @@ Tcl_DdeObjCmd(
 
     enum {
 	DDE_SERVERNAME_EXACT,
+	DDE_SERVERNAME_HANDLER,
 	DDE_SERVERNAME_LAST,
     };
 
@@ -1049,7 +1147,7 @@ Tcl_DdeObjCmd(
 	  (char *) NULL};
     static CONST char *ddeOptions[] = {"-async", (char *) NULL};
     static CONST char *ddeReqOptions[] = {"-binary", (char *) NULL};
-    static CONST char *ddeSrvOptions[] = {"-exact", "--", (char *) NULL};
+    static CONST char *ddeSrvOptions[] = {"-exact", "-handler", "--", (char *) NULL};
     int index, argIndex, i;
     int async = 0, binary = 0, exact = 0;
     int result = TCL_OK;
@@ -1067,7 +1165,7 @@ Tcl_DdeObjCmd(
     HDDEDATA ddeReturn;
     RegisteredInterp *riPtr;
     Tcl_Interp *sendInterp;
-    Tcl_Obj *objPtr;
+    Tcl_Obj *objPtr, *handlerPtr = NULL;
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
     /*
@@ -1093,6 +1191,17 @@ Tcl_DdeObjCmd(
 		    break;
 		} else if (argIndex == DDE_SERVERNAME_EXACT) {
 		    exact = 1;
+		} else if (argIndex == DDE_SERVERNAME_HANDLER) {
+		    if ((objc - i) == 1) { /* return current handler */
+			RegisteredInterp *riPtr = DdeGetRegistrationPtr(interp);
+			if (riPtr && riPtr->handlerPtr) {
+			    Tcl_SetObjResult(interp, riPtr->handlerPtr);
+			} else {
+			    Tcl_ResetResult(interp);
+			}
+			return TCL_OK;
+		    }
+		    handlerPtr = objv[++i];
 		} else if (argIndex == DDE_SERVERNAME_LAST) {
 		    i++;
 		    break;
@@ -1100,7 +1209,7 @@ Tcl_DdeObjCmd(
 		    Tcl_ResetResult(interp);
 		    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
 			    "bad option \"", Tcl_GetString(objv[i]),
-			    "\": must be -exact, or --",
+			    "\": must be -exact, -handler or --",
 			    (char*)NULL);
 		    return TCL_ERROR;
 		}
@@ -1109,7 +1218,7 @@ Tcl_DdeObjCmd(
 	    if ((objc - i) > 1) {
 		Tcl_ResetResult(interp);
 		Tcl_WrongNumArgs(interp, 1, objv,
-			"servername ?-exact? ?--?"
+			"servername ?-exact? ?-handler proc? ?--?"
 			" ?serverName?");
 		return TCL_ERROR;
 	    }
@@ -1236,7 +1345,8 @@ Tcl_DdeObjCmd(
 
     switch (index) {
 	case DDE_SERVERNAME: {
-	    serviceName = DdeSetServerName(interp, serviceName, exact);
+	    serviceName = DdeSetServerName(interp, serviceName,
+		   exact, handlerPtr);
 	    if (serviceName != NULL) {
 		Tcl_SetStringObj(Tcl_GetObjResult(interp),
 			serviceName, -1);
@@ -1415,14 +1525,31 @@ Tcl_DdeObjCmd(
 		 * be referring to deallocated objects.
 		 */
 
-		if (objc == 1) {
-		    result = Tcl_EvalObjEx(sendInterp, objv[0],
-			    TCL_EVAL_GLOBAL);
-		} else {
-		    objPtr = Tcl_ConcatObj(objc, objv);
+		if (Tcl_IsSafe(riPtr->interp) && riPtr->handlerPtr == NULL) {
+		    Tcl_SetResult(riPtr->interp, "permission denied: "
+			    "a handler procedure must be defined for use in a safe interp", TCL_STATIC);
+		    result = TCL_ERROR;
+		}
+
+		if (result == TCL_OK) {
+		    if (objc == 1)
+			objPtr = objv[0];
+		    else {
+			objPtr = Tcl_ConcatObj(objc, objv);
+		    }
+		    if (riPtr->handlerPtr != NULL) {
+			/* add the dde request data to the handler proc list */			
+			/*result = Tcl_ListObjReplace(sendInterp, objPtr, 0, 0, 1, &(riPtr->handlerPtr));*/
+			Tcl_Obj *cmdPtr = Tcl_DuplicateObj(riPtr->handlerPtr);
+			result = Tcl_ListObjAppendElement(sendInterp, cmdPtr, objPtr);
+			if (result == TCL_OK) {
+			    objPtr = cmdPtr;
+			}
+		    }
+		}
+		if (result == TCL_OK) {
 		    Tcl_IncrRefCount(objPtr);
-		    result = Tcl_EvalObjEx(sendInterp, objPtr,
-			    TCL_EVAL_GLOBAL);
+		    result = Tcl_EvalObjEx(sendInterp, objPtr, TCL_EVAL_GLOBAL);
 		    Tcl_DecrRefCount(objPtr);
 		}
 		if (interp != sendInterp) {
@@ -1436,12 +1563,15 @@ Tcl_DdeObjCmd(
 			Tcl_ResetResult(interp);
 			objPtr = Tcl_GetVar2Ex(sendInterp, "errorInfo", NULL, 
 				TCL_GLOBAL_ONLY);
-			string = Tcl_GetStringFromObj(objPtr, &length);
-			Tcl_AddObjErrorInfo(interp, string, length);
+			if (objPtr) {
+			    string = Tcl_GetStringFromObj(objPtr, &length);
+			    Tcl_AddObjErrorInfo(interp, string, length);
+			}
 			
 			objPtr = Tcl_GetVar2Ex(sendInterp, "errorCode", NULL,
 				TCL_GLOBAL_ONLY);
-			Tcl_SetObjErrorCode(interp, objPtr);
+			if (objPtr)
+			    Tcl_SetObjErrorCode(interp, objPtr);
 		    }
 		    Tcl_SetObjResult(interp, Tcl_GetObjResult(sendInterp));
 		}
@@ -1580,3 +1710,11 @@ Tcl_DdeObjCmd(
     }
     return TCL_ERROR;
 }
+
+/*
+ * Local variables:
+ *  mode: c
+ *  indent-tabs-mode: t
+ *  tab-width: 8
+ * End:
+ */