summaryrefslogtreecommitdiffstats
path: root/library
diff options
context:
space:
mode:
Diffstat (limited to 'library')
-rw-r--r--library/safe.tcl54
1 files changed, 25 insertions, 29 deletions
diff --git a/library/safe.tcl b/library/safe.tcl
index 662a727..8bc26f9 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.33 2009/11/19 11:59:54 dkf Exp $
+# RCS: @(#) $Id: safe.tcl,v 1.34 2009/12/03 15:49:22 dkf Exp $
#
# The implementation is based on namespaces. These naming conventions are
@@ -651,7 +651,6 @@ proc ::safe::CheckFileName {slave file} {
}
# AliasGlob is the target of the "glob" alias in safe interpreters.
-
proc ::safe::AliasGlob {slave args} {
Log $slave "GLOB ! $args" NOTICE
set cmd {}
@@ -663,30 +662,22 @@ proc ::safe::AliasGlob {slave args} {
while {$at < [llength $args]} {
switch -glob -- [set opt [lindex $args $at]] {
-nocomplain -
- -join {
+ -join {
lappend cmd $opt
incr at
}
- -directory {
- lappend cmd $opt
- incr at
- set virtualdir [lindex $args $at]
-
- # get the real path from the virtual one.
+ -directory {
+ set virtualdir [lindex $args [incr at]]
+ # Get the real path from the virtual one and check that the
+ # path is in the access path of that slave.
try {
set dir [TranslatePath $slave $virtualdir]
- } on error msg {
- Log $slave $msg
- return -code error "permission denied"
- }
- # check that the path is in the access path of that slave
- try {
DirInAccessPath $slave $dir
} on error msg {
Log $slave $msg
return -code error "permission denied"
}
- lappend cmd $dir
+ lappend cmd -directory $dir
incr at
}
pkgIndex.tcl {
@@ -701,6 +692,14 @@ proc ::safe::AliasGlob {slave args} {
return -code error "Safe base rejecting glob option '$opt'"
}
default {
+ if {[regexp {(.*)[\\/]} $opt -> thedir]} {
+ try {
+ DirInAccessPath $slave [TranslatePath $slave $thedir]
+ } on error msg {
+ Log $slave $msg
+ return -code error "permission denied"
+ }
+ }
lappend cmd $opt
incr at
}
@@ -928,18 +927,14 @@ proc ::safe::AliasSubset {slave alias target args} {
# AliasEncoding is the target of the "encoding" alias in safe interpreters.
-proc ::safe::AliasEncoding {slave args} {
- set argc [llength $args]
-
- set okpat "^(name.*|convert.*)\$"
- set subcommand [lindex $args 0]
-
- if {[regexp $okpat $subcommand]} {
- return [::interp invokehidden $slave encoding {*}$args]
+proc ::safe::AliasEncoding {slave option args} {
+ # Careful; do not want empty option to get through to the [string equal]
+ if {[regexp {^(name.*|convert.*|)$} $option]} {
+ return [::interp invokehidden $slave encoding $option {*}$args]
}
- if {[string first $subcommand system] == 0} {
- if {$argc == 1} {
+ if {[string equal -length [string length $option] $option "system"]} {
+ if {[llength $args] == 0} {
# passed all the tests , lets source it:
try {
return [::interp invokehidden $slave encoding system]
@@ -949,16 +944,17 @@ proc ::safe::AliasEncoding {slave args} {
}
}
set msg "wrong # args: should be \"encoding system\""
+ set code {TCL WRONGARGS}
} else {
- set msg "wrong # args: should be \"encoding option ?arg ...?\""
+ set msg "bad option \"$option\": must be convertfrom, convertto, names, or system"
+ set code [list TCL LOOKUP INDEX option $option]
}
Log $slave $msg
- return -code error $msg
+ return -code error -errorcode $code $msg
}
proc ::safe::Setup {} {
-
####
#
# Setup the arguments parsing