summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2012-05-28 13:17:59 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2012-05-28 13:17:59 (GMT)
commitd2671297206026b44157d1a47ba3720c8159d508 (patch)
treee5911d1d60c84659ed8bad2d8eb634050e556e0c
parent27312fa939f40f22a19c293959bfdced6ba15730 (diff)
downloadtcl-d2671297206026b44157d1a47ba3720c8159d508.zip
tcl-d2671297206026b44157d1a47ba3720c8159d508.tar.gz
tcl-d2671297206026b44157d1a47ba3720c8159d508.tar.bz2
[Bug 3529949]: Defang 'file dirname ~' etc in safe interps
-rw-r--r--ChangeLog6
-rw-r--r--library/safe.tcl16
-rw-r--r--tests/safe.test44
3 files changed, 43 insertions, 23 deletions
diff --git a/ChangeLog b/ChangeLog
index 2958fa0..9405ed9 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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