# monitor.tcl --
#
# This file contains the implementation of some monitoring
# procedures which usually run in the background and create
# events using the event command. This is work in progress
# so this might change in future versions.
#
# Copyright (c) 1996 Technical University of Braunschweig.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require Tnm
package provide TnmMonitor $tnm(version)

proc TnmGetStatusProc {job status vbl} {
    array set cx [$job attribute status]
    switch $status {
	noError {
	    set value [lindex [lindex $vbl 0] 2]
	    if {$value != $cx(value)} {
		event raise GetStatus:Change $cx(session) $cx(oid) $value
	    }
	    set cx(value) $value
	    $job attribute status [array get cx]
	}
	noSuchName {
	    event raise GetStatus:NoSuchName $cx(session) $cx(oid)
	}
	noResponse {
	    event raise GetStatus:NoResponse $cx(session)
	}
    }
}

proc TnmGetStatusCmd {} {
    set job [job current]
    array set cx [$job attribute status]
    $cx(session) get $cx(oid) \
	    [subst { TnmGetStatusProc "$job" "%E" "%V" } ]
}

proc Tnm_MonitorStatus {s tree seconds} {
    set result ""
    set ms [expr $seconds * 1000]
    foreach var $tree {
	$s walk vbl $var {
	    set cx(session)  [eval snmp session [$s configure]]
	    set cx(oid)	     [lindex [lindex $vbl 0] 0]
	    set cx(value)    [lindex [lindex $vbl 0] 2]
	    set j [job create -command TnmGetStatusCmd -interval $ms]
	    $j attribute status [array get cx]
	    lappend result $j
	}
    }
    return $result
}

#########################################################################

proc TnmGetValueProc {job status vbl} {
    array set cx [$job attribute status]
    switch $status {
	noError {
	    set value [lindex [lindex $vbl 0] 2]
	    event raise GetValue:Value $cx(session) $cx(oid) $value
	}
	noSuchName {
	    event raise GetValue:NoSuchName $cx(session) $cx(oid)
	}
	noResponse {
	    event raise GetValue:NoResponse $cx(session)
	}
    }
}

proc TnmGetValueCmd {} {
    set job [job current]
    array set cx [$job attribute status]
    $cx(session) get $cx(oid) \
	    [subst { TnmGetValueProc "$job" "%E" "%V" } ]
}

proc Tnm_MonitorValue {s tree seconds} {
    set result ""
    set ms [expr $seconds * 1000]
    foreach var $tree {
	$s walk vbl $var {
	    set cx(session)  [eval snmp session [$s configure]]
	    set cx(oid)	     [lindex [lindex $vbl 0] 0]
	    set j [job create -command TnmGetValue -interval $ms]
	    $j attribute status [array get cx]
	    lappend result $j
	}
    }
    return $result
}

#########################################################################

proc TnmGetUpTimeProc {job status vbl} {
    switch $status {
	noError {
	    array set cx [$job attribute status]
	    set uptime [lindex [lindex $vbl 0] 2]
	    if {$uptime < $cx(sysUpTime)} {
		event raise SysUpTime:Restart $cx(session) $uptime
	    }
	    set cx(sysUpTime) $uptime
	    $job attribute status [array get cx]
	}
	noResponse {
	    event raise SysUpTime:NoResponse $cx(session)
	}
    }
}

proc TnmGetUpTimeCmd {} {
    set job [job current]
    array set cx [$job attribute status]
    $cx(session) get sysUpTime.0 \
	    [subst { TnmGetUpTimeProc "$job" "%E" "%V" } ]
}

proc Tnm_MonitorSysUpTime {s seconds} {
    set ms [expr $seconds * 1000]
    set vbl [$s get sysUpTime.0]
    set cx(session)      [eval snmp session [$s configure]]
    set cx(sysUpTime)    [mib scan sysUpTime [lindex [lindex $vbl 0] 2]]
    set j [job create -command TnmGetUpTime -interval $ms]
    $j attribute status [array get cx]
    return $j
}

#########################################################################

#
# Calculate the interface utilisation. This is done using the formula
#
# util = ( 8 * ( delta (ifInOctets, t1, t0) 
#              + delta (ifOutOctets, t1, t0) ) / (t1 - t0) ) / ifSpeed
#
# This formula returns incorrect results for full-duplex point to point
# links. In this case, the following formula should be used:
#
# util = ( 8 * max ( delta (ifInOctets, t1, t0) ,
#                    delta (ifOutOctets, t1, t0) ) / (t1 - t0) ) / ifSpeed
#
# See Simple Times, 1(5), November/December, 1992 for more details.
#

proc TnmGetIfLoadProc {job status vbl} {

    if {$status != "noError"} return

    array set cx [$job attribute status]

    set ifIndex	     $cx(ifIndex)
    set sysUpTime    [mib scan sysUpTime [lindex [lindex $vbl 0] 2]]
    set ifOperStatus [lindex [lindex $vbl 1] 2]
    set ifInOctets   [lindex [lindex $vbl 2] 2]
    set ifOutOctets  [lindex [lindex $vbl 3] 2]
    
    # be careful with Tcl's broken arithmetic
    
    if {[catch {expr $ifInOctets - $cx(ifInOctets)} deltaIn]} {
	set deltaIn  [expr double($ifInOctets) - $cx(ifInOctets)]
    }
    if {[catch {expr $ifOutOctets - $cx(ifOutOctets)} deltaOut]} {
	set deltaOut [expr double($ifOutOctets) - $cx(ifOutOctets)]
    }
    
    if {$cx(fullduplex)} {
	set delta [expr $deltaIn > $deltaOut ? $deltaIn : $deltaOut]
    } else {
	set delta [expr $deltaIn + $deltaOut]
    }
    
    if {$sysUpTime > $cx(sysUpTime) && $cx(ifSpeed) > 0} {
	set secs [expr ($sysUpTime - $cx(sysUpTime)) / 100.0]
	set val  [expr (8.0 * $delta / $secs) / $cx(ifSpeed) * 100]
    } else {
	set val 0
    }

    event raise ifLoad $cx(session) $ifIndex $cx(ifDescr) $ifOperStatus $val
    if {$ifOperStatus != $cx(ifOperStatus)} {
	event raise ifStatusChange $ifIndex $cx(ifDescr) $ifOperStatus
    }

    set cx(sysUpTime)    $sysUpTime
    set cx(ifInOctets)   $ifInOctets
    set cx(ifOutOctets)  $ifOutOctets
    set cx(ifOperStatus) $ifOperStatus
    $job attribute status [array get cx]
}

proc TnmGetIfLoad {} {
    set job [job current]
    array set cx [$job attribute status]
    set i $cx(ifIndex)
    set vbl "sysUpTime.0 ifOperStatus.$i ifInOctets.$i ifOutOctets.$i"
    $cx(session) get $vbl [subst { TnmGetIfLoadProc "$job" "%E" "%V" } ]
}

#
# The following procedure walks the ifTable and starts an interface 
# load monitoring procedure for every interface. We retrieve some 
# initial status information from the agent to initialize the monitor
# jobs.
#

proc Tnm_MonitorIfLoad {s seconds {iterations {}}} {

    set ms [expr $seconds * 1000]
    set result ""

    # The list of full duplex interface types. Note, IANAifType 
    # (RFC 1573) uses slightly different encodings than RFC 1213. 
    # We use RFC 1213 style here.
    
    set fullDuplex {
	regular1822 hdh1822 ddn-x25 rfc877-x25 lapb sdlc ds1 e1 
	basicISDN primaryISDN propPointToPointSerial ppp slip ds3 sip 
	frame-relay
    }

    $s walk vbl ifIndex {
	set ifIndex [lindex [lindex $vbl 0] 2]

	set vbl [$s get [list sysUpTime.0 \
                          ifInOctets.$ifIndex ifOutOctets.$ifIndex \
                          ifSpeed.$ifIndex ifDescr.$ifIndex \
			  ifType.$ifIndex ifOperStatus.$ifIndex]]

	set cx(session)      [eval snmp session [$s configure]]
	set cx(ifIndex)      $ifIndex
	set cx(sysUpTime)    [lindex [lindex $vbl 0] 2]
	set cx(sysUpTime)    [mib scan sysUpTime $cx(sysUpTime)]
	set cx(ifInOctets)   [lindex [lindex $vbl 1] 2]
	set cx(ifOutOctets)  [lindex [lindex $vbl 2] 2]
	set cx(ifSpeed)      [lindex [lindex $vbl 3] 2]
	set cx(ifDescr)      [lindex [lindex $vbl 4] 2]
	set cx(ifType)       [lindex [lindex $vbl 5] 2]
	set cx(ifOperStatus) [lindex [lindex $vbl 6] 2]
	set cx(fullduplex)   [expr [lsearch $fullDuplex $cx(ifType)] < 0]

	set j [job create -command TnmGetIfLoad -interval $ms]
	if {$iterations != ""} {
	    $j configure -iterations $iterations
	}

	$j attribute status [array get cx]
	lappend result $j
    }

    return $result
}

#########################################################################

proc show {args} {
    puts stderr $args
}
