# 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: ping.tcl,v 2.41 2005/01/02 00:45:07 jfontain Exp $


package provide ping [lindex {$Revision: 2.41 $} 1]
if {$::tcl_platform(platform) eq "windows"} {
    package require Tnm                        ;# for host to IP address conversion since the library below is not ported to Windows
} else {
    package require network 1
}
package require hashes
package require stooop 4.1
namespace import stooop::*


namespace eval ping {

    variable directory [pwd]                                                                           ;# save this module directory

    array set data {
        updates 0
        0,label host 0,type dictionary 0,message {host or gateway name} 0,anchor left
        1,label address 1,type dictionary 1,message {IP address} 1,anchor left
        2,label replied 2,type dictionary 2,message {reply address} 2,anchor left
        3,label period 3,type integer 3,message {polling period in seconds}
        4,label count 4,type integer 4,message {number of packets transmitted for each period}
        5,label size 5,type integer 5,message {packet size in bytes}
        6,label timeout 6,type integer 6,message {maximum time spent waiting for a response for each packet, in seconds}
        7,label delay 7,type integer 7,message {delay between transmitted packets in seconds}
        8,label transmitted 8,type integer 8,message {number of packets transmitted for the last period}
        9,label received 9,type integer 9,message {number of packets received for the last period}
        10,label loss 10,type integer 10,message {percentage of packets lost for the last period}
        11,label minimum 11,type integer 11,message {minimum round trip time for the last period, in milliseconds}
        12,label averaged 12,type integer 12,message {averaged round trip time for the last period, in milliseconds}
        13,label maximum 13,type integer 13,message {maximum round trip time for the last period, in milliseconds}
        views {
            {visibleColumns {0 1 2 3 4 5 6 7} sort {0 increasing}}
            {visibleColumns {0 8 9 10 11 12 13} sort {0 increasing}}
        }
        persistent 1 64Bits 1
        switches {-f 1 -r 1}
    }
    set file [open ping.htm]
    set data(helpText) [read $file]                                                           ;# initialize HTML help data from file
    close $file
    unset file

    proc initialize {optionsName} {
        upvar 1 $optionsName options
        variable directory
        variable data

        if {[catch {set name $options(-f)}]} {                                                            ;# no hosts file specified
            set name [file join $directory hosts]                                                                     ;# use default
        }
        set file [open $name]
        set period 2147483647
        set rows {}
        while {[gets $file line] >= 0} {
            set line [string trim $line]
            if {$line eq ""} continue                                                                            ;# skip empty lines
            if {[string match #* $line]} continue                                                                        ;# comments
            if {[llength $line] != 6} {                                                                         ;# and invalid lines
                error "invalid line in hosts file:\n$line"
            }
            set row [hash64::string [lindex $line 0]]                              ;# derive row number from host name or IP address
            foreach "data($row,0) data($row,3) data($row,6) data($row,4) data($row,5) data($row,7)" $line {}
            if {$data($row,3) <= 0} {
                error "host $data($row,0) period ($data($row,3)) must be greater than 0."
                exit 1
            }
            if {$data($row,6) <= 0} {
                error "host $data($row,0) timeout ($data($row,6)) must be greater than 0."
                exit 1
            }
            if {$data($row,4) <= 0} {
                error "host $data($row,0) packet count ($data($row,4)) must be greater than 0."
                exit 1
            }
            if {$data($row,5) < 56} {
                error "host $data($row,0) packet size ($data($row,5)) must be greater than or equal 56."
                exit 1
            }
            if {$data($row,7) < 0} {
                error "host $data($row,0) delay ($data($row,7)) must be greater than or equal 0."
                exit 1
            }
            pushMessage "looking up IP address for $data($row,0)"                                        ;# looking time may be long
            set data($row,1) {}
            if {$::tcl_platform(platform) eq "windows"} {
                catch {set data($row,1) [::Tnm::netdb hosts address $data($row,0)]}
            } else {
                catch {set data($row,1) [::network::addressfromhost $data($row,0)]}
            }
            popMessage
            array set data [list $row,2 {} $row,8 ? $row,9 ? $row,10 ? $row,11 ? $row,12 ? $row,13 ?]
            if {$data($row,3) < $period} {
                set period $data($row,3)                                           ;# keep track of the minimum period for all hosts
            }
            lappend rows $row
        }
        close $file
        set data(pollTimes) -$period
        set requestsHost 127.0.0.1                                                                          ;# local host by default
        catch {set requestsHost $options(-r)}                                                   ;# may be overridden in command line
        ::session::initialize $requestsHost ::ping::received
        foreach row $rows {                                                                                    ;# initialize polling
            if {$data($row,1) eq ""} continue                                         ;# do not attempt to ping unresolved addresses
            launch $row
        }
    }

    proc launch {row} {
        variable stamp
        variable data

        set stamp [clock clicks -milliseconds]
        new session $data($row,1) $data($row,4) $data($row,6) $data($row,5) $data($row,7) "::ping::process $row"
    }

    proc process {row session replyAddress times states} {
        variable data
        variable stamp

        delete $session                                                                                            ;# first clean up

        set transmitted 0
        set received 0
        set total 0
        set minimum 2147483647
        set maximum 0
        foreach time $times status $states {
            if {$status == 2} continue                                         ;# general error occured: no packets were transmitted
            incr transmitted
            if {$status == 1} continue                                                                           ;# timeout occurred
            incr received
            incr total $time
            if {$time < $minimum} {
                set minimum $time
            }
            if {$time > $maximum} {
                set maximum $time
            }
        }
        set data($row,2) $replyAddress
        set data($row,8) $transmitted
        set data($row,9) $received
        if {$transmitted > 0} {
            set data($row,10) [expr {(100 * ($transmitted - $received)) / $transmitted}]
        } else {                                                              ;# may happen when network is unreachable, for example
            set data($row,10) ?
        }
        if {$received > 0} {
            set data($row,11) $minimum
            set data($row,12) [expr {$total / $received}]
            set data($row,13) $maximum
        } else {
            array set data [list $row,11 ? $row,12 ? $row,13 ?]
        }
        # now setup next poll for this row
        set left [expr {($data($row,3) * 1000) - ([clock clicks -milliseconds] - $stamp)}]                        ;# in milliseconds
        if {$left < 500} {                                                                           ;# with a half second precision
            launch $row
        } else {
            after $left "::ping::launch $row"
        }
    }

    proc received {} {
        variable event

        if {![info exists event]} {      ;# optimize by waiting a short time before updating so that multiple updates can be grouped
            set event [after 1000 ::ping::update]
        }
    }

    proc update {} {
        variable event
        variable data

        unset event
        incr data(updates)
    }

}


class session {

    proc session {this address count timeout size delay command} {
        set ($this,address) [split $address .]
        set ($this,count) $count
        set ($this,timeout) $timeout
        set ($this,size) $size
        set ($this,delay) [expr {1000 * $delay}]                                                                  ;# in milliseconds
        set ($this,command) $command
        send $this
    }

    proc ~session {this} {}

    proc initialize {requestsHost receiveCommand} {                             ;# command to be invoked once reception is completed
        if {[catch {set ::session::(socket) [socket $requestsHost nmicmp]} message]} {
            error \
"could not connect to the nmicmpd server for the following reason:
  $message
Please read the INSTALL file in the ping module sub-directory."
        }
        fconfigure $::session::(socket) -blocking 0 -translation binary
        set ::session::(command) $receiveCommand
        fileevent $::session::(socket) readable ::session::receive
    }

    proc send {this} {
        set ($this,stamp) [clock clicks -milliseconds]
        puts -nonewline $::session::(socket)\
            [binary format c4Ic4ccccSS {0 1 0 0} $this $($this,address) 255 $($this,timeout) 0 0 $($this,size) 0]
        flush $::session::(socket)
    }

    proc receive {} {
        set completed 0
        while {[binary scan [read $::session::(socket) 16] xxcxIc4I status session bytes time] == 4} {        ;# process all replies
            if {$status == 0} {                                                                                    ;# valid response
                if {![info exists ($session,replyAddress)]} {                                 ;# only store valid reply address once
                    catch {unset address}
                    foreach byte $bytes {
                        if {[info exists address]} {
                            append address .
                        }
                        append address [expr {($byte + 256) % 256}]                                           ;# convert to unsigned
                    }
                    set ($session,replyAddress) $address
                }
                lappend ($session,times) $time
            } else {                                                                                                     ;# no reply
                lappend ($session,times) {}
            }
            lappend ($session,states) $status
            if {[incr ($session,count) -1] == 0} {                                                                           ;# done
                if {![info exists ($session,replyAddress)]} {                            ;# if no reply address, use an empty string
                    set ($session,replyAddress) {}
                }
                uplevel #0 $($session,command) $session\
                    [list $($session,replyAddress)] [list $($session,times)] [list $($session,states)]
                set completed 1                                                                         ;# one request was completed
            } else {
                # calculate time left before next probe
                set left [expr {$($session,delay) - ([clock clicks -milliseconds] - $($session,stamp))}]          ;# in milliseconds
                if {$left < 500} {                                                                   ;# with a half second precision
                    send $session
                } else {
                    after $left "::session::send $session"
                }
            }
        }
        if {$completed} {                                                                      ;# at least one request was completed
            uplevel #0 $::session::(command)
        }
    }

}