[SDW] This is an example implementation of a client/server arrangment to execute command to a remote safe interpreter.


    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 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]





----
Related topics include "[Tuplespace]",
"[remote execution using tcl and Pcom]", 
"[remote ssh tcl]", '[mkextensions]' mkRinterp, 
"[Distributing a series of tasks]", and so on.
And so on includes ... "[comm]".