# VERSION 1.3 # Code below by Zarutian is under the Creative Commons SH-BY lisence. # Contact him if any other lisence is required. proc makeSerializableSafeSlaveInterp {interp} { interp create $interp -safe foreach command [$interp eval {info commands}] { $interp hide $command $interp alias $command passThrough $interp $command } $interp alias rename slaveRename $interp } proc passThrough args { set interp [lindex $args 0] set command [lindex $args 1] set args [lrange $args 2 end] set temp [list $interp invokehidden [set command]] foreach arg $args { lappend temp $arg } return [eval $temp] } proc slaveRename args { set interp [lindex $args 0] set oldname [lindex $args 1] set newname [lindex $args 2] if {[$interp invokehidden info procs $oldname] != {}} { return [$interp invokehidden rename $oldname $newname] } $interp invokehidden rename $oldname {} $interp alias $newname passThrough $interp $oldname } proc serializeInterp {interp {ns {}}} { set result [list] if {$ns == {}} { if {[llength [interp invokehidden $interp -global file channels]] > 0} { error "cant serialize an interp that has IO channels open!" } } set vars [interp invokehidden $interp -global info vars [set ns]::*] foreach var $vars { if {[$interp invokehidden -global array exists $var]} { lappend result [list array $var [interp invokehidden $interp -global array get $var]] } else { lappend result [list scalar $var [interp invokehidden $interp -global set $var]] } } set procs [interp invokehidden $interp -global info procs [set ns]::*] foreach proc $procs { lappend result [list proc $proc [interp invokehidden $interp -global info args $proc] [interp invokehidden $interp -global info body $proc]] } foreach item [interp aliases $interp] { #set alias [interp alias $interp $item] # if {([lindex $alias 0] == "passThrough") && \ # ([lindex $alias 1] == $interp) && \ # ([lindex $alias 2] != $item) && \ # ([interp target $interp] == {}} { # lappend result [list mapping $item [lindex $alias 2]] #} lappend result [list alias $item [interp target $interp $item] [interp alias $interp $item]] } set packages [interp invokehidden $interp -global package names] foreach name $packages { set versions [interp invokehidden $interp -global package versions $name] if {[llength $versions] == 0} { set versions [interp invokehidden $interp -global package present $name] } foreach version $versions { set script [interp invokehidden $interp -global package ifneeded $name $version] set present [interp invokehidden $interp -global package present $name $version] lappend result [list package $name $version $script $present] } } foreach child [interp invokehidden $interp -global namespace children $ns] { foreach item [serializeInterp $interp $child] { lappend result $item } } foreach slave [interp slaves $interp] { lappend result [list slave_interp $slave [serializeInterp [join $interp $slave]]] } return $result } proc deserializeInterp {interp state} { foreach item $state { set op [lindex $item 0] switch -exact -- $op { "array" { set name [lindex $item 1] set data [lindex $item 2] interp invokehidden $interp -global array set $name $data } "scalar" { set name [lindex $item 1] set data [lindex $item 2] interp invokehidden $interp -global set $name $data } "proc" { set name [lindex $item 1] set args [lindex $item 2] set body [lindex $item 3] interp invokehidden $interp -global proc $name $args $body } #"mapping" { # # set newname [lindex $item 1] # # set oldname [lindex $item 2] # # interp alias $interp $newname {} passThrough $interp $oldname #} "slave_interp" { set name [lindex $item 1] set data [lindex $item 2] deserializeInterp [join $interp $name] $data } "alias" { # possible security hole if state is passed through 3rd party # and not verified agenst hash-key or public key on return set slavecommand [lindex $item 1] set target [lindex $item 2] set command&args [lrange $item 3 end] set t [list interp alias $interp $slavecommand $target] foreach item [set command&args] { lappend t $item } eval $t } "invoked" { # mainly used when the slave isnt allways running # and one is using journaling to keep track of the state set command&args [lindex $item 1] interp eval $interp [set command&args] } "package" { set name [lindex $item 1] set version [lindex $item 2] set script [lindex $item 3] set present [lindex $item 4] interp invokehidden $interp -global package ifneeded $name $version $script] } default { error "deserializeInterp: unknown op [lindex $item 0]"} } } }
Zarutian 3. August 2006: the above code has been tested somewhat, but not extensively
RS 2006-08-14: Note that this code from above
set name [lindex $item 1] set version [lindex $item 2] set script [lindex $item 3] set present [lindex $item 4]
can also be written as
foreach {- name version script present} $item break
Matter of style, and taste, of course... :^)
schlenk 2006-08-14: And if you're up for using Tcl 8.5 you can use lassign for the same.
Zarutian 7. december 2006: I am still figuring out how I can serialize the slave interp's callstack. (So I can use interp limit to implement preemptive scheduling of running tasks)
See also safe, interp slaves, Safe Interps, and Dumping interpreter state.