summaryrefslogtreecommitdiffstats
path: root/library/safe.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'library/safe.tcl')
-rw-r--r--library/safe.tcl100
1 files changed, 53 insertions, 47 deletions
diff --git a/library/safe.tcl b/library/safe.tcl
index 8a99032..95db3b2 100644
--- a/library/safe.tcl
+++ b/library/safe.tcl
@@ -4,7 +4,7 @@
# It implements a virtual path mecanism to hide the real pathnames from the
# slave. It runs in a master interpreter and sets up data structure and
# aliases that will be invoked when used from a slave interpreter.
-#
+#
# See the safe.n man page for details.
#
# Copyright (c) 1996-1997 Sun Microsystems, Inc.
@@ -36,7 +36,7 @@ proc ::safe::InterpStatics {} {
upvar $v $v
}
set flag [::tcl::OptProcArgGiven -noStatics]
- if {$flag && (!$noStatics == !$statics)
+ if {$flag && (!$noStatics == !$statics)
&& ([::tcl::OptProcArgGiven -statics])} {
return -code error\
"conflicting values given for -statics and -noStatics"
@@ -57,7 +57,7 @@ proc ::safe::InterpNested {} {
set flag [::tcl::OptProcArgGiven -nestedLoadOk]
# note that the test here is the opposite of the "InterpStatics" one
# (it is not -noNested... because of the wanted default value)
- if {$flag && (!$nestedLoadOk != !$nested)
+ if {$flag && (!$nestedLoadOk != !$nested)
&& ([::tcl::OptProcArgGiven -nested])} {
return -code error\
"conflicting values given for -nested and -nestedLoadOk"
@@ -151,10 +151,18 @@ proc ::safe::interpConfigure {args} {
set item [::tcl::OptCurDesc $desc]
set name [::tcl::OptName $item]
switch -exact -- $name {
- -accessPath {return [list -accessPath $state(access_path)]}
- -statics {return [list -statics $state(staticsok)]}
- -nested {return [list -nested $state(nestedok)]}
- -deleteHook {return [list -deleteHook $state(cleanupHook)]}
+ -accessPath {
+ return [list -accessPath $state(access_path)]
+ }
+ -statics {
+ return [list -statics $state(staticsok)]
+ }
+ -nested {
+ return [list -nested $state(nestedok)]
+ }
+ -deleteHook {
+ return [list -deleteHook $state(cleanupHook)]
+ }
-noStatics {
# it is most probably a set in fact but we would need
# then to jump to the set part and it is not *sure*
@@ -192,7 +200,7 @@ proc ::safe::interpConfigure {args} {
if {
![::tcl::OptProcArgGiven -statics]
&& ![::tcl::OptProcArgGiven -noStatics]
- } {
+ } then {
set statics $state(staticsok)
} else {
set statics [InterpStatics]
@@ -200,7 +208,7 @@ proc ::safe::interpConfigure {args} {
if {
[::tcl::OptProcArgGiven -nested] ||
[::tcl::OptProcArgGiven -nestedLoadOk]
- } {
+ } then {
set nested [InterpNested]
} else {
set nested $state(nestedok)
@@ -238,7 +246,7 @@ proc ::safe::interpConfigure {args} {
#
# Returns the slave name.
#
-# Optional Arguments :
+# Optional Arguments :
# + slave name : if empty, generated name will be used
# + access_path: path list controlling where load/source can occur,
# if empty: the master auto_path will be used.
@@ -249,7 +257,7 @@ proc ::safe::interpConfigure {args} {
# use the full name and no indent so auto_mkIndex can find us
proc ::safe::InterpCreate {
- slave
+ slave
access_path
staticsok
nestedok
@@ -424,7 +432,7 @@ proc ::safe::interpAddToAccessPath {slave path} {
# interpreter. It is useful when you want to install the safe base aliases
# into a preexisting safe interpreter.
proc ::safe::InterpInit {
- slave
+ slave
access_path
staticsok
nestedok
@@ -537,9 +545,9 @@ proc ::safe::interpDelete {slave} {
# remove the hook now, otherwise if the hook calls us somehow,
# we'll loop
unset state(cleanupHook)
- if {[catch {
+ try {
{*}$hook $slave
- } err]} {
+ } on error err {
Log $slave "Delete hook error ($err)"
}
}
@@ -562,7 +570,7 @@ proc ::safe::interpDelete {slave} {
return
}
-# Set (or get) the logging mecanism
+# Set (or get) the logging mecanism
proc ::safe::setLogCmd {args} {
variable Log
@@ -657,6 +665,7 @@ 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 {}
@@ -720,16 +729,15 @@ proc ::safe::AliasGlob {slave args} {
# access path of that slave. Done after basic argument processing so that
# we know if -nocomplain is set.
if {$got(-directory)} {
- if {[catch {
+ try {
set dir [TranslatePath $slave $virtualdir]
DirInAccessPath $slave $dir
- } msg]} {
+ } on error 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
}
@@ -744,14 +752,15 @@ proc ::safe::AliasGlob {slave args} {
while {$at < [llength $args]} {
set opt [lindex $args $at]
incr at
- if {[regexp $dirPartRE $opt -> thedir] && [catch {
- set thedir [file join $virtualdir $thedir]
- DirInAccessPath $slave [TranslatePath $slave $thedir]
- } msg]} {
- Log $slave $msg
- if {$got(-nocomplain)} {
- continue
- } else {
+ if {[regexp $dirPartRE $opt -> thedir]} {
+ try {
+ set thedir [file join $virtualdir $thedir]
+ DirInAccessPath $slave [TranslatePath $slave $thedir]
+ } on error msg {
+ Log $slave $msg
+ if {$got(-nocomplain)} {
+ continue
+ }
return -code error "permission denied"
}
}
@@ -763,19 +772,19 @@ proc ::safe::AliasGlob {slave args} {
if {$got(-nocomplain) && [llength $cmd] eq $firstPattern} {
return
}
- if {[catch {
- ::interp invokehidden $slave glob {*}$cmd
- } msg]} {
+ try {
+ 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]
}
@@ -905,30 +914,28 @@ proc ::safe::AliasLoad {slave file args} {
# file loading
# get the real path from the virtual one.
- if {[catch {
+ try {
set file [TranslatePath $slave $file]
- } msg]} {
+ } on error msg {
Log $slave $msg
return -code error "permission denied"
}
# check the translated path
- if {[catch {
+ try {
FileInAccessPath $slave $file
- } msg]} {
+ } on error msg {
Log $slave $msg
return -code error "permission denied (path)"
}
}
- if {[catch {
- ::interp invokehidden $slave load $file $package $target
- } msg]} {
+ try {
+ 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
@@ -1008,15 +1015,14 @@ proc ::safe::AliasEncoding {slave option args} {
}
if {[string equal -length [string length $option] $option "system"]} {
- if {[llength $args] == 0} {
+ if {![llength $args]} {
# passed all the tests , lets source it:
- if {[catch {
- set sysenc [::interp invokehidden $slave encoding system]
- } msg]} {
+ try {
+ return [::interp invokehidden $slave encoding system]
+ } on error msg {
Log $slave $msg
return -code error "script error"
}
- return $sysenc
}
set msg "wrong # args: should be \"encoding system\""
set code {TCL WRONGARGS}
generated by cgit v0.12 at 2024-07-15 21:57:41 (GMT)