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} {
	    for {set level 1} {
		    [uplevel $level namespace current] eq "::distanciel"
	    } {incr level} {}
    	    set current [uplevel $level namespace current]
	    puts $current
	    connect
            variable socket
	    # write <length>,data
            set data [string length $args],[string length $current]\n
	    append data $current$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
	    puts "script $script"
            uplevel 1 $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
            uplevel 1 [list proc ${allctx}::$procname $arglist $body]
        }
        source tools.tcl
        proc lambdaargs {procname} {
            set arglist [send delegate [list info args $procname]]
	    if {[llength $arglist] == 0} {return [list]}
	    foreach arg $arglist {
                if {[send delegate [list info default $procname $arg dummy]]} {
                    lappend result [list $arg [send delegate [list default $procname $arg]]]
                } else {
		    lappend result $arg
	        }
            }
	    puts "lambdaargs $result"
            return $result
        }
        
        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 {currentns ::}} {
		if {[string range $varname 0 1] ne "::"} {
		       set varname $currentns$varname
       		}	       
	    puts here
	        if {![info exists $varname]} {
        	    return
            	}
            	# install traces
            	watch $varname
            	# tell the server an update
		puts herebeforedelegate
            	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 "err: $msg"
        }
        if {[uplevel 1 namespace current] eq "::tk"} {
            set cmd ::tk::$cmd
	    puts $cmd
            if {![catch {distanciel::lambda $cmd} msg]} {
                return [uplevel $args]
            }
            puts "err: $msg"
	}
    }][info body unknown]
    
    namespace eval ::tk {
        proc myvariable {name} {
            foreach {ns var} [distanciel::context $name] {
                if {$ns eq "::tk"} {
                    uplevel ::variable $var
                    return
                }
            }
            uplevel ::variable $name
        }
        namespace eval unsupported {}
    }
    
    # widget list
    foreach name {
        button label frame entry text canvas checkbutton radiobutton menu menubutton
        scrollbar spinbox listbox labelframe message tk_optionMenu panedwindow
	toplevel
    } {
        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]
    }
	proc . {args} {
		distanciel::send action [info level 0]
	}
    foreach name {
        bell bind bindtags clipboard tk_chooseColor tk_chooseDirectory console
        destroy tk_dialog event focus tk_focusNext tk_focusPrev tk_focusFollowsMouse
        font tk_getOpenFile tk_getSaveFile grab grid image lower tk_messageBox
        option pack tk_setPalette tk_bisque place tk_popup raise scale selection
        send tk winfo wm tk_textCopy tk_testCut tk_textPaste tkwait
    } {
        proc $name {args} [string map [list NAME $name] {
            distanciel::send delegate [linsert $args 0 NAME]
        }]
    }
    foreach name {::tk::unsupported::ExposePrivateCommand
	    ::tk::unsupported::ExposePrivateVariable} {
	proc $name {args} [string map [list NAME $name] {
            catch {distanciel::send delegate [linsert $args 0 NAME]}
        }]
    }
    trace add execution exit enter distanciel::delete
    # some hacks
    # proc dputs {args} {puts $args}
    
    # 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 *
    set currentns ::
    
    # 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 counts
	foreach {count ns} [split $counts ,] {break}
	incr count $ns
        if {[catch {set data [read $channel $count]}]} {return}
	set ::currentns [string range $data 0 [expr {$ns - 1}]]
	set data [string range $data $ns end]
        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} {
		foreach {widget cmd} $args {break}
		switch -- $cmd {
			configure {
				set args [linsert [configure [lrange $args 2 end]] 0 $widget $cmd]
            		}
            		cget {
                		return [cget $args]
            		}
			add {
				# $menu add command -command "MyCmd"
				if {[lindex $args 2] eq "command"} {
					dputs "menu $args"
					set args [linsert [configure [lrange $args 3 end]] 0 $widget add command]
					dputs "menu $args"
				}
			}
			default {}
		}
        	seceval $args
	}
    
    # TODO : proc Set
    proc Set {var value} {
        context $var $::currentns
        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
    }
    # instanciate a variable link
    proc myvar {varname} {
	dputs "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]} {
		Set $varname ""
                callback [list distanciel::varread $varname $::currentns]
            } elseif {[trace info variable $varname] eq ""} {
                trace add variable $varname write wvar
		wvar $myvar $key write
                if {[trace info variable $myvar] eq ""} {
                    trace add variable $myvar array wvar
                }
            }
            return $varname
        }
        if {![info exists $varname]} {
	    Set $varname ""
            callback [list distanciel::varread $varname $::currentns]
        } elseif {[trace info variable $varname] eq ""} {
            trace add variable $varname write wvar
	    wvar $varname "" write
        }
        # 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]
        }
	if {[llength $args] % 2 != 0} {return $args}
        set l ""
        foreach {opt value} $args {
            switch -- $opt {
                -command {
                    lappend l $opt [linsert $value 0 callback]
                }
                -listvariable -
                -textvariable -
		-yscrollvariable -
		-xscrollvariable -
		-variable {
                    lappend l $opt [myvar $value]
                }
                default  {lappend l $opt $value}
            }
        }
        #dputs config=$l
        set l
    }
    proc cget {arg} {
        foreach {obj cmd option} $arg {break}
        set res [seceval $arg]
        switch -- $option {
            -command {
                # value is {callback {cmd arg ...}}
                # we want the command
                set res [lindex $res 1]
            }
            default {
                # nothing to be done
            }
        }
        return $res
    }
    # create a widget instance
    proc create {args} {
        foreach {cmd obj} $args {break}
        set l [linsert [configure [lrange $args 2 end]] 0 $cmd $obj]
        dputs $l
        seceval $l
    }
    proc callback {args} {
        dputs callback//$args//[info level 1]
	if {[llength $args] == 1} {set args [lindex $args 0]}
	append ::script $args
	append ::script \n
    }
    
    # not needed anymore
    #callback {namespace eval tk {}}
    # to share Tk private data with the client
    
    	foreach var [concat [info vars ::tk::*] [info vars ::tk_*]] {
		if {[array exists $var]} {
			foreach key [array names $var] {
				myvar ${var}($key)
			}
		} else {
			myvar $var
		}
	}
    
    
    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 {globalns ::}} {
        if {$globalns ne "::"} {set name $globalns$name}
        set ns [wsplit $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 ""} {
		append allctx ::
                continue
            }
	    if {$allctx ne "::" && $allctx ne ""} {
		append allctx ::
	    }
	    append allctx $context
            namespace eval $allctx {}
        }
        list $allctx $name
    }
    # Split a string $str after the separator $sep
    # the built-in split command cannot do that
    proc wsplit {str sep} {
        set out ""
        set sepLen [string length $sep]
        if {$sepLen < 2} {
        			return [split $str $sep]
        }
        while {[set idx [string first $sep $str]] >= 0} {
            if {$idx>0} {
                # the left part : the current element
                lappend out [string range $str 0 [expr {$idx-1}]]
            }
            # get the right part and iterate with it
            set str [string range $str [incr idx $sepLen] end]
        }
        # there is no separator anymore, but keep in mind the right part must be appended
        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] ]]