diff options
author | hobbs <hobbs@noemail.net> | 2002-02-22 19:51:29 (GMT) |
---|---|---|
committer | hobbs <hobbs@noemail.net> | 2002-02-22 19:51:29 (GMT) |
commit | b7870de7af3b369bed06db6868a87c517c27a0b3 (patch) | |
tree | 69dedf5a24d87d82afd4f3238c05c64ab0b6bd3a /library | |
parent | cd9d7fe124fdbde747ca8db785a48a591152abbd (diff) | |
download | tcl-b7870de7af3b369bed06db6868a87c517c27a0b3.zip tcl-b7870de7af3b369bed06db6868a87c517c27a0b3.tar.gz tcl-b7870de7af3b369bed06db6868a87c517c27a0b3.tar.bz2 |
* library/safe.tcl (CheckFileName): removed the limit on
sourceable file names (was only *.tcl or tclIndex files with no
more than one dot and 14 chars). There is enough internal
protection in a safe interpreter already. Fixes [Tk Bug #521560].
FossilOrigin-Name: a5f9958f8fb9a6129705e67875885e3bab86ec12
Diffstat (limited to 'library')
-rw-r--r-- | library/safe.tcl | 22 |
1 files changed, 6 insertions, 16 deletions
diff --git a/library/safe.tcl b/library/safe.tcl index 6d4c41b..9faeffe 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.7 2000/11/24 13:56:40 dkf Exp $ +# RCS: @(#) $Id: safe.tcl,v 1.8 2002/02/22 19:51:29 hobbs Exp $ # # The implementation is based on namespaces. These naming conventions @@ -695,24 +695,14 @@ proc ::safe::setLogCmd {args} { } } - + # file name control (limit access to files/ressources that should be # a valid tcl source file) proc CheckFileName {slave file} { - # limit what can be sourced to .tcl - # and forbid files with more than 1 dot and - # longer than 14 chars - set ftail [file tail $file] - if {[string length $ftail]>14} { - error "$ftail: filename too long" - } - if {[regexp {\..*\.} $ftail]} { - error "$ftail: more than one dot is forbidden" - } - if {[string compare $ftail "tclIndex"] && \ - [string compare -nocase [file extension $ftail] ".tcl"]} { - error "$ftail: must be a *.tcl or tclIndex" - } + # This used to limit what can be sourced to ".tcl" and forbid files + # with more than 1 dot and longer than 14 chars, but I changed that + # for 8.4 as a safe interp has enough internal protection already + # to allow sourcing anything. - hobbs if {![file exists $file]} { # don't tell the file path |