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.See also dde