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.
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 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} {
uplevel #0 $args
}
# restricted to info
proc restricted_handler {args} {
set cmd [lindex $args 0]
switch -exact -- $cmd {
info { uplevel #0 $args }
default { return -code error "permission denied" }
}
}
package require dde
dde servername -handler ::permissive TestInterpThis 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 invokehidden load tcldde12d.dll Dde
interp alias slave dde_cmd {} restricted_handler
slave invokehidden dde servername -handler dde_cmd SafeSlaveto 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 by default, we will refuse to evaluate dde eval requests in the safe interpreter if there is no handler defined. We also disable the dde request handling in the server code.
This patch against the Tcl 8.4.1 source (dde 1.2) provides the -handler and safe interpreter usage outliner above.
*** tclWinDde.c.orig Wed Dec 04 13:54:54 2002
--- tclWinDde.c Wed Dec 04 15:42:36 2002
***************
*** 35,40 ****
--- 35,41 ----
/* The next interp this application knows char *name; /* Interpreter's name (malloc-ed). */
+ Tcl_Obj *handlerPtr; /* The server handler command */
Tcl_Interp *interp; /* The interpreter attached to this name. */
} RegisteredInterp;
***************
*** 97,102 ****
--- 98,104 ----
Tcl_Obj *CONST objv[]); /* The arguments */
EXTERN int Dde_Init(Tcl_Interp *interp);
+ EXTERN int Dde_SafeInit(Tcl_Interp *interp);
�
/*
*----------------------------------------------------------------------
***************
*** 139,144 ****
--- 141,172 ----
return Tcl_PkgProvide(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION);
}
�
+ /*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ }
�
/*
*----------------------------------------------------------------------
***************
*** 233,242 ****
static char *
DdeSetServerName(
Tcl_Interp *interp,
! char *name /* The name that will be used to )
{
int suffix, offset;
--- 261,272 ----
static char *
DdeSetServerName(
Tcl_Interp *interp,
! char *name, /* The name that will be used to + Tcl_Obj *handlerPtr /* Name of the optional proc/command to handle
+ * incoming Dde eval's */
)
{
int suffix, offset;
***************
*** 300,308 ****
--- 330,345 ----
riPtr->interp = interp;
riPtr->name = ckalloc(strlen(name) + 1);
riPtr->nextPtr = tsdPtr->interpListPtr;
+ riPtr->handlerPtr = handlerPtr;
+ if (riPtr->handlerPtr != NULL)
+ Tcl_IncrRefCount(riPtr->handlerPtr);
tsdPtr->interpListPtr = riPtr;
strcpy(riPtr->name, name);
+ if (Tcl_IsSafe(interp)) {
+ Tcl_ExposeCommand(interp, "dde", "dde");
+ }
+
Tcl_CreateObjCommand(interp, "dde", Tcl_DdeObjCmd,
(ClientData) riPtr, DeleteProc);
if (Tcl_IsSafe(interp)) {
***************
*** 359,364 ****
--- 396,403 ----
}
}
ckfree(riPtr->name);
+ if (riPtr->handlerPtr)
+ Tcl_DecrRefCount(riPtr->handlerPtr);
Tcl_EventuallyFree(clientData, TCL_DYNAMIC);
}
�
***************
*** 395,401 ****
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));
--- 434,454 ----
Tcl_Obj *returnPackagePtr;
int result;
! if (riPtr->handlerPtr == NULL && Tcl_IsSafe(riPtr->interp)) {
! Tcl_SetStringObj(Tcl_GetObjResult(riPtr->interp),
! "permission denied: a handler procedure must be defined for use in a safe interp", -1);
! result = TCL_ERROR;
! }
!
! if (riPtr->handlerPtr != NULL) {
! /* prefix the passed in arguments with the handler command */
! result = Tcl_ListObjReplace(riPtr->interp, ddeObjectPtr, 0, 0, 1, &(riPtr->handlerPtr));
! }
!
! 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));
***************
*** 570,591 ****
DdeQueryString(ddeInstance, ddeItem, utilString,
len + 1, CP_WINANSI);
if (stricmp(utilString, "$TCLEVAL$EXECUTE$RESULT") == 0) {
! returnString =
! Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len);
ddeReturn = DdeCreateDataHandle(ddeInstance,
returnString, 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, len+1, 0, ddeItem, CF_TEXT, 0);
} else {
! ddeReturn = NULL;
}
}
Tcl_DStringFree(&dString);
--- 623,648 ----
DdeQueryString(ddeInstance, ddeItem, utilString,
len + 1, CP_WINANSI);
if (stricmp(utilString, "$TCLEVAL$EXECUTE$RESULT") == 0) {
! returnString =
! Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len);
ddeReturn = DdeCreateDataHandle(ddeInstance,
returnString, 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, len+1, 0, ddeItem, CF_TEXT, 0);
! } else {
! ddeReturn = NULL;
! }
}
}
Tcl_DStringFree(&dString);
***************
*** 839,844 ****
--- 896,902 ----
(char *) NULL};
static CONST char *ddeOptions[] = {"-async", (char *) NULL};
static CONST char *ddeReqOptions[] = {"-binary", (char *) NULL};
+ static CONST char *ddeSrvOptions[] = {"-handler", (char *) NULL};
int index, argIndex;
int async = 0, binary = 0;
int result = TCL_OK;
***************
*** 856,862 ****
HDDEDATA ddeReturn;
RegisteredInterp *riPtr;
Tcl_Interp *sendInterp;
! Tcl_Obj *objPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
/*
--- 914,920 ----
HDDEDATA ddeReturn;
RegisteredInterp *riPtr;
Tcl_Interp *sendInterp;
! Tcl_Obj *objPtr, *handlerPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
/*
***************
*** 876,886 ****
switch (index) {
case DDE_SERVERNAME:
! if ((objc != 3) && (objc != 2)) {
! Tcl_WrongNumArgs(interp, 1, objv, "servername ?serverName?");
return TCL_ERROR;
}
! firstArg = (objc - 1);
break;
case DDE_EXECUTE:
if ((objc < 5) || (objc > 6)) {
--- 934,960 ----
switch (index) {
case DDE_SERVERNAME:
! if ((objc < 2) && (objc > 5)) {
! Tcl_WrongNumArgs(interp, 1, objv, "servername ?-handler proc? ?serverName?");
return TCL_ERROR;
}
! if (Tcl_GetIndexFromObj(NULL, objv[2], ddeSrvOptions, "option", 0,
! &argIndex) != TCL_OK) {
! if (objc > 3) {
! Tcl_WrongNumArgs(interp, 1, objv,
! "servername ?-handler proc? ?serverName?");
! return TCL_ERROR;
! }
! handlerPtr = NULL;
! firstArg = (objc - 1);
! } else {
! if (objc < 4) {
! Tcl_SetStringObj(Tcl_GetObjResult(interp), "HANDLER", -1);
! return TCL_OK;
! }
! handlerPtr = objv[3];
! firstArg = (objc == 5) ? (objc - 1) : 1;
! }
break;
case DDE_EXECUTE:
if ((objc < 5) || (objc > 6)) {
***************
*** 1002,1008 ****
switch (index) {
case DDE_SERVERNAME: {
! serviceName = DdeSetServerName(interp, serviceName);
if (serviceName != NULL) {
Tcl_SetStringObj(Tcl_GetObjResult(interp),
serviceName, -1);
--- 1076,1082 ----
switch (index) {
case DDE_SERVERNAME: {
! serviceName = DdeSetServerName(interp, serviceName, handlerPtr);
if (serviceName != NULL) {
Tcl_SetStringObj(Tcl_GetObjResult(interp),
serviceName, -1);See also dde