Tcl Source Code

Artifact Content
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Artifact 66631353c429df494d3fe25d27d32df8842a1492:

Attachment "RestrictedDDE.patch" to ticket [649859ffff] added by patthoyts 2002-12-07 08:07:01.
Index: tclWinDde.c
===================================================================
RCS file: /cvsroot/tcl/tcl/win/tclWinDde.c,v
retrieving revision 1.8
diff -c -r1.8 tclWinDde.c
*** tclWinDde.c	18 Jan 2002 14:07:40 -0000	1.8
--- tclWinDde.c	7 Dec 2002 00:56:43 -0000
***************
*** 35,40 ****
--- 35,41 ----
  				/* The next interp this application knows
  				 * about. */
      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
  				 * refer to the interpreter in later
  				 * "send" commands.  Must be globally
  				 * unique. */
      )
  {
      int suffix, offset;
--- 261,272 ----
  static char *
  DdeSetServerName(
      Tcl_Interp *interp,
!     char *name,			/* The name that will be used to
  				 * refer to the interpreter in later
  				 * "send" commands.  Must be globally
  				 * unique. */
+     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)) {
***************
*** 321,326 ****
--- 358,395 ----
  /*
   *--------------------------------------------------------------
   *
+  * DdeGetRegistrationPtr
+  *
+  *	Retrieve the registration info for an interpreter.
+  *
+  * Results:
+  *	Returns a pointer to the registration structure or NULL
+  *
+  * Side effects:
+  *	None
+  *
+  *--------------------------------------------------------------
+  */
+ static RegisteredInterp *
+ DdeGetRegistrationPtr(
+     Tcl_Interp *interp
+     )
+ {
+     RegisteredInterp *riPtr;
+     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ 
+     for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; 
+ 	    riPtr = riPtr->nextPtr) {
+ 	if (riPtr->interp == interp) {
+ 	    break;
+ 	}
+     }
+     return riPtr;
+ }
+ 
+ /*
+  *--------------------------------------------------------------
+  *
   * DeleteProc
   *
   *	This procedure is called when the command "dde" is destroyed.
***************
*** 359,364 ****
--- 428,435 ----
  	}
      }
      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));
--- 466,486 ----
      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));
***************
*** 576,591 ****
  			    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);
--- 661,680 ----
  			    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 ****
--- 928,934 ----
  	  (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);
  
      /*
--- 946,952 ----
      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)) {
--- 966,997 ----
  
      switch (index) {
  	case DDE_SERVERNAME:
! 	    if ((objc < 2) && (objc > 5)) {
! 		Tcl_WrongNumArgs(interp, 1, objv, "servername ?-handler proc? ?serverName?");
  		return TCL_ERROR;
  	    }
! 	    if (objc > 2 && Tcl_GetIndexFromObj(NULL, objv[2], ddeSrvOptions, "option", 0,
! 		    &argIndex) == TCL_OK) {
! 		if (objc < 4) {
! 		    RegisteredInterp *riPtr = DdeGetRegistrationPtr(interp);
! 		    if (riPtr && riPtr->handlerPtr) {
! 			Tcl_SetObjResult(interp, riPtr->handlerPtr);
! 		    } else {
! 			Tcl_ResetResult(interp);
! 		    }
! 		    return TCL_OK;
! 		}
! 		handlerPtr = objv[3];
! 		firstArg = (objc == 5) ? (objc - 1) : 1;
! 	    } else {
! 		if (objc > 3) {
! 		    Tcl_WrongNumArgs(interp, 1, objv,
! 			    "servername ?-handler proc? ?serverName?");
! 		    return TCL_ERROR;
! 		}
! 		handlerPtr = NULL;
! 		firstArg = (objc - 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);
--- 1113,1119 ----
  
      switch (index) {
  	case DDE_SERVERNAME: {
! 	    serviceName = DdeSetServerName(interp, serviceName, handlerPtr);
  	    if (serviceName != NULL) {
  		Tcl_SetStringObj(Tcl_GetObjResult(interp),
  			serviceName, -1);