summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2009-12-23 11:17:33 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2009-12-23 11:17:33 (GMT)
commitd267c20fe43b1a00bb1e392f86443133855c2afe (patch)
treebb83c2bdb235bebfffc35e21041df5cab1c5fd64
parent3a53365f6bd955a33150ac9ca7097adc46f2acdc (diff)
downloadtcl-d267c20fe43b1a00bb1e392f86443133855c2afe.zip
tcl-d267c20fe43b1a00bb1e392f86443133855c2afe.tar.gz
tcl-d267c20fe43b1a00bb1e392f86443133855c2afe.tar.bz2
[Bug 2913625]: Stop information about paths from leaking through [info script]
and [info nameofexecutable].
-rw-r--r--ChangeLog12
-rw-r--r--library/safe.tcl63
2 files changed, 55 insertions, 20 deletions
diff --git a/ChangeLog b/ChangeLog
index 6e1ef94..106f6e7 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,8 +1,14 @@
+2009-12-23 Donal K. Fellows <dkf@users.sf.net>
+
+ * library/safe.tcl (AliasSource, AliasExeName): [Bug 2913625]: Stop
+ information about paths from leaking through [info script] and [info
+ nameofexecutable].
+
2009-12-23 Jan Nijtmans <nijtmans@users.sf.net>
- * unix/tcl.m4 Install libtcl8.6.dll in bin directory
- * unix/Makefile.in
- * unix/configure (regenerated)
+ * unix/tcl.m4: Install libtcl8.6.dll in bin directory
+ * unix/Makefile.in:
+ * unix/configure: (regenerated)
2009-12-22 Donal K. Fellows <dkf@users.sf.net>
diff --git a/library/safe.tcl b/library/safe.tcl
index 6d896ea..eaae00d 100644
--- a/library/safe.tcl
+++ b/library/safe.tcl
@@ -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: safe.tcl,v 1.35 2009/12/16 23:44:15 dkf Exp $
+# RCS: @(#) $Id: safe.tcl,v 1.36 2009/12/23 11:17:33 dkf Exp $
#
# The implementation is based on namespaces. These naming conventions are
@@ -462,6 +462,14 @@ proc ::safe::InterpInit {
AliasSubset $slave file \
file dir.* join root.* ext.* tail path.* split
+ # Subcommands of info
+ foreach {subcommand alias} {
+ nameofexecutable AliasExeName
+ } {
+ ::interp alias $slave ::tcl::info::$subcommand \
+ {} [namespace current]::$alias $slave
+ }
+
# The allowed slave variables already have been set by Tcl_MakeSafe(3)
# Source init.tcl and tm.tcl into the slave, to get auto_load and
@@ -789,8 +797,12 @@ proc ::safe::AliasSource {slave args} {
# filename", but "source -encoding E filename" as well.
if {[lindex $args 0] eq "-encoding"} {
incr argc -2
- set encoding [lrange $args 0 1]
+ set encoding [lindex $args 1]
set at 2
+ if {$encoding eq "identity"} {
+ Log $slave "attempt to use the identity encoding"
+ return -code error "permission denied"
+ }
} else {
set at 0
set encoding {}
@@ -801,39 +813,51 @@ proc ::safe::AliasSource {slave args} {
return -code error $msg
}
set file [lindex $args $at]
-
+
# get the real path from the virtual one.
- try {
- set file [TranslatePath $slave $file]
- } on error msg {
+ if {[catch {
+ set realfile [TranslatePath $slave $file]
+ } msg]} {
Log $slave $msg
return -code error "permission denied"
}
-
+
# check that the path is in the access path of that slave
- try {
- FileInAccessPath $slave $file
- } on error msg {
+ if {[catch {
+ FileInAccessPath $slave $realfile
+ } msg]} {
Log $slave $msg
return -code error "permission denied"
}
# do the checks on the filename :
- try {
- CheckFileName $slave $file
- } on error msg {
- Log $slave "$file:$msg"
+ if {[catch {
+ CheckFileName $slave $realfile
+ } msg]} {
+ Log $slave "$realfile:$msg"
return -code error $msg
}
- # passed all the tests , lets source it:
+ # Passed all the tests, lets source it. Note that we do this all manually
+ # because we want to control [info script] in the slave so information
+ # doesn't leak so much. [Bug 2913625]
+ set old [::interp eval $slave {info script}]
if {[catch {
- # We use catch here because we want to catch non-error/ok too
- ::interp invokehidden $slave source {*}$encoding $file
+ set f [open $realfile]
+ fconfigure $f -eofchar \032
+ if {$encoding ne ""} {
+ fconfigure $f -encoding $encoding
+ }
+ set contents [read $f]
+ close $f
+ ::interp eval $slave [list info script $file]
+ ::interp eval $slave $contents
} msg]} {
+ catch {interp eval $slave [list info script $old]}
Log $slave $msg
return -code error "script error"
}
+ catch {interp eval $slave [list info script $old]}
return $msg
}
@@ -1004,6 +1028,11 @@ proc ::safe::AliasEncoding {slave option args} {
return -code error -errorcode $code $msg
}
+# Various minor hiding of platform features. [Bug 2913625]
+
+proc ::safe::AliasExeName {slave} {
+ return ""
+}
proc ::safe::Setup {} {
####