diff options
| -rw-r--r-- | generic/tkFrame.c | 24 | ||||
| -rw-r--r-- | generic/tkInt.h | 3 | ||||
| -rw-r--r-- | generic/tkWindow.c | 309 | ||||
| -rw-r--r-- | tests/safe.test | 2 |
4 files changed, 168 insertions, 170 deletions
diff --git a/generic/tkFrame.c b/generic/tkFrame.c index 057b4b8..f6edfb0 100644 --- a/generic/tkFrame.c +++ b/generic/tkFrame.c @@ -447,6 +447,30 @@ TkCreateFrame( return result; } +int +TkListCreateFrame( + ClientData clientData, /* Either NULL or pointer to option table. */ + Tcl_Interp *interp, /* Current interpreter. */ + Tcl_Obj *listObj, /* List of arguments. */ + int toplevel, /* Non-zero means create a toplevel window, + * zero means create a frame. */ + Tcl_Obj *nameObj) /* Should only be non-NULL if there is no main + * window associated with the interpreter. + * Gives the base name to use for the new + * application. */ + +{ + int objc; + Tcl_Obj **objv; + + if (TCL_OK != Tcl_ListObjGetElements(interp, listObj, &objc, &objv)) { + return TCL_ERROR; + } + return CreateFrame(clientData, interp, objc, objv, + toplevel ? TYPE_TOPLEVEL : TYPE_FRAME, + nameObj ? Tcl_GetString(nameObj) : NULL); +} + static int CreateFrame( ClientData clientData, /* NULL. */ diff --git a/generic/tkInt.h b/generic/tkInt.h index 029f0f1..dd5dcad 100644 --- a/generic/tkInt.h +++ b/generic/tkInt.h @@ -1217,6 +1217,9 @@ MODULE_SCOPE int TkInitTkCmd(Tcl_Interp *interp, MODULE_SCOPE int TkInitFontchooser(Tcl_Interp *interp, ClientData clientData); MODULE_SCOPE void TkpWarpPointer(TkDisplay *dispPtr); +MODULE_SCOPE int TkListCreateFrame(ClientData clientData, + Tcl_Interp *interp, Tcl_Obj *listObj, + int toplevel, Tcl_Obj *nameObj); #ifdef _WIN32 #define TkParseColor XParseColor diff --git a/generic/tkWindow.c b/generic/tkWindow.c index 9977ac5..7afb031 100644 --- a/generic/tkWindow.c +++ b/generic/tkWindow.c @@ -54,12 +54,6 @@ typedef struct ThreadSpecificData { static Tcl_ThreadDataKey dataKey; /* - * The Mutex below is used to lock access to the Tk_Uid structs above. - */ - -TCL_DECLARE_MUTEX(windowMutex) - -/* * Default values for "changes" and "atts" fields of TkWindows. Note that Tk * always requests all events for all windows, except StructureNotify events * on internal windows: these events are generated internally. @@ -206,40 +200,6 @@ static const TkCmd commands[] = { }; /* - * The variables and table below are used to parse arguments from the "argv" - * variable in Tk_Init. - */ - -static int synchronize = 0; -static char *name = NULL; -static char *display = NULL; -static char *geometry = NULL; -static char *colormap = NULL; -static char *use = NULL; -static char *visual = NULL; -static int rest = 0; - -static const Tk_ArgvInfo argTable[] = { - {"-colormap", TK_ARGV_STRING, NULL, (char *) &colormap, - "Colormap for main window"}, - {"-display", TK_ARGV_STRING, NULL, (char *) &display, - "Display to use"}, - {"-geometry", TK_ARGV_STRING, NULL, (char *) &geometry, - "Initial geometry for window"}, - {"-name", TK_ARGV_STRING, NULL, (char *) &name, - "Name to use for application"}, - {"-sync", TK_ARGV_CONSTANT, (char *) 1, (char *) &synchronize, - "Use synchronous mode for display server"}, - {"-visual", TK_ARGV_STRING, NULL, (char *) &visual, - "Visual for main window"}, - {"-use", TK_ARGV_STRING, NULL, (char *) &use, - "Id of window in which to embed application"}, - {"--", TK_ARGV_REST, (char *) 1, (char *) &rest, - "Pass all remaining arguments through to script"}, - {NULL, TK_ARGV_END, NULL, NULL, NULL} -}; - -/* * Forward declarations to functions defined later in this file: */ @@ -3028,16 +2988,51 @@ MODULE_SCOPE const TkStubs tkStubs; */ static int +CopyValue( + ClientData dummy, + Tcl_Obj *objPtr, + void *dstPtr) +{ + *(Tcl_Obj **)dstPtr = objPtr; + return 1; +} + +static int Initialize( Tcl_Interp *interp) /* Interpreter to initialize. */ { - char *p; - int argc, code; - const char **argv; - const char *args[20]; - const char *argString = NULL; - Tcl_DString class; + int code = TCL_OK; ThreadSpecificData *tsdPtr; + Tcl_Obj *value = NULL; + Tcl_Obj *cmd; + + Tcl_Obj *nameObj = NULL; + Tcl_Obj *classObj = NULL; + Tcl_Obj *displayObj = NULL; + Tcl_Obj *colorMapObj = NULL; + Tcl_Obj *useObj = NULL; + Tcl_Obj *visualObj = NULL; + Tcl_Obj *geometryObj = NULL; + + int sync = 0; + + const Tcl_ArgvInfo table[] = { + {TCL_ARGV_CONSTANT, "-sync", INT2PTR(1), &sync, + "Use synchronous mode for display server", NULL}, + {TCL_ARGV_FUNC, "-colormap", CopyValue, &colorMapObj, + "Colormap for main window", NULL}, + {TCL_ARGV_FUNC, "-display", CopyValue, &displayObj, + "Display to use", NULL}, + {TCL_ARGV_FUNC, "-geometry", CopyValue, &geometryObj, + "Initial geometry for window", NULL}, + {TCL_ARGV_FUNC, "-name", CopyValue, &nameObj, + "Name to use for application", NULL}, + {TCL_ARGV_FUNC, "-visual", CopyValue, &visualObj, + "Visual for main window", NULL}, + {TCL_ARGV_FUNC, "-use", CopyValue, &useObj, + "Id of window in which to embed application", NULL}, + TCL_ARGV_AUTO_REST, TCL_ARGV_AUTO_HELP, TCL_ARGV_TABLE_END + }; /* * Ensure that we are getting a compatible version of Tcl. @@ -3056,23 +3051,6 @@ Initialize( tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* - * Start by initializing all the static variables to default acceptable - * values so that no information is leaked from a previous run of this - * code. - */ - - Tcl_MutexLock(&windowMutex); - synchronize = 0; - name = NULL; - display = NULL; - geometry = NULL; - colormap = NULL; - use = NULL; - visual = NULL; - rest = 0; - argv = NULL; - - /* * We start by resetting the result because it might not be clean. */ @@ -3084,8 +3062,6 @@ Initialize( * master. */ - Tcl_DString ds; - /* * Step 1 : find the master and construct the interp name (could be a * function if new APIs were ok). We could also construct the path @@ -3095,18 +3071,13 @@ Initialize( Tcl_Interp *master = interp; - while (1) { + while (Tcl_IsSafe(master)) { master = Tcl_GetMaster(master); if (master == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "no controlling master interpreter", -1)); Tcl_SetErrorCode(interp, "TK", "SAFE", "NO_MASTER", NULL); - code = TCL_ERROR; - goto done; - } - if (!Tcl_IsSafe(master)) { - /* Found the trusted master. */ - break; + return TCL_ERROR; } } @@ -3116,39 +3087,30 @@ Initialize( code = Tcl_GetInterpPath(master, interp); if (code != TCL_OK) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "error in Tcl_GetInterpPath", -1)); - Tcl_SetErrorCode(interp, "TK", "SAFE", "FAILED", NULL); - goto done; + Tcl_Panic("Tcl_GetInterpPath broken!"); } /* - * Build the string to eval. + * Build the command to eval in trusted master. */ - Tcl_DStringInit(&ds); - Tcl_DStringAppendElement(&ds, "::safe::TkInit"); - Tcl_DStringAppendElement(&ds, Tcl_GetString(Tcl_GetObjResult(master))); - + cmd = Tcl_NewListObj(2, NULL); + Tcl_ListObjAppendElement(NULL, cmd, + Tcl_NewStringObj("::safe::TkInit", -1)); + Tcl_ListObjAppendElement(NULL, cmd, Tcl_GetObjResult(master)); + /* * Step 2 : Eval in the master. The argument is the *reversed* interp * path of the slave. */ - code = Tcl_EvalEx(master, Tcl_DStringValue(&ds), -1, 0); + Tcl_IncrRefCount(cmd); + code = Tcl_EvalObjEx(master, cmd, 0); + Tcl_DecrRefCount(cmd); + Tcl_TransferResult(master, code, interp); if (code != TCL_OK) { - /* - * We might want to transfer the error message or not. We don't. - * (No API to do it and maybe security reasons). - */ - - Tcl_DStringFree(&ds); - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "not allowed to start Tk by master's safe::TkInit", -1)); - Tcl_SetErrorCode(interp, "TK", "SAFE", "FAILED", NULL); - goto done; + return code; } - Tcl_DStringFree(&ds); /* * Use the master's result as argv. Note: We don't use the Obj @@ -3156,7 +3118,7 @@ Initialize( * changing the code below. */ - argString = Tcl_GetString(Tcl_GetObjResult(master)); + value = Tcl_GetObjResult(interp); } else { /* * If there is an "argv" variable, get its value, extract out relevant @@ -3164,50 +3126,67 @@ Initialize( * that we used. */ - argString = Tcl_GetVar2(interp, "argv", NULL, TCL_GLOBAL_ONLY); + value = Tcl_GetVar2Ex(interp, "argv", NULL, TCL_GLOBAL_ONLY); } - if (argString != NULL) { - char buffer[TCL_INTEGER_SPACE]; - if (Tcl_SplitList(interp, argString, &argc, &argv) != TCL_OK) { - argError: + if (value) { + int objc; + Tcl_Obj **objv, **rest; + Tcl_Obj *parseList = Tcl_NewListObj(1, NULL); + + Tcl_ListObjAppendElement(NULL, parseList, Tcl_NewObj()); + + Tcl_IncrRefCount(value); + if (TCL_OK != Tcl_ListObjAppendList(interp, parseList, value) || + TCL_OK != Tcl_ListObjGetElements(NULL, parseList, &objc, &objv) || + TCL_OK != Tcl_ParseArgsObjv(interp, table, &objc, objv, &rest)) { Tcl_AddErrorInfo(interp, "\n (processing arguments in argv variable)"); code = TCL_ERROR; - goto done; } - if (Tk_ParseArgv(interp, (Tk_Window) NULL, &argc, argv, - argTable, TK_ARGV_DONT_SKIP_FIRST_ARG|TK_ARGV_NO_DEFAULTS) - != TCL_OK) { - goto argError; + if (code == TCL_OK) { + Tcl_SetVar2Ex(interp, "argv", NULL, + Tcl_NewListObj(objc-1, rest+1), TCL_GLOBAL_ONLY); + Tcl_SetVar2Ex(interp, "argc", NULL, + Tcl_NewIntObj(objc-1), TCL_GLOBAL_ONLY); + ckfree(rest); + } + Tcl_DecrRefCount(parseList); + if (code != TCL_OK) { + goto done; } - p = Tcl_Merge(argc, argv); - Tcl_SetVar2(interp, "argv", NULL, p, TCL_GLOBAL_ONLY); - sprintf(buffer, "%d", argc); - Tcl_SetVar2(interp, "argc", NULL, buffer, TCL_GLOBAL_ONLY); - ckfree(p); } /* * Figure out the application's name and class. */ - Tcl_DStringInit(&class); - if (name == NULL) { - int offset; + /* + * If we got no -name argument, fetch from TkpGetAppName(). + */ - TkpGetAppName(interp, &class); - offset = Tcl_DStringLength(&class)+1; - Tcl_DStringSetLength(&class, 2*offset); - Tcl_DStringAppend(&class, Tcl_DStringValue(&class), offset-1); - name = Tcl_DStringValue(&class) + offset; - } else { - Tcl_DStringAppend(&class, name, -1); + if (nameObj == NULL) { + Tcl_DString nameDS; + + Tcl_DStringInit(&nameDS); + TkpGetAppName(interp, &nameDS); + nameObj = Tcl_NewStringObj(Tcl_DStringValue(&nameDS), + Tcl_DStringLength(&nameDS)); + Tcl_DStringFree(&nameDS); } - p = Tcl_DStringValue(&class); - if (*p) { - Tcl_UtfToTitle(p); + /* + * The -class argument is always the ToTitle of the -name + */ + + { + int numBytes; + const char *bytes = Tcl_GetStringFromObj(nameObj, &numBytes); + + classObj = Tcl_NewStringObj(bytes, numBytes); + + numBytes = Tcl_UtfToTitle(Tcl_GetString(classObj)); + Tcl_SetObjLength(classObj, numBytes); } /* @@ -3215,15 +3194,14 @@ Initialize( * information parsed from argv, if any. */ - args[0] = "toplevel"; - args[1] = "."; - args[2] = "-class"; - args[3] = Tcl_DStringValue(&class); - argc = 4; - if (display != NULL) { - args[argc] = "-screen"; - args[argc+1] = display; - argc += 2; + cmd = Tcl_NewStringObj("toplevel . -class", -1); + + Tcl_ListObjAppendElement(NULL, cmd, classObj); + classObj = NULL; + + if (displayObj) { + Tcl_ListObjAppendElement(NULL, cmd, Tcl_NewStringObj("-screen", -1)); + Tcl_ListObjAppendElement(NULL, cmd, displayObj); /* * If this is the first application for this process, save the display @@ -3232,36 +3210,35 @@ Initialize( */ if (tsdPtr->numMainWindows == 0) { - Tcl_SetVar2(interp, "env", "DISPLAY", display, TCL_GLOBAL_ONLY); + Tcl_SetVar2Ex(interp, "env", "DISPLAY", displayObj, TCL_GLOBAL_ONLY); } + displayObj = NULL; } - if (colormap != NULL) { - args[argc] = "-colormap"; - args[argc+1] = colormap; - argc += 2; - colormap = NULL; + if (colorMapObj) { + Tcl_ListObjAppendElement(NULL, cmd, Tcl_NewStringObj("-colormap", -1)); + Tcl_ListObjAppendElement(NULL, cmd, colorMapObj); + colorMapObj = NULL; } - if (use != NULL) { - args[argc] = "-use"; - args[argc+1] = use; - argc += 2; - use = NULL; + if (useObj) { + Tcl_ListObjAppendElement(NULL, cmd, Tcl_NewStringObj("-use", -1)); + Tcl_ListObjAppendElement(NULL, cmd, useObj); + useObj = NULL; } - if (visual != NULL) { - args[argc] = "-visual"; - args[argc+1] = visual; - argc += 2; - visual = NULL; + if (visualObj) { + Tcl_ListObjAppendElement(NULL, cmd, Tcl_NewStringObj("-visual", -1)); + Tcl_ListObjAppendElement(NULL, cmd, visualObj); + visualObj = NULL; } - args[argc] = NULL; - code = TkCreateFrame(NULL, interp, argc, args, 1, name); - Tcl_DStringFree(&class); + code = TkListCreateFrame(NULL, interp, cmd, 1, nameObj); + + Tcl_DecrRefCount(cmd); + if (code != TCL_OK) { goto done; } Tcl_ResetResult(interp); - if (synchronize) { + if (sync) { XSynchronize(Tk_Display(Tk_MainWindow(interp)), True); } @@ -3270,19 +3247,19 @@ Initialize( * geometry into the "geometry" variable. */ - if (geometry != NULL) { - Tcl_DString buf; + if (geometryObj) { + + Tcl_SetVar2Ex(interp, "geometry", NULL, geometryObj, TCL_GLOBAL_ONLY); - Tcl_SetVar2(interp, "geometry", NULL, geometry, TCL_GLOBAL_ONLY); - Tcl_DStringInit(&buf); - Tcl_DStringAppend(&buf, "wm geometry . ", -1); - Tcl_DStringAppend(&buf, geometry, -1); - code = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), -1, 0); - Tcl_DStringFree(&buf); + cmd = Tcl_NewStringObj("wm geometry .", -1); + Tcl_ListObjAppendElement(NULL, cmd, geometryObj); + Tcl_IncrRefCount(cmd); + code = Tcl_EvalObjEx(interp, cmd, 0); + Tcl_DecrRefCount(cmd); + geometryObj = NULL; if (code != TCL_OK) { goto done; } - geometry = NULL; } /* @@ -3319,10 +3296,6 @@ Initialize( * console window interpreter. */ - Tcl_MutexUnlock(&windowMutex); - if (argv != NULL) { - ckfree(argv); - } code = TkpInit(interp); if (code == TCL_OK) { @@ -3355,12 +3328,10 @@ tkInit", -1, 0); TkCreateThreadExitHandler(DeleteWindowsExitProc, tsdPtr); } - return code; - done: - Tcl_MutexUnlock(&windowMutex); - if (argv != NULL) { - ckfree(argv); + if (value) { + Tcl_DecrRefCount(value); + value = NULL; } return code; } diff --git a/tests/safe.test b/tests/safe.test index e7ed6c7..69a67ba 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -187,7 +187,7 @@ test safe-5.1 {loading Tk in safe interps without master's clearance} -body { interp eval $i {load {} Tk} } -cleanup { safe::interpDelete $i -} -returnCodes error -result {not allowed to start Tk by master's safe::TkInit} +} -returnCodes error -result {not allowed} test safe-5.2 {multi-level Tk loading with clearance} -setup { set safeParent [safe::interpCreate] } -body { |