# copyright (C) 1997-2006 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.33 2006/04/04 20:02:52 jfontain Exp $


package provide netdev [lindex {$Revision: 2.33 $} 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(exact format in net/core/dev.c):
        # 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]
                if {[catch {set row [hash64::string $interface 1]} message]} {                                    ;# repeatable mode
                    flashMessage "warning: duplicate row ($interface) removed: $message"                      ;# should be very rare
                    continue
                }
                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 {(($cell - $last($row,$column)) & 0xFFFFFFFF) / ($clock - $last(clock))}]\
                        ]                  ;# (unsigned longs): use 32 bit integer subtractions valid on 32 and 64 bit Tcl platforms
                    } 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
    }

}
