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


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


namespace eval route {

    array set data {
        updates 0
        0,label interface 0,type ascii 0,message {networking interface}
        1,label destination 1,type dictionary 1,message {destination network or host, or default} 1,anchor left
        2,label gateway 2,type dictionary 2,message {gateway address, if any} 2,anchor left
        3,label flags 3,type ascii 3,message "D: dynamic, G: gateway, H: host\nM: modified, R: reinstate, U: up, !: reject"
        4,label mask 4,type dictionary 4,message {network mask (empty for default route)}
        5,label references 5,type integer 5,message {number of references to the route}
        6,label use 6,type integer 6,message {count of lookups for the route}
        7,label metric 7,type integer 7,message {distance (in hops) to the target}
        sort {1 increasing}
        persistent 1
        switches {-C 0 --daemon 0 -i 1 -n 0 --numeric 0 -p 1 -r 1 --remote 1}
    }
    set file [open route.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
        variable littleEndian

        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 littleEndian [string equal $::tcl_platform(byteOrder) littleEndian]
            set local(routes) [open /proc/net/route]                                  ;# 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) route($remote(host))
        set remote(command,endian) {echo -n 01 | od -x 2>\&1}
        set remote(command,route) {cat /proc/net/route 2>\&1}          ;# note: echo "$(< /proc/net/route)" only returns first line!
        set remote(pattern) {%c | tr '\n' '\v'}  ;# important: pack data in a single line using special control separator characters
        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)]} {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(pattern) {; echo}
        }
        set remote(task) [new lineTask -callback route::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(busy) 0
    }

    proc update {} {
        variable remote
        variable local
        variable littleEndian

        if {[info exists remote]} {
            if {$remote(busy)} return                                               ;# core invocation while waiting for remote data
            set remote(busy) 1
            if {![info exists littleEndian]} {
                regsub %c $remote(pattern) $remote(command,endian) command                                  ;# determine endian type
                if {$remote(rsh)} {
                    switched::configure $remote(task) -command $command
                } else {
                    set remote(command) $command
                }
            }
            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(routes) 0                                                                   ;# rewind before retrieving data
            process [split [::read -nonewline $local(routes)] \n]
        }
    }

    proc process {lines} {                                                            ;# process route data lines and update display
        variable data
        variable lookup
        variable littleEndian

        if {([llength $lines] > 0) && [string match "*destination*gateway*" [string tolower [lindex $lines 0]]]} {
            # detect seemingly invalid data
            foreach line $lines {
                if {[scan\
                    $line {%s %2x%2x%2x%2x %2x%2x%2x%2x %x %u %u %u %2x%2x%2x%2x}\
                    interface destination(3) destination(2) destination(1) destination(0)\
                    gateway(3) gateway(2) gateway(1) gateway(0) flags references use metric mask(3) mask(2) mask(1) mask(0)\
                ] != 17} continue
                set row [format %u 0x[lindex $line 1]]                               ;# generate 32 unsigned integer from IP address
                if {$littleEndian} {
                    set address $destination(0).$destination(1).$destination(2).$destination(3)
                } else {
                    set address $destination(3).$destination(2).$destination(1).$destination(0)
                }
                set data($row,0) $interface
                if {$row == 0} {                                                                                    ;# default route
                    set data($row,1) default
                } else {
                    set data($row,1) $address
                    if {$lookup && [catch {set data($row,1) [network::networkfromaddress $address]}]} {   ;# try network name lookup
                        catch {set data($row,1) [network::hostfromaddress $address]}                          ;# or host name lookup
                    }
                }
                if {$littleEndian} {
                    set data($row,2) $gateway(0).$gateway(1).$gateway(2).$gateway(3)
                } else {
                    set data($row,2) $gateway(3).$gateway(2).$gateway(1).$gateway(0)
                }
                if {[string equal $data($row,2) 0.0.0.0]} {
                    set data($row,2) {}                                                                                ;# no gateway
                } elseif {$lookup} {
                    catch {set data($row,2) [network::hostfromaddress $data($row,2)]}                             ;# try name lookup
                }
                set data($row,3) [network::routeletterflags $flags]
                if {$littleEndian} {
                    set data($row,4) $mask(0).$mask(1).$mask(2).$mask(3)
                } else {
                    set data($row,4) $mask(3).$mask(2).$mask(1).$mask(0)
                }
                if {[string equal $data($row,4) 0.0.0.0]} {
                    set data($row,4) {}                                                                                   ;# no mask
                }
                set data($row,5) $references
                set data($row,6) $use
                set data($row,7) $metric
                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]} {
            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
        variable littleEndian

        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
        }
        if {[info exists littleEndian]} {                                                                           ;# normal update
            process [split [string trimright $line \v] \v]
        } else {
            if {![string match "00*31*" $line]} {                                                          ;# seemingly invalid data
                flashMessage "invalid data: $line"
            }
            set littleEndian [string match *3130* $line]          ;# on i386 machines: 'echo -n 01 | od -x' = '0000000 3130 0000002'
            regsub %c $remote(pattern) $remote(command,route) command                       ;# continue with route retrieval command
            if {$remote(rsh)} {
                switched::configure $remote(task) -command $command
            } else {
                set remote(command) $command
            }
            after idle route::update                                                    ;# since an update was requested by the core
        }
        set remote(busy) 0
    }

}
