'''How to Restrict The List of Exposed Commands'''

By default the dde package, when used as a server, exposes all of the commands and variables available in the interpreter. This is not always what is desired. One solution might be to load the package into a safe slave interpreter and use [interp alias] to expose the required commands. Unfortunately the package doesn't support safe interpreters.

A second solution is to build a modified dde package where the submitted code is first checked against list of permitted commands. The following patch allows you to setup, for instance:
  package require dde
  dde servername test
  proc ddeexported {cmd args} {return ok}
  set tcl_ddeok {ddeexported}
This will setup a dde server that will reject any attempt to execute any command except the ddeexported command. [PT]

----  
  
 Patch against Tcl 8.3.4

 *** tclWinDde.c.orig	Tue Apr 03 23:54:40 2001
 --- tclWinDde.c	Wed Apr 10 10:24:33 2002
 ***************
 *** 393,406 ****
   {
       Tcl_Obj *errorObjPtr;
       Tcl_Obj *returnPackagePtr;
 !     int result;
   
 -     result = Tcl_EvalObjEx(riPtr->interp, ddeObjectPtr, TCL_EVAL_GLOBAL);
       returnPackagePtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
       Tcl_ListObjAppendElement(NULL, returnPackagePtr,
 ! 	    Tcl_NewIntObj(result));
       Tcl_ListObjAppendElement(NULL, returnPackagePtr,
 ! 	    Tcl_GetObjResult(riPtr->interp));
       if (result == TCL_ERROR) {
   	errorObjPtr = Tcl_GetVar2Ex(riPtr->interp, "errorCode", NULL,
   		TCL_GLOBAL_ONLY);
 --- 393,448 ----
   {
       Tcl_Obj *errorObjPtr;
       Tcl_Obj *returnPackagePtr;
 !     Tcl_Obj *restrictObjPtr;	    /* The list of permitted commands */
 !     int      result = TCL_OK;
 ! 
 !     /** start
 !      *
 !      * check the restricted command list. In non-empty the only commands
 !      * in this list may be called [PT]
 !      */
 ! 
 !     restrictObjPtr = Tcl_GetVar2Ex(riPtr->interp,
 ! 				   "tcl_ddeok", NULL,
 ! 				   TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG);
 ! 
 !     /* get the first element from the ddeObjPtr list and compare against
 !      * our permitted command list. If it's not found then reject the 
 !      * submitted script */
 !     if (restrictObjPtr != NULL) {
 ! 	    int objc = 0, matched = 0, n;
 ! 	    Tcl_Obj **objv;
 ! 	    Tcl_Obj *ddeCmd;
 ! 
 ! 	    result = Tcl_ListObjIndex(riPtr->interp, ddeObjectPtr, 0, &ddeCmd);
 ! 	    if (result == TCL_OK && ddeCmd != NULL) {
 !     
 ! 		    result = Tcl_ListObjGetElements(riPtr->interp, restrictObjPtr, &objc, &objv);
 ! 		    if (result == TCL_OK) {
 ! 			    char * ddeCmdString = Tcl_GetString(ddeCmd);
 ! 			    for (n = 0; !matched && n < objc; ++n) {
 ! 				    matched = Tcl_StringMatch(ddeCmdString, Tcl_GetString(objv[n]));
 ! 			    }
 ! 			    if (!matched) {
 ! 				    Tcl_SetObjResult(riPtr->interp,
 ! 						     Tcl_NewStringObj("dde command refused", -1));
 ! 				    result = TCL_ERROR;
 ! 			    }
 ! 		    }
 ! 	    }
 !     }
 ! 
 !     if (result == TCL_OK) {
 !     
 ! 	    result = Tcl_EvalObjEx(riPtr->interp, ddeObjectPtr, TCL_EVAL_GLOBAL);
 !     }
   
       returnPackagePtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
       Tcl_ListObjAppendElement(NULL, returnPackagePtr,
 ! 			     Tcl_NewIntObj(result));
       Tcl_ListObjAppendElement(NULL, returnPackagePtr,
 ! 			     Tcl_GetObjResult(riPtr->interp));
 !     
       if (result == TCL_ERROR) {
   	errorObjPtr = Tcl_GetVar2Ex(riPtr->interp, "errorCode", NULL,
   		TCL_GLOBAL_ONLY);

----

 From: Donal K. Fellows 
 Subject: Re: calling tcl-procedures from outside tclsh
 View: Complete Thread (11 articles)
 Original Format
 Newsgroups: comp.lang.tcl
 Date: 2002-04-18 03:45:12 PST

 Pat Thoyts wrote:
 > On the other hand, significantly less work is involved in hacking the
 > dde command to read a list of permitted commands.
 > 
 > The attached patch lets you define a global tcl_ddeok list of
 > permitted command names (eg: set ::tcl_ddeok {ddemethod1 ddemethod2} )
 > and if this list exists only evaluates the script if the first word
 > [string match]es an element of this list.

 That seems like a bad (i.e. insecure) way to go; imagine something evil in
 square brackets for the second argument to ddemethod1.  A better way would be to
 allow a handler command to be nominated such that the whole incoming string gets
 passed as a single uninterpreted argument to the command in question (which in
 turn could pass things into a safe interpreter, of course, or anything else it
 feels like.)  This is probably an even easier way to do it too.

 Donal.

----

Donal's comment is right. If we allow 
 dde servername ?-handler procname? ?appname?
then we can set an optional handler procedure to handle all incoming DDE calls. Suitable handlers might be:
 # Allow all commands
 proc permissive {args} {
     eval uplevel #0 $args
 }

 # restricted to info
 proc restricted_handler {args} {
     set cmd [lindex $args 0]
     set allowed 0
     switch -exact -- $cmd {
         info { set allowed 1 }
     }
     if $allowed {
         eval uplevel #0 $args
     }
 }

 package require dde
 dde servername -handler ::permissive TestInterp

This should permit the use of Dde within a safe interpreter. Currently the dde command is marked as hidden if the interpreter is safe although you cannot currently load the dde package into a safe interp. Fixing this we can do
 safe::interpCreate slave
 slave load tcldde12d.dll Dde
 slave invokehidden dde servername -handler dde_cmd SafeSlave
 slave eval {proc dde_cmd args {eval uplevel #0 $args}}
to setup a dde server within a safe interpreter. As the [dde] command is hidden, the client cannot call the command. However, with a little aliasing we could change that - for instance, only permitting dde calls back to the originator. To make it secure bu default, we will refuse to evaluate dde eval request in the safe interp if there is no handler defined.

----
See also [dde]