1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
|
# copyright (C) 1997-2005 Jean-Luc Fontaine (mailto:jfontain@free.fr)
# this program is free software: please read the COPYRIGHT file enclosed in this package or use the Help Copyright menu
# $Id: netdev.tcl,v 2.30 2005/02/06 14:24:45 jfontain Exp $
package provide netdev [lindex {$Revision: 2.30 $} 1]
package require network 1
package require stooop 4.1
namespace import stooop::*
package require switched
if {[catch {package require Thread 2.5}]} {
namespace eval netdev {variable threads 0}
} else { ;# load thread worker class implementation
package require threads 1
namespace eval netdev {variable threads 1}
}
package require linetask 1
package require hashes
namespace eval netdev {
# documentation from net/core/dev.c and include/linux/netdevice.h kernel source files
array set data {
updates 0
0,label interface 0,type dictionary 0,message {network device name}
1,label <bytes 1,type integer 1,message {total bytes received}
2,label <packets 2,type integer 2,message {total packets received}
3,label <errors 3,type integer 3,message {bad packets received}
4,label <dropped 4,type integer
4,message {received packets dropped for lack of space in kernel buffers, plus receiver missed packets}
5,label <FIFO 5,type integer 5,message {receiver FIFO overruns}
6,label <frame 6,type integer
6,message {frame alignment errors received, including length, receiver ring buff overflow and CRC errors}
7,label <compressed 7,type integer 7,message {compressed packets received}
8,label <multicast 8,type integer 8,message {multicast packets received}
9,label bytes> 9,type integer 9,message {total bytes transmitted}
10,label packets> 10,type integer 10,message {total packets transmitted}
11,label errors> 11,type integer 11,message {packet transmit problems}
12,label dropped> 12,type integer 12,message {packets not transmitted for lack of space in kernel buffers}
13,label FIFO> 13,type integer 13,message {transmitter FIFO overruns}
14,label collisions> 14,type integer 14,message {collisions while transmitting}
15,label carrier> 15,type integer 15,message {carriers errors, including aborted, window and heartbeat errors}
16,label compressed> 16,type integer 16,message {compressed packets transmitted}
17,label <bytes/s 17,type real 17,message {total bytes received per second during last poll period}
18,label <packets/s 18,type real 18,message {total packets received per second during last poll period}
19,label <errors/s 19,type real 19,message {bad packets received per second during last poll period}
20,label <dropped/s 20,type real 20,message {received packets dropped for lack of space in kernel buffers, plus receiver missed packets, per second during last poll period}
21,label <FIFO/s 21,type real 21,message {receiver FIFO overruns per second during last poll period}
22,label <frame/s 22,type real 22,message {frame alignment errors received, including length, receiver ring buff overflow and CRC errors, per second during last poll period}
23,label <compressed/s 23,type real 23,message {compressed packets received per second during last poll period}
24,label <multicast/s 24,type real 24,message {multicast packets received per second during last poll period}
25,label bytes/s> 25,type real 25,message {total bytes transmitted per second during last poll period}
26,label packets/s> 26,type real 26,message {total packets transmitted per second during last poll period}
27,label errors/s> 27,type real 27,message {packet transmit problems per second during last poll period}
28,label dropped/s> 28,type real
28,message {packets not transmitted for lack of space in kernel buffers, per second during last poll period}
29,label FIFO/s> 29,type real 29,message {transmitter FIFO overruns per second during last poll period}
30,label collisions/s> 30,type real 30,message {collisions while transmitting per second during last poll period}
31,label carrier/s> 31,type real
31,message {carriers errors, including aborted, window and heartbeat errors, per second during last poll period}
32,label compressed/s> 32,type real 32,message {compressed packets transmitted per second during last poll period}
indexColumns 0
views {
{visibleColumns {0 1 2 3 4 5 6 7 8} sort {0 increasing}}
{visibleColumns {0 9 10 11 12 13 14 15 16} sort {0 increasing}}
{visibleColumns {0 17 18 19 20 21 22 23 24} sort {0 increasing}}
{visibleColumns {0 25 26 27 28 29 30 31 32} sort {0 increasing}}
}
persistent 1 64Bits 1
switches {-C 0 --daemon 0 -i 1 -p 1 --proc 1 -r 1 --remote 1}
}
set file [open netdev.htm]
set data(helpText) [::read $file] ;# initialize HTML help data from file
close $file
unset file
proc initialize {optionsName} {
upvar 1 $optionsName options
variable lookup
variable local
variable remote
variable data
variable threads ;# whether threads package is available
set devices /proc; catch {set devices $options(--proc)} ;# note: use /compat/linux/proc for FreeBSD
set devices [file join $devices net/dev] ;# data file
catch {set locator $options(-r)}; catch {set locator $options(--remote)} ;# favor long option
set lookup [expr {![info exists options(-n)] && ![info exists options(--numeric)]}] ;# host or network names lookup
if {[info exists locator]} { ;# remote host
set data(pollTimes) {20 10 30 60 120 300 600} ;# poll less often when remotely monitoring
} else { ;# local host
set data(pollTimes) {10 5 20 30 60 120 300 600}
set local(devices) [open $devices] ;# keep local file open for better performance
return ;# local monitoring
}
# for remote monitoring, decode protocol, remote user and host
foreach {remote(protocol) remote(user) remote(host)} [network::parseRemoteLocator $locator] {}
set remote(rsh) [string equal $remote(protocol) rsh]
set data(identifier) netdev($remote(host))
# important: pack data in a single line using special control separator characters
set remote(command) "cat $devices 2>&1 | tr '\\n' '\\v'"
if {$::tcl_platform(platform) eq "unix"} {
if {$remote(rsh)} {
set command "rsh -n -l $remote(user) $remote(host) {$remote(command)}"
} else {
set command ssh
if {[info exists options(-C)]} {append command { -C}} ;# data compression
if {[info exists options(-i)]} {append command " -i \"$options(-i)\""} ;# identity file
if {[info exists options(-p)]} {append command " -p $options(-p)"} ;# port
append command " -T -l $remote(user) $remote(host)"
}
} else { ;# windows
if {$remote(rsh)} {error {use -r(--remote) ssh://session syntax (see help)}}
set remote(rsh) 0
set command "plink -ssh -batch -T $remote(host)" ;# note: host must be a putty session and pageant must be running
}
if {$remote(rsh)} {
set access r ;# writing to pipe is not needed
} else {
set access r+ ;# bi-directional pipe
# terminate remote command output by a newline so that the buffered stream flushes it through the pipe as soon as the
# remote data becomes available:
append remote(command) {; echo}
}
set remote(task) [new lineTask\
-command $command -callback netdev::read -begin 0 -access $access -translation lf -threaded $threads\
]
if {![info exists options(--daemon)] && !$remote(rsh)} { ;# for ssh, detect errors early when not in daemon mode
lineTask::begin $remote(task)
} ;# note: for rsh, shell and command need be restarted at each update
set remote(busy) 0
}
proc update {} {
variable remote
variable local
if {[info exists remote]} {
if {$remote(busy)} return ;# core invocation while waiting for remote data
set remote(busy) 1
if {[lineTask::end $remote(task)]} { ;# rsh or ssh daemon mode
lineTask::begin $remote(task) ;# note: for rsh, shell and command are restarted here each time
}
if {!$remote(rsh)} {
lineTask::write $remote(task) $remote(command) ;# start data retrieval by sending command to remote side
}
} else {
seek $local(devices) 0 ;# rewind before retrieving data
process [split [::read -nonewline $local(devices)] \n]
}
}
proc process {lines} { ;# process network interfaces data lines and update display
variable data
variable last
# output sample:
# Inter-| Receive | Transmit
# face |bytes packets errs drop fifo frame compressed multicast|bytes packets errs drop fifo colls carrier compressed
# lo: 127462 963 0 0 0 0 0 0 127462 963 0 0 0 0 0 0
if {([llength $lines] >= 2) && [string match "*bytes*packets*" [lindex $lines 1]]} { ;# detect seemingly invalid data
set clock [expr {[clock clicks -milliseconds] / 1000.0}] ;# immediately store current clock in seconds
set count 0
foreach line $lines {
if {[incr count] < 3} continue ;# skip the 2 column titles lines
regsub : $line { } line ;# remove column after interface name to make sure of proper list structure
set interface [lindex $line 0]
set row [hash64::string $interface]
set data($row,0) $interface
set column 1
foreach cell [lrange $line 1 end] {
set data($row,$column) $cell
if {[info exists last($row,$column)]} {
set data($row,[expr {$column + 16}])\
[format %.1f [expr {int($cell - $last($row,$column)) / ($clock - $last(clock))}]] ;# (unsigned longs)
} else { ;# first update
set data($row,[expr {$column + 16}]) ?
}
set last($row,$column) $cell
incr column
}
set current($row) {}
}
set last(clock) $clock
}
foreach name [array names data *,0] { ;# cleanup disappeared entries
set row [lindex [split $name ,] 0]
if {[info exists current($row)]} continue
array unset last $row,\[0-9\]*
array unset data $row,\[0-9\]*
}
if {![info exists current] && ([string length [lindex $lines 0]] > 0)} {
set message "invalid data: [lindex $lines 0]"
if {[llength $lines] > 1} {append message "..."}
flashMessage $message
}
incr data(updates)
}
proc read {line} { ;# read remote data now that it is available and possibly handle errors
variable remote
switch $lineTask::($remote(task),event) {
end {
# either valid data availability as rsh connection was closed, or connection broken for ssh, in which case remote
# shell command will be attempted to be restarted at next update
}
error { ;# some communication error occured
set message "error on remote data: $lineTask::($remote(task),error)"
}
timeout { ;# remote host did not respond in time
set message "timeout on remote host: $remote(host)"
}
}
# note: in case of an unexpected event, task insures that line is empty
if {[info exists message]} {
flashMessage $message
}
process [split [string trimright $line \v] \v]
set remote(busy) 0
}
}
|
