Remote execution software is translated into ''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' is the machine on which the user interacts with a GUI. It needs [wish].
   * The 'client' is the machine where the software really turns. It only needs [tclsh].

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.

Update to support BWidgets - ''20060607 Sarnold''

----
'''Client File #1 : distanciel.tcl'''

    namespace eval distanciel {
        variable server localhost
        variable port 2006
        variable socket
        variable delayed
        variable limit 10
        variable operations
        array set operations {unset Unset write Write read Read}
        
        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
            uplevel $script
            return $data
        }
        # create an local incarnation of a remote (Tk-related) proc
        proc lambda {procname} {
            #puts lambda=$procname
            set body [send delegate [list info body $procname]]
            set arglist [lambdaargs $procname]
            # get the namespace
            foreach {allctx procname} [context $procname] {break}
            # creates locally the proc
            #puts $allctx,$procname,$arglist,$body
            proc ${allctx}::$procname $arglist $body
        }
        source tools.tcl
        proc lambdaargs {procname} {
            set arglist [send delegate [list info args $procname]]
            for {set i 0} {$i < [llength $arglist]} {incr i} {
                set arg [lindex $arglist $i]
                if {[send delegate [list info default $procname $arg dummy]]} {
                    set default [send delegate [list default $procname $arg]]
                    lset arglist $i [list $arg $default]
                }
            }
            return $arglist
        }
        
        proc delete {cmd op} {
            send delegate $cmd
        }
        # when a variable has to be remotely controlled
        # here we write data
        proc wvar {varname value} {
            trace remove variable $varname write distanciel::myvar
            set $varname $value
            trace add variable $varname write distanciel::myvar
        }
        # like incr : returns the incremented value, but without modifying the variable
        proc getincr {var {increment 0}} {
            upvar $var x
            incr x 0
            incr increment 0
            return [expr {$x + $increment}]
        }
        proc normalize {varname} {
            set i [string first ( $varname]
            if {$i<0} {
                return [list $varname ""]
            }
            list [string range $varname [getincr i -1]] \
                    [string range $varname [getincr i] end-1]
        }
        proc varread {varname} {
            if {![info exists $varname]} {
                return
            }
            # install traces
            watch $varname
            # tell the server an update
            send delegate [list Write $varname [set $varname]]
        }
        proc watch {varname} {
            #puts $varname
            # adds the same trace proc to all possible operations : read, write and unset
            trace add variable $varname write distanciel::myvar
            # see principles : we do not need to remotely read
            #trace add variable $varname read  distanciel::myvar
            trace add variable $varname unset distanciel::myvar
        }
        # given a var name and an eventual key, return the fully qualified name of the variable
        proc yourvar {name key} {
            if {$key eq ""} {
                return $name
            }
            return ${name}($key)
        }
        #
        # About -textvariable and -listvariable : these options allow the server to share
        # data with the client, because they exists in the client, must be displayed
        # and might be updated by the GUI server.
        # 
        # principles :
        #  * each time a variable is set, the other side must be telled of that
        #    (with the problem raising when both sides update variables at the same time)
        #  * when a variable is unset (that cannot happen at the other, server side)
        #    it must be destroyed at the server side
        #  * if all the above conditions are met, no problem happen with reading variables
        # 
        # unsets, reads or writes to a variable
        proc myvar {var key op} {
            foreach {ns var} [context $var] {break}
            if {$ns eq ""} {
                set ns [uplevel namespace current]
            }
            variable operations
            set name ${ns}::[yourvar $var $key]
            # translates an operation (read-write-unset) into a remote command
            set cmd [list $operations($op) $name]
            #puts $cmd
            switch -- $op {
                unset -
                read  {}
                write {
                    lappend cmd [set $name]
                }
            }
            send delegate $cmd
        }
        proc renproc {oldname newname op} {
            send delegate [list rename $oldname $newname]
        }
    }
    
    package provide distanciel 0.1

----
'''Client file #2 : distclt.tcl'''

    source distanciel.tcl
    
    # let unknown know...
    proc unknown {args} [string map {} {
        set cmd [lindex $args 0]
        switch -glob -- $cmd {
            \.*     {
                if {[winfo exists $cmd]} {
                    return [distanciel::send delegate $args]
                }
            }
        }
        #puts $cmd
        if {[string match ::tk::* $cmd] || [string match tk::* $cmd]} {
            # private Tk procs, or even widget commands !
            #puts $cmd
            if {![catch {distanciel::lambda $cmd} msg]} {
                return [uplevel $args]
            }
            puts stderr $msg
        }
        if {[uplevel namespace current] eq "::tk"} {
            set cmd ::tk::$cmd
            if {![catch {distanciel::lambda $cmd}]} {
                return [uplevel $args]
            }
        }
    }][info body unknown]
    # widget list
    foreach name {
        button label frame entry
    } {
        set body {
            # creates the widget
            distanciel::send create [linsert $args 0 NAME $obj]
            # instanciates a wrapper to handle widget methods
            proc $obj {args} {
                distanciel::send action [info level 0]
            }
            trace add command $obj rename distanciel::renproc
            # next line causes severe errors
            #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 tk
        option bindtags tk_messageBox focus
    } {
        proc $name {args} [string map [list NAME $name] {
            distanciel::send delegate [linsert $args 0 NAME]
        }]
    }
    trace add execution exit enter distanciel::delete
    # some hacks
    # proc dputs {args} {puts $args}
    namespace eval ::tk {
        proc myvariable {name} {
            foreach {ns var} [distanciel::context $name] {
                if {$ns eq "::tk"} {
                    uplevel ::variable $var
                    return
                }
            }
            uplevel ::variable $name
        }
    }
    
    # because we emulate Tk, and because some megawidgets call "package require Tk"
    package provide Tk [package require Tcl]
    set argv0 [lindex $argv 0]
    set argv  [lrange $argv 1 end]
    source $argv0
    while {1} {
        update
        after 30
        distanciel::send script
    }

----
'''Server : distserver.tcl'''

    package require Tk
    source tools.tcl
    proc dputs {arg} {
        set fd [open traces.txt a]
        puts $fd $arg
        close $fd
    }
    file delete traces.txt
    set script ""
    set mybreak 0
    array set watch ""
    array unset watch *
    
    # used by distanciel::lambda
    proc default {procname arg} {
        info default $procname $arg value
        return $value
    }
    proc recv {channel args} {
        #fconfigure $channel -translation binary
        gets $channel count
        if {[catch {set data [read $channel $count]}]} {return}
        if {[llength $data]>2} {
            dputs $data
            error "internal error"
        }
        foreach {type cmd} $data {break}
        set quit no
        switch -- $type {
            action -
            create -
            delegate  {
                #dputs $data
                set data [eval [linsert $cmd 0 $type]]
            }
            script    {set data ""}
            default   {error "unknown request type, should be one of : $types"}
        }
        foreach {var keys} [array get ::watch] {
            #dputs var=$var
            if {[llength $keys] > 1} {
                foreach key $keys {
                    callback [list distanciel::wvar ${var}($key) [set ${var}($key)]]
                }
            } elseif {$keys eq ""} {
                callback [list distanciel::wvar $var [set $var]]
            } else  {
                callback [list distanciel::wvar ${var}($keys) [set ${var}($keys)]]
            }
        }
        # clear the array
        array unset ::watch *
        #dputs S:$::script
        set data [list $::script $data]
        set ::script ""
        #dputs Resp:$data
        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 action {args} {
        seceval $args
    }
    
    # TODO : proc Set
    proc Set {var value} {
        context $var
        set $var $value
    }
    # secure eval
    proc seceval {arg} {
        if {[catch {eval $arg} msg]} {
            callback [list error $msg]
            return
        }
        set msg
    }
    rename exit __exit__
    proc exit {{code 0}} {
        callback [list exit $code]
        update
        after 2000
        __exit__
    }
    proc delegate {args} {
        switch -- [lindex $args 0] {
            exit {
                # delay exit script
                uplevel set quit yes
                callback $args
                return
            }
            bind {
                if {[llength $args] == 3} {
                    #dputs $args
                    # skip the callback
                    set result [seceval $args]
                    #dputs $result
                    catch {
                        if {[llength $result] == 2 && [lindex $result 0] eq "callback"} {
                            set result [lindex $result 1]
                        }
                    }
                    return $result
                }
                if {[llength $args] == 4} {
                    # there is a script (bind may be called without)
                    set script [lindex $args 3]
                    if {[string index $script 0] eq "+"} {
                        # append the script to the current bindings
                        set plus +
                        set script [string range $script 1 end]
                    } else  {
                        set plus ""
                    }
                    # the third argument to the bind command is a callback
                    lset args 3 $plus[list callback $script]
                }
            }
            Unset {
                # unset a shared variable
                unset [lindex $args 1]
                return
            }
            Write {
                # set the shared variable to its new value
                #dputs Write:$args
                set var   [lindex $args 1]
                set value [lindex $args 2]
                # remove traces before setting the variable to avoid aller-retour
                trace remove variable $var write wvar
                Set $var $value
                trace add variable $var write wvar
                # in order to be a little more synchronous,
                # $value was replaced by [set $var]
                return [set $var]
            }
            default {
                # nothing to be done
            }
        }
        # take the first pair
        foreach {cmd obj} $args {break}
        switch -- $obj {
            configure {
                set args [linsert [lindex [configure [lrange $args 2 end]] 0] 0 $cmd $obj]
            }
            cget {
                return [cget $args]
            }
            default {}
        }
        #dputs del:$args
        seceval $args
    }
    proc myvar {varname} {
        set pos [string first ( $varname]
        if {$pos>=0} {
            set key [string range $varname [expr {$pos+1}] end-1]
            set myvar [string range $varname 0 [incr pos -1]]
        }
        if {[info exists key]} {
            if {![info exists $varname]} {
                callback [list distanciel::varread $varname]
            } elseif {[trace info variable $varname] eq ""} {
                trace add variable $varname write wvar
                if {[trace info variable $myvar] eq ""} {
                    trace add variable $myvar array wvar
                }
            }
            return $varname
        }
        if {![info exists $varname]} {
            callback [list distanciel::varread $varname]
        } elseif {[trace info variable $varname] eq ""} {
            trace add variable $varname write wvar
        }
        # returns the var name
        return $varname
    }
    proc wvar {name key op} {
        # it overwrites previously trace invokations, if any
        if {[llength [split $name ::]]==1} {
            set name [uplevel namespace current]::$name
        }
        #dputs var=$name
        if {$op eq "array"} {
            foreach key [array names $name] {
                wvar $name $key write
            }
            return
        }
        if {![info exists ::watch($name)]} {
            set ::watch($name) $key
            return
        }
        if {$key eq ""} {
            # scalar variable
            return
        }
        if {[lsearch -exact $::watch($name) $key]<0} {
            lappend ::watch($name) $key
        }
    }
    proc configure {args} {
        if {[llength $args] == 1} {
            set args [lindex $args 0]
        }
        set l ""
        foreach {opt value} $args {
            switch -- $opt {
                -command {
                    lappend l $opt [list callback $value]
                }
                -listvariable -
                -textvariable {
                    lappend l $opt [myvar $value]
                }
                default  {lappend l $opt $value}
            }
        }
        #dputs config=$l
        set l
    }
    proc cget {cmd} {
        foreach {obj cmd option} $cmd {break}
        set res [seceval $obj $cmd $option]
        switch -- $opt {
            -command {
                # value is {callback {cmd arg ...}}
                # we want the command
                set res [lindex $value 1]
            }
            default {
                # nothing to be done
            }
        }
        return $res
    }
    # create a widget instance
    proc create {args} {
        foreach {cmd obj} [lrange $args 0 1] {break}
        set l [linsert [configure [lrange $args 2 end]] 0 $cmd $obj]
        #dputs $l
        seceval $l
    }
    proc callback {arg} {
        #dputs callback//$arg//[info level 1]
        append ::script $arg\n
    }
    
    # not needed anymore
    #callback {namespace eval tk {}}
    # to share Tk private data with the client
    foreach var [info vars tk::*] {
        foreach {ns myvar} [context $var] {break}
        set var ${ns}::$myvar
        callback [list namespace eval $ns [list variable $myvar]]
        foreach name [array names $var] {
            set varname ${var}($name)
            trace add variable $varname write wvar
            callback [list namespace eval $ns [list set ${myvar}($name) [set $varname]]]
            callback [list distanciel::watch $varname]
        }
        trace add variable $var array wvar
    }
    
    
    socket -server recv 2006

----
'''Common file : the tools (tools.tcl)'''
It must be present at both ends.

    # common tools for distanciel
    # By Stéphane Arnold 2006
    proc context {name} {
        set ns [Split $name ::]
        set name [lindex $ns end]
        set ns [lrange $ns 0 end-1]
        # creates all intermediate namespace, if they do not exist
        set allctx ""
        foreach context $ns {
            if {$context eq ""} {
                continue
            }
            append allctx ::$context
            namespace eval $allctx {}
        }
        list $allctx $name
    }
    proc Split {str sep} {
        set out ""
        while {[set idx [string first :: $str]] >= 0} {
            if {$idx>0} {
                # the left part : the current element
                lappend out [string range $str 0 [expr {$idx-1}]]
            }
            # get the right part
            set str [string range $str [incr idx 2] end]
        }
        lappend out $str
    }

----
'''Client file #3 : the test program (mytest.tcl)'''

    package require BWidget
    
    Label .lbl -text "Hello Stéphane!"
    Button .b -command exit -text Exit
    set enter "Enter your text here"
    proc echo {var key op} {
        if {$key ne ""} {
            puts [set $var($key)]
            return
        }
        puts [set $var]
    }
    #trace add variable ::enter write echo
    Entry .en -textvariable ::enter
    Button .echo -command {tk_messageBox -message "You have typed : $::enter"} -text Echo
    pack .lbl .b .en .echo
        

''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 Interprocess Communication] ]]