[Napier / Dash Automation] - 12-30-2015

**Overview**

Hey All!  So I wanted to post my little Ping Testing Script which utilizes coroutines and should work asynchronously.  You may need to adjust the actual ping command a bit to fit your OS, but it is working well with my busy box implementation.  Essentially I needed a script which I could run to check if internet connectivity was available.  So I wrote a Ping Utility (not meant to be used on its own, it is an extension of the WAN Check option.  I will post the example of the actual ping utility when I write it as well.

For ping data it is actually quite useful as it will parse and organize the results of your ping test and place it into a nice Tcl Dict for you to work with.

======
proc myCallback {hasWAN} {
    puts "System has Internet: $hasWAN"
}

::Net::WAN::Check myCallback
======

This utility will ping 5 hosts, which is a combination of google, yahoo, and bing.  If any of them succeed it will immediately quit and return true in an attempt to run as quickly as possible.  I use my dict extensions heavily so I am going to post the code to handle that as well.  You could pretty easily modify those if you didn't want to utilize.

======
## Check for Network Information

namespace eval Net {
    
    namespace eval WAN {
    
        proc Check {callback {attempt 0}} {
            # Check for WAN Connectivity
            variable Counter
            set name [coroutine w[incr Counter] Receive $callback]
            puts "Coroutine Response: $name"
            return $name
        }
        
        proc Receive { {callback ""} {data ""} } {   
            variable Store
            after 0 [info coroutine]
            yield [info coroutine]
            dict pull data lossPct
            set i 0
            set response {}
            while {$i <= 5} {
                try {
                    switch -- $i {
                        0                   {   set host www.google.com   }
                        1                   {   set host www.bing.com     }
                        2                   {   set host www.google.com   }
                        3                   {   set host www.yahoo.com    }
                        default             {   set host www.google.com   }
                    }
                    set response {}
                    set pingData [ ::Net::Ping::Send 1 $host ]
                    dict pull pingData stats
                    dict pull stats lossPct
                    puts "----------------------------------------"
                    puts "\t -- PING DATA:"
                    puts "$pingData"
                    puts "----------------------------------------"
                    if {$lossPct == 0} { {*}::$callback true; return }
                    dict set tempDict $i $data
                } on error {result options} {
                    puts $result
                    puts $options
                    return 0
                }
                incr i
            }
            {*}::$callback false
            return
        }
    }
    

    namespace eval Ping {
        variable Store {}
        
        proc Send {count host } {
            variable Store
            set chan [ open |[list ping -c $count $host] ]
            chan configure $chan -blocking 0 -buffering line
            set afterID [ after [ expr { $count * 2000 } ] [callback Cleanup $chan] ]
            chan event $chan readable [info coroutine]
            set lineCount 0
            while 1 {
                yield
                if {[chan gets $chan line] >= 0} {
                            set data [split $line \n]
                            puts $data
                            foreach response $data {
                               incr lineCount
                               dict lappend Data data $response
                               dict set Data count $lineCount
                            }
                            dict set Store $chan $Data
                } elseif {[eof $chan]} {
                            try {
                                Cleanup $chan
                                after cancel $afterID
                            } on error {result options} {
                                ::onError $result $options "While Closing Ping Channel"
                                return
                            }
                            try {
                                dict unset Store $chan
                            } on error {result options} {
                                ::onError $result $options "While Unsetting Ping Store"
                            }
                            dict set Data stats [Process $Data]
                            dict set Store $chan $Data
                            return $Data
                }
            }
        }
        
        proc Cleanup chan {
            variable Store
            try {
                chan close $chan
                dict unset Store $chan
            } on error {result options} {
                ::onError $result $options "During Ping Cleanup"
            }
        }
        
        proc Process tempDict {
            dict pull $tempDict data count
            set roundTrip [ lindex $data [ expr { $count - 1 } ] ]
            set transmitData [ lindex $data [ expr { $count - 2 } ] ]
            foreach {info stats} [ split $roundTrip "=" ] { break }
            set roundTrip [ split [ string trim [ string map {"ms" ""} $stats ] ] "/" ]
            foreach {min avg max} $roundTrip { break }
            set roundTrip {}
            dict push roundTrip min avg max

            set transmitData [split $transmitData ,]
            foreach {tx rx loss} $transmitData { break }
            set tx [string trim $tx]
            set packetsSent [lindex $tx 0]
            set rx [string trim $rx]
            set loss [string trim $loss]
            set lossPct [string map {"% packet loss" ""} $loss]
                        
            return [dict push Response roundTrip tx rx loss lossPct packetsSent]
        }
    }
}


proc extend {ens script} {
    namespace eval $ens [concat {
        proc _unknown {ens cmd args} {
            if {$cmd in [namespace eval ::${ens} {::info commands}]} {
                set map [namespace ensemble configure $ens -map]
                dict set map $cmd ::${ens}::$cmd
                namespace ensemble configure $ens -map $map
            }
            return "" ;# back to namespace ensemble dispatch
                      ;# which will error appropriately if the cmd doesn't exist
        }
    }   \; $script]
    namespace ensemble configure $ens -unknown ${ens}::_unknown
}

extend dict {
    proc isDict {var} { 
        if { [catch {dict keys ${var}}] } {return 0} else {return 1} 
    }
    
    proc get? {tempDict args} {
        if {[dict exists $tempDict {*}$args]} {
            return [dict get $tempDict {*}$args]
        }
    }
    
    proc modify {var args} {
       upvar 1 $var dvar
       foreach {name val} $args {
          dict set dvar $name $val
       }
    }
    
    proc pull {tempDict args} {
        if {![isDict $tempDict]} {upvar 1 $tempDict theDict} else {set theDict $tempDict}
        foreach val $args {
            upvar 1 $val $val
            if {[dict exists $theDict $val]} {
                set $val [dict get $theDict $val]
                dict set returnDict $val [dict get $theDict $val]
            } else {
                set $val {}
            }
        }
        if { [ info exists returnDict ] } { return $returnDict }
    }
    
    proc destruct {tempDict args} {
        upvar 1 $tempDict theDict
        puts "The Dict: $theDict"
        foreach val $args {
            upvar 1 $val $val
            if {[dict exists $theDict $val]} {
                set $val [dict get $theDict $val]
                dict unset theDict $val
            } else {
                set $val {}
            }
        }
    }
    
    proc push {var args} {
        upvar 1 $var d
        foreach key $args {
            upvar 1 $key isKey
            if {[info exists isKey]} {dict set d $key $isKey} else {throw error "$key doesn't exist"}
        }
        return $d
    }
}

======