Remote Script Execution implements a system to evaluate commands in a remote safe interpreter.
The script on this page may be out of date. Check Sean's website for changes: http://www.etoyoc.com/programs
namespace eval ::rpc {
variable mysock
variable sport
variable connections
proc trace string {
puts $string
}
###
# Change me, should be an odd number
# smaller than the random number range
###
variable secret_key 666
variable secret_range 10000
proc hash {arglist {key {}}} {
set accum 0
if { $key eq {} } {
variable secret_key
set key $secret_key
}
foreach s $arglist {
set accum [expr ($accum + $s) % $key]
}
return $accum
}
proc init {interp port} {
variable mysock
variable sport
variable error_log_file
set sport $port
set mysock [socket -server [list ::rpc::newcon $interp] $port]
}
proc newcon {interp sock addr port} {
fconfigure $sock -buffering line -translation crlf
trace [list OPEN $sock from $addr]
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 }
trace "$sock closed"
###
# 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
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] {
NOOP {
puts $sock [list NOOP]
}
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 eq {.} } {
set buffer [decode $state(script)]
###
# Eval script
###
set ::errorInfo {}
set err [catch { interp eval $state(interp) $buffer } reply]
if $err {
puts $sock ERROR
puts $sock [encode [list $err $reply $::errorInfo]]
} else {
if ![regexp \n $reply] {
if { [string length $reply] > 32768 } {
set reply [join $reply \n]
}
}
if [regexp \n $reply] {
puts $sock MULTILINE
puts $sock [encode $reply]
puts $sock .
} else {
puts $sock [list RETURN $reply]
}
}
# puts $sock [list RETURN]
set state(state) auth
} else {
if { $state(script) eq {} } {
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
}
###
# Begin Client Code
###
proc reval_init {handle server port {key {}}} {
upvar #0 [namespace current]::${handle} token
if { $key eq {} } {
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)
###
# Check for echo
###
if { $sock ne {} } {
if [catch {
sendline $sock NOOP $handle NOOP line
}] {
set sock {}
}
}
if { $sock eq {} } {
trace [list OPENING connection to $token(server) at $token(port)]
set sock [socket $token(server) $token(port)]
fconfigure $sock -buffering line -translation crlf -blocking 1
set token(sock) $sock
sendline $sock AUTH $handle CHAL line
set hash [hash [lindex $line 1] $token(secret_key)]
sendline $sock [list RESP $hash] $handle OK line
}
set token(sock) $sock
return $sock
}
proc reval_reset {handle sock} {
upvar #0 [namespace current]::${handle} token
closechan $sock
set token(sock) {}
}
proc sendline {sock sendline handle token resultvar} {
upvar 1 $resultvar reply
puts $sock $sendline
if { [gets $sock reply] < 0 } {
reval_reset $sock $handle
error "Connection Closed"
}
if { [lindex $reply 0] != "$token" } {
error "Server sent [lindex $line 0] instead of $token in response to $sendline"
}
return $reply
}
proc recvline {sock} {
if { [gets $sock line] < 0 } {
closechan $sock
error "Connection Closed"
}
return $line
}
proc getblock {sock varname} {
upvar 1 $varname result
set result {}
while 1 {
if {[gets $sock line] < 0 } {
error "Connection Reset"
}
if { $line eq {.} } break
append result \n $line
}
return [decode [string range $result 1 end]]
}
proc reval {handle args} {
if { [llength $args] == 1 } {
set args [lindex $args 0]
}
set sock [reval_wake $handle]
sendline $sock EVAL $handle BEGIN line
puts $sock [encode $args]
puts $sock .
set reply [recvline $sock]
switch [lindex $reply 0] {
RETURN {
return [lindex $reply 1]
}
ERROR {
if [catch {getblock $sock reply} err] {
reval_reset $handle $sock
error $err
}
return -code [lindex $reply 0] -errorinfo [lindex $reply 2] [lindex $reply 1]
}
MULTILINE {
if [catch {getblock $sock reply} err] {
reval_reset $handle $sock
error $err
}
return $reply
}
}
}
}Starting a server process:
interp create -safe example ::rpc::init example 8016 1337 ### # Important, or the server will never # start listening ### vwait forever
Starting 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]