summaryrefslogtreecommitdiffstats
path: root/library/safe.tcl
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2012-05-17 14:14:26 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2012-05-17 14:14:26 (GMT)
commiteb98b2c7785409192628ad59475e3581ca2b901b (patch)
treea53893d967208756835ec6a76683d4007a153761 /library/safe.tcl
parent95a02f829d476464637599f39be7aeaa335c70ad (diff)
downloadtcl-eb98b2c7785409192628ad59475e3581ca2b901b.zip
tcl-eb98b2c7785409192628ad59475e3581ca2b901b.tar.gz
tcl-eb98b2c7785409192628ad59475e3581ca2b901b.tar.bz2
[Bug 2964715]: fixes to globbing in safe interpreters
Diffstat (limited to 'library/safe.tcl')
-rw-r--r--library/safe.tcl47
1 files changed, 30 insertions, 17 deletions
diff --git a/library/safe.tcl b/library/safe.tcl
index 8a99032..1a340a1 100644
--- a/library/safe.tcl
+++ b/library/safe.tcl
@@ -491,7 +491,8 @@ proc ::safe::InterpInit {
# now, after tm.tcl was loaded.
namespace upvar ::safe S$slave state
if {[llength $state(tm_path_slave)] > 0} {
- ::interp eval $slave [list ::tcl::tm::add {*}$state(tm_path_slave)]
+ ::interp eval $slave [list \
+ ::tcl::tm::add {*}[lreverse $state(tm_path_slave)]]
}
return $slave
}
@@ -670,9 +671,9 @@ proc ::safe::AliasGlob {slave args} {
}
if {$::tcl_platform(platform) eq "windows"} {
- set dirPartRE {^(.*)[\\/]}
+ set dirPartRE {^(.*)[\\/]([^\\/]*)$}
} else {
- set dirPartRE {^(.*)/}
+ set dirPartRE {^(.*)/([^/]*)$}
}
set dir {}
@@ -725,11 +726,10 @@ proc ::safe::AliasGlob {slave args} {
DirInAccessPath $slave $dir
} msg]} {
Log $slave $msg
- if {!$got(-nocomplain)} {
- return -code error "permission denied"
- } else {
+ if {$got(-nocomplain)} {
return
}
+ return -code error "permission denied"
}
lappend cmd -directory $dir
}
@@ -741,19 +741,32 @@ proc ::safe::AliasGlob {slave args} {
# Process remaining pattern arguments
set firstPattern [llength $cmd]
- while {$at < [llength $args]} {
- set opt [lindex $args $at]
- incr at
- if {[regexp $dirPartRE $opt -> thedir] && [catch {
+ foreach opt [lrange $args $at end] {
+ if {![regexp $dirPartRE $opt -> thedir thefile]} {
+ set thedir .
+ }
+ if {$thedir eq "*"} {
+ set mapped 0
+ foreach d [glob -directory [TranslatePath $slave $virtualdir] \
+ -types d -tails *] {
+ catch {
+ DirInAccessPath $slave \
+ [TranslatePath $slave [file join $virtualdir $d]]
+ if {$thefile eq "pkgIndex.tcl" || $thefile eq "*.tm"} {
+ lappend cmd [file join $d $thefile]
+ set mapped 1
+ }
+ }
+ }
+ if {$mapped} continue
+ }
+ if {[catch {
set thedir [file join $virtualdir $thedir]
DirInAccessPath $slave [TranslatePath $slave $thedir]
} msg]} {
Log $slave $msg
- if {$got(-nocomplain)} {
- continue
- } else {
- return -code error "permission denied"
- }
+ if {$got(-nocomplain)} continue
+ return -code error "permission denied"
}
lappend cmd $opt
}
@@ -770,7 +783,7 @@ proc ::safe::AliasGlob {slave args} {
return -code error "script error"
}
- Log $slave "GLOB @ $msg" NOTICE
+ Log $slave "GLOB < $msg" NOTICE
# Translate path back to what the slave should see.
set res {}
@@ -782,7 +795,7 @@ proc ::safe::AliasGlob {slave args} {
lappend res $p
}
- Log $slave "GLOB @ $res" NOTICE
+ Log $slave "GLOB > $res" NOTICE
return $res
}