SDW This is an example implementation of a client/server arrangment to execute command to a remote safe interpretor.
namespace eval ::rpc {
variable mysock
variable sport
variable connections
###
# Change me, should be an odd number
# smaller than the random number range
###
variable secret_key 1337
variable secret_range 10000
proc hash {arglist {key {}}} {
set accum 0
if { $key == {} } {
variable secret_key
set key $secret_key
}
foreach s $arglist {
set accum [expr ($accum + $s) % $key]
}
return $accum
}
proc init {interp port {key {}}} {
variable mysock
variable sport
variable error_log_file
if { $key != {} } {
variable secret_key
set secret_key $key
}
set sport $port
set mysock [socket -server [list ::rpc::newcon $interp] $port]
}
proc newcon {interp sock addr port} {
fconfigure $sock -buffering line -translation crlf
upvar #0 [namespace current]::${sock} state
array set state [list interp $interp ipaddr $addr ipport $port state ready]
fileevent $sock readable [list ::rpc::getline $sock]
}
proc closechan {sock} {
catch { close $sock }
###
# Wake up any pending command
###
set [namespace current]::${sock}_block -1
update
catch {unset [namespace current]::${sock}_block}
array unset [namespace current]::${sock}
}
proc getline {sock} {
upvar #0 [namespace current]::${sock} state
variable connections
if { [gets $sock line] < 0 } {
closechan $sock
return
}
state_$state(state) $sock $line
}
proc state_ready {sock line} {
upvar #0 [namespace current]::${sock} state
variable secret_range
switch [lindex $line 0] {
AUTH {
set n [expr rand() * 10]
set state(challenge) {}
for {set x 0} { $x < $n } { incr x } {
lappend state(challenge) [expr int(rand() * $secret_range)]
}
puts $sock [list CHAL $state(challenge)]
}
RESP {
set response [lindex $line 1]
set correct [hash $state(challenge)]
if { $response != $correct } {
closechan $sock
}
set state(state) auth
puts $sock "OK"
}
QUIT {
closechan $sock
}
}
}
proc state_auth {sock line} {
upvar #0 [namespace current]::${sock} state
switch [lindex $line 0] {
EVAL {
puts $sock "BEGIN SCRIPT, TERMIATE WITH '.'"
set state(state) data
set state(script) {}
}
NOOP {
puts $sock NOOP
}
}
}
proc state_data {sock line} {
upvar #0 [namespace current]::${sock} state
if { $line == "." } {
set buffer [decode $state(script)]
###
# Eval script
###
set ::errorInfo {}
set err [catch { interp eval $state(interp) $buffer } reply]
puts $sock [list RETURN]
puts $sock [encode [list $err $::errorInfo $reply]]
puts $sock .
set state(state) ready
} else {
if { $state(script) == {} } {
set state(script) $line
} else {
append state(script) \n $line
}
}
}
proc encode buffer {
regsub -all "\n." $buffer "\n.." buffer
return $buffer
}
proc decode buffer {
regsub -all "\n.." $buffer "\n." buffer
return $buffer
}
proc reval_init {handle server port {key {}}} {
upvar #0 [namespace current]::${handle} token
if { $key == {} } {
variable secret_key
set key $secret_key
}
array set token [list handle $handle server $server port $port secret_key $key sock {}]
}
proc reval_wake handle {
upvar #0 [namespace current]::${handle} token
set sock $token(sock)
if { $sock == {} } {
set sock [socket $token(server) $token(port)]
fconfigure $sock -buffering line -translation crlf
set token(sock) $sock
}
upvar #0 [namespace current]::${sock} state
set state(state) open
fileevent $sock readable [list ::rpc::getline $sock]
set line [sendline $sock AUTH]
if { [lindex $line 0] != "CHAL" } {
closechan $sock
set token(sock) {}
error "Server doesn't understand us"
}
set hash [hash [lindex $line 1] $token(secret_key)]
set line [sendline $sock [list RESP $hash]]
if { [lindex $line 0] != "OK" } {
closechan $sock
set token(sock) {}
error "Server doesn't understand us"
}
set token(sock) $sock
return $sock
}
proc sendline {sock line} {
upvar #0 [namespace current]::${sock} state
set state(reply) {}
puts $sock $line
sockwait $sock
return $state(reply)
}
proc sockwait sock {
vwait [namespace current]::${sock}_block
if {[set [namespace current]::${sock}_block] < 0 } {
error "Connection reset"
}
}
proc reval {handle args} {
if { [llength $args] == 1 } {
set args [lindex $args 0]
}
set sock [reval_wake $handle]
upvar #0 [namespace current]::${sock} state
set line [sendline $sock EVAL]
if { [lindex $line 0] != "BEGIN" } {
closechan $sock
set token(sock) {}
error "Could not enter EVAL state"
}
set state(sock) reply
puts $sock [encode $args]
puts $sock .
sockwait $sock
if { [lindex $state(reply)] != "RETURN" } {
closesock $sock
set token(sock) {}
error "Server Doesn't understand us"
}
sockwait $sock
set reply $state(reply)
return -code [lindex $reply 0] -errorinfo [lindex $reply 1] [lindex $reply 2]
}
proc state_open {sock line} {
upvar #0 [namespace current]::${sock} state
set state(reply) $line
set [namespace current]::${sock}_block 1
}
proc state_reply {sock line} {
upvar #0 [namespace current]::${sock} state
if { $line == "." } {
set buffer [decode $state(reply)]
set state(state) open
set state(reply) $buffer
set [namespace current]::${sock}_block 1
} else {
if { $state(script) == {} } {
set state(reply) $line
} else {
append state(reply) \n $line
}
}
}
}Starting a server process:
interp create -safe example
::rpc::init example 8016 1337
###
# Important, or the server will never
# start listening
###
vwait foreverStarting a client process:
::rpc::reval_init localhost localhost 8016 1337
set stmt {expr 1 + 1}
set reply [::rpc::reval localhost $stmt]
puts [list $stmt = $reply]