# copyright (C) 1997-2001 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

set rcsId {$Id: route.tcl,v 2.9 2001/01/27 15:08:19 jfontain Exp $}


package provide route [lindex {$Revision: 2.9 $} 1]
package require network 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, M: 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}
        switches {-n 0 --numeric 0 -r 1 --remote 1}
    }
    set file [open route.htm]
    set data(helpText) [read $file]                                                           ;# initialize HTML help data from file
    close $file

    proc initialize {optionsName} {
        upvar $optionsName options
        variable lookup
        variable remote
        variable data
        variable routeFile

        set lookup [expr {![info exists options(-n)]&&![info exists options(--numeric)]}]            ;# host or network names lookup
        if {![catch {set locator $options(--remote)}]||![catch {set locator $options(-r)}]} {                   ;# remote monitoring
            set data(pollTimes) {20 10 30 60 120 300 600}                                ;# poll less often when remotely monitoring
            foreach {remote(protocol) remote(user) remote(host)} [network::parseRemoteLocator $locator] {}
            network::checkRemoteOutputEmptiness $remote(protocol) $remote(user) $remote(host)
            set data(identifier) route($remote(host))
            set file [open "| /usr/bin/$remote(protocol) -n -l $remote(user) $remote(host) cat /proc/net/route"]
            fileevent $file readable {set ::route::remote(busy) 0}
            vwait ::route::remote(busy)                                                                     ;# allow GUI interaction
            # detect errors early (but avoid write on pipe with no readers errors by reading whole data)
            if {[catch {read $file} message]||[catch {close $file} message]} {
                error "on remote host $remote(host) as user $remote(user): $message"
            }
        } else {
            set data(pollTimes) {10 5 20 30 60 120 300 600}
            set routeFile [open /proc/net/route]                                      ;# keep local file open for better performance
        }
    }

    set nextIndex 0

    proc update {} {
        variable remote
        variable routeFile
        variable index
        variable nextIndex
        variable data
        variable lookup

        if {[info exists remote]} {
            if {![info exists routeFile]} {                                ;# start data gathering process in a non blocking fashion
                if {$remote(busy)} return                                           ;# core invocation while waiting for remote data
                set remote(busy) 1
                set file [open "| /usr/bin/$remote(protocol) -n -l $remote(user) $remote(host) cat /proc/net/route"]
                # do not hang GUI, allow other modules updates
                fileevent $file readable "set ::route::routeFile $file; ::route::update"
                return                                                                                       ;# wait for remote data
            }                                                                                 ;# else continue below to process data
        } else {
            seek $routeFile 0                                                                       ;# rewind before retrieving data
        }
        gets $routeFile                                                                                          ;# skip header line
        while {[gets $routeFile line]>=0} {
            lappend lines $line
        }
        if {[info exists remote]} {                                                 ;# closing is necessary since seek does not work
            read $routeFile                                  ;# avoid write on pipe with no readers errors by reading remaining data
            if {[catch {close $routeFile} message]} {                                    ;# communication error can be detected here
                flashMessage "route error: $message"
                set lines {}                                                                   ;# consider data corrupted as a whole
            }
            unset routeFile
            set remote(busy) 0
        }
        foreach line $lines {
            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)
            set address $destination(0).$destination(1).$destination(2).$destination(3)
            if {[catch {set index($address)} row]} {                                                                    ;# new entry
                set row [set index($address) $nextIndex]
                incr nextIndex
            }
            set data($row,0) $interface
            if {[string equal $address 0.0.0.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 name lookup
                }
            }
            set data($row,2) $gateway(0).$gateway(1).$gateway(2).$gateway(3)
            if {[string equal $data($row,2) 0.0.0.0]} {
                set data($row,2) {}                                                                                    ;# no gateway
            } else {
                if {$lookup} {
                    catch {set data($row,2) [network::hostfromaddress $data($row,2)]}                             ;# try name lookup
                }
            }
            set data($row,3) [network::routeletterflags $flags]
            set data($row,4) $mask(0).$mask(1).$mask(2).$mask(3)
            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($address) {}
        }
        foreach {address row} [array get index] {                                                     ;# cleanup disappeared entries
            if {[info exists current($address)]} continue
            unset index($address) data($row,0) data($row,1) data($row,2) data($row,3)
        }
        incr data(updates)
    }
}
