diff options
| -rw-r--r-- | ChangeLog | 6 | ||||
| -rw-r--r-- | library/safe.tcl | 16 | ||||
| -rw-r--r-- | tests/safe.test | 44 |
3 files changed, 43 insertions, 23 deletions
@@ -1,3 +1,9 @@ +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 |