diff options
Diffstat (limited to 'library/safe.tcl')
-rw-r--r-- | library/safe.tcl | 47 |
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 } |