diff options
-rw-r--r-- | ChangeLog | 11 | ||||
-rw-r--r-- | library/safe.tcl | 16 | ||||
-rw-r--r-- | tests/safe.test | 44 | ||||
-rw-r--r-- | win/tclWinDde.c | 14 |
4 files changed, 58 insertions, 27 deletions
@@ -1,3 +1,14 @@ +2012-05-29 Jan Nijtmans <nijtmans@users.sf.net> + + * win/tclWinDde.c: [Bug 3525762]: Encoding handling in dde. + * win/Makefile.in: Fix "make genstubs" when cross-compiling on UNIX + +2012-05-28 Donal K. Fellows <dkf@users.sf.net> + + * library/safe.tcl (safe::AliasFileSubcommand): [Bug 3529949]: Made a + more sophisticated method for preventing information leakage; it + changes references to "~user" into "./~user", which is safe. + 2012-05-25 Donal K. Fellows <dkf@users.sf.net> * doc/namespace.n, doc/Ensemble.3: [Bug 3528418]: Document what is diff --git a/library/safe.tcl b/library/safe.tcl index 52f6e85..4ad5c36 100644 --- a/library/safe.tcl +++ b/library/safe.tcl @@ -467,7 +467,8 @@ proc ::safe::InterpInit { ::interp expose $slave file foreach subcommand {dirname extension rootname tail} { - ::interp alias $slave ::tcl::file::$subcommand {} file $subcommand + ::interp alias $slave ::tcl::file::$subcommand {} \ + ::safe::AliasFileSubcommand $slave $subcommand } foreach subcommand { atime attributes copy delete executable exists isdirectory isfile @@ -675,6 +676,17 @@ proc ::safe::CheckFileName {slave file} { } } +# AliasFileSubcommand handles selected subcommands of [file] in safe +# interpreters that are *almost* safe. In particular, it just acts to +# prevent discovery of what home directories exist. + +proc ::safe::AliasFileSubcommand {slave subcommand name} { + if {[string match ~* $name]} { + set name ./$name + } + tailcall $slave invokehidden tcl:file:$subcommand $name +} + # AliasGlob is the target of the "glob" alias in safe interpreters. proc ::safe::AliasGlob {slave args} { @@ -761,6 +773,8 @@ proc ::safe::AliasGlob {slave args} { foreach opt [lrange $args $at end] { if {![regexp $dirPartRE $opt -> thedir thefile]} { set thedir . + } elseif {[string match ~* $thedir]} { + set thedir ./$thedir } if {$thedir eq "*" && ($thefile eq "pkgIndex.tcl" || $thefile eq "*.tm")} { diff --git a/tests/safe.test b/tests/safe.test index ae78da9..f270248 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -27,7 +27,7 @@ set ::auto_path [info library] # Force actual loading of the safe package because we use un exported (and # thus un-autoindexed) APIs in this test result arguments: catch {safe::interpConfigure} - + # testing that nested and statics do what is advertised (we use a static # package - Tcltest - but it might be absent if we're in standard tclsh) @@ -700,50 +700,50 @@ test safe-15.1 {safe file ensemble does not surprise code} -setup { } -result {1 {a b c} 1 {a b c} 1 {invalid command name "file"} 1 0 {a b c} 1 {not allowed to invoke subcommand isdirectory of file}} ### ~ should have no special meaning in paths in safe interpreters -test safe-16.1 {Bug 2913625: defang ~ in paths} -setup { +test safe-16.1 {Bug 3529949: defang ~ in paths} -setup { set savedHOME $env(HOME) set env(HOME) /foo/bar set i [safe::interpCreate] -} -constraints knownBug -body { +} -body { $i eval { set d [format %c 126] - list [file dirname $d] [file tail $d] \ - [file join [file dirname $d] [file tail $d]] + list [file join [file dirname $d] [file tail $d]] } } -cleanup { safe::interpDelete $i set env(HOME) $savedHOME -} -result {~} -test safe-16.2 {Bug 2913625: defang ~user in paths} -setup { +} -result {./~} +test safe-16.2 {Bug 3529949: defang ~user in paths} -setup { set i [safe::interpCreate] set user $tcl_platform(user) -} -constraints knownBug -body { +} -body { string map [list $user USER] [$i eval \ "file join \[file dirname ~$user\] \[file tail ~$user\]"] } -cleanup { safe::interpDelete $i -} -result {~USER} -test safe-16.3 {Bug 2913625: defang ~ in globs} -setup { +} -result {./~USER} +test safe-16.3 {Bug 3529949: defang ~ in globs} -setup { + set syntheticHOME [makeDirectory foo] + makeFile {} bar $syntheticHOME set savedHOME $env(HOME) - set env(HOME) / + set env(HOME) $syntheticHOME set i [safe::interpCreate] -} -constraints knownBug -body { - $i expose glob realglob - $i eval {realglob -nocomplain [join {~ / *} ""]} +} -body { + ::safe::interpAddToAccessPath $i $syntheticHOME + $i eval {glob -nocomplain ~/*} } -cleanup { safe::interpDelete $i set env(HOME) $savedHOME -} -result {~} -test safe-16.4 {Bug 2913625: defang ~user in globs} -setup { + removeDirectory $syntheticHOME +} -result {} +test safe-16.4 {Bug 3529949: defang ~user in globs} -setup { set i [safe::interpCreate] - set user $tcl_platform(user) -} -constraints knownBug -body { - $i expose glob realglob - string map [list $user USER] [$i eval [list\ - realglob -directory ~$user *]] +} -body { + ::safe::interpAddToAccessPath $i $~$tcl_platform(user) + $i eval [list glob -nocomplain ~$tcl_platform(user)/*] } -cleanup { safe::interpDelete $i -} -result {~USER} +} -result {} set ::auto_path $saveAutoPath # cleanup diff --git a/win/tclWinDde.c b/win/tclWinDde.c index 8e74f73..5f2ef32 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -21,9 +21,9 @@ # undef CP_WINUNICODE # define CP_WINUNICODE CP_WINANSI # undef Tcl_WinTCharToUtf -# define Tcl_WinTCharToUtf(a,b,c) Tcl_UtfToExternalDString(NULL,a,b,c) +# define Tcl_WinTCharToUtf(a,b,c) Tcl_ExternalToUtfDString(NULL,a,b,c) # undef Tcl_WinUtfToTChar -# define Tcl_WinUtfToTChar(a,b,c) Tcl_ExternalToUtfDString(NULL,a,b,c) +# define Tcl_WinUtfToTChar(a,b,c) Tcl_UtfToExternalDString(NULL,a,b,c) #endif /* @@ -155,6 +155,12 @@ Dde_Init( return TCL_ERROR; } +#ifdef UNICODE + if (TclWinGetPlatformId() < VER_PLATFORM_WIN32_NT) { + Tcl_AppendResult(interp, "Win32s and Windows 9x are not supported platforms", NULL); + return TCL_ERROR; + } +#endif Tcl_CreateObjCommand(interp, "dde", DdeObjCmd, NULL, NULL); Tcl_CreateExitHandler(DdeExitProc, NULL); return Tcl_PkgProvide(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION); @@ -638,7 +644,7 @@ DdeServerProc( * sure we have a valid topic. */ - len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, 0); + len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, CP_WINUNICODE); Tcl_DStringInit(&dString); Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1); utilString = (TCHAR *) Tcl_DStringValue(&dString); @@ -663,7 +669,7 @@ DdeServerProc( * result to return in an XTYP_REQUEST. */ - len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, 0); + len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, CP_WINUNICODE); Tcl_DStringInit(&dString); Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1); utilString = (TCHAR *) Tcl_DStringValue(&dString); |