Remote execution software is translated with Logiciel d'exécution à distance in French. It is what distanciel (distance logiciel) means to be. 20060606 Sarnold
There are 4 files needed : 3 on the 'client', only one on the 'server'. Architecture is a bit like X Window model.
The 'server' opens a TCP port 2006, waiting for 'client' requests. Currently, distanciel is just a prototype, or fun project if you like more, but it works for simple tasks.
Client File #1 : distanciel.tcl
namespace eval distanciel {
variable server localhost
variable port 2006
variable socket
variable delayed
variable limit 10
proc connect {args} {
variable server
variable port
variable socket
if {[catch {set socket [socket $server $port]}]} {
error "cannot connect to server $server on port $port"
}
return
}
proc send {args} {
connect
variable socket
# write <length>,data
set data [string length $args]\n$args
for {set i 0} {$i < 3 && [set b [catch {puts -nonewline $socket $data} msg]]} {incr i} {
# do nothing
}
catch {flush $socket}
if {$b} {
error "cannot write after $i attempts"
}
# read <length>,data
gets $socket count
foreach {script data} [read $socket $count] {break}
close $socket
# todo : variable handling
catch {uplevel $script}
return $data
}
proc delete {cmd op} {
send delegate $cmd
}
}
package provide distanciel 0.1
Client file #2 : distclt.tcl
source distanciel.tcl
foreach name {button label frame} {
set body {
# creates the widget
distanciel::send create [linsert $args 0 NAME $obj]
# instanciates a wrapper to handle widget methods
proc $obj {args} [string map [list OBJ $obj] {
distanciel::send action [lindex $args 0 OBJ]
}]
trace add command $obj rename distanciel::renproc
trace add command $obj delete distanciel::renproc
return $obj
}
proc $name {obj args} [string map [list NAME $name] $body]
}
foreach name {pack place grid winfo wm destroy bind} {
proc $name {args} [string map [list NAME $name] {
distanciel::send delegate [linsert $args 0 NAME]
}]
}
trace add execution exit enter distanciel::delete
set argv0 [lindex $argv 0]
set argv [lrange $argv 1 end]
source $argv0
while {1} {
update
after 500
distanciel::send script
}Server : distserver.tcl
package require Tk
proc dputs {arg} {
set fd [open traces.txt a]
puts $fd $arg
close $fd
}
file delete traces.txt
set script ""
proc recv {channel args} {
#fconfigure $channel -translation binary
gets $channel count
if {[catch {set data [read $channel $count]}]} {return}
set types {action create delegate}
if {[llength $data]>2} {
dputs $data
error "internal error"
}
dputs $data
foreach {type cmd} $data {break}
set quit no
switch -- $type {
action - create - delegate - script {set data [eval [linsert $cmd 0 $type]]}
default {error "unknown request type, should be one of : $types"}
}
puts -nonewline $channel [string length $data]\n$data
flush $channel
close $channel
if {$quit} {
after 1000; # here to flush network buffers before exiting
exit
}
}
proc delegate {args} {
if {[lindex $args 0] eq "exit"} {
# delay exit script
uplevel set quit yes
return [list $args ""]
}
list "" [eval $args]
}
proc create {args} {
foreach {cmd obj} [set l [lrange $args 0 1]] {break}
foreach {opt value} [lrange $args 2 end] {
switch -- $opt {
-command {lappend l $opt [list callback $value]}
default {lappend l $opt $value}
}
}
list "" [eval $l]
}
proc callback {arg} {
append ::script $arg\n
}
proc script {args} {
set s $::script
set ::script ""
return [list $s ""]
}
socket -server recv 2006Client file #3 : the test program (mytest.tcl)
label .lbl -text "Hello Stéphane!" button .b -command exit -text Exit pack .lbl .b
How to launch it :
# on the server wish distserver.tcl & # on the client tclsh distclt.tcl mytest.tcl &
See also Remote Script Execution.
[ Category Networking | Category ??? ]