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.
Following on from Donal's suggestion, 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.
TIP Proposal
Title: Restricted DDE services Author: Pat Thoyts <[email protected]> Created: 04-Dec-2002
~ Abstract
This TIP proposes to provide a mechanism to restrict the exposure of the Tcl interpreter when used as a DDE service.
~ Rationale
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 loading into safe interpreters.
~ Proposed Changes
Firstly, this TIP proposes a -handler option to the [dde servername] sub-command. The argument for this option should be the name of a procedure that will authenticate and evaluate DDE requests.
Secondly, the DDE package should be enhanced to be capable of providing a service within a safe interpreter.
~ New option
The new syntax will be dde servername ?-handler procname? servername To permit introspection we will accept dde servername -handler which will return the handler name (if any). If a servername must be defined using an initial hyphen then the standard '--' separator can be used.
The handler name is inserted as the first element of the code to be evaluated. This ensures that all unsafe elements will not be evaluated before the handler code has a chance to examine them. So
proc handler {args} {
if {[string match info [lindex $args 0]]} {
uplevel #0 $args
} else
return -code error "permission denied"
}
}The above handler will permit [info vars] but will fail when trying [info vars ; bad_proc] with info complaining about the wrong number of parameters.
~ Safe DDE
The dde package should support loading within a safe interpreter but with the following constraints.
~ Reference Implementation
~ Example
# Provide a handler that only allows the [info] command
# Note: This runs in the master interp.
proc restricted_handler {args} {
set cmd [lindex $args 0]
set allowed 0
switch -exact -- $cmd {
info { uplevel #0 $args }
default { return -code error "permission denied" }
}
}
# Create a safe slave interpreter and expose as a DDE service.
safe::interpCreate slave
slave invokehidden package require dde
slave invokehidden dde servername -handler dde_cmd SafeSlave
interp alias slave dde_cmd {} restricted_handler
set ::_waiting 0 ; after 20000 {set ::_waiting 1} ; vwait ::_waiting
~ Consequences
There should be no change to current users of this package unless they are using a server name beginning with a hyphen. In this case they will need to insert '--' before the server name.
~ Copyright
This document is hereby placed in the public domain.
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