#!/usr/bin/wish
#!/usr/bin/wish8.0
#!/usr/local/bin/wish8.0
#
#NAME
#  IF - interface status display
#
#SYNOPSIS
#  IF &
#
#DESCRIPTION
#  This is a wrapper for  the  "netstat  -ni"  command,  showing  the
#  results  in  tabular  form,  with  a bar graph showing the traffic
#  levels. It pops up a window with one line per interface, and every
#  so often, runs netstat and updates the data.
#
#REQUIRES
#  Source.tcl -- tcl source search routine.
#  Help.w     -- wish help package.
#
#OPTIONS
#
#BUGS
#  The netstat command varies somewhat from system to system, and you
#  may need to modify the patterns used to match its output.  Look at
#  the lnxpat* and osfpat patterns; if they don't work,  add  one  for
#  your system (and send me a copy).
#
#SEE ALSO
#
#AUTHOR
#  John Chambers <jc@trillian.mit.edu>


set me [lindex [wm title .] 0]
set H [exec hostname]
wm title . "Interfaces on $H"
if [info exists env(D_$me)] {set D $env(D_$me)} else {set D 0}
if [info exists env(V_$me)] {set V $env(V_$me)} else {set V 0}
if [info exists env(B_$me)] {set B $env(B_$me)} else {set B 1}

set niFil {}
set niPid {}

# Some colors:
set C(Data) yellow
set C(Info) white
set C(NotYet) green4
set C(OK)	green
set C(Poor)	yellow
set C(Warn)	orange
set C(Bad)	tomato
set C(bgIrate) navy
set C(bgOrate) navy
set C(bgCrate) navy
set C(bgCpct) black
set CI {} ;# "-fg $C(Info)"
set CD {} ;# "-fg $C(Data)"

# Some common args:
set PP {-padx 0 -pady 0}
set R ridge
set BR "-bd $B -relief $R"
set BC "-bg black -fg yellow -activebackground navy -activeforeground yellow $PP"
set LC {-bg grey40 -fg green}
set XC {-bg navy -fg green}
set BW {-width 5}
set FB {-bd $B -relief ridge}
set EF {-expand 1 -fill x}
set MC {-bg navy -fg green}

foreach d [split $env(PATH) :] {
	if {$V>2} {puts "$me: check: $d/Source.tcl"}
	if [file exists $d/Source.tcl] {
		if {$V>1} {puts "$me: source $d/Source.tcl"}
		source [set Path(Source.tcl) $d/Source.tcl]
		break
	}
}

# Set up some Help-key bindings, if we can find Help.w:
if ![Source Help.w] {
	set errmsg {Help.w not found; help feature disabled}
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Refresh the data once, by triggering a netstat  subprocess  and  posting  a
# fileevent  to  handle  its output.  If passed any args, we schedule another
# Refresh $refresh seconds in the future.
proc Refresh {args} {
	global B D V refresh errmsg niFil niPid r t0
	if {$args != {}} {
		if [catch {set aft [expr $refresh * 1000]} err] {
			set aft [set refresh 10]000
			set errmsg $err
		}
		after $aft Refresh $args
	}
	if [catch {open {|netstat -ni} {RDWR NONBLOCK}} p] {
		puts "Can't run netstat ($p)"
		return
	}
	set niFil $p
	set niPid [pid $p]
	if {$V>1} {puts "New netstat process is $niPid file $niFil."}
	set r 0
	fileevent $p readable "niRdr $p"
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc niRdr {pr} {
	global B C D V EF an refresh factor niFil niPid lnxpat10 lnxpat12 osfpat r Vars
	eval global $Vars
	if {$V>2} {puts "niRdr r=$r ..."}
	if {$pr == {}} {
		if {$V>1} {puts "niRdr: called with pr \"$pr\""}
		return
	}
	if {$pr != $niFil} {
		if {$V>1} {puts "niRdr: pr $pr superseded by $niFil."}
		close $pr
		exec kill -TERM $niPid
		return
	}
	if {[gets $pr line] < 0} {
		if {$V>1} {puts "niRdr: EOF on pr $pr."}
		close $pr
		return
	}
	if ![info exists refresh] {
		if {$V>1} {puts "niRdr: refresh not defined, set to 10."}
		set refresh 10
	}
	set Ip 0
	set Op 0
	set Co 0
	set cp 0
	regsub -all {[ 	]+} $line { } line
	if {$V>1} {puts "niRdr: \"$line\""}
	set Na {}
	set Sys {}
	if [regexp $osfpat $line X Na Mt Ne Ad Ip Ie Op Oe Co] {
		if {$V>2} {puts "Matched osfpat Na=\"$Na\" Mt=\"$Mt\" Ne=\"$Ne\" Ad=\"$Ad\" Ip=\"$Ip\" Ie=\"$Ie\" Op=\"$Op\" Oe=\"$Oe\" Co=\"$Co\""}
		set Sys osf
	}
#	set RXOK  0
#	set RXERR 0
#	set RXDRP 0
#	set RXOVR 0
#	set TXOK  0
#	set TXERR 0
#	set TXDRP 0
#	set TXOVR 0
#
	if [regexp $lnxpat10 $line X Na Mt Ne RXOK RXERR RXDRP RXOVR TXOK TXERR TXDRP TXOVR Fl] {
		if {$V>1} {puts "Matched lnxpat10 Na=\"$Na\" Mt=\"$Mt\" Ne=\"$Ne\" RXOK=\"$RXOK\" RXERR=\"$RXERR\" RXDRP=\"$RXDRP\" RXOVR=\"$RXOVR\" TXOK=\"$TXOK\" TXERR=\"$TXERR\" TXDRP=\"$TXDRP\" TXOVR=\"$TXOVR\" Fl=\"$Fl\""}
		set Ip [expr $RXOK+$RXERR+$RXDRP+$RXOVR]
		set Op [expr $TXOK+$TXERR+$TXDRP+$TXOVR]
		set Co 0
		set Address($r) ?
		set Sys lnx10
	}
	if [regexp $lnxpat12 $line X Na Mt Ne RXOK RXERR RXDRP RXOVR TXOK TXERR TXDRP TXOVR Fl] {
		if {$V>1} {puts "Matched lnxpat12 Na=\"$Na\" Mt=\"$Mt\" Ne=\"$Ne\" RXOK=\"$RXOK\" RXERR=\"$RXERR\" RXDRP=\"$RXDRP\" RXOVR=\"$RXOVR\" TXOK=\"$TXOK\" TXERR=\"$TXERR\" TXDRP=\"$TXDRP\" TXOVR=\"$TXOVR\" Fl=\"$Fl\""}
		set Ip [expr $RXOK+$RXERR+$RXDRP+$RXOVR]
		set Op [expr $TXOK+$TXERR+$TXDRP+$TXOVR]
		set Co 0
		set Address($r) ?
		set Sys lnx12
	}
	if {$Sys == {}} {
		if {$V > 1} {
			puts "niRdr: No match for:"
			puts "niRdr: $line"
		}
	}
	if {$V>1} {puts "niRdr: Ip=$Ip Op=$Op Co=$Co refresh=$refresh."}
	if {$Na != {}} {
		if {$V>2} {puts "niRdr: Matched."}
		incr r
		if {$V>1} {puts "niRdr: row $r"}
		if ![info exists Ipkts($r)] {set Ipkts($r) $Ip}
		if ![info exists Opkts($r)] {set Opkts($r) $Op}
		if ![info exists Coll($r)] {set Coll($r) $Co}
		if {$V>1} {puts "niRdr: Ipkts($r)=$Ipkts($r) Opkts($r)=$Opkts($r) Coll($r)=$Coll($r)."}
		if {$V>1} {puts "niRdr: Ip=$Ip Ipkts($r)=$Ipkts($r)."}
		set ip [expr ($Ip - $Ipkts($r))]
		if {$V>1} {puts "niRdr: ip=$ip."}
		if {$V>1} {puts "niRdr: Op=$Op Opkts($r)=$Opkts($r)."}
		set op [expr ($Op - $Opkts($r))]
		if {$V>1} {puts "niRdr: op=$op."}
		if {$V>1} {puts "niRdr: Co=$Co Coll($r)=$Coll($r)."}
		set co [expr ($Co - $Coll($r))]
		if {$V>1} {puts "niRdr: co=$co."}
		if {$V>1} {puts "niRdr: ip=$ip op=$op co=$co."}
		set Irate($r) [expr $ip * $factor / $refresh]
		set Orate($r) [expr $op * $factor / $refresh]
		set Crate($r) [expr ($Co - $Coll($r)) * $factor / $refresh]
		if {$V>1} {puts "niRdr: ip=$ip op=$op co=$co."}
		set pkts [expr ($ip + $op)]
		if {$V>1} {puts "niRdr: Irate($r)=$Irate($r) Orate($r)=$Orate($r) Crate($r)=$Crate($r)."}
		if {$pkts > 0} {
			set Cpct($r) [expr int(100 * [set cfrac [expr double($cp) / $pkts]])]%
			if       {$cfrac < 0.1} {set clr $C(OK)
			} elseif {$cfrac < 0.5} {set clr $C(Poor)
			} elseif {$cfrac < 0.9} {set clr $C(Warn)
			} else                  {set clr $C(Bad)}
			if [winfo exists .fCpct.v$r]  {.fCpct.v$r  config -fg $clr}
			if [winfo exists .fCrate.v$r] {.fCrate.v$r config -fg $clr}
		} else {
			set Cpct($r) 0%
		}
		if {$V>1} {puts "niRdr: ip=$ip op=$op pkts=$pkts Cpct($r)=$Cpct($r)."}
		if ![info exists Na] {set Na ?}
		if ![info exists Mt] {set Mt 0}
		if ![info exists Ne] {set Ne ?}
		if ![info exists Ad] {set Ad ?}
		if ![info exists Ip] {set Ip 0}
		if ![info exists Ie] {set Ie 0}
		if ![info exists Op] {set Op 0}
		if ![info exists Oe] {set Oe 0}
		if ![info exists Co] {set Co 0}
		set Name($r)    $Na
		set Mtu($r)     $Mt
		set Network($r) $Ne
		set Address($r) $Ad
		set Ipkts($r)   $Ip
		set Ierrs($r)   $Ie
		set Opkts($r)   $Op
		set Oerrs($r)   $Oe
		set Coll($r)    $Co
		if {$V>1} {puts "niRdr: Vars={$Vars}"}
		foreach x $Vars {
			if ![winfo exists .f$x.v$r] {
				set v [set ${x}($r)]
				if {$V>4} {puts "label .f$x.v$r -textvariable ${x}($r) ($v)"}
				if ![info exists C(bg$x)] {set C(bg$x) grey50}
				if ![info exists C(fg$x)] {set C(fg$x) green}
				eval label .f$x.v$r -bg $C(bg$x) -fg $C(fg$x) -textvariable ${x}($r)
				eval pack .f$x.v$r -in .f$x -anchor $an($x) -fill x
			}
		}
	}
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #

eval frame .b $FB
eval pack .b -side bottom $EF

eval button .b.quit $BC -text QUIT -command exit -activebackground $C(Bad)
eval pack .b.quit -in .b -side right

eval entry .b.err $LC -textvariable errmsg -fg $C(Warn)
eval pack .b.err -in .b -side right $EF

eval frame .b.refresh $FB
eval button .b.refresh.b -text Refresh -command Refresh $BC
eval entry .b.refresh.v $LC -textvariable refresh -width 0
eval pack .b.refresh.b -in .b.refresh -side left
eval pack .b.refresh.v -in .b.refresh -side left
eval pack .b.refresh -in .b -side left

eval frame .b.factor $FB
eval label .b.factor.l -text factor
eval entry .b.factor.v $LC -textvariable factor -width 0
eval pack .b.factor.l -in .b.factor -side left
eval pack .b.factor.v -in .b.factor -side left
eval pack .b.factor -in .b -side left

set refresh 10
set factor 1.0

set osfpat {^(\w+) +([0-9]+) +([0-9.]+) +([0-9.]+) +([0-9]+) +([0-9]+) +([0-9]+) +([0-9]+) +([0-9]+) *$}
#            Name   Mtu       Network    Address   Ipkts     Ierrs     Opkts   Oerrs      Coll
set lnxpat10 {^(\w+) +([0-9]+) +(0+)([0-9]+) +([0-9]+) +([0-9]+) +(0+)+([0-9]+) +([0-9]+) +([0-9]+) +([0-9]+) +(\w+) *$}
#              Iface  MTU       Met RXOK      RXERR     RXDRP     RXOVR TXOK      TXERR     TXDRP     TXOVR    Flags
set lnxpat12 {^(\w+) +([0-9]+) +([0-9]+) +([0-9]+) +([0-9]+) +([0-9]+) +([0-9]+) +([0-9]+) +([0-9]+) +([0-9]+) +([0-9]+) (\w+) *$}
#              Iface  MTU       Met       RXOK      RXERR     RXDRP     RXOVR     TXOK      TXERR     TXDRP     TXOVR    Flags
set an(Coll) e
set an(Ipkts) e
set an(Irate) e
set an(Mtu) e
set an(Oerrs) e
set an(Opkts) e
set an(orate) e
set an(Crate) e
set an(Cpct) e
set Ttl(Irate) {I p/s}
set Ttl(Orate) {O p/s}
set Ttl(Crate) {C p/s}
set Ttl(Cpct) {C %}
set Vars {Name Mtu Network Address Ipkts Irate Ierrs Opkts Orate Oerrs Coll Crate Cpct}
foreach x $Vars {
	eval frame .f$x $FB
	eval pack .f$x -side left $EF
	if ![info exists Ttl($x)] {set Ttl($x) $x}
	eval label .f$x.l$x $FB -textvariable Ttl($x)
	eval pack .f$x.l$x -in .f$x -side top $EF
	if ![info exists an($x)] {set an($x) w}
	if {$V>4} {puts "$x an=$an($x)"}
}

# Trigger the first fetch of the data:
Refresh 1