summaryrefslogtreecommitdiffstats
path: root/library/safe.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'library/safe.tcl')
-rw-r--r--library/safe.tcl69
1 files changed, 38 insertions, 31 deletions
diff --git a/library/safe.tcl b/library/safe.tcl
index 758e1db..5ea12b1 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.30 2009/11/05 20:51:25 andreas_kupries Exp $
+# RCS: @(#) $Id: safe.tcl,v 1.31 2009/11/06 18:16:58 andreas_kupries Exp $
#
# The implementation is based on namespaces. These naming conventions are
@@ -96,7 +96,7 @@ proc ::safe::interpInit {args} {
# Check that the given slave is "one of us"
proc ::safe::CheckInterp {slave} {
- InterpState $slave
+ namespace upvar ::safe S$slave state
if {![info exists state] || ![::interp exists $slave]} {
return -code error \
"\"$slave\" is not an interpreter managed by ::safe::"
@@ -125,7 +125,7 @@ proc ::safe::interpConfigure {args} {
# checks for the "-help" option.
set Args [::tcl::OptKeyParse ::safe::interpIC $args]
CheckInterp $slave
- InterpState $slave
+ namespace upvar ::safe S$slave state
return [join [list \
[list -accessPath $state(access_path)] \
@@ -148,7 +148,7 @@ proc ::safe::interpConfigure {args} {
return -code error [::tcl::OptFlagUsage $desc $arg]
}
CheckInterp $slave
- InterpState $slave
+ namespace upvar ::safe S$slave state
set item [::tcl::OptCurDesc $desc]
set name [::tcl::OptName $item]
@@ -181,7 +181,7 @@ proc ::safe::interpConfigure {args} {
# create did
set Args [::tcl::OptKeyParse ::safe::interpIC $args]
CheckInterp $slave
- InterpState $slave
+ namespace upvar ::safe S$slave state
# Get the current (and not the default) values of whatever has
# not been given:
@@ -312,7 +312,7 @@ proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook} {
Log $slave "Setting accessPath=($access_path) staticsok=$staticsok\
nestedok=$nestedok deletehook=($deletehook)" NOTICE
- InterpState $slave
+ namespace upvar ::safe S$slave state
# clear old autopath if it existed
# build new one
@@ -387,7 +387,7 @@ proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook} {
# Search for a real directory and returns its virtual Id (including the
# "$")
proc ::safe::interpFindInAccessPath {slave path} {
- InterpState $slave
+ namespace upvar ::safe S$slave state
if {![dict exists $state(access_path,remap) $path]} {
return -code error "$path not found in access path $access_path"
@@ -403,7 +403,7 @@ proc ::safe::interpFindInAccessPath {slave path} {
proc ::safe::interpAddToAccessPath {slave path} {
# first check if the directory is already in there
# (inlined interpFindInAccessPath).
- InterpState $slave
+ namespace upvar ::safe S$slave state
if {[dict exists $state(access_path,remap) $path]} {
return [dict get $state(access_path,remap) $path]
@@ -483,7 +483,7 @@ proc ::safe::InterpInit {
# Sync the paths used to search for Tcl modules. This can be done only
# now, after tm.tcl was loaded.
- InterpState $slave
+ namespace upvar ::safe S$slave state
::interp eval $slave [list \
::tcl::tm::add {*}$state(tm_path_slave)]
@@ -519,7 +519,7 @@ proc ::safe::AddSubDirs {pathList} {
proc ::safe::interpDelete {slave} {
Log $slave "About to delete" NOTICE
- InterpState $slave
+ namespace upvar ::safe S$slave state
# If the slave has a cleanup hook registered, call it. Check the
# existance because we might be called to delete an interp which has
@@ -591,7 +591,7 @@ proc ::safe::setLogCmd {args} {
# tcl_library to the first token of the virtual path.
#
proc ::safe::SyncAccessPath {slave} {
- InterpState $slave
+ namespace upvar ::safe S$slave state
set slave_access_path $state(access_path,slave)
::interp eval $slave [list set auto_path $slave_access_path]
@@ -607,19 +607,6 @@ proc ::safe::SyncAccessPath {slave} {
set tcl_library [lindex $slave_access_path 0]]
}
-# base name for storing all the slave states
-# the array variable name for slave foo is thus "Sfoo"
-# and for sub slave {foo bar} "Sfoo bar" (spaces are handled
-# ok everywhere (or should))
-# We add the S prefix to avoid that a slave interp called "Log"
-# would smash our "Log" variable.
-
-proc ::safe::InterpState {slave} {
- uplevel 1 [list variable S$slave]
- uplevel 1 [list upvar 0 S$slave state]
- return
-}
-
# Returns the virtual token for directory number N.
proc ::safe::PathToken {n} {
# We need to have a ":" in the token string so [file join] on the
@@ -631,7 +618,7 @@ proc ::safe::PathToken {n} {
# translate virtual path into real path
#
proc ::safe::TranslatePath {slave path} {
- InterpState $slave
+ namespace upvar ::safe S$slave state
# somehow strip the namespaces 'functionality' out (the danger is that
# we would strip valid macintosh "../" queries... :
@@ -813,7 +800,7 @@ proc ::safe::AliasLoad {slave file args} {
# package name (can be empty if file is not).
set package [lindex $args 0]
- InterpState $slave
+ namespace upvar ::safe S$slave state
# Determine where to load. load use a relative interp path and {}
# means self, so we can directly and safely use passed arg.
@@ -877,7 +864,7 @@ proc ::safe::AliasLoad {slave file args} {
# the security here relies on "file dirname" answering the proper
# result... needs checking ?
proc ::safe::FileInAccessPath {slave file} {
- InterpState $slave
+ namespace upvar ::safe S$slave state
set access_path $state(access_path)
if {[file isdirectory $file]} {
@@ -889,14 +876,14 @@ proc ::safe::FileInAccessPath {slave file} {
# potential pathname anomalies.
set norm_parent [file normalize $parent]
- InterpState $slave
+ namespace upvar ::safe S$slave state
if {$norm_parent ni $state(access_path,norm)} {
return -code error "\"$file\": not in access_path"
}
}
proc ::safe::DirInAccessPath {slave dir} {
- InterpState $slave
+ namespace upvar ::safe S$slave state
set access_path $state(access_path)
if {[file isfile $dir]} {
@@ -907,7 +894,7 @@ proc ::safe::DirInAccessPath {slave dir} {
# potential pathname anomalies.
set norm_dir [file normalize $dir]
- InterpState $slave
+ namespace upvar ::safe S$slave state
if {$norm_dir ni $state(access_path,norm)} {
return -code error "\"$dir\": not in access_path"
}
@@ -1024,8 +1011,28 @@ proc ::safe::Setup {} {
}
namespace eval ::safe {
- # internal variable
+ # internal variables
+
+ # Log command, set via 'setLogCmd'. Logging is disabled when empty.
variable Log {}
+
+ # The package maintains a state array per slave interp under its
+ # control. The name of this array is S<interp-name>. This array is
+ # brought into scope where needed, using 'namespace upvar'. The S
+ # prefix is used to avoid that a slave interp called "Log" smashes
+ # the "Log" variable.
+ #
+ # The array's elements are:
+ #
+ # access_path : List of paths accessible to the slave.
+ # access_path,norm : Ditto, in normalized form.
+ # access_path,slave : Ditto, as the path tokens as seen by the slave.
+ # access_path,map : dict ( token -> path )
+ # access_path,remap : dict ( path -> token )
+ # tm_path_slave : List of TM root directories, as tokens seen by the slave.
+ # staticsok : Value of option -statics
+ # nestedok : Value of option -nested
+ # cleanupHook : Value of option -deleteHook
}
::safe::Setup