diff options
| -rw-r--r-- | ChangeLog | 5 | ||||
| -rw-r--r-- | library/safe.tcl | 12 | ||||
| -rw-r--r-- | tests/safe.test | 9 |
3 files changed, 18 insertions, 8 deletions
@@ -1,3 +1,8 @@ +2010-08-18 Donal K. Fellows <dkf@users.sf.net> + + * library/safe.tcl (AliasGlob): [Bug 3004191]: Restore safe [glob] to + working condition. + 2010-08-15 Donal K. Fellows <dkf@users.sf.net> * generic/tclProc.c (ProcWrongNumArgs): [Bug 3045010]: Make the diff --git a/library/safe.tcl b/library/safe.tcl index c5fad56..81b53b4 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.38 2010/06/14 13:48:25 nijtmans Exp $ +# RCS: @(#) $Id: safe.tcl,v 1.39 2010/08/18 13:31:55 dkf Exp $ # # The implementation is based on namespaces. These naming conventions are @@ -775,18 +775,18 @@ proc ::safe::AliasGlob {slave args} { return } try { - ::interp invokehidden $slave glob {*}$cmd + set entries [::interp invokehidden $slave glob {*}$cmd] } on error msg { Log $slave $msg return -code error "script error" } - Log $slave "GLOB @ $msg" NOTICE + Log $slave "GLOB @ $entries" NOTICE # Translate path back to what the slave should see. set res {} set l [string length $dir] - foreach p $msg { + foreach p $entries { if {[string equal -length $l $dir $p]} { set p [string replace $p 0 [expr {$l-1}] $virtualdir] } @@ -933,13 +933,11 @@ proc ::safe::AliasLoad {slave file args} { } try { - ::interp invokehidden $slave load $file $package $target + return [::interp invokehidden $slave load $file $package $target] } on error msg { Log $slave $msg return -code error $msg } - - return $msg } # FileInAccessPath raises an error if the file is not found in the list of diff --git a/tests/safe.test b/tests/safe.test index 9de3954..c22cf6e 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -10,7 +10,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.test,v 1.33 2010/05/27 08:32:23 nijtmans Exp $ +# RCS: @(#) $Id: safe.test,v 1.34 2010/08/18 13:31:55 dkf Exp $ package require Tcl 8.5 @@ -544,6 +544,13 @@ test safe-12.6 {glob is restricted [Bug 2906841]} -setup { } -cleanup { safe::interpDelete $i } -result {} +test safe-12.7 {glob is restricted} -setup { + set i [safe::interpCreate] +} -body { + $i eval glob * +} -cleanup { + safe::interpDelete $i +} -match glob -result * set ::auto_path $saveAutoPath # cleanup |