GIN

GIN is a remote execution tool and was inspired by Tequila from jcw.

but i wanted a distributed system with no dedicated server and faster performance. Any function, in my case actors and sensors, running as separate processes, attached with gin can die, be removed, restarted and moved from one host to another without disruption ( aside from losing some data ).

gin uses udp packets from either

  • Tnm by Juergen Schoenwaelder <[email protected]> this is currently broken as Tnm Udp Stuff seems to have been turned inside out.

or

  • TclUDP from Pat Thoyts

Multicast Addresses are used for sending to multiple addresses.

In my application sensors of any kind send their data on a multicast channel. Acknowledges of commands ( to any actor ) are repeated on a multicast channel.

Unicast Addresses for sending to a single instance actor. In my application actors of any kind get their data from a unicast channel.

These files work for me ( i think ), but it may mutilate your hamster YMMV

You will need

  • TclUDP from Pat Thoyts, after some changes to udp from scotty/tnm i have not updated gin
  • util4gin.tcl
 #!/bin/tclsh
 # $Id: 13357,v 1.7 2006-08-22 18:00:17 jcw Exp $
 # file: util4gin.tcl
 # cprt: C2002 Uwe Klein Habertwedt
 #  lic:
 # what: simple async remote execution ala send to multiple clients
 # what: using udp multicast ( from Scotty/Tnm )
 # what: this has been tested on linux only
 # what: provide external functionality


 # either udp from tclUDP or from Tnm is used:
 # multicast functionality needs at least 3.0 ( IMHO )

 if {![ catch { package require udp } cerr ]} {
        puts stderr "tclUDP $cerr found"

 } elseif {![ catch { package require Tnm 3.0 } cerr ]} {
        puts stderr "Tnm $cerr found"
 } else {
        puts stderr "no udp found : cerr:\"$cerr\""
        puts [ package names ]
 }

 if {[ catch { namespace children Tnm } ]} {
        puts notthere
 } else {
        puts import
        catch { namespace import ::Tnm::* }
 }

 # lvarpop / lvarpush from Tclx is used:

 if {[ catch {package require Tclx } cerr ]} {
        proc lvarpop lvar {
                set ret [ uplevel lindex \$$lvar 0 ]
                uplevel set $lvar \[ lrange \$$lvar 1 end \]
                return $ret
        }
 }

 package provide util4gin  1.0
 return
 foreach cmd [ list udp lvarpop ] {
        if {[ info commands $cmd ] != $cmd } {
                puts stderr " \"$cmd\" not found"
                error "cmd $cmd not found"
        }
 }

 # OK:
  • gin.tcl
 #!/bin/tclsh
 # $Id: 13357,v 1.7 2006-08-22 18:00:17 jcw Exp $
 # simple async remote execution ala send to multiple clients
 # using udp multicast ( from tclUDP or Scotty/Tnm )
 # this has been tested on linux only

 # provide for udp and lvarpop:
 package require util4gin
 # source util4gin.tcl

 # find at end: package provide gin $version
 namespace eval gin {
        set rcsid { $Id: 13357,v 1.7 2006-08-22 18:00:17 jcw Exp $ }
        set version [ split [ lindex $rcsid 2 ] . ]
        variable ver [ join [ lrange  $version 0 1 ] . ]
        variable gin [ namespace current ]
        variable defaults { interface 0 port 0 listen info }
        variable config
        variable aliases
        variable aliaslist {    info 224.1.0.0:7770
                                data 224.1.0.0:7771
                                cmd  224.1.0.0:7772
                                log  224.1.0.0:7773
        }
        variable listen
        variable listenlist info
        variable send_hdl
        variable send_dest

        proc init {args} {
                variable defaults
                variable config
                variable listen
                variable listenlist
                variable aliases
                variable aliaslist
                variable send_hdl
                variable send_dest

                namespace export init listen unlisten \
                                 send trace  untrace \
                                 updt

                foreach {arg val} $defaults {
                        set config($arg) $val
                }
                foreach {arg val} $args {
                        set arg [ string trimleft $arg - ]
                        set config($arg) $val
                }
                foreach {al hp} $aliaslist {
                        alias $al $hp
                }
                foreach {hp} $listenlist {
                        listen $hp
                }
                set send_hdl [ udp_open $config(port) ]
                set send_dest {}
                fconfigure $send_hdl -buffering none -translation binary
                set shost $config(interface)
                set sport [ udp_conf $send_hdl -myport ]
                # set up proper if
                # puts "alias self $shost:$sport"
                alias self $shost:$sport
        }
        proc alias {args} {
                variable aliases
                foreach {al hp} $args {
                        set aliases(forw,$al)   $hp
                        set aliases(rev,$hp)    $al
                }
        }
        proc handle_dgram {host_port} {
                # puts stderr hit
                variable listen
                variable aliases

                set handle $listen($host_port)
                set msg  [ read $handle ]
                foreach {host port} [ udp_conf $handle -peer ] break

                if {[ catch { set ns $aliases(rev,${host}:$port)} ]} {
                        # puts aliasnotfound:$host:$port
                        set ns ${host}::$port
                }
                #D0#  puts stderr "gin::recv \"$ns\" $msg"
                if {$listen($host_port,enable)} {
                        if {[catch {namespace eval $ns $msg} cerr]} {
                                puts stderr $cerr
                        }
                }
        }
        proc send {args} {
                variable aliases
                variable send_hdl
                variable send_dest
                set dest [ lvarpop args ]
                catch { set dest $aliases(forw,$dest) }
                if { $dest != $send_dest } {
                        foreach {host port} [ split $dest : ] break
                        udp_conf $send_hdl $host $port
                        set send_dest $dest
                }
                puts -nonewline $send_hdl  $args
                #D0# puts stderr gin::send:[ list $args ]
        }
        proc listen {host_port args} {
                variable gin
                variable listen
                variable aliases
                if {[ array names listen $host_port ] == $host_port } {
                        return
                }
                set src $host_port
                catch { set src $aliases(forw,$src) }
                # puts listen:$host_port:$src
                foreach {host port} [ split $src : ] break
                # set listen($host_port) [ udp_open -mcastadd $host $port ]
                # tcludp has added the mcastadd option differently form my personal patch [UK]
                set listen($host_port) [ udp_open $port ]
                fconfigure $listen($host_port) -mcastadd $host 
                set listen($host_port,enable) 1
                fconfigure $listen($host_port) \
                        -buffering none -translation binary
                # puts hp:$host:$port
                fileevent $listen($host_port) \
                        readable [ list ${gin}::handle_dgram $host_port ]
        }
        proc unlisten {host_port} {
                variable listen
                # puts unlisten:[ array names listen $host_port ]
                if {[ array names listen $host_port ] == {} } {
                        return
                }
                close $listen($host_port)
                unset listen($host_port)
        }
        proc mask {host_port} {
                if {[ catch { set ns $aliases(rev,$host_port)} ]} {
                        set ns $host_port
                }
                #D0# puts stderr gin::mask:$host_port:$ns
                namespace eval $ns {
                        proc set args {
                        }
                        proc array args {
                        }
                }

        }
        proc unmask {host_port} {
                if {[ catch { set ns $aliases(rev,$host_port)} ]} {
                        set ns $host_port
                }
                #D0# puts stderr gin::unmask:$host_port:$ns
                namespace eval $ns {
                        rename set {}
                        rename array {}
                }
        }
        proc tracevar {name svar dvar elems _var elem op} {
                if { $elem == {} } {
                        upvar $_var var
                        gin::send $name set $dvar $var
                } else {
                        upvar ${_var}($elem) var
                        gin::send $name set ${dvar}($elem) $var
                }
        }
        proc trace {name var args } {
                set svar [ lindex $var 0]
                set dvar [ lindex $var end]
                if {[ array exist $svar ]} {
                        if { $args == "" } {
                                set args *
                        }
                        ::trace add variable $svar write [ list ::gin::tracevar $name $svar $dvar $args ]
                } else {
                        ::trace add variable $svar write [ list ::gin::tracevar $name $svar $dvar ]
                }
        }
        proc untrace {name var} {
                set svar [ lindex $var 0]
                set dvar [ lindex $var end]
                ::trace remove variable $svar write [ list ::gin::tracevar $name $svar $dvar ]
        }
        proc updt {name arr {elems {}} } {
                set src [ lindex $arr 0]
                set dest [ lindex $arr end]
                if { $elems == {} } {
                        gin::send $name array set $dest [ \
                                array get $src \
                        ]
                } else {
                        gin::send $name array set $dest [ \
                                array get $src $elems \
                        ]
                }
        }
        puts stderr ver:$ver
        package provide gin $ver
 }

 #end
  • pgkIndex.tcl
 # Tcl package index file, version 1.1
 # This file is generated by the "pkg_mkIndex -lazy" command
 # and sourced either when an application starts up or
 # by a "package unknown" script.  It invokes the
 # "package ifneeded" command to set up package-related
 # information so that packages will be loaded automatically
 # in response to "package require" commands.  When this
 # script is sourced, the variable $dir must contain the
 # full path name of this file's directory.

 package ifneeded gin 1.1 [list source [file join $dir gin.tcl]]
 package ifneeded util4gin 1.0 [list source [file join $dir util4gin.tcl]]
  • using GIN
 package require gin
 gin::init
 if $src {
    set count 0
    while 1 {
       incr count
       gin::send info puts hallo nr$count
       after 1000
    }
 }
  • injecting scripts with bash
 echo "puts hallo from $USR" >/dev/udp/224.1.0.0/7770
  • sending and receiving from C
 notyet