diff options
| -rw-r--r-- | generic/tkCmds.c | 35 | ||||
| -rw-r--r-- | generic/tkWindow.c | 4 | ||||
| -rw-r--r-- | tests/safe.test | 30 |
3 files changed, 56 insertions, 13 deletions
diff --git a/generic/tkCmds.c b/generic/tkCmds.c index 28da6e4..e84ba83 100644 --- a/generic/tkCmds.c +++ b/generic/tkCmds.c @@ -11,14 +11,14 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkCmds.c,v 1.30 2002/08/31 06:12:20 das Exp $ + * RCS: @(#) $Id: tkCmds.c,v 1.31 2002/09/02 19:16:23 hobbs Exp $ */ #include "tkPort.h" #include "tkInt.h" #include <errno.h> -#if defined(__WIN32__) +#if defined(WIN32) #include "tkWinInt.h" #elif defined(MAC_TCL) #include "tkMacInt.h" @@ -644,6 +644,13 @@ Tk_TkObjCmd(clientData, interp, objc, objv) TkWindow *winPtr; char *string; + if (Tcl_IsSafe(interp)) { + Tcl_SetResult(interp, + "appname not accessible in a safe interpreter", + TCL_STATIC); + return TCL_ERROR; + } + winPtr = (TkWindow *) tkwin; if (objc > 3) { @@ -741,6 +748,13 @@ Tk_TkObjCmd(clientData, interp, objc, objv) int skip, width, height; double d; + if (Tcl_IsSafe(interp)) { + Tcl_SetResult(interp, + "scaling not accessible in a safe interpreter", + TCL_STATIC); + return TCL_ERROR; + } + screenPtr = Tk_Screen(tkwin); skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin); @@ -778,6 +792,13 @@ Tk_TkObjCmd(clientData, interp, objc, objv) TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; int skip; + if (Tcl_IsSafe(interp)) { + Tcl_SetResult(interp, + "useinputmethods not accessible in a safe interpreter", + TCL_STATIC); + return TCL_ERROR; + } + skip = TkGetDisplayOf(interp, objc-2, objv+2, &tkwin); if (skip < 0) { return TCL_ERROR; @@ -819,15 +840,15 @@ Tk_TkObjCmd(clientData, interp, objc, objv) Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } - #if defined(__WIN32__) || defined(_WIN32) +#if defined(WIN32) windowingsystem = "win32"; - #elif defined(MAC_TCL) +#elif defined(MAC_TCL) windowingsystem = "classic"; - #elif defined(MAC_OSX_TK) +#elif defined(MAC_OSX_TK) windowingsystem = "aqua"; - #else +#else windowingsystem = "x11"; - #endif +#endif Tcl_SetStringObj(Tcl_GetObjResult(interp), windowingsystem, -1); break; } diff --git a/generic/tkWindow.c b/generic/tkWindow.c index a69c681..d358cbf 100644 --- a/generic/tkWindow.c +++ b/generic/tkWindow.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkWindow.c,v 1.53 2002/08/31 06:12:28 das Exp $ + * RCS: @(#) $Id: tkWindow.c,v 1.54 2002/09/02 19:16:23 hobbs Exp $ */ #include "tkPort.h" @@ -114,7 +114,7 @@ static TkCmd commands[] = { {"place", NULL, Tk_PlaceObjCmd, 1, 0}, {"raise", NULL, Tk_RaiseObjCmd, 1, 1}, {"selection", NULL, Tk_SelectionObjCmd, 0, 1}, - {"tk", NULL, Tk_TkObjCmd, 0, 1}, + {"tk", NULL, Tk_TkObjCmd, 1, 1}, {"tkwait", NULL, Tk_TkwaitObjCmd, 1, 1}, #if defined(__WIN32__) || defined(MAC_TCL) || defined(MAC_OSX_TK) {"tk_chooseColor", NULL, Tk_ChooseColorObjCmd, 0, 1}, diff --git a/tests/safe.test b/tests/safe.test index ba483dc..060a1e1 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -6,7 +6,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: safe.test,v 1.9 2002/07/13 20:28:35 dgp Exp $ +# RCS: @(#) $Id: safe.test,v 1.10 2002/09/02 19:16:24 hobbs Exp $ package require tcltest 2.1 namespace import -force tcltest::configure @@ -38,11 +38,11 @@ tcltest::loadTestedCommands # The set of hidden commands is platform dependent: if {"$tcl_platform(platform)" == "macintosh"} { - set hidden_cmds {beep bell cd clipboard echo encoding exit fconfigure file glob grab load ls menu open pwd selection send socket source tk tk_chooseColor tk_chooseDirectory tk_getOpenFile tk_getSaveFile toplevel wm} + set hidden_cmds {beep bell cd clipboard echo encoding exit fconfigure file glob grab load ls menu open pwd selection send socket source tk_chooseColor tk_chooseDirectory tk_getOpenFile tk_getSaveFile toplevel wm} } elseif {"$tcl_platform(platform)" == "windows"} { - set hidden_cmds {bell cd clipboard encoding exec exit fconfigure file glob grab load menu open pwd selection socket source tk tk_chooseColor tk_chooseDirectory tk_getOpenFile tk_getSaveFile tk_messageBox toplevel wm} + set hidden_cmds {bell cd clipboard encoding exec exit fconfigure file glob grab load menu open pwd selection socket source tk_chooseColor tk_chooseDirectory tk_getOpenFile tk_getSaveFile tk_messageBox toplevel wm} } else { - set hidden_cmds {bell cd clipboard encoding exec exit fconfigure file glob grab load menu open pwd selection send socket source tk toplevel wm} + set hidden_cmds {bell cd clipboard encoding exec exit fconfigure file glob grab load menu open pwd selection send socket source toplevel wm} } test safe-1.1 {Safe Tk loading into an interpreter} { @@ -91,6 +91,28 @@ test safe-2.2 {Unsafe commands not available} { safe::interpDelete a set status } ok +test safe-2.3 {Unsafe subcommands not available} { + catch {safe::interpDelete a} + safe::interpCreate a + safe::loadTk a + set status broken + if {[catch {interp eval a {tk appname}} msg]} { + set status ok + } + safe::interpDelete a + list $status $msg +} {ok {appname not accessible in a safe interpreter}} +test safe-2.4 {Unsafe subcommands not available} { + catch {safe::interpDelete a} + safe::interpCreate a + safe::loadTk a + set status broken + if {[catch {interp eval a {tk scaling}} msg]} { + set status ok + } + safe::interpDelete a + list $status $msg +} {ok {scaling not accessible in a safe interpreter}} test safe-3.1 {Unsafe commands are available hidden} { catch {safe::interpDelete a} |