#
# Module Discovery.tcl  15.01.03 vfom
#
# $Log: Discovery.tcl,v $
# Revision 1.2  2006/10/26 09:39:17  vfom
# Added code for netstate server query
#
#		
package require msgcat
package require Tktable
package require BLT
namespace eval ::Discovery {
variable     discovery_exitFlag		0	\
    idx				0	\
    background			"black"	\
    foreground			"white"	\
    tbl_cold_width		"0 16 1 24 2 68" \
    visitedIps			[list]	\
    tmpAlive			[list]	\
    seedList			[list]	\
    progress			""	\
    lastGeometry		""
    array set dArray		[list]
    array set dArray_prototype	[list {0,0} [msgcat::mc "IP Address"]  \
				      {0,1} [msgcat::mc "FQDN name"]   \
				      {0,2} [msgcat::mc "Details"] ]
    array set nodesArray	[list]
    array set snmpArray		[list]
    array set devArray		[list]
}
#
proc discoveryMonitor_GUIconstructor { } {
    set w .discoveryMonitor
    set wf $w.tableFrame
    set wt $wf.table
    set wb $w.buttonFrame

    toplevel $w 
    wm title $w [msgcat::mc "Discovery Monitor"]
    wm withdraw $w

    frame $wf  
    pack $wf -side top -fill both -expand on -padx 5 -pady 5

    grid rowconfig	$wf 0 -weight 1 -minsize 0
    grid columnconfig   $wf 0 -weight 1 -minsize 0

    scrollbar $wf.sy -command " $wt yview "
    scrollbar $wf.sx -orient horiz -command " $wt xview "

    table $wt -rows 1 -cols [array size ::Discovery::dArray_prototype ] \
	-variable ::Discovery::dArray \
	-titlerows 1 -titlecols 0 \
	-yscrollcommand " $wf.sy set "  \
	-xscrollcommand " $wf.sx set "  \
	-background $::Discovery::background \
	-foreground $::Discovery::foreground \
	-maxwidth 300 -maxheight 400  \
	-roworigin 0 -colorigin 0 \
	-selectmode extended \
	-selecttype row \
	-rowstretch none -colstretch last \
	-drawmode single \
	-resizeborders both \
	-flashmode 0 \
	-state disabled \
	-borderwidth 1 \
	-anchor nw

    ClearDTable
    grid $wt -in $wf \
	-row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news
    grid $wf.sy -in $wf -column 1 -row 0 \
	-columnspan 1 -rowspan 1 -sticky news
    grid $wf.sx -in $wf -column 0 -row 1 \
	-columnspan 1 -rowspan 1 -sticky news

    $wt tag config title -bg #0000bf00ff00 -relief groove
    $wt tag config sel -fg #f700f700f700 -bg #48003d008b00 
    $wt tag configure snmp_tag -wrap 1
    $wt tag col snmp_tag 2
    eval $wt  width $::Discovery::tbl_cold_width
    frame $wb 

    button $wb.start  -text [msgcat::mc "Start"] \
	-command doDiscovery
    button $wb.stop -text [msgcat::mc "Stop"]\
	-command {
	    set wb .discoveryMonitor.buttonFrame 
	    set wb2 .discoveryMonitor.buttonFrame2 
	    set  ::Discovery::discovery_exitFlag "KILLED by Stop button"
	    $wb.stop configure -state disabled
	    foreach bt { $wb.start $wb.merge $wb.clear $wb.targets $wb.snmp $wb2.ok } {
		eval $bt configure -state normal
	    }
	}
    button $wb.merge  -text [msgcat::mc "Merge to Map"] \
	-command "mergeToMap $wt"
    button $wb.clear  -text [msgcat::mc "Clear"] \
	-command "ClearDTable"
    button $wb.targets  -text [msgcat::mc "Select Targets"] \
	-command "selectTargets"
    button $wb.snmp  -text [msgcat::mc "SNMP community"] \
	-command "snmpNames"
    pack $wb.start $wb.stop $wb.merge $wb.clear $wb.targets $wb.snmp \
	-side left  -padx 5 -pady 5

    frame $w.buttonFrame2 
    set wb $w.buttonFrame2
    label $wb.prg -width 80 -justify left -textvariable ::Discovery::progress
    button $wb.ok -text [msgcat::mc "Close"] -command  "wm withdraw $w"

    pack $wb.prg  -side left  -padx 5 -pady 5						    
    pack $wb.ok  -side right  -padx 5 -pady 5						    
    pack $w.buttonFrame2 $w.buttonFrame -side bottom -pady 5

    $w.buttonFrame.stop configure -state disabled

    update idletasks
    if { $::Discovery::lastGeometry=="" } {
        set x [expr {[winfo screenwidth $w]/2 - 400  \
	    - [winfo vrootx [winfo parent $w]]}]
        set y [expr {[winfo screenheight $w]/2 - 300 \
	    - [winfo vrooty [winfo parent $w]]}]
	wm geom $w [format "%sx%s+%s+%s" 800 600 $x $y]
    } else {
	wm geom $w $::Discovery::lastGeometry
    }
    bind $w <Control-a> "$wt selection set 1,0 end"
    bind $w <Destroy> {
	set  ::Discovery::discovery_exitFlag "KILLED by Stop button"
	if { "XX%W" == "XX.discoveryMonitor" } {
	    set ::Discovery::lastGeometry [ wm geom $w ]
	}
    }
}

proc discoveryMonitor { } {
        
    set w .discoveryMonitor
    set wf $w.tableFrame
    set wt $wf.table

    if {! [ winfo exists $w ] } {
	discoveryMonitor_GUIconstructor
    }
    if { [string equal [wm state $w] withdrawn ] } {
	wm deiconify $w
    }
    raise $w
        
}
#############################################################
# Proc cleanup array of discovered hosts
#
proc ClearDTable { } {
    set t .discoveryMonitor.tableFrame.table
    set ::Discovery::idx  1
    $t configure -rows $::Discovery::idx
    array unset ::Discovery::dArray
    array set ::Discovery::dArray  [ array get ::Discovery::dArray_prototype ]
    set ::Discovery::visitedIps [ list ]
}
#############################################################
# extract IP adrresses from router's adresses table
#
proc GetAliases { host comm } {
    set ipList [list]
    # check  router'r aliases
    foreach str [split [SnmpWalk $host $comm $::MIB(ipAdEntAddr) ] "\n" ] {
	lappend ipList [ lindex $str end ]
    }
    return [ lsort -unique $ipList ]    
}
#############################################################
# extract IP adrresses from router's adresses table
#
proc GetIpFromRouterTables { host comm } {
    array set addrArr [list]
    array set macArr  [list]
    set ipList	[list]
    foreach str [split [SnmpWalk $host $comm $::MIB(ipNetToMediaNetAddress)] "\n" ] {
	set oid  [ lindex $str 0 ]
	regexp --  {\d+\.\d+\.\d+\.\d+$} $oid key
	set val  [ lindex $str end ]
	lappend ipList $val
	set addrArr($key) $val
    }
    foreach str [split [SnmpWalk $host $comm $::MIB(ipNetToMediaPhysAddress)] "\n" ] {
	set oid  [ lindex $str 0 ]
	regexp --  {\d+\.\d+\.\d+\.\d+$} $oid key
	set val  [ lindex $str end ]
	set macArr($key) $val
    }
    # check router's ROUTING table - extract NextHop
    foreach str [split [SnmpWalk $host $comm $::MIB(ipRouteNextHop)] "\n" ] {
	lappend ipList [ lindex [split  $str " "] end ]
    }
    foreach kk  [ array names addrArr "*"] {
	set ip  $addrArr($kk)
	if { [info exists macArr($kk) ] } {
	    set mac $macArr($kk)
	    set ::Discovery::nodesArray(mac,$ip) $mac
	}
    }
    return [ lsort -unique $ipList ]    
}
#############################################################
# 
#
proc IsAddressInMyRealm { ii } {
    if { [string equal $ii "0.0.0.0"] } { return false }
    if { [string equal $ii "127.0.0.1"] } { return false }
    foreach j  $::targetList  {
	set bg [ lindex $j 0 ]
	set en [ lindex $j 1 ]
	if { [ IsIpAddrInRange $ii $bg $en ] } {
    	    return true
	}
    }
    return false
}
#############################################################
# 
#
proc IsSnmpAgent  { ip comm } {
    set rez [ SnmpNGet $ip $comm $::MIB(sysObjectID) ]
    if {  $rez =="" } {
	return false
    }    
    set ::Discovery::nodesArray(eoid,$ip) [ lindex $rez end ]
    set ::Discovery::nodesArray(descr,$ip) [ lrange [ SnmpNGet $ip $comm $::MIB(sysDescr) ] 1 end ]    
    set ::Discovery::nodesArray(isrouter,$ip) [ lindex [ SnmpNGet $ip $comm $::MIB(ipForwarding) ] end ]    
    return true
}
#############################################################
#
#
proc ResolveIp { ip } {
    catch { exec $::host_command $ip } rez
    if { [ regexp {IN-ADDR\.ARPA} $rez ] } {
	return [ lindex [split $rez " "] end ] 
    } else {
	return $ip
    }
}
#############################################################
#
#
proc ProcessSingleIp { ip pass } {
    if { [ IsAddressInMyRealm $ip ]  } { } else { return }
    if { [lsearch -exact $::Discovery::visitedIps $ip ] >= 0 } { return }
    if { [ string equal [lindex $::Discovery::discovery_exitFlag 0] "KILLED" ] } { return }
    #
    set ::Discovery::nodesArray(name,$ip) [ ResolveIp $ip ]
    set ::Discovery::progress [concat [msgcat::mc "Checking "]  $::Discovery::nodesArray(name,$ip) "\[$ip\]" ]    
    #
    if { [info exists ::Discovery::snmpArray($ip) ] } {
	set comm $::Discovery::snmpArray($ip)
    } else {
	set comm $::node_getCommunity
    }
    #
    if { ![IsSnmpAgent $ip $comm ] } {
	lappend ::Discovery::visitedIps  $ip
	return
    }
    set ::Discovery::progress [concat [msgcat::mc "Getting SNMP tables from"]  $::Discovery::nodesArray(name,$ip) "\[$ip\]" ]    
    # remember, this IP HAS snmp agent. 
    set ::Discovery::nodesArray(snmpget,$ip) $comm
    set my_addresses [ GetAliases $ip $comm ]
    # remember, this IP HAS many interfaces or aliases
    set ::Discovery::nodesArray(aliases,$ip) $my_addresses
    foreach ix $my_addresses {   lappend ::Discovery::visitedIps  $ix    } 
    set rList [list]
    foreach lip [ GetIpFromRouterTables $ip $comm ] {
	if { [lsearch $lip $::Discovery::visitedIps ] < 0 } { lappend rList $lip }
    }
    incr pass
    foreach lip $rList { ProcessSingleIp $lip $pass }
}
#############################################################
# 
#
proc doDiscovery { } {
    set w .discoveryMonitor
    if {$::targetList == {} } {
	tk_dialog $w.dlg "Discovery"  "Can't do Discovery - no targets defined." error 0 [msgcat::mc "Approve" ]
	return
    }
    set ::Discovery::seedList [list]
    array unset ::Discovery::nodesArray
    array unset ::Discovery::snmpArray 
    array set ::Discovery::nodesArray	[list]
    array set ::Discovery::snmpArray 	[list]
    foreach i $::snmpList {
    	set ip [lindex $i 0]
	set ::Discovery::snmpArray($ip) [lindex $i 1]
    }
    set ::Discovery::discovery_exitFlag ""
    set wb  $w.buttonFrame
    set wb2 $w.buttonFrame2
    set wt  $w.tableFrame.table
    $wb.stop configure -state normal
    foreach bt { $wb.start $wb.merge $wb.clear $wb.targets $wb.snmp $wb2.ok } {
        eval $bt configure -state disabled
    }    
    set old_cursor [ $wt cget -cursor ]
    $wt configure -cursor watch
    foreach i $::targetList {
	set st [ lindex $i 0]
	set en [ lindex $i 1]
	if { $en == {} } { set i "$st $st"}
	set ::Discovery::progress [ concat [msgcat::mc "Scaning adresses from "] $st "to" $en  ] 
	catch { eval blt::bgexec ::Discovery::discovery_exitFlag \
	        -output ::Discovery::tmpAlive 	\
		$::fping_command [ join $i ] 			
	}
	set exit_type [lindex $::Discovery::discovery_exitFlag 0]
	if { [ string equal [lindex $::Discovery::discovery_exitFlag 0] "KILLED" ] } {    break    }
	foreach j [split $::Discovery::tmpAlive "\n"] { lappend ::Discovery::seedList $j }
    }
    foreach lip $::Discovery::seedList { 
	ProcessSingleIp $lip 0 
	if { [ string equal [lindex $::Discovery::discovery_exitFlag 0] "KILLED" ] } {    break    }
	update idletasks
    }
    #
    foreach ii [ array names ::Discovery::nodesArray "name,*" ] {
	set ip [ lindex [ split  $ii ","] end ]
	if { [lsearch -exact [ array get ::Discovery::dArray] $ip ] < 0 } {
	    set nrows [ $wt cget -rows ]
	    incr nrows
	    $wt configure -rows $nrows        
    	    set ::Discovery::dArray($::Discovery::idx,0) $ip
    	    set ::Discovery::dArray($::Discovery::idx,1) $::Discovery::nodesArray(name,$ip)
	    set ndescr ""
	    if { [info exists ::Discovery::nodesArray(descr,$ip)] } {
		set ndescr "$::Discovery::nodesArray(descr,$ip)"
	    } 
	    if { [info exists ::Discovery::nodesArray(mac,$ip)] } {
		set ndescr "$ndescr\nMAC=$::Discovery::nodesArray(mac,$ip)"
	    } 
	    if { [info exists ::Discovery::nodesArray(isrouter,$ip)] } {
		set ndescr "$ndescr\nROUTERMODE=$::Discovery::nodesArray(isrouter,$ip)"
	    }	    
	    if { [info exists ::Discovery::nodesArray(aliases,$ip)] } {
		set ndescr "$ndescr \nALIASES=$::Discovery::nodesArray(aliases,$ip)"
	    }	    
	    if { $ndescr != "" } { set ndescr "$ndescr\n" }
    	    set ::Discovery::dArray($::Discovery::idx,2) $ndescr
	    incr ::Discovery::idx	    
	}
    }
    #
    $wb.stop configure -state disabled
    foreach bt { $wb.start $wb.merge $wb.clear $wb.targets $wb.snmp $wb2.ok } {
	eval $bt configure -state normal
    }
    $wt configure -cursor $old_cursor
    set ::Discovery::progress [concat [msgcat::mc "Discovery finished at"] [clock format [clock seconds]] ]
}
#
proc LoadDevTable { } {
    if { [ catch { open $::DevTable r } fd ] } {
	puts stderr "Can't open DEVTABLE $::DevTable : $fd "	
	return
    }
    set devt [read $fd]
    close $fd
    regsub -all  -- {[ 	]+}   $devt  " " devt1
    foreach str [ split $devt1 "\n"] {
	set oid [ lindex $str 0 ]
	set icon [ lindex $str 1 ]	
	if { [string index $oid 0] == "#" } {
	} elseif {$oid != "" } {
	    if { [ lsearch -exact [array names ::arIcons] $icon ] >=0 } {
		set ::Discovery::devArray(icon,.$oid) $icon	
	    }
	}
    }
}
#
proc UnknownDevice { } { }
#
proc mergeToMap { tbl } {
    global  snmpList tcl_platform
    global nodeIcon node_ip node_descr node_snmpget startX startY nodeFont \
	nodeFontColor node_key node_getCommunity
    global h_autoplacement w_autoplacement

    set idxs [ lsort [ $tbl tag row sel ] ]
    if { $idxs == "" } {
	tk_dialog $tbl.nohosts [msgcat::mc "Discovery Monitor"] \
	    [msgcat::mc "No Hosts Selected!"] \
	    error 0 [msgcat::mc "Approve"]
	    return
    }	
    LoadDevTable    
    array set ::Discovery::snmpArray 	[list]
    foreach i $::snmpList {
    	set ip [lindex $i 0]
	set ::Discovery::snmpArray($ip) [lindex $i 1]
    }			
    set scroll_reg [ grid bbox .grid 0 0 0 0 ]
    set curr_width [expr [lindex $scroll_reg 2] - [lindex $scroll_reg 0] ]
    set i_w [image width $::arIcons($nodeIcon)]
    set i_h [image height $::arIcons($nodeIcon)]
    set ::startX 0
    set ::startY 0
    # AutoPlace new nodes below all known objects
    set bgimg_id [ .canvas find withtag bgimage ]
    foreach obj [.canvas find all] {
	if { $obj != $bgimg_id } { 
	    set bounds [.canvas bbox $obj ]
	    set rdy [lindex $bounds 3]
	    if { $rdy > $startY } { set startY $rdy } 
	}
    }
    set ::startY [expr $::startY + $h_autoplacement ]
    foreach i $idxs {
	if { $::supressDomain && ![IsValidIpAddr $::Discovery::dArray($i,1) ]  } {
	    set name [lindex [split $::Discovery::dArray($i,1) {.} ] 0 ]
	    if { [info exists ::node_key($name)] } {
		if { $::node_ip($::node_key($name)) != $::Discovery::dArray($i,0) } {
		    set name $::Discovery::dArray($i,1)
		}
	    }	    
	} else {
	    set name $::Discovery::dArray($i,1)
	} 	    
        if {![info exists ::node_key($name)] } {
    	    set startX  [ expr  $startX + $w_autoplacement ]
	    if { $startX >= $curr_width } {
		set startX  $w_autoplacement
    		set startY [expr $startY + $h_autoplacement  ]
    	    }
	    #
	    set tmp_ip $::Discovery::dArray($i,0)
	    set icon $::nodeIcon
	    if { [ info exists ::Discovery::nodesArray(eoid,$tmp_ip)] } {	
		if { [ info exists ::Discovery::devArray(icon,$::Discovery::nodesArray(eoid,$tmp_ip))] } {	
		    set icon $::Discovery::devArray(icon,$::Discovery::nodesArray(eoid,$tmp_ip))
		}
	    }	    
	    #                                   na        X       Y       icon     font        fontColor
	    set hostKey  [ CreateNodeNoUpdate $name  $::startX $::startY  $icon  $::nodeFont  $::nodeFontColor ]
	    set ::node_ip($hostKey) $::Discovery::dArray($i,0)
	    set mark [ concat  "<<!>> Object Discovered by" $tcl_platform(user) "at" [clock format [clock seconds]] ]
	    set ::node_descr($hostKey) "$::Discovery::dArray($i,2) $mark"
	    if { [ info exists ::Discovery::nodesArray(snmpget,$tmp_ip)] } {	
		set ::node_snmpget($hostKey) $::Discovery::nodesArray(snmpget,$tmp_ip)
		set  ::node_snmptrapslist($hostKey) "generic"
	    } else {
		set ::node_snmpget($hostKey) $::node_getCommunity
	    }
	    if { [ info exists ::Discovery::nodesArray(isrouter,$tmp_ip)] } {	
		if { [string match [string trim $::Discovery::nodesArray(isrouter,$tmp_ip)] "forwarding"] } {
		    lappend  ::node_methodslist($hostKey) [list Method router "\"$::node_snmpget($hostKey)\"" ]
		}
	    }
	}
    }
    updateScrollRegion {}    
}
#
lappend ::GUI_pregenerate_list [list { discoveryMonitor_GUIconstructor } {Loading Discovery dialog...}]
