#!./snmpwish -f
#
# mib-tree: Mr. Mib Walker  Version $ver 
#           
#
# -----------------------------------------------------------------------------
# Copyrights 1993 Subodh Nijsure, and creators of Tcl/Tk, tree widget, snmptcl
# 
# 
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted,
# provided that the above copyright notice appear in all copies.  No one
# makes no representations about the suitability of this software
# for any purpose.  It is provided "as is" without express or implied
# warranty.
# -----------------------------------------------------------------------------

##############################################################
# These are  some user defined  variables.
#
set ver "1.0" 
set source_dir ""
proc set_source_directory {argv0} {
	global source_dir
	while {0==[string compare link [file type $argv0]] } {
        	set link [file readlink $argv0]
        	if {![string match /* $link]} {
                	set argv0 [file dirname $argv0]/$link
        	} else {
                	set argv0 $link
        	}
	}
        set base [file dirname $argv0]
       return $base
}
set source_dir [set_source_directory $argv0]

lappend auto_path $source_dir/lib/tk
lappend auto_path $source_dir/lib/tcl

###############################################################
#
# Make sure that the wish has MIB extension in it.
#
if { ![info exists snmp_tcl_status] } {
		wm withdraw .
		tk_dialog .foo "MIB Walker Error" "Current wish doesn't have MIB extention\n Can't continure the execution " error -1 OK
		exit 1
}
if { $snmp_tcl_status != 1 } {
		wm withdraw .
		tk_dialog .foo "MIB Walker Error" "Couldn't parse the MIB file.\n\no Check your MIBFILE environment variable.\n\no Check the format for the MIB." error -1 OK
		exit 1
}
set current_root  iso 

if { [file exists ./bitmaps/node.xbm] == 1 } {
	set bitmap_name  ./bitmaps/node.xbm 
} elseif { [ file exists $source_dir/bitmaps/node.xbm ] == 1 } {
	set bitmap_name  $source_dir/bitmaps/node.xbm 
} elseif { [ file exists $tk_library/tk/demos/bitmaps/node.xbm ] == 1 } {
	set bitmap_name   $tk_library/tk/demos/bitmaps/node.xbm 
} else {	
	set bitmap_name /disk/tcl/lib/tk/demos/bitmaps/node.xbm 
}

#########################################################################
#
# This proc allows you to save text from a Text widget to a file.
#
# Some misc stuff that I got from net - Subodh Nijsure
proc SaveTextToFile { w filename } {
	set New_Report_File [open "$filename" w]
	scan [$w index end] %d numLines
    for {set i 1} {$i <= $numLines} {incr i} {
        set line [$w get $i.0 $i.1000]
        puts $New_Report_File $line nonewline
      }
	close $New_Report_File
}
#################################################
#
# Show a browser dialog. 
#
proc tkBrowserDialog {  w  } {
	set browser_window .tk_browser_dialog
	set text_widget $browser_window.frame.text
	set scroll_widget $browser_window.frame.scroll
	if { [winfo exists .tk_browser_dialog ] == 0 } {
		toplevel $browser_window
		wm title $browser_window "TK Text Browser Window"
		wm minsize $browser_window 10 10
		wm protocol $browser_window WM_DELETE_WINDOW {
 			wm iconify .tk_browser_dialog
		}
		frame $browser_window.frame -relief groove -bd 2 
		text $text_widget -relief raised -bd 2 -yscrollcommand "$scroll_widget set"	
		scrollbar $scroll_widget -command "$text_widget yview"
		pack $scroll_widget -side right -fill y
		pack $text_widget -side left -fill both 
		frame $browser_window.bframe -bd 2 
		button $browser_window.bframe.close -text "Close " -command { destroy .tk_browser_dialog } 
		button $browser_window.bframe.print -text "Print " -command { SaveTextToFile .tk_browser_dialog.frame.text /tmp/print.out ; exec lp /tmp/print.out } 
		button $browser_window.bframe.saveto -text "Save To browse.out" -command { SaveTextToFile .tk_browser_dialog.frame.text browse.out }

		pack $browser_window.bframe.close $browser_window.bframe.print $browser_window.bframe.saveto -side left -padx 2m -pady 1m -expand 1

		pack $browser_window.bframe -side bottom -pady 1
		pack $browser_window.frame -side top -expand yes -fill both
    } else {
 			wm deiconify .tk_browser_dialog
	}
	$text_widget delete 1.0 end
	scan [$w index end] %d numLines
   	for {set i 1} {$i <= $numLines} {incr i} {
        set line [$w get $i.0 $i.1000]
		$text_widget insert end $line
	}
}
#############################################
##
##
proc showHelpInfo { } {
	global ver
	global source_dir
	set help_window .help_window
	set text_widget $help_window.frame.text
	set scroll_widget $help_window.frame.scroll
	if { [file exists $source_dir/README] == 0 } {
		tk_dialog .foo "MIB Walker Error" "Couldn't locate the $source_dir/README file." error -1 OK
		return
	}
	if { [winfo exists .help_window ] == 0 } {
		toplevel $help_window
		wm title $help_window "Mib-Walker Version $ver"
		wm minsize $help_window 10 10
		wm protocol $help_window WM_DELETE_WINDOW {
 			wm iconify .help_window
		}
		frame $help_window.frame -relief groove -bd 2 
		text $text_widget -relief raised -bd 2 -yscrollcommand "$scroll_widget set"	
		scrollbar $scroll_widget -command "$text_widget yview"
		pack $scroll_widget -side right -fill y
		pack $text_widget -side left -fill both 
		frame $help_window.bframe -bd 2 
		button $help_window.bframe.close -text "Close " -command { destroy .help_window } 
		button $help_window.bframe.print -text "Print " -command { SaveTextToFile .help_window.frame.text /tmp/print.out ; exec lp /tmp/print.out } 
		pack $help_window.bframe.close $help_window.bframe.print -side left -padx 2m -pady 1m -expand 1

		pack $help_window.bframe -side bottom -pady 1
		pack $help_window.frame -side top -expand yes -fill both
		$text_widget delete 1.0 end
		set fd [ open $source_dir/README ] 
		while { ![eof $fd] } {
			$text_widget insert end [read $fd 1000]
		}
		close $fd	
				
    } else {
 			wm deiconify .help_window
    }
}

proc create_mib_tree {tree {text_action ""} {text_select_action} {bitmap_action}} {

    global tree_private
    tree $tree

    set tree_private($tree,text_action) $text_action
    set tree_private($tree,bitmap_action) $bitmap_action
    set tree_private($tree,text_select_action) $text_select_action 

    tree_set_default_bindings $tree

    return $tree
}


set font_name 9x15
set peer_name "foobar-ss10"
set read_comm "public"
set rw_comm "private"

###################################################
# Some utilty procedures. from tk/demos
#
proc insertWithTags {w text args} {
    set start [$w index insert]
    $w insert insert $text
    foreach tag [$w tag names $start] {
        $w tag remove $tag $start insert
    }
    foreach i $args {
        $w tag add $i $start insert
    }
}
####################################################
#
# Set the busy cursor
#
proc set_busy_cursor { { w "." } } {
	set list [winfo children $w]	
	foreach w $list {
			set_busy_cursor $w
			set foo [ catch {$w configure -cursor watch} ]
	}
	update idletasks
}
###################################################
#
# Set the normal left arrow cursor
#
proc set_normal_cursor { { w "."} } {
	set list [winfo children $w]	
	foreach w $list {
			set_normal_cursor $w
			set foo [ catch {$w configure -cursor left_ptr} ]
	}
	update idletasks
}

####################################################
#
# Clears the text from the specified text widget.
#
#
proc clear_text { w } {
	$w delete 1.0 end
}

#####################################################################
#
# This procedure asks for agent name, comm strings.
#
#
proc askInput { {info_text} } {
    global font_name
    toplevel .w -relief raised  
    wm title .w "SNMP Device Info Dialog"
    wm iconname .w "Form"
    wm minsize .w 10 10
	upvar #0 peer_name device_name
	upvar #0 read_comm r_comm
	upvar #0 rw_comm write_comm
    
    message .w.msg -font $font_name -width 4i -justify left \
	    -text "$info_text" -aspect 100 
	pack .w.msg -side top -fill x -padx 2m -pady 2m

    frame .w.name -relief groove -bd 2 
    entry .w.name.entry -relief sunken -borderwidth 3 
	.w.name.entry insert @0 $device_name
    label .w.name.label
	pack .w.name.label -side left
	pack .w.name.entry -side right -fill x -expand 1

	pack .w.name -side top -fill x -pady 2m


    frame .w.read -relief groove -bd 2 
    entry .w.read.entry -relief sunken -borderwidth 3 
	.w.read.entry insert @0 $r_comm
    label .w.read.label
	pack .w.read.label -side left
	pack .w.read.entry -side right -fill x -expand 1

	pack .w.read -side top -fill x -pady 2m

    frame .w.rw -relief groove -bd 2 
    entry .w.rw.entry -relief sunken -borderwidth 3 -text $write_comm
	.w.rw.entry insert @0 $write_comm
    label .w.rw.label
	pack .w.rw.label -side left
	pack .w.rw.entry -side right -fill x -expand 1

	pack .w.rw -side top -fill x -pady 2m

    .w.name.label config -text "Device  Name:    "
    .w.read.label config -text "Read  Community:"
    .w.rw.label config -text   "Write Community:"

    button .w.ok -text " OK " -command {
	upvar #0 peer_name device_name
	upvar #0 read_comm r_comm
	upvar #0 rw_comm write_comm
        set device_name [ .w.name.entry get ]
        set read_comm [ .w.read.entry get ]
        set rw_comm [ .w.read.entry get ]
        destroy .w 
    }
	bind .w.name.entry <Return> {
	upvar #0 peer_name device_name
	upvar #0 read_comm r_comm
	upvar #0 rw_comm write_comm
        set device_name [ .w.name.entry get ]
        set read_comm [ .w.read.entry get ]
        set rw_comm [ .w.read.entry get ]
        destroy .w 
    }


    button .w.cancel -text Cancel -command "destroy .w"
	pack .w.ok .w.cancel -side left -expand 1 -padx 2m -pady 1m -ipadx 1m -ipady 2m
    grab set .w
    tkwait window .w
}
########
# Internal global variable user shouldn't touch this.
set display_text 1
###################################################
#
# Create the menubar, a lot of yyp stuff here.
proc create_menubar { tree canvas } {
    set menubar [frame .menu -relief raised -bd 2]
    pack $menubar -side top -fill x -ipady 1m

    # file menu
    set mb  [menubutton $menubar.file -text "File" -menu $menubar.file.m]
    set m [menu $mb.m]

    pack $mb -side left -padx 1m -ipadx 1m
    $m add command -label "Print" -command {print_tree $canvas}
    $m add command -label "Print Rotated" -command {print_tree $canvas 1}
    $m add command -label "Exit" -command {destroy .}

    # view menu
    set mb  [menubutton $menubar.view -text "View" -menu $menubar.view.m]
    set m [menu $mb.m]
    pack $mb -side left -padx 1m -ipadx 1m
    $m add command -label "Toggle Tree Layout" \
    -command "tree_toggleLayout $tree"
    $m add command -label "Current Node as Root" \
    -command "make_current_selection_root $tree"
    $m add command -label "Show Parent" -command {show_parent $tree}
    $m add checkbutton -label "Show Text" -variable display_text  -command {manage_text }

    # Connect menu
    set mb  [menubutton $menubar.connection -text "Connection" -menu $menubar.connection.m]
    set m [menu $mb.m]

    pack $mb -side left -padx 1m -ipadx 1m
    $m add command -label "Open" -command {open_snmp_conn }
    $m add command -label "Close" -command {close_snmp_conn }

    # Help menu
    set mb  [menubutton $menubar.help -text "Help" -menu $menubar.help.m]
    set m [menu $mb.m]

    pack $mb -side right -padx 1m -ipadx 1m
    $m add command -label "Help..."  -command { showHelpInfo }
    $m add command -label "About"  -command { show_version }
	
}
##############################################################
#
# This procedure maps and unmaps the two text widgets.
#
proc  manage_text {  } {
	global display_text value_frame
	if { $display_text == 1 } {
		pack .desc_frame -in . -side top -fill x
		set peer_open [info commands peer]
		if { $peer_open != "" }  {
			pack $value_frame -in . -side top -fill x 
		}
	} else {
		pack forget .desc_frame 
		set peer_open [info commands peer]
		if { $peer_open != "" }  {
			pack forget $value_frame
		}
	}
}
##############################################################
#
# Open the snmp connection
#
proc open_snmp_conn {} {
	global peer_name read_comm rw_comm value_text value_frame
	set peer_open [info commands peer]
	if { $peer_open != "" }  {
		tk_dialog .foo "MIB Walker Error" "You already have a connection open to $peer_name.\n Please close that connection first." error -1 OK
		return
	}
	askInput "Enter name of the device to open SNMP connection with.\nAlso enter correct community strings" 
	set open_error [catch { snmp open -v 1 peer $peer_name $read_comm } ]
	if { $open_error == 1 } {
	tk_dialog .foo "MIB Walker Error" "Couldn't open connection to $peer_name" \
error -1 OK
	} else {
		set foobar [ peer get 1.1.0 ] 
		if { $foobar == "" } {
	tk_dialog .foo "MIB Walker Error" "Host name $peer_name doesn't respond" \
error -1 OK
			peer close
		} else {
			global ver
			global display_text value_text
			wm title . "MIB Walker Version $ver \[ connected to $peer_name\]"
			if { $display_text == 1 } {
				pack $value_frame -in . -side top -fill x 
				clear_text $value_text				
			}
		}
	}
}
##############################################################
#
# Close the snmp connection
#
proc close_snmp_conn {} {
	global value_frame ver
	peer close
	wm title . "MIB Walker Version $ver" 
	pack forget $value_frame
} 

##############################################################
#
# Show the version info.
#
proc show_version { } {
	global ver
	set version_info "$ver"
	tk_dialog .foo "MIB Walker Version Info" \
"MIB Walker ($version_info)\n\n This MIB Walker is created using\n\no Tcl 7.3, Tk3.6\no CMU SNMP extension\no Tree widget by Allan Brighton\no MIB extension by Subodh.\n\nAny problems, suggestions send e-mail to snijsure@cisco.com\n" "" -1 OK
}

##############################################################
#
# Print the tree.
#
proc print_tree { w {rotate "0"} } {
	# Default value for rotate will be 0.
	$w select clear
#This is way cool.  
	$w postscript -file /tmp/mib-tree.ps -rotate $rotate
	exec lp /tmp/mib-tree.ps &
}

##########################################################################
#
# Remove the oid crap from the received data string and print it
# to the browser.
# Need to display tables with little bit more intelligent manner, some day
proc parse_and_insert { in_value } {
	global value_text
	regsub "\{" $in_value "" value	
	set text_end [ string last null $value]
	if { $text_end != -1 } {
		incr text_end -1
		set set_text [ string range $value 0 $text_end ]
	} else {
		set set_text $value
	} 
# OK at this time we have removed the "null" stuff from output. 
	set has_double_quote 0

	set is_string [ string first string $set_text]
	if { $is_string != -1 } { set is_string 1 } 

	set is_hex [ string first hex $set_text]
	if { $is_hex != -1 } { set is_hex 1 } 

	if { $is_string == 1 } {
		regsub string $set_text "" foobar	
		set foobar1 [ string trim $foobar ]	
		set last_pos  [ string last "\"" $foobar1 ]
		set s_value [ string range $foobar1 0 $last_pos]
		set last_pos  [ string last " " $foobar1 ]
		set inst_name [ string range $foobar1 $last_pos end]
		set foobar1 [ format "%-55s %-20s" $inst_name $s_value ]
		$value_text insert end $foobar1
		$value_text insert end "\n" 
		return
    } 
	if { $is_hex == 1 } {
		regsub hex $set_text "" foobar	
		set foobar1 [ string trim $foobar ]	
		set last_pos  [ string last "\"" $foobar1 ]
		set hex_value [ string range $foobar1 0 $last_pos]
		set last_pos  [ string last " " $foobar1 ]
		set inst_name [ string range $foobar1 $last_pos end]
		set foobar1 [ format "%-55s %-20s" $inst_name $hex_value ]
		$value_text insert end $foobar1
		$value_text insert end "\n" 
		return
    } 
	if { $set_text == "done" || $set_text == "{Success}" || $set_text == "{No_Such_name}" } {
		$value_text insert end $set_text
	} else { 
		set fname ""
		set actual_value ""
		set foobar [ catch {scan $set_text "%s %s %s %s" actual_value type oid fname} ]
		if { $fname != "" && $actual_value != "" } {
			set foobar [ format "%-55s %-20s" $fname $actual_value ]
			$value_text insert end $foobar 
		} else {
			$value_text insert end $set_text
		}
	}
	$value_text insert end "\n" 
}

###########################################################################
#
# This proc is called everytime we get response from agent during MIB walk.
#
proc walk_proc { value } {
	parse_and_insert $value
	update idletasks
}

##########################################################################
#
# This procedure is called when user double clicks on text of the node
# Checks if the nore is table or other type in that case a snmpwalk is
# started for that node
# For simple types like DisplayString, integer etc snmpget nodename.0 is done.
#
#
proc text_action {tree} {
	global value_text 
	set peer_open [info commands peer]
	if { $peer_open != "" } {
    	set cur_selection [tree_getCurrent $tree]
		set full_info [ mib get_info $cur_selection ]
		if { $full_info != "" } {
			scan $full_info "{%s %s %s}" tmp1 type oid 
			if { $type == "other" || $type == "table" } {
				set_busy_cursor
				$value_text insert end "Begin snmpwalk $oid"
				$value_text insert end "\n"
		 		peer walk $oid walk_proc	
				set_normal_cursor
			} else {
				set_busy_cursor
				$value_text insert end "snmpget $oid.0"
				$value_text insert end "\n"
				set foobar [ peer get $oid.0 ]
				parse_and_insert $foobar
				set_normal_cursor
			}
		} else {
			set_busy_cursor
			update idletasks
			peer walk .1  walk_proc
			set_normal_cursor
		}
	} else {
			puts stdout "Open connection to some host" 
	}
}

###########################################################
#
# This procedure is called when text is selected. Description for that
# node is show.
#
proc text_select_action {tree} {
	global desc_text desc_frame boldtag  normaltag
	$desc_text configure -state normal 
	clear_text $desc_text
#	$desc_text delete 1.0 end 
    set cur_selection [tree_getCurrent $tree]
	set full_info [ mib get_info $cur_selection ]
	if { $full_info != "" } {
		set foo [ string first \" $full_info]
		incr foo 1
		set len [ string length $full_info]
		incr len -5
		set desc [ string range $full_info $foo $len] 	
		scan $full_info "{%s %s %s}" tmp1 type oid 

		insertWithTags  $desc_text {Name } 	boldtag
		insertWithTags  $desc_text $cur_selection normaltag
		insertWithTags  $desc_text "\n" normaltag

		insertWithTags  $desc_text {OID } 	boldtag
		insertWithTags  $desc_text $oid normaltag
		insertWithTags  $desc_text "\n" normaltag
		insertWithTags  $desc_text {Type } 	boldtag
		insertWithTags  $desc_text $type normaltag
		insertWithTags  $desc_text "\n" normaltag
		if { $desc == "(null)" } {
			$desc_text insert 5.0 "No description available for this node in the MIB." 
		} else {	
			$desc_text insert 5.0 $desc
		}
	} else {
		insertWithTags  $desc_text {Name } 	boldtag
		insertWithTags  $desc_text $cur_selection normaltag
	}
	$desc_text configure -state disabled 
}

proc make_current_selection_root { tree } {
	global current_root
    set cur_selection [tree_getCurrent $tree]
	set current_root $cur_selection
	$tree root $cur_selection 
	$tree draw
	tree_center $tree
}

#########################################################################
# called when bitmap of a node is double-clicked
# Either the node is collapsed or expanded.
#
proc bitmap_proc {tree} {
	global bitmap_name
    set cur_selection [tree_getCurrent $tree]
	if { [ $tree isleaf $cur_selection ] } {
		set_busy_cursor
		update idletasks
		set child_list [mib	lchildren $cur_selection]
		foreach node $child_list {
			tree_addNode $tree $cur_selection $node $bitmap_name
			$tree draw
			tree_center $tree
		}	
		set_normal_cursor
		update idletasks
	} else {
		$tree prune $cur_selection
		$tree draw
		tree_center $tree
	}
}

proc show_parent { tree } {
	global current_root bitmap_name
	if {  $current_root != "iso" } {
		set tmp_parent  [mib parent $current_root] 
		tree_addNode $tree "" $tmp_parent $bitmap_name
		$tree movelink $current_root $tmp_parent
	 	$tree root $tmp_parent
		set current_root $tmp_parent
    	$tree draw
    	tree_center $tree
	} else {
		puts stdout "You are already at the root!!"
	}
}

proc create_tree { tree } {
	global bitmap_name argc argv
	create_mib_tree $tree "text_action $tree" "text_select_action $tree" "bitmap_proc $tree"
	$tree config -layout horizontal
	# add the root node
	if { $argc > 0 } {
		global current_root
    	set arg1 [ lindex $argv 0 ]
		tree_addNode $tree "" $arg1 $bitmap_name 
		set current_root $arg1 
	} else {
		tree_addNode $tree "" "iso" $bitmap_name 
	}
}


wm title . "MIB Walker Version $ver"
wm minsize . 10 10 
# Set the names of critical widgets. 
set canvas .tree_frame.canvas
set tree .tree_frame.canvas.tree

create_menubar $tree $canvas
frame .tree_frame -relief ridge -bd 2

canvas .tree_frame.canvas -scrollregion "0 0 0 0" -selectbackground white
#-width 15c -height 10c
set vscroll [scrollbar .tree_frame.vscroll \
        -relief sunken \
        -command "$canvas yview"]
set hscroll [scrollbar .tree_frame.hscroll \
        -orient horiz \
        -relief sunken \
        -command "$canvas xview"]
$canvas config -xscroll "$hscroll set" -yscroll "$vscroll set"

pack $hscroll -side bottom -fill x 
pack $vscroll -side right -fill y
pack $canvas -in .tree_frame -expand yes -fill both
#pack $canvas  -fill both

pack .tree_frame -side top -fill both -expand yes
create_tree $tree
tkwait visibility $canvas
$tree draw
tree_center $tree

$canvas configure -background #a3af96 -selectbackground gray22 

set desc_frame .desc_frame 
frame .desc_frame -bd 2 -relief sunken 

text .desc_frame.text -height 8 -wrap word -yscroll ".desc_frame.vscroll set" -setgrid 1
scrollbar .desc_frame.vscroll -relief flat -command ".desc_frame.text yview"
pack .desc_frame.vscroll -side right  -fill y  
pack .desc_frame.text -side top  -fill x  
pack .desc_frame -in . -side top -fill x
.desc_frame.text tag configure boldtag -font 10x20  -foreground blue
.desc_frame.text tag configure normaltag -font 9x15  
set desc_text .desc_frame.text

frame .value_frame -bd 2 -relief sunken 
frame .value_frame.f -bd 2 -relief sunken 
text .value_frame.f.text  -height 5 -wrap word -width 60 -yscrollcommand ".value_frame.f.vscroll set " 
scrollbar .value_frame.f.vscroll -relief flat -command ".value_frame.f.text yview"

pack .value_frame.f.vscroll -side right  -fill y  
pack .value_frame.f.text -side top  -fill x  
pack .value_frame.f -side top -fill x -expand true
#pack .value_frame -side top -fill x

set value_frame .value_frame 
set value_text .value_frame.f.text

frame .value_frame.fb  -relief flat -bd 1 
button .value_frame.fb.browser  -text "Browser..." -command { tkBrowserDialog $value_text }
button .value_frame.fb.clean  -text "Clear Text" -command { clear_text $value_text }
pack .value_frame.fb.browser .value_frame.fb.clean -side right -padx 2m -ipadx 3m
pack .value_frame.fb -side bottom -fill x -expand true
