#!/usr/bin/wish
#
#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. (On linux systems, we can get the data directly from the
#  /proc filesystem instead of netstat, which is a lot faster.)
#
#  Addition 2007-11-8 by jc:
#  We can also open the /proc/net/dev file,  which  on  newer  linux  systems
#  contains the "netstat -ni" for all the interfaces, plus some extra fields.
#  We use this to show the traffic in bytes as well as packets.
#
#  Also, the raw (total) throughput numbers aren't  shown  by  default.   The
#  $show(Field)  array  says whether to display each column.  We oughta add a
#  method of changing this on the fly, to make columns appear  and  disappear
#  as we like.
#
#REQUIRES
#  Source.tcl -- tcl source search routine.
#  Help.w     -- wish help package.
#
#OPTIONS
#
#FILES
#  /proc/net/dev is read if available and enabled (see $pollType).
#
#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
#  pat(lnx*) and pat(osf) 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 1}
if [info exists env(B_$me)] {set B $env(B_$me)} else {set B 1}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
set path  [split $env(PATH) :]
foreach f {Help.w Verbose.w} {
	foreach d $path {
		if [file readable $d/$f] {
			if {$V>2} {puts "$me: source $d/$f"}
			source $d/$f
			break
}	}	}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Here is data that controls the polling mechanism.  Set one of these:

#et pollType {ns-ni};	# nxlookup, works on linux, but no byte counts
set pollType {p-n-d};	# /proc fs, works on linux, has byte counts

# If using netstat, set these:
set pollData {};		# Command to get the data
set ifconfig {};		# How to call ifconfig

if {$pollType == {ns-ni}} {
	set pollData {|netstat -ni};	# Command to return the data
}
if {$pollType == {p-n-d}} {
	set pollData {/proc/net/dev};	# File that contains the data
	set ifconfig {|/sbin/ifconfig -a};	# Command to get interface info
}

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

set niFil {}
set niPid {}
set rows 0;		# Count rows in table
set r    0;		# Current row in table

# 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(bgCcps) navy
set C(bgIBps) grey20
set C(fgIBps) green
set C(bgIPps) navy
set C(bgOBps) grey20
set C(fgOBps) green
set C(bgOPps) navy
set C(bgTBps) grey20
set C(fgTBps) green
set C(bgTPps) navy
set C(bgCpct) black
set C(bgSp1) grey80
set C(bgSp2) grey80
set C(bgSp3) grey80
set C(bgSp4) grey80
set CI {} ;# "-fg $C(Info)"
set CD {} ;# "-fg $C(Data)"

# Some common args:
set PP {-padx 0 -pady 0}
set R ridge
set BB "-bd 3 -relief raised"
set BR "-bd $B -relief $R"
set BC "-bg black -fg white -activebackground navy -activeforeground yellow $PP"
set LC {-bg grey30 -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>3} {puts "$me: check: $d/Source.tcl"}
	if [file exists $d/Source.tcl] {
		if {$V>2} {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 ifconfig ifr niFil niPid pollData t0
	if {$V>2} {puts "Refresh	{$args}"}
	if {$args != {}} {
		if [catch {set aft [expr $refresh * 1000]} err] {
			set aft [set refresh 10]000
			set errmsg $err
		}
		after $aft Refresh $args
	}
	if {$V>2} {puts "Refresh	pollData=\"$pollData\""}
	if [catch {open $pollData RDONLY} p] {
		puts "Can't open ($p)"
		return
	}
	set niFil $p
	set niPid [pid $p]
	if {$V>2} {puts "New netstat process is $niPid file $niFil."}
	fileevent $p readable "niRdr $p"
	# Do we need to ask for interface info?
	if {$ifconfig == {p-n-d}} {
		;
	} else {
		set ifr(IF)  {}
		set ifr(IP4) {}
		set ifr(IP6) {}
		set ifr(MTU) {}
		set ifr(ETH) {}
		if [catch {open $ifconfig RDONLY} p] {
			 puts "Can't run ($ifconfig)"
			 return
		}
		set ifr(Fil) $p
		set ifr(Pid) [pid $p]
		if {$V>2} {puts "New ifconfig process is $ifr(Pid) file $ifr(Fil)."}
		fileevent $p readable "ifRdr $p"
	}
}

proc ifRdr {pr} {
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# This reads the output of the ifconfig command, parses out data of  interest #
# to  this program, and stuffs the data into global variables.  This has only #
# been tested on linux systems; you will probably need some more patterns  on #
# a different system whose ifconfig gives different output.                   #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
	global B C D V EF an bd refresh factor ifr pat pollType r Row Vars
	eval global $Vars
	if {$V>1} {puts "ifRdr pr=$pr <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<"}
	if {$pr == {}} {
		if {$V>1} {puts "ifRdr: called with null pr \"$pr\""}
		return
	}
	if {$pr != $ifr(Fil)} {
		if {$V>1} {puts "ifRdr: pr $pr superseded by $ifr(Fil)."}
		close $pr
		exec kill -TERM $ifr(Pid)
		return
	}
	if {[gets $pr line] < 0} {
		if {$V>1} {puts "ifRdr: EOF on pr $pr."}
		close $pr
		return
	}
	if {$V>1} {puts "ifRdr: LINE $line ####"}
	if ![info exists refresh] {
		if {$V>1} {puts "ifRdr: refresh not defined, set to 10."}
		set refresh 10
	}
	regsub -all {[ 	]+} $line { } line
	if {$V>1} {puts "ifRdr: \"$line\""}
	if [regexp {^(\w+)\s+} $line X ifr(IF)] {
		if {$V>1} {puts "ifRdr: ifr(IF)=$ifr(IF)"}
		set r [Row $ifr(IF)]
		if {$V>1} {puts "ifRdr: r=$r for ifr(IF)=$ifr(IF)"}
		set Sys lnx26
		set ifr(IP4) {};	# Wipe out info for previous interface
		set ifr(IP6) {}
		set ifr(MTU) {}
		set ifr(ETH) {}
	} elseif [regexp {^\s+inet addr:([\d.]+)} $line X ip4] {
		if {$V>1} {puts "ifRdr: ip4=$ip4 ifr(IF)=$ifr(IF)"}
		set r [Row $ifr(IF)]
		set Addr($r) $ip4
		if {$V>1} {puts "ifRdr: ip4=$ip4 ifr(IF)=$ifr(IF) r=$r Addr($r)=$Addr($r)"}
	} elseif [regexp {\sMTU:(\d+)} $line X mtu] {
		if {$V>1} {puts "ifRdr: mtu=$mtu ifr(IF)=$ifr(IF)"}
		set r [Row $ifr(IF)]
		set MTU($r) $mtu
		if {$V>1} {puts "ifRdr: mtu=$mtu ifr(IF)=$ifr(IF) r=$r Addr($r)=$Addr($r)"}
	} elseif [regexp {^\s+inet6 addr:([\d:/A-Fa-f]+)} $line X ifr(IP6)] {
		if {$V>1} {puts "ifRdr: ifr(IP6)=$ifr(IP6)"}
	} elseif [regexp {^\s+ether\s+([\d:A-Fa-f/]+)} $line X ifr(ETH)] {
		if {$V>1} {puts "ifRdr: ifr(ETH)=$ifr(ETH)"}
		ifInfo $ifr(IF) $ifr(IP4) $ifr(IP6) $ifr(ETH)
		set ifr(IF)  {};	# We've done this interface; forget it
	} else {
		if {$V>2} {puts "ifRdr: BAD {$line}"}
		if {$V>2} {puts "ifRdr: pat {$pat(pnd26)}"}
	}
	if {$V>1} {puts "ifRdr: ifr(IF)=$ifr(IF) ifr(IP4)=$ifr(IP4) ifr(MTU)=$ifr(MTU)."}
}

proc Row {ifName} {
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Return the row number for an interface name.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
	global V Row
	if [info exists Row($ifName)] {
		if {$V>1} {puts "Row: IF $ifName is row $Row($ifName)."}
		return $Row($ifName)
	} else {
		if {$V>1} {puts "Row: IF $ifName is new."}
		ifInfo $ifName {} {} {}
		set r $Row($ifName)
		if {$V>1} {puts "Row: r=$r for ifName=$ifName"}
		return $r
	}
}

proc ifInfo {if ip4 ip6 eth} {
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Given info about an interface, store it where the code expects it.   A  new #
# row is allocated for a new interface.  The row number is returned.          #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
	global Addr B C high MTU Name Net Row rows V warn
	if  [info exists Row($if)] {
		set r $Row($if)
		if {$V>1} {puts "ifInfo: Old r=$r \"$if\" ip4=$ip4."}
	} else {
		set r $rows
		if {$V>1} {puts "ifInfo: r=$r = rows=$rows"}
		incr rows
		if {$V>1} {puts "ifInfo: New r=$r \"$if\" ip4=$ip4."}
		if ![info exists high(IBps:$r)] {set high(IBps:$r) 0}
		if ![info exists warn(IBps:$r)] {set warn(IBps:$r) 0}
		if ![info exists high(OBps:$r)] {set high(OBps:$r) 0}
		if ![info exists warn(OBps:$r)] {set warn(OBps:$r) 0}
		if ![info exists high(TBps:$r)] {set high(TBps:$r) 0}
		if ![info exists warn(TBps:$r)] {set warn(TBps:$r) 0}
		set Row($if) $r
		set Name($r) $if
		if {$V>1} {puts "ifInfo: New r=$r Name($r)=$Name($r) Row($if)=$Row($if) <===="}
	}
	if {$ip4 != {}} {
		set Addr($r) $ip4
		if {$V>1} {puts "ifInfo: IF r=$r \"$if\" Addr($r)=$Addr($r)"}
	}
#	if {$eth != {}} {
#		set EthAddr($r) $eth
#		if {$V>1} {puts "ifInfo: IF r=$r \"$if\" EthAddr($r)=$EthAddr($r)"}
#	}
	return $r
}

proc colorval {val lo hi} { set F 'colorval'
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Calculate a color value in the green-yellow-red spectrum. 
#   val is a numeric value
#   lo  is the "low" value, below which we return green (#0000FF)
#   hi  is the "high" value, above which we return red (#FF0000)
# Between lo and hi, the returned color varies from green to yellow  to  red,
# depending  on where it is in the range.  In the lower half of the range, we
# increase the red intensity, giving yellow (#FFFF00) at the midpoint. In the
# upper half, we decrease green.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
	global V me
	set id "$me/$F"
	if {$V>4} {puts "$id: Called."}
	set m [expr {($hi-$lo)/2.0+$lo}]
	set R 0
	set G 0
	set B 0
	if {$val <= $lo} {
		set G 15
		set R 0
		if {$V>3} {puts "$F: R=$R G=$G (val=$val <= $lo < $m < $hi)"}
	} elseif {$val >= $hi} {
		set R 15
		set G 0
		if {$V>3} {puts "$F: R=$R G=$G ($lo < $m < $hi <= val=$val)"}
	} else {
		if {$V>1} {puts "$F: ($lo < $val < $hi)"}
		if {$val < $m} {
			if {$V>1} {puts "$F: ($val < $m)"}
			set G 15
			set num [expr {$val-$lo}]
			set den [expr {$m-$lo}]
			set R [expr {int(15*$num/$den)}]
			if {$V>1} {puts "$F: R=$R G=$G num=$num den=$den ($lo < val=$val < $m < $hi)"}
		} else {
			if {$V>1} {puts "$F: ($m <= $val)"}
			set G [expr {int((15*($hi-$val))/($hi-$m))}]
			set R 15
			if {$V>1} {puts "$F: R=$R G=$G ($lo < $m < val=$val < $hi)"}
		}
	}
	return [format {#%X%X%X} $R $G $B]
}

proc highfld {f r x} {
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
	global V fld high warn
	set high($f:$r) $x
	set warn($f:$r) [expr $x * 0.5]
	if  [winfo exists .f$f.v$r] {
		BindHelp .f$f.v$r "High:$x\nWarn:$warn($f:$r)"
	}
}

proc setfld {f r ib} {
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
	global C V fld high warn factor refresh
	set fld($f:$r) [set Bps [expr $ib * $factor / $refresh]]
	if {$Bps > $high($f:$r)} {
		highfld $f $r $Bps
	}
	if  [winfo exists .f$f.v$r] {
		if {$Bps > $warn($f:$r)} {
			set c [colorval $Bps $warn($f:$r) $high($f:$r)]
			.f$f.v$r config -fg $c
			if {$V>1} {puts "setfld: c=$c ($Bps $warn($f:$r) $high($f:$r))"}
		} else {
		#	.f$f.v$r config -fg white
			.f$f.v$r config -fg $C(fg$f)
		}
		BindHelp .f$f.v$r "High:$high($f:$r)\nWarn:$warn($f:$r)\nVal:$Bps"
	}
}

proc niRdr {pr} {
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# This routine reads a line from the "netstat -ni" command's output, or  from #
# the  /proc/net/dev file if it exists.  It parses out data that this program #
# wants, and stuffs the data into global variables.  We have several patterns #
# that  work on different systems, and you may need some more for your system #
# if your netstat gives different output.                                     #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
	global B C D V EF an bd refresh factor MTU niFil niPid pat pollType Vars
	eval global $Vars
	if {$V>1} {puts "niRdr pr=$pr <-<-<-<-<-<-<-<-<-<-<-<-<-<-<-<-<-<-<-"}
	if {$pr == {}} {
		if {$V>2} {puts "niRdr: called with pr \"$pr\""}
		return
	}
	if {$pr != $niFil} {
		if {$V>2} {puts "niRdr: pr $pr superseded by $niFil."}
		close $pr
		exec kill -TERM $niPid
		return
	}
	if {[gets $pr line] < 0} {
		if {$V>2} {puts "niRdr: EOF on pr $pr."}
		close $pr
		return
	}
	if ![info exists refresh] {
		if {$V>2} {puts "niRdr: refresh not defined, set to 10."}
		set refresh 10
	}
	set Ib 0
	set Ip 0
	set Ob 0
	set Op 0
	set Tb 0
	set Tp 0
	set Co 0
	set cp 0
	regsub -all {[ 	]+} $line { } line
	if {$V>2} {puts "niRdr: \"$line\""}
	set IF {}
	set Sys {}
	if {$pollType == {ns-ni}} {
		if [regexp $pat(osf) $line X IF Mt Ne Ad Ip Ie Op Oe Co] {
			if {$V>3} {puts "niRdr: Matched pat(osf) IF=\"$IF\" Mt=\"$Mt\" Ne=\"$Ne\" Ad=\"$Ad\" Ip=\"$Ip\" Ie=\"$Ie\" Op=\"$Op\" Oe=\"$Oe\" Co=\"$Co\""}
			set Sys osf
		}
		if [regexp $pat(lnx10) $line X IF Mt Ne RXOK RXERR RXDRP RXOVR TXOK TXERR TXDRP TXOVR Fl] {
			if {$V>1} {puts "niRdr: pat(lnx10) IF=\"$IF\""}
			if {$V>1} {puts "niRdr: pat(lnx10) IF=\"$IF\" Mt=\"$Mt\" Ne=\"$Ne\" RXOK=\"$RXOK\" RXERR=\"$RXERR\" RXDRP=\"$RXDRP\" RXOVR=\"$RXOVR\" TXOK=\"$TXOK\" TXERR=\"$TXERR\" TXDRP=\"$TXDRP\" TXOVR=\"$TXOVR\" Fl=\"$Fl\""}
			set r [Row $IF]
			if {$V>1} {puts "niRdr: r=$r for Row IF=$IF"}
			set Ip [expr $RXOK+$RXERR+$RXDRP+$RXOVR]
			set Op [expr $TXOK+$TXERR+$TXDRP+$TXOVR]
			set Co 0
			set Sys lnx10
		}
		if [regexp $pat(lnx12) $line X IF Mt Ne RXOK RXERR RXDRP RXOVR TXOK TXERR TXDRP TXOVR Fl] {
			if {$V>1} {puts "niRdr: pat(lnx12) IF=\"$IF\""}
			if {$V>1} {puts "niRdr: Matched pat(lnx12) IF=\"$IF\" Mt=\"$Mt\" Ne=\"$Ne\" RXOK=\"$RXOK\" RXERR=\"$RXERR\" RXDRP=\"$RXDRP\" RXOVR=\"$RXOVR\" TXOK=\"$TXOK\" TXERR=\"$TXERR\" TXDRP=\"$TXDRP\" TXOVR=\"$TXOVR\" Fl=\"$Fl\""}
			set r [Row $IF]
			if {$V>1} {puts "niRdr: r=$r for Row IF=$IF"}
			set Ip [expr $RXOK+$RXERR+$RXDRP+$RXOVR]
			set Op [expr $TXOK+$TXERR+$TXDRP+$TXOVR]
			set Co 0
			set Sys lnx12
		}
	} elseif {$pollType == {p-n-d}} {
		if [regexp $pat(pnd26) $line X IF Ib Ip iERRS iDROP Ififo Iframe Icompressed Imulticast Ob Op oERRS oDROP Ofifo Ocolls] {
			if {$V>1} {puts "niRdr: pat(lnx26) IF=\"$IF\""}
			if {$V>2} {puts "niRdr: Matched pat(pnd26)"}
			if {$V>2} {puts "niRdr: IF=$IF Ib=$Ib Ip=$Ip Ob=$Ob Op=$Op"}
			set Sys lnx26
		} else {
			if {$V>2} {puts "niRdr: BAD {$line}"}
			if {$V>2} {puts "niRdr: pat {$pat(pnd26)}"}
		}
	} else {
		if {$V>2} {puts "niRdr: Unknown pollType=\"$pollType\""}
	}
	if {$Sys == {}} {
		if {$V>2} {
			puts "niRdr: No match for:"
			puts "niRdr: $line"
		}
	}
	if {$V>1} {puts "niRdr: Ip=$Ip Op=$Op Co=$Co refresh=$refresh."}
	if {$IF != {}} {
		if {$V>3} {puts "niRdr: Matched."}
		set r [Row $IF]
		if {$V>1} {puts "niRdr: r=$r for Row IF=$IF"}
		if {$V>2} {puts "niRdr: row $r"}
		if ![info exists Ibytes($r)] {set Ibytes($r) $Ib}
		if ![info exists Ipkts($r)] {set Ipkts($r) $Ip}
		if ![info exists Obytes($r)] {set Obytes($r) $Ob}
		if ![info exists Opkts($r)] {set Opkts($r) $Op}
		if ![info exists Coll($r)] {set Coll($r) $Co}
		if {$V>2} {puts "niRdr: Ipkts($r)=$Ipkts($r) Opkts($r)=$Opkts($r) Coll($r)=$Coll($r)."}
		if {$V>2} {puts "niRdr: Ibytes($r)=$Ibytes($r) Obytes($r)=$Obytes($r)."}
		if {$V>2} {puts "niRdr: Ib=$Ib Ibytes($r)=$Ibytes($r)."}
		set ib [expr ($Ib - $Ibytes($r))]
		if {$V>2} {puts "niRdr: Ip=$Ip Ipkts($r)=$Ipkts($r)."}
		set ip [expr ($Ip - $Ipkts($r))]
		if {$V>2} {puts "niRdr: ib=$ib ip=$ip."}
		if {$V>2} {puts "niRdr: Ob=$Ob Obytes($r)=$Obytes($r)."}
		set ob [expr ($Ob - $Obytes($r))]
		if {$V>2} {puts "niRdr: Op=$Op Opkts($r)=$Opkts($r)."}
		set op [expr ($Op - $Opkts($r))]
		if {$V>2} {puts "niRdr: ob=$ob op=$op."}
		if {$V>2} {puts "niRdr: Co=$Co Coll($r)=$Coll($r)."}
		set co [expr ($Co - $Coll($r))]
		if {$V>2} {puts "niRdr: co=$co."}
		if {$V>2} {puts "niRdr: ib=$ib ip=$ip ob=$ob op=$op co=$co."}
		setfld IBps $r  $ib
		setfld OBps $r  $ob
		setfld TBps $r  [expr (($ib + $ob) * $factor)]
		set    IPps($r) [expr  ($ip * $factor)        / $refresh]
		set    OPps($r) [expr  ($op * $factor)        / $refresh]
		set    TPps($r) [expr (($ip + $op) * $factor) / $refresh]
		set    Ccps($r) [expr (($Co - $Coll($r)) * $factor) / $refresh]
		if {$V>2} {puts "niRdr: ip=$ip op=$op co=$co."}
		set pkts [expr ($ip + $op)]
		if {$V>2} {puts "niRdr: IPps($r)=$IPps($r) OPps($r)=$OPps($r) Ccps($r)=$Ccps($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 .fCcps.v$r] {.fCcps.v$r config -fg $clr}
		} else {
			set Cpct($r) 0%
		}
		if {$V>2} {puts "niRdr: ip=$ip op=$op pkts=$pkts Cpct($r)=$Cpct($r)."}
		if ![info exists IF] {set IF {}}
		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}
		if {$IF != {}} {set Name($r)   $IF}
#		if {$Mt != {}} {set MTU($r)    $Mt}
		if {$Ne != {}} {set Net($r)    $Ne}
#		if {$Ad != {}} {set Addr($r)   $Ad}
		if {$Ib != {}} {set Ibytes($r) $Ib}
		if {$Ip != {}} {set Ipkts($r)  $Ip}
		if {$Ie != {}} {set Ierrs($r)  $Ie}
		if {$Ob != {}} {set Obytes($r) $Ob}
		if {$Op != {}} {set Opkts($r)  $Op}
		if {$Oe != {}} {set Oerrs($r)  $Oe}
		set Tbytes($r) [expr $Ib+$Ob]
		set Tpkts($r)  [expr $Ip+$Op]
		if {$Oe != {}} {set Terrs($r)  $Oe}
		if {$Co != {}} {set Coll($r)   $Co}
		if {$V>2} {puts "niRdr: niRdr: Vars={$Vars}"}
		foreach x $Vars {
			if ![winfo exists .f$x.v$r] {
				global $x
				if ![info exists ${x}($r)] {set ${x}($r) {}}
				set v [set ${x}($r)]
				if       {$x == "IBps"} {set f "fld($x:$r)"
				} elseif {$x == "OBps"} {set f "fld($x:$r)"
				} elseif {$x == "TBps"} {set f "fld($x:$r)"
				} else                  {set f "${x}($r)"}
				if {$V>4} {puts "niRdr: x='$x' r='$r' f='$f'"}
				if {$V>4} {puts "niRdr: 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}
				if ![info exists  bd($x)] {global bddefault; set  bd($x) $bddefault}
				eval label .f$x.v$r -bg $C(bg$x) -fg $C(fg$x) -textvariable "$f" -bd $bd($x) -relief ridge
				if {$V>2 && $r==1} {puts "niRdr: pack .f$x.v$r -in .f$x -anchor $an($x)"}
				eval pack .f$x.v$r -in .f$x -anchor $an($x)
			}
		}
	}
}

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

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

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

Verbose .b

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 $BB $BC -text Refresh -command Refresh
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 $BC
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
BindHelp .b.factor {Conversion factor for per-second rates:
1    Show rates as integer          .
1.0  Show rates as real value         .
60   Show per-minute rates as integer
60.0 Show per-minute rates as real  .}

set refresh 10
set factor 1.0

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Patterns for matching interface data:
# Patterns for netstat output on various systems:
set pat(osf) {^(\w+) +([0-9]+) +([0-9.]+) +([0-9.]+) +([0-9]+) +([0-9]+) +([0-9]+) +([0-9]+) +([0-9]+) *$}
#            Name   MTU       Network    Addr   Ipkts     Ierrs     Opkts   Oerrs      Coll
set pat(lnx10) {^(\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 pat(lnx12) {^(\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
#
# Patterns for /proc/net/dev files:
set pat(pnd26) {^ *(\w+): *(\d+) *(\d+) +(\d+) +(\d+) +(\d+) +(\d+) +(\d+) +(\d+) +(\d+) +(\d+) +(\d+) +(\d+) +(\d+) +(\d+) +(\d+) +(\d+) *$}
# Inter-| Receive                                                 | Transmit
#  face | bytes packets errs drop fifo frame compressed multicast | bytes packets errs drop fifo colls carrier compressed
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #

# Alignment of data colums (e=east=right)
set an(Addr) w
set an(Ccps) e
set an(Coll) e
set an(Cpct) e
set an(Eerrs) e
set an(IBps) e
set an(Ibytes) e
set an(Ierrs) e
set an(Ipkts) e
set an(IPps) e
set an(MTU) e
set an(Name) w
set an(Net) w
set an(OBps) e
set an(Obytes) e
set an(Oerrs) e
set an(Opkts) e
set an(OPps) e
set an(TBps) e
set an(Tbytes) e
set an(Terrs) e
set an(Tpkts) e
set an(TPps) e

# Border width for some widgets
set bddefault 0
set bd(Sp1) 0

# Flags controlling which fields (columns) are displayed
set show(Name) 1
set show(MTU) 1
set show(Net) 1
set show(Addr) 1
set show(Ibytes) 0
set show(IBps) 1
set show(Ipkts) 0
set show(IPps) 1
set show(Ierrs) 1
set show(Obytes) 0
set show(OBps) 1
set show(Opkts) 0
set show(OPps) 1
set show(Oerrs) 1
set show(Coll) 0
set show(Ccps) 1
set show(Cpct) 1
set show(Sp1) 0
set show(Sp2) 0
set show(Sp3) 0
set show(Sp4) 0
set show(Tbytes) 0
set show(TBps) 1
set show(Tpkts) 0
set show(TPps) 1
set show(Terrs) 1

# Titles of columns
set Ttl(Cpct) {C %}
set Ttl(Ccps) {C P/s}
set Ttl(IBps) {I B/s}
set Ttl(Ierrs) {Ierr}
set Ttl(IPps) {I P/s}
set Ttl(OBps) {O B/s}
set Ttl(Oerrs) {Oerr}
set Ttl(OPps) {O P/s}
set Ttl(Sp1) {}
set Ttl(Sp2) {}
set Ttl(Sp3) {}
set Ttl(Sp4) {}
set Ttl(TBps) {T B/s}
set Ttl(Terrs) {Terr}
set Ttl(TPps) {T P/s}
set Vars {Name Net Addr MTU Sp1 Ipkts IPps Ibytes IBps Ierrs Sp2 Opkts OPps Obytes OBps Oerrs Sp3 Tpkts TPps Tbytes TBps Terrs Sp4 Coll Ccps Cpct}

foreach x $Vars {
	if ![info exists C(bg$x)] {set C(bg$x) grey50}
	if ![info exists C(fg$x)] {set C(fg$x) white}
	eval frame .f$x $FB -bg $C(bg$x)
	if {$show($x) > 0} {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) -bg orange -fg black
	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