Updated 2015-11-12 20:58:17 by pooryorick

Remote Script Execution implements a system to evaluate commands in a remote safe interpreter.

See Also  edit

comm

Description  edit

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]

Page Authors  edit

sdw