[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.
Example Call
proc myCallback {hasWAN} {
puts "System has Internet: $hasWAN"
}
::Net::WAN::Check myCallbackThis 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.
The Code
## Check for Network Information
namespace eval Net {
namespace eval WAN {
proc Check {callback {attempt 0}} {
# Check for WAN Connectivity
variable Counter
coroutine w[incr Counter] Receive $callback
return $Counter
}
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
##### REMOVE THIS IN PRODUCTION - IT PRINTS PARSED PING DATA!
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]
##### REMOVE THIS IN PRODUCTION - IT PRINTS EACH LINE IT PARSES!
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
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
}
}
proc callback {args} {tailcall namespace code $args}When you run the ::Net::WAN::Check procedure, your results should be something like this:
{PING www.google.com (216.58.219.36): 56 data bytes}
{64 bytes from 216.58.219.36: seq=0 ttl=53 time=13.642 ms}
{--- www.google.com ping statistics ---}
{1 packets transmitted, 1 packets received, 0% packet loss}
{round-trip min/avg/max = 13.642/13.642/13.642 ms}
----------------------------------------
-- PING DATA:
data {{PING www.google.com (216.58.219.36): 56 data bytes} {64 bytes from 216.58.219.36: seq=0 ttl=53 time=13.642 ms}
{--- www.google.com ping statistics ---} {1 packets transmitted, 1 packets received, 0% packet loss}
{round-trip min/avg/max = 13.642/13.642/13.642 ms}} count 5 stats {roundTrip {min 13.642 avg 13.642 max 13.642}
tx {1 packets transmitted} rx {1 packets received} loss {0% packet loss} lossPct 0 packetsSent 1}
----------------------------------------
System has Internet: true 
