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
*** 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);