# 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: arp.tcl,v 1.54 2006/01/28 19:16:59 jfontain Exp $


package provide arp [lindex {$Revision: 1.54 $} 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 arp {variable threads 0}
} else {                                                                                  ;# load thread worker class implementation
    package require threads 1
    namespace eval arp {variable threads 1}
}
package require linetask 1


namespace eval arp {

    array set data {
        updates 0
        0,label IP 0,type dictionary 0,message {IP address} 0,anchor left
        1,label hardware 1,type dictionary 1,message {hardware address}
        2,label decoded 2,type dictionary 2,message {decoded hardware address} 2,anchor left
        3,label type 3,type ascii 3,message {hardware type}
        4,label flags 4,type ascii 4,message {entry flags (C: complete, M: permanent, P: published)}
        5,label interface 5,type ascii 5,message {networking interface}
        sort {0 increasing}
        persistent 1
        switches {-C 0 --daemon 0 -i 1 -n 0 --numeric 0 -r 1 --remote 1}
    }
    set file [open arp.htm]
    set data(helpText) [::read $file]                                                         ;# initialize HTML help data from file
    close $file
    set file [open manuf.txt]
    while {[gets $file line] >= 0} {                      ;# save ethernet address code (first 3 bytes) to manufacturer name mapping
        if {[scan $line {%*2x:%*2x:%*2x %s} word] == 1} {                              ;# only keep the manufacturer name first word
            set manufacturer([lindex $line 0]) $word
        }
    }
    unset word
    close $file
    unset file
    # initialize hardware type mapping (from kernel include/linux/if_arp.h file)
    array set hardwareType {
        0 NETROM 1 ETHER 2 EETHER 3 AX25 4 PRONET 5 CHAOS 6 IEEE802 7 ARCNET 8 APPLETLK
        15 DLCI 19 ATM 23 METRICOM 24 IEEE1394 27 EUI64 32 INFINIBAND
        256 SLIP 257 CSLIP 258 SLIP6 259 CSLIP6 260 RSRVD 264 ADAPT 270 ROSE 271 X25 272 HWX25
        512 PPP 513 HDLC 516 LAPB 517 DDCMP 518 RAWHDLC
        768 TUNNEL 769 TUNNEL6 770 FRAD 771 SKIP 772 LOOPBACK 773 LOCALTLK 774 FDDI 775 BIF 776 SIT 777 IPDDP 778 IPGRE 779 PIMREG
        780 HIPPI 781 ASH 782 ECONET 783 IRDA 784 FCPP 785 FCAL 786 FCPL 787 FCFABRIC
        800 IEEE802_TR 801 IEEE80211 802 IEEE80211_PRISM
        65535 VOID
    }

    proc initialize {optionsName} {
        upvar 1 $optionsName options
        variable local
        variable remote
        variable data
        variable lookup
        variable threads                                                                     ;# whether threads package is available

        set lookup [expr {![info exists options(-n)] && ![info exists options(--numeric)]}]          ;# host or network names lookup
        catch {set locator $options(-r)}
        catch {set locator $options(--remote)}                                                                  ;# favor long option
        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(arp) [open /proc/net/arp]                                       ;# keep local file open for better performance
            getEtherNames
            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) arp($remote(host))
        # important: pack data in a single line using special control separator characters
        set remote(pattern) {cat %f 2>&1 | tr '\n' '\v'}               ;# redirect error output to make sure ssh sees error messages
        if {[string equal $::tcl_platform(platform) unix]} {
            if {$remote(rsh)} {                         ;# pipe command is included in line task command, so it must include pattern
                set remote(pattern) "rsh -n -l $remote(user) $remote(host) {$remote(pattern)}"
            } else {
                set command ssh
                if {[info exists options(-C)]} {                                                                 ;# data compression
                    append command { -C}
                }
                if {[info exists options(-i)]} {                                                                    ;# identity file
                    append command " -i \"$options(-i)\""
                }
                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(pattern) {; echo}
        }
        set remote(task) [new lineTask -callback arp::read -begin 0 -access $access -translation lf -threaded $threads]
        if {!$remote(rsh)} {
            switched::configure $remote(task) -command $command
        }
        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(initialized) 0
        set remote(busy) 0
    }

    proc getEtherNames {} {
        variable remote
        variable threads

        set name /etc/ethers
        if {[info exists remote]} {
            set remote(process) saveEtherNames
            set remote(ignoreError) {}                                                                   ;# since file may not exist
            regsub %f $remote(pattern) $name command
            if {$remote(rsh)} {
                switched::configure $remote(task) -command $command
            }
            set remote(busy) 1
            if {[lineTask::end $remote(task)]} {                                                           ;# rsh or ssh daemon mode
                lineTask::begin $remote(task)
            }
            if {!$remote(rsh)} {
                lineTask::write $remote(task) $command
            }
        } elseif {![catch {set file [open $name]}]} {
            saveEtherNames [split [::read -nonewline $file] \n]
            close $file
        }
    }

    proc saveEtherNames {lines} {
        variable remote
        variable etherName

        foreach line $lines {
            if {[string match #* $line]} continue                                                                   ;# skip comments
            if {[scan $line {%x:%x:%x:%x:%x:%x %s} byte(0) byte(1) byte(2) byte(3) byte(4) byte(5) name] == 7} {
                set address [format {%02X:%02X:%02X:%02X:%02X:%02X} $byte(0) $byte(1) $byte(2) $byte(3) $byte(4) $byte(5)]
                set etherName($address) $name
            }
        }
        if {[info exists remote]} {
            set remote(initialized) 1
            unset remote(ignoreError)
            set remote(process) process                                                               ;# continue with normal update
            set name /proc/net/arp
            if {$remote(rsh)} {
                regsub %f $remote(pattern) $name command
                switched::configure $remote(task) -command $command
            } else {
                regsub %f $remote(pattern) $name remote(command)
            }
            after idle arp::update                                                      ;# since an update was requested by the core
        }
    }

    proc update {} {
        variable remote
        variable local

        if {[info exists remote]} {
            if {$remote(busy)} return                                               ;# core invocation while waiting for remote data
            if {!$remote(initialized)} {
                getEtherNames
                return
            }
            set remote(busy) 1
            if {[lineTask::end $remote(task)]} {                                                                              ;# rsh
                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(arp) 0                                                                      ;# rewind before retrieving data
            process [split [::read -nonewline $local(arp)] \n]
        }
    }

    proc process {lines} {                                                              ;# process arp data lines and update display
        variable data
        variable hardwareType
        variable etherName
        variable manufacturer
        variable lookup

        set first 1
        foreach line $lines {
            if {$first} {
                set first 0
                continue                                                                                         ;# skip header line
            }
            scan $line {%u.%u.%u.%u 0x%x 0x%x %s %*s %s} ip0 ip1 ip2 ip3 type flags address interface
            # generate 32 unsigned integer from IP address:
            set row [format %u [expr {($ip0 << 24) | ($ip1 << 16) | ($ip2 << 8) | $ip3}]]
            set data($row,0) $ip0.$ip1.$ip2.$ip3
            if {$lookup} {
                catch {set data($row,0) [network::hostfromaddress $data($row,0)]}                                 ;# try name lookup
            }
            if {![info exists data($row,1)]} {                                                                          ;# new entry
                set data($row,1) $address
                set data($row,2) {}
                if {$type == 1} {                                                                                        ;# ethernet
                    if {[info exists etherName($address)]} {                                                      ;# try name lookup
                        set data($row,2) $etherName($address)
                    } else {
                        regexp {^(..:..:..):(..:..:..)$} $address dummy code number
                        if {[info exists manufacturer($code)]} {                                          ;# try manufacturer lookup
                            set data($row,2) $manufacturer($code):$number
                        }
                    }
                }
            }
            if {[catch {set data($row,3) $hardwareType($type)}]} {
                set data($row,3) ?                                                                               ;# unknown hardware
            }
            set data($row,4) {}                                         ;# flags from the /usr/src/linux/include/linux/if_arp.h file
            if {$flags & 2} {append data($row,4) C}                                                               ;# completed entry
            if {$flags & 4} {append data($row,4) M}                                                               ;# permanent entry
            if {$flags & 8} {append data($row,4) P}                                                               ;# published entry
            set data($row,5) $interface
            set current($row) {}
        }
        foreach name [array names data *,0] {                                                         ;# cleanup disappeared entries
            set row [lindex [split $name ,] 0]
            if {![info exists current($row)]} {array unset data $row,\[0-9\]*}
        }
        if {![info exists current] && ([string length [lindex $lines 0]] > 0) && ![string match "IP*address*" [lindex $lines 0]]} {
            # there should be at least the header line
            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
                if {![info exists remote(ignoreError)]} {
                    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
        }
        $remote(process) [split [string trimright $line \v] \v]
        set remote(busy) 0
    }

}
