summaryrefslogtreecommitdiffstats
path: root/library/safe.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'library/safe.tcl')
-rw-r--r--library/safe.tcl333
1 files changed, 162 insertions, 171 deletions
diff --git a/library/safe.tcl b/library/safe.tcl
index 3be7739..a929653 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.5 1999/04/16 00:46:57 stanton Exp $
+# RCS: @(#) $Id: safe.tcl,v 1.6 1999/08/19 02:59:40 hobbs Exp $
#
# The implementation is based on namespaces. These naming conventions
@@ -29,8 +29,7 @@ namespace eval ::safe {
# Exported API:
namespace export interpCreate interpInit interpConfigure interpDelete \
- interpAddToAccessPath interpFindInAccessPath \
- setLogCmd ;
+ interpAddToAccessPath interpFindInAccessPath setLogCmd
####
#
@@ -51,20 +50,20 @@ namespace eval ::safe {
# create case (slave is optional)
::tcl::OptKeyRegister {
{?slave? -name {} "name of the slave (optional)"}
- } ::safe::interpCreate ;
+ } ::safe::interpCreate
# adding the flags sub programs to the command program
# (relying on Opt's internal implementation details)
- lappend ::tcl::OptDesc(::safe::interpCreate) $::tcl::OptDesc($temp);
+ lappend ::tcl::OptDesc(::safe::interpCreate) $::tcl::OptDesc($temp)
# init and configure (slave is needed)
::tcl::OptKeyRegister {
{slave -name {} "name of the slave"}
- } ::safe::interpIC;
+ } ::safe::interpIC
# adding the flags sub programs to the command program
# (relying on Opt's internal implementation details)
- lappend ::tcl::OptDesc(::safe::interpIC) $::tcl::OptDesc($temp);
+ lappend ::tcl::OptDesc(::safe::interpIC) $::tcl::OptDesc($temp)
# temp not needed anymore
- ::tcl::OptKeyDelete $temp;
+ ::tcl::OptKeyDelete $temp
# Helper function to resolve the dual way of specifying staticsok
@@ -77,10 +76,10 @@ namespace eval ::safe {
if {$flag && ($noStatics == $statics)
&& ([::tcl::OptProcArgGiven -statics])} {
return -code error\
- "conflicting values given for -statics and -noStatics";
+ "conflicting values given for -statics and -noStatics"
}
if {$flag} {
- return [expr {!$noStatics}];
+ return [expr {!$noStatics}]
} else {
return $statics
}
@@ -98,7 +97,7 @@ namespace eval ::safe {
if {$flag && ($nestedLoadOk != $nested)
&& ([::tcl::OptProcArgGiven -nested])} {
return -code error\
- "conflicting values given for -nested and -nestedLoadOk";
+ "conflicting values given for -nested and -nestedLoadOk"
}
if {$flag} {
# another difference with "InterpStatics"
@@ -119,14 +118,13 @@ namespace eval ::safe {
proc interpCreate {args} {
set Args [::tcl::OptKeyParse ::safe::interpCreate $args]
InterpCreate $slave $accessPath \
- [InterpStatics] [InterpNested] $deleteHook;
+ [InterpStatics] [InterpNested] $deleteHook
}
proc interpInit {args} {
set Args [::tcl::OptKeyParse ::safe::interpIC $args]
if {![::interp exists $slave]} {
- return -code error \
- "\"$slave\" is not an interpreter";
+ return -code error "\"$slave\" is not an interpreter"
}
InterpInit $slave $accessPath \
[InterpStatics] [InterpNested] $deleteHook;
@@ -135,7 +133,7 @@ namespace eval ::safe {
proc CheckInterp {slave} {
if {![IsInterp $slave]} {
return -code error \
- "\"$slave\" is not an interpreter managed by ::safe::" ;
+ "\"$slave\" is not an interpreter managed by ::safe::"
}
}
@@ -160,8 +158,8 @@ namespace eval ::safe {
# We still call OptKeyParse though we know that "slave"
# is our given argument because it also checks
# for the "-help" option.
- set Args [::tcl::OptKeyParse ::safe::interpIC $args];
- CheckInterp $slave;
+ set Args [::tcl::OptKeyParse ::safe::interpIC $args]
+ CheckInterp $slave
set res {}
lappend res [list -accessPath [Set [PathListName $slave]]]
lappend res [list -statics [Set [StaticsOkName $slave]]]
@@ -172,19 +170,19 @@ namespace eval ::safe {
2 {
# If we have exactly 2 arguments
# the semantic is a "configure get"
- ::tcl::Lassign $args slave arg;
+ ::tcl::Lassign $args slave arg
# get the flag sub program (we 'know' about Opt's internal
# representation of data)
set desc [lindex [::tcl::OptKeyGetDesc ::safe::interpIC] 2]
- set hits [::tcl::OptHits desc $arg];
+ set hits [::tcl::OptHits desc $arg]
if {$hits > 1} {
return -code error [::tcl::OptAmbigous $desc $arg]
} elseif {$hits == 0} {
return -code error [::tcl::OptFlagUsage $desc $arg]
}
- CheckInterp $slave;
- set item [::tcl::OptCurDesc $desc];
- set name [::tcl::OptName $item];
+ CheckInterp $slave
+ set item [::tcl::OptCurDesc $desc]
+ set name [::tcl::OptName $item]
switch -exact -- $name {
-accessPath {
return [list -accessPath [Set [PathListName $slave]]]
@@ -206,23 +204,23 @@ namespace eval ::safe {
# unambigous -statics ?value? instead:
return -code error\
"ambigous query (get or set -noStatics ?)\
- use -statics instead";
+ use -statics instead"
}
-nestedLoadOk {
return -code error\
"ambigous query (get or set -nestedLoadOk ?)\
- use -nested instead";
+ use -nested instead"
}
default {
- return -code error "unknown flag $name (bug)";
+ return -code error "unknown flag $name (bug)"
}
}
}
default {
# Otherwise we want to parse the arguments like init and create
# did
- set Args [::tcl::OptKeyParse ::safe::interpIC $args];
- CheckInterp $slave;
+ set Args [::tcl::OptKeyParse ::safe::interpIC $args]
+ CheckInterp $slave
# Get the current (and not the default) values of
# whatever has not been given:
if {![::tcl::OptProcArgGiven -accessPath]} {
@@ -231,14 +229,14 @@ namespace eval ::safe {
} else {
set doreset 0
}
- if { (![::tcl::OptProcArgGiven -statics])
- && (![::tcl::OptProcArgGiven -noStatics]) } {
+ if {(![::tcl::OptProcArgGiven -statics]) \
+ && (![::tcl::OptProcArgGiven -noStatics]) } {
set statics [Set [StaticsOkName $slave]]
} else {
set statics [InterpStatics]
}
- if { ([::tcl::OptProcArgGiven -nested])
- || ([::tcl::OptProcArgGiven -nestedLoadOk]) } {
+ if {([::tcl::OptProcArgGiven -nested]) \
+ || ([::tcl::OptProcArgGiven -nestedLoadOk]) } {
set nested [InterpNested]
} else {
set nested [Set [NestedOkName $slave]]
@@ -247,14 +245,13 @@ namespace eval ::safe {
set deleteHook [Set [DeleteHookName $slave]]
}
# we can now reconfigure :
- InterpSetConfig $slave $accessPath \
- $statics $nested $deleteHook;
+ InterpSetConfig $slave $accessPath $statics $nested $deleteHook
# auto_reset the slave (to completly synch the new access_path)
if {$doreset} {
if {[catch {::interp eval $slave {auto_reset}} msg]} {
- Log $slave "auto_reset failed: $msg";
+ Log $slave "auto_reset failed: $msg"
} else {
- Log $slave "successful auto_reset" NOTICE;
+ Log $slave "successful auto_reset" NOTICE
}
}
}
@@ -298,15 +295,15 @@ namespace eval ::safe {
} {
# Create the slave.
if {[string compare "" $slave]} {
- ::interp create -safe $slave;
+ ::interp create -safe $slave
} else {
# empty argument: generate slave name
- set slave [::interp create -safe];
+ set slave [::interp create -safe]
}
- Log $slave "Created" NOTICE;
+ Log $slave "Created" NOTICE
# Initialize it. (returns slave name)
- InterpInit $slave $access_path $staticsok $nestedok $deletehook;
+ InterpInit $slave $access_path $staticsok $nestedok $deletehook
}
@@ -323,60 +320,60 @@ namespace eval ::safe {
nestedok deletehook} {
# determine and store the access path if empty
- if {[string match "" $access_path]} {
- set access_path [uplevel #0 set auto_path];
+ if {[string equal "" $access_path]} {
+ set access_path [uplevel #0 set auto_path]
# Make sure that tcl_library is in auto_path
# and at the first position (needed by setAccessPath)
- set where [lsearch -exact $access_path [info library]];
+ set where [lsearch -exact $access_path [info library]]
if {$where == -1} {
# not found, add it.
- set access_path [concat [list [info library]] $access_path];
+ set access_path [concat [list [info library]] $access_path]
Log $slave "tcl_library was not in auto_path,\
- added it to slave's access_path" NOTICE;
+ added it to slave's access_path" NOTICE
} elseif {$where != 0} {
# not first, move it first
set access_path [concat [list [info library]]\
- [lreplace $access_path $where $where]];
+ [lreplace $access_path $where $where]]
Log $slave "tcl_libray was not in first in auto_path,\
- moved it to front of slave's access_path" NOTICE;
+ moved it to front of slave's access_path" NOTICE
}
# Add 1st level sub dirs (will searched by auto loading from tcl
# code in the slave using glob and thus fail, so we add them
# here so by default it works the same).
- set access_path [AddSubDirs $access_path];
+ set access_path [AddSubDirs $access_path]
}
Log $slave "Setting accessPath=($access_path) staticsok=$staticsok\
- nestedok=$nestedok deletehook=($deletehook)" NOTICE;
+ nestedok=$nestedok deletehook=($deletehook)" NOTICE
# clear old autopath if it existed
- set nname [PathNumberName $slave];
+ set nname [PathNumberName $slave]
if {[Exists $nname]} {
- set n [Set $nname];
+ set n [Set $nname]
for {set i 0} {$i<$n} {incr i} {
- Unset [PathToken $i $slave];
+ Unset [PathToken $i $slave]
}
}
# build new one
set slave_auto_path {}
- set i 0;
+ set i 0
foreach dir $access_path {
- Set [PathToken $i $slave] $dir;
- lappend slave_auto_path "\$[PathToken $i]";
- incr i;
+ Set [PathToken $i $slave] $dir
+ lappend slave_auto_path "\$[PathToken $i]"
+ incr i
}
- Set $nname $i;
- Set [PathListName $slave] $access_path;
- Set [VirtualPathListName $slave] $slave_auto_path;
+ Set $nname $i
+ Set [PathListName $slave] $access_path
+ Set [VirtualPathListName $slave] $slave_auto_path
Set [StaticsOkName $slave] $staticsok
Set [NestedOkName $slave] $nestedok
Set [DeleteHookName $slave] $deletehook
- SyncAccessPath $slave;
+ SyncAccessPath $slave
}
#
@@ -385,12 +382,12 @@ namespace eval ::safe {
# Search for a real directory and returns its virtual Id
# (including the "$")
proc ::safe::interpFindInAccessPath {slave path} {
- set access_path [GetAccessPath $slave];
- set where [lsearch -exact $access_path $path];
+ set access_path [GetAccessPath $slave]
+ set where [lsearch -exact $access_path $path]
if {$where == -1} {
- return -code error "$path not found in access path $access_path";
+ return -code error "$path not found in access path $access_path"
}
- return "\$[PathToken $where]";
+ return "\$[PathToken $where]"
}
#
@@ -400,22 +397,22 @@ proc ::safe::interpFindInAccessPath {slave path} {
proc ::safe::interpAddToAccessPath {slave path} {
# first check if the directory is already in there
if {![catch {interpFindInAccessPath $slave $path} res]} {
- return $res;
+ return $res
}
# new one, add it:
- set nname [PathNumberName $slave];
- set n [Set $nname];
- Set [PathToken $n $slave] $path;
+ set nname [PathNumberName $slave]
+ set n [Set $nname]
+ Set [PathToken $n $slave] $path
- set token "\$[PathToken $n]";
+ set token "\$[PathToken $n]"
- Lappend [VirtualPathListName $slave] $token;
- Lappend [PathListName $slave] $path;
- Set $nname [expr {$n+1}];
+ Lappend [VirtualPathListName $slave] $token
+ Lappend [PathListName $slave] $path
+ Set $nname [expr {$n+1}]
- SyncAccessPath $slave;
+ SyncAccessPath $slave
- return $token;
+ return $token
}
# This procedure applies the initializations to an already existing
@@ -431,7 +428,7 @@ proc ::safe::interpAddToAccessPath {slave path} {
# Configure will generate an access_path when access_path is
# empty.
- InterpSetConfig $slave $access_path $staticsok $nestedok $deletehook;
+ InterpSetConfig $slave $access_path $staticsok $nestedok $deletehook
# These aliases let the slave load files to define new commands
@@ -478,9 +475,8 @@ proc ::safe::interpAddToAccessPath {slave path} {
# model platform dependant and thus more error prone.
if {[catch {::interp eval $slave\
- {source [file join $tcl_library init.tcl]}}\
- msg]} {
- Log $slave "can't source init.tcl ($msg)";
+ {source [file join $tcl_library init.tcl]}} msg]} {
+ Log $slave "can't source init.tcl ($msg)"
error "can't source init.tcl into slave $slave ($msg)"
}
@@ -498,18 +494,18 @@ proc ::safe::interpAddToAccessPath {slave path} {
# check that we don't have it yet as a children
# of a previous dir
if {[lsearch -exact $res $dir]<0} {
- lappend res $dir;
+ lappend res $dir
}
foreach sub [glob -nocomplain -- [file join $dir *]] {
- if { ([file isdirectory $sub])
- && ([lsearch -exact $res $sub]<0) } {
+ if {([file isdirectory $sub]) \
+ && ([lsearch -exact $res $sub]<0) } {
# new sub dir, add it !
- lappend res $sub;
+ lappend res $sub
}
}
}
}
- return $res;
+ return $res
}
# This procedure deletes a safe slave managed by Safe Tcl and
@@ -517,20 +513,20 @@ proc ::safe::interpAddToAccessPath {slave path} {
proc ::safe::interpDelete {slave} {
- Log $slave "About to delete" NOTICE;
+ Log $slave "About to delete" NOTICE
# If the slave has a cleanup hook registered, call it.
# check the existance because we might be called to delete an interp
# which has not been registered with us at all
- set hookname [DeleteHookName $slave];
+ set hookname [DeleteHookName $slave]
if {[Exists $hookname]} {
- set hook [Set $hookname];
+ set hook [Set $hookname]
if {![::tcl::Lempty $hook]} {
# remove the hook now, otherwise if the hook
# calls us somehow, we'll loop
- Unset $hookname;
+ Unset $hookname
if {[catch {eval $hook [list $slave]} err]} {
- Log $slave "Delete hook error ($err)";
+ Log $slave "Delete hook error ($err)"
}
}
}
@@ -538,16 +534,16 @@ proc ::safe::interpDelete {slave} {
# Discard the global array of state associated with the slave, and
# delete the interpreter.
- set statename [InterpStateName $slave];
+ set statename [InterpStateName $slave]
if {[Exists $statename]} {
- Unset $statename;
+ Unset $statename
}
# if we have been called twice, the interp might have been deleted
# already
if {[::interp exists $slave]} {
- ::interp delete $slave;
- Log $slave "Deleted" NOTICE;
+ ::interp delete $slave
+ Log $slave "Deleted" NOTICE
}
return
@@ -556,12 +552,12 @@ proc ::safe::interpDelete {slave} {
# Set (or get) the loging mecanism
proc ::safe::setLogCmd {args} {
- variable Log;
+ variable Log
if {[llength $args] == 0} {
- return $Log;
+ return $Log
} else {
if {[llength $args] == 1} {
- set Log [lindex $args 0];
+ set Log [lindex $args 0]
} else {
set Log $args
}
@@ -579,12 +575,11 @@ proc ::safe::setLogCmd {args} {
# also sets tcl_library to the first token of the virtual path.
#
proc SyncAccessPath {slave} {
- set slave_auto_path [Set [VirtualPathListName $slave]];
- ::interp eval $slave [list set auto_path $slave_auto_path];
- Log $slave \
- "auto_path in $slave has been set to $slave_auto_path"\
- NOTICE;
- ::interp eval $slave [list set tcl_library [lindex $slave_auto_path 0]];
+ set slave_auto_path [Set [VirtualPathListName $slave]]
+ ::interp eval $slave [list set auto_path $slave_auto_path]
+ Log $slave "auto_path in $slave has been set to $slave_auto_path"\
+ NOTICE
+ ::interp eval $slave [list set tcl_library [lindex $slave_auto_path 0]]
}
# base name for storing all the slave states
@@ -594,13 +589,12 @@ proc ::safe::setLogCmd {args} {
# We add the S prefix to avoid that a slave interp called "Log"
# would smash our "Log" variable.
proc InterpStateName {slave} {
- return "S$slave";
+ return "S$slave"
}
# Check that the given slave is "one of us"
proc IsInterp {slave} {
- expr { ([Exists [InterpStateName $slave]])
- && ([::interp exists $slave])}
+ expr {[Exists [InterpStateName $slave]] && [::interp exists $slave]}
}
# returns the virtual token for directory number N
@@ -608,53 +602,53 @@ proc ::safe::setLogCmd {args} {
# it will return the corresponding master global variable name
proc PathToken {n {slave ""}} {
if {[string compare "" $slave]} {
- return "[InterpStateName $slave](access_path,$n)";
+ return "[InterpStateName $slave](access_path,$n)"
} else {
# We need to have a ":" in the token string so
# [file join] on the mac won't turn it into a relative
# path.
- return "p(:$n:)";
+ return "p(:$n:)"
}
}
# returns the variable name of the complete path list
proc PathListName {slave} {
- return "[InterpStateName $slave](access_path)";
+ return "[InterpStateName $slave](access_path)"
}
# returns the variable name of the complete path list
proc VirtualPathListName {slave} {
- return "[InterpStateName $slave](access_path_slave)";
+ return "[InterpStateName $slave](access_path_slave)"
}
# returns the variable name of the number of items
proc PathNumberName {slave} {
- return "[InterpStateName $slave](access_path,n)";
+ return "[InterpStateName $slave](access_path,n)"
}
# returns the staticsok flag var name
proc StaticsOkName {slave} {
- return "[InterpStateName $slave](staticsok)";
+ return "[InterpStateName $slave](staticsok)"
}
# returns the nestedok flag var name
proc NestedOkName {slave} {
- return "[InterpStateName $slave](nestedok)";
+ return "[InterpStateName $slave](nestedok)"
}
# Run some code at the namespace toplevel
proc Toplevel {args} {
- namespace eval [namespace current] $args;
+ namespace eval [namespace current] $args
}
# set/get values
proc Set {args} {
- eval Toplevel set $args;
+ eval Toplevel set $args
}
# lappend on toplevel vars
proc Lappend {args} {
- eval Toplevel lappend $args;
+ eval Toplevel lappend $args
}
# unset a var/token (currently just an global level eval)
proc Unset {args} {
- eval Toplevel unset $args;
+ eval Toplevel unset $args
}
# test existance
proc Exists {varname} {
- Toplevel info exists $varname;
+ Toplevel info exists $varname
}
# short cut for access path getting
proc GetAccessPath {slave} {
@@ -680,24 +674,24 @@ proc ::safe::setLogCmd {args} {
# somehow strip the namespaces 'functionality' out (the danger
# is that we would strip valid macintosh "../" queries... :
if {[regexp {(::)|(\.\.)} $path]} {
- error "invalid characters in path $path";
+ error "invalid characters in path $path"
}
- set n [expr {[Set [PathNumberName $slave]]-1}];
+ set n [expr {[Set [PathNumberName $slave]]-1}]
for {} {$n>=0} {incr n -1} {
# fill the token virtual names with their real value
- set [PathToken $n] [Set [PathToken $n $slave]];
+ set [PathToken $n] [Set [PathToken $n $slave]]
}
# replaces the token by their value
- subst -nobackslashes -nocommands $path;
+ subst -nobackslashes -nocommands $path
}
# Log eventually log an error
# to enable error logging, set Log to {puts stderr} for instance
proc Log {slave msg {type ERROR}} {
- variable Log;
+ variable Log
if {[info exists Log] && [llength $Log]} {
- eval $Log [list "$type for slave $slave : $msg"];
+ eval $Log [list "$type for slave $slave : $msg"]
}
}
@@ -708,29 +702,27 @@ proc ::safe::setLogCmd {args} {
# limit what can be sourced to .tcl
# and forbid files with more than 1 dot and
# longer than 14 chars
- set ftail [file tail $file];
+ set ftail [file tail $file]
if {[string length $ftail]>14} {
- error "$ftail: filename too long";
+ error "$ftail: filename too long"
}
if {[regexp {\..*\.} $ftail]} {
- error "$ftail: more than one dot is forbidden";
+ error "$ftail: more than one dot is forbidden"
}
if {[string compare $ftail "tclIndex"] && \
- [string compare [string tolower [file extension $ftail]]\
- ".tcl"]} {
- error "$ftail: must be a *.tcl or tclIndex";
+ [string compare -nocase [file extension $ftail] ".tcl"]} {
+ error "$ftail: must be a *.tcl or tclIndex"
}
if {![file exists $file]} {
# don't tell the file path
- error "no such file or directory";
+ error "no such file or directory"
}
if {![file readable $file]} {
# don't tell the file path
- error "not readable";
+ error "not readable"
}
-
}
@@ -738,39 +730,39 @@ proc ::safe::setLogCmd {args} {
proc AliasSource {slave args} {
- set argc [llength $args];
+ set argc [llength $args]
# Allow only "source filename"
# (and not mac specific -rsrc for instance - see comment in ::init
# for current rationale)
if {$argc != 1} {
set msg "wrong # args: should be \"source fileName\""
- Log $slave "$msg ($args)";
- return -code error $msg;
+ Log $slave "$msg ($args)"
+ return -code error $msg
}
set file [lindex $args 0]
# get the real path from the virtual one.
if {[catch {set file [TranslatePath $slave $file]} msg]} {
- Log $slave $msg;
+ Log $slave $msg
return -code error "permission denied"
}
# check that the path is in the access path of that slave
if {[catch {FileInAccessPath $slave $file} msg]} {
- Log $slave $msg;
+ Log $slave $msg
return -code error "permission denied"
}
# do the checks on the filename :
if {[catch {CheckFileName $slave $file} msg]} {
- Log $slave "$file:$msg";
- return -code error $msg;
+ Log $slave "$file:$msg"
+ return -code error $msg
}
# passed all the tests , lets source it:
if {[catch {::interp invokehidden $slave source $file} msg]} {
- Log $slave $msg;
- return -code error "script error";
+ Log $slave $msg
+ return -code error "script error"
}
return $msg
}
@@ -779,26 +771,26 @@ proc ::safe::setLogCmd {args} {
proc AliasLoad {slave file args} {
- set argc [llength $args];
+ set argc [llength $args]
if {$argc > 2} {
- set msg "load error: too many arguments";
- Log $slave "$msg ($argc) {$file $args}";
- return -code error $msg;
+ set msg "load error: too many arguments"
+ Log $slave "$msg ($argc) {$file $args}"
+ return -code error $msg
}
# package name (can be empty if file is not).
- set package [lindex $args 0];
+ set package [lindex $args 0]
# Determine where to load. load use a relative interp path
# and {} means self, so we can directly and safely use passed arg.
- set target [lindex $args 1];
+ set target [lindex $args 1]
if {[string length $target]} {
# we will try to load into a sub sub interp
# check that we want to authorize that.
if {![NestedOk $slave]} {
Log $slave "loading to a sub interp (nestedok)\
- disabled (trying to load $package to $target)";
- return -code error "permission denied (nested load)";
+ disabled (trying to load $package to $target)"
+ return -code error "permission denied (nested load)"
}
}
@@ -807,34 +799,34 @@ proc ::safe::setLogCmd {args} {
if {[string length $file] == 0} {
# static package loading
if {[string length $package] == 0} {
- set msg "load error: empty filename and no package name";
- Log $slave $msg;
- return -code error $msg;
+ set msg "load error: empty filename and no package name"
+ Log $slave $msg
+ return -code error $msg
}
if {![StaticsOk $slave]} {
Log $slave "static packages loading disabled\
- (trying to load $package to $target)";
- return -code error "permission denied (static package)";
+ (trying to load $package to $target)"
+ return -code error "permission denied (static package)"
}
} else {
# file loading
# get the real path from the virtual one.
if {[catch {set file [TranslatePath $slave $file]} msg]} {
- Log $slave $msg;
+ Log $slave $msg
return -code error "permission denied"
}
# check the translated path
if {[catch {FileInAccessPath $slave $file} msg]} {
- Log $slave $msg;
+ Log $slave $msg
return -code error "permission denied (path)"
}
}
if {[catch {::interp invokehidden\
$slave load $file $package $target} msg]} {
- Log $slave $msg;
+ Log $slave $msg
return -code error $msg
}
@@ -849,14 +841,14 @@ proc ::safe::setLogCmd {args} {
# result.... needs checking ?
proc FileInAccessPath {slave file} {
- set access_path [GetAccessPath $slave];
+ set access_path [GetAccessPath $slave]
if {[file isdirectory $file]} {
error "\"$file\": is a directory"
}
set parent [file dirname $file]
if {[lsearch -exact $access_path $parent] == -1} {
- error "\"$file\": not in access_path";
+ error "\"$file\": not in access_path"
}
}
@@ -868,9 +860,9 @@ proc ::safe::setLogCmd {args} {
if {[regexp $okpat $subcommand]} {
return [eval {$command $subcommand} [lrange $args 1 end]]
}
- set msg "not allowed to invoke subcommand $subcommand of $command";
- Log $slave $msg;
- error $msg;
+ set msg "not allowed to invoke subcommand $subcommand of $command"
+ Log $slave $msg
+ error $msg
}
# This procedure installs an alias in a slave that invokes "safesubset"
@@ -895,7 +887,7 @@ proc ::safe::setLogCmd {args} {
proc AliasEncoding {slave args} {
- set argc [llength $args];
+ set argc [llength $args]
set okpat "^(name.*|convert.*)\$"
set subcommand [lindex $args 0]
@@ -910,21 +902,20 @@ proc ::safe::setLogCmd {args} {
# passed all the tests , lets source it:
if {[catch {::interp invokehidden \
$slave encoding system} msg]} {
- Log $slave $msg;
- return -code error "script error";
+ Log $slave $msg
+ return -code error "script error"
}
} else {
- set msg "wrong # args: should be \"encoding system\"";
- Log $slave $msg;
- error $msg;
+ set msg "wrong # args: should be \"encoding system\""
+ Log $slave $msg
+ error $msg
}
} else {
- set msg "wrong # args: should be \"encoding option ?arg ...?\"";
- Log $slave $msg;
- error $msg;
+ set msg "wrong # args: should be \"encoding option ?arg ...?\""
+ Log $slave $msg
+ error $msg
}
-
-
+
return $msg
}