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.
TIP Proposal
TIP: 107 Title: Fix the 2-second "raise delay" in Tk Version: $Revision: 1.13 $ Author: Joe English <[email protected]> State: Final Type: Project Created: 28-Aug-2002 Tcl-Version: 8.4 Vote: Done Post-History:
~ Abstract
This TIP explains the genesis of the long delays often associated with the [raise] and [lower] commands under Unix/X with some window managers, as well as describing the solution.
~ Rationale
Currently, Tk's [raise] and [lower] commands do not return to the caller until the operation has completed. Under Unix, the window manager is responsible for changing the stacking order of toplevel windows, so [raise] and [lower] must wait for a notification from the WM before returning. Not all window managers are ICCCM-compliant in this regard, however, so the operation may time out instead.
This two-second "raise delay" has been a longstanding, persistent problem in Tk. It has supposedly been fixed several times, but the problem keeps reoccurring under new window managers and new environments. At present, the problem is most noticeable under KDE 2 and KDE 3.
~ Proposal
Change Tk so that [raise] and [lower] return immediately, without waiting for a notification that may not be forthcoming.
This should not be be a controversial change. This behaviour is not documented anywhere, and is not observable by Tk programs except via [wm stackorder] (see 74).
Moreover, the guarantee is largely meaningless. After [raise] returns, the window contents may still not be visible (there may be pending <Expose> events, for example), and the actual position in the stacking order is still subject to window manager intervention.
~ Compatibility Issues
The only Tk programs that would break with this change are ones which expect the return value of [wm stackorder] to reflect the results of any immediately-preceding [raise] and [lower] commands. (The Tk test suite is one such program, and would need to be modified).
Unfortunately there is no reliable way to fix such programs - [update] will not work, and the ICCCM does not, to the author's knowledge, provide a way to synchronize with the window manager to make sure it has processed all outstanding client requests. Even if it did, this wouldn't help - the raise delay problem only occurs under non-compliant window managers to begin with!
Since the stacking order is not observable except through [wm stackorder] - that was the whole point of 74 - no other programs will be affected. (Note that [wm stackorder] will still work: the only difference is that it may return soon-to-be out-of-date information. Since this is the case already - the user may restack or iconify windows at any time - this change should be low-impact.)
~ Reference Implementation
See Sourceforge Tk Patch #601518. http://sourceforge.net/tracker/index.php?func=detail&aid=601518&group_id=12997&atid=312997
~ Author's Note
Could we fast-track this? It's a longstanding problem with a simple fix and ought to make it in before 8.4 goes final.
~ Detailed Analysis
First, some terminology:
toplevel and its (optional) menubar. Initially created as a
child of the root window. window created as a child of the root window by an X client.
Tk wrapper windows are client windows. Most window managers
reparent client windows under a new frame window which holds
window manager decorations.wrapper which has been reparented by a window manager.
root window) created by the window manager to hold a client
window and its decorations. May or may not be the same as the
reparent window.Next, some methodology:
The correct way to change the stacking order of a client window is to make a ConfigureRequest on the client window with stack_mode set appropriately. If the client has not been reparented, then the X server performs the operation directly, and will send a ConfigureNotify back to the client if, and only if, the actual stacking order has changed. (Raising a window which is already at the top of the stacking order will not result in a ConfigureNotify, for example).
If the client window has been reparented (which is usually the case), then the window manager intercepts the request and, at its discretion, restacks the frame window instead. It then sends a synthetic ConfigureNotify back to the client, regardless of whether or not it honored the request.
If the stacking order is to be changed relative to some other window - that is, if the sibling field is also set - and the client has been reparented, then the ConfigureRequest will fail with a BadMatch error before it gets to the WM. Clients must be prepared to handle this case by catching the error and re-sending a synthetic ConfigureRequest to the root window, which the WM receives and handles as above.
See ICCCM section 4.1.5 "Configuring the Window" for the full specification. The Xlib function XReconfigureWMWindow() takes care of all these details.
Now, some archaeology:
Tk 4.0 did not do this: instead, it called XConfigureWindow() on the reparent window, then waited for a ConfigureNotify on that window.
This was wrong on at least two counts. First, the reparent window might not be the same as the frame window, in which case this would have no effect at all. (In 4DWm and Sawfish, for example, the reparent window is a child of an outer frame window). Second, it's not ICCCM-compliant (Tk doesn't own the reparent window and shouldn't be mucking with it).
Tk 4.0 also included several heuristics that attempted to determine when the operation was unnecessary, to avoid waiting for a ConfigureNotify on the reparent that was not forthcoming.
In Tk 4.1, the (incorrect) call to XConfigureWindow() on the reparent was changed to a (correct) call to XReconfigureWMWindow() on the wrapper, but the old heuristic code was left mostly intact.
Browsing the CVS logs and the older Tk Changelog, we see that this code has been updated several times to account for new conditions, but ultimately without success: the problem persists.
These heuristics are not needed at all under WMs which send a synthetic ConfigureNotify in response to client window stacking order changes. On some non-compliant WMs, however, they may help lessen the problem - more by accident than by design - if the reparent is the same as the frame window then the Tk 4.0 heuristics sometimes still work. But even then the heuristics are not reliable. For instance under KDE 2.2 and KDE 3, calling [raise] twice in succession always results in a 2-second delay.
It is the author's opinion that the only way forward is to let [raise] and [lower] run asynchronously, and fix the two-second raise delay once and for all.
~ 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