Diff
Not logged in

Differences From Artifact [d2e22e8a81]:

To Artifact [b69dd81ceb]:


1
2
3
4
5

6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23

24
25
26
27
28
29
30
1
2
3
4

5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

23
24
25
26
27
28
29
30




-
+

















-
+







# safe.tcl --
#
# This file provide a safe loading/sourcing mechanism for safe interpreters.
# 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
# slave. It runs in a parent 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.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

#
# The implementation is based on namespaces. These naming conventions are
# followed:
# Private procs starts with uppercase.
# Public  procs are exported and starts with lowercase
#

# Needed utilities package
package require opt 0.4.7
package require opt 0.4.8

# Create the safe namespace
namespace eval ::safe {
    # Exported API:
    namespace export interpCreate interpInit interpConfigure interpDelete \
	interpAddToAccessPath interpFindInAccessPath setLogCmd
}
266
267
268
269
270
271
272
273

274
275
276
277
278
279
280
266
267
268
269
270
271
272

273
274
275
276
277
278
279
280







-
+







# {},...  {because the state array is stored as part of the name}
#
# Returns the slave name.
#
# 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.
#                if empty: the parent auto_path will be used.
# + staticsok  : flag, if 0 :no static package can be loaded (load {} Xxx)
#                      if 1 :static packages are ok.
# + nestedok: flag, if 0 :no loading to sub-sub interps (load xx xx sub)
#                      if 1 : multiple levels are ok.

# use the full name and no indent so auto_mkIndex can find us
proc ::safe::InterpCreate {
298
299
300
301
302
303
304
305

306
307
308
309
310
311
312
298
299
300
301
302
303
304

305
306
307
308
309
310
311
312







-
+







    # Initialize it. (returns slave name)
    InterpInit $slave $access_path $staticsok $nestedok $deletehook
}

#
# InterpSetConfig (was setAccessPath) :
#    Sets up slave virtual auto_path and corresponding structure within
#    the master. Also sets the tcl_library in the slave to be the first
#    the parent. Also sets the tcl_library in the slave to be the first
#    directory in the path.
#    NB: If you change the path after the slave has been initialized you
#    probably need to call "auto_reset" in the slave in order that it gets
#    the right auto_index() array values.

proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook} {
    global auto_path
591
592
593
594
595
596
597
598

599
600
601
602
603
604
605
591
592
593
594
595
596
597

598
599
600
601
602
603
604
605







-
+







    namespace upvar ::safe [VarName $slave] state

    # When an interpreter is deleted with [interp delete], any sub-interpreters
    # are deleted automatically, but this leaves behind their data in the Safe
    # Base. To clean up properly, we call safe::interpDelete recursively on each
    # Safe Base sub-interpreter, so each one is deleted cleanly and not by
    # the automatic mechanism built into [interp delete].
    foreach sub [interp slaves $slave] {
    foreach sub [interp children $slave] {
        if {[info exists ::safe::[VarName [list $slave $sub]]]} {
            ::safe::interpDelete [list $slave $sub]
        }
    }

    # If the slave has a cleanup hook registered, call it.  Check the
    # existance because we might be called to delete an interp which has
663
664
665
666
667
668
669
670

671
672
673
674
675
676
677
663
664
665
666
667
668
669

670
671
672
673
674
675
676
677







-
+







	}
    }
}

# ------------------- END OF PUBLIC METHODS ------------

#
# Sets the slave auto_path to the master recorded value.  Also sets
# Sets the slave auto_path to the parent recorded value.  Also sets
# tcl_library to the first token of the virtual path.
#
proc ::safe::SyncAccessPath {slave} {
    namespace upvar ::safe [VarName $slave] state

    set slave_access_path $state(access_path,slave)
    ::interp eval $slave [list set auto_path $slave_access_path]
1077
1078
1079
1080
1081
1082
1083
1084

1085
1086
1087
1088
1089
1090
1091
1077
1078
1079
1080
1081
1082
1083

1084
1085
1086
1087
1088
1089
1090
1091







-
+







	}
	Log $slave $msg
	return -code error $msg
    }
}

# FileInAccessPath raises an error if the file is not found in the list of
# directories contained in the (master side recorded) slave's access path.
# directories contained in the (parent side recorded) slave's access path.

# the security here relies on "file dirname" answering the proper
# result... needs checking ?
proc ::safe::FileInAccessPath {slave file} {
    namespace upvar ::safe [VarName $slave] state
    set access_path $state(access_path)