#!/bin/sh
# the next line restarts using wish -*- tcl -*- \
    exec wish4.1 "$0" "$@"

# mibwander v2.0 
# This is a tcl gizmo to wander around the mibs provided by the scotty package
# It will also wander around the mib on an snmp demon on a different host.
# Use with care. Only tested on an SNMPv1 deamon. Comments especially welcome.

package require Tnm 2.1

proc ScrolledListbox2 { parent args } {
    frame $parent
    # Create listbox attached to scrollbars, pass thru $args
    eval {listbox $parent.list \
	      -yscrollcommand [list $parent.sy set] \
	      -xscrollcommand [list $parent.sx set]} $args
    scrollbar $parent.sy -orient vertical \
	-command [list $parent.list yview]
    # Create extra frame to hold pad and horizontal scrollbar
    frame $parent.bottom
    scrollbar $parent.sx -orient horizontal \
	-command [list $parent.list xview]
    # Create padding based on the scrollbar width and border
    set pad [expr [$parent.sy cget -width] + 2* \
		 ([$parent.sy cget -bd] + \
		      [$parent.sy cget -highlightthickness])]
    frame $parent.pad -width $pad -height $pad
    # Arrange everything in the parent frame
    pack $parent.bottom -side bottom -fill x
    pack $parent.pad -in $parent.bottom -side right
    pack $parent.sx -in $parent.bottom -side bottom -fill x
    pack $parent.sy -side right -fill y
    pack $parent.list -side left -fill both -expand true
    return $parent.list
}


proc ListSelect { parent choices } {
    # Create two lists side by side
    frame $parent -bg white
    ScrolledListbox2 $parent.choices -setgrid 1
    ScrolledListbox2 $parent.picked  -setgrid 1
    pack $parent.choices -side left \
	-expand false -fill both
    pack $parent.picked -side right \
	-expand true -fill both
    
    # Selecting in choice moves items into picked
    bind $parent.choices.list <ButtonPress-1> \
	{ListSelectStart %W %y}
    bind $parent.choices.list <B1-Motion> \
	{ListSelectExtend %W %y}
    bind $parent.choices.list <ButtonRelease-1> \
	[list ListSelectEnd %W %y $parent.picked.list]
    
    # Selecting in picked deletes items
    bind $parent.picked.list <ButtonPress-1> \
	{ListSelectStart %W %y}
    bind $parent.picked.list <B1-Motion> \
	{ListSelectExtend %W %y}
    bind $parent.picked.list <ButtonRelease-1> \
	[list ListDeleteEnd %W %y $parent.choices.list]
    
    # Insert all the choices
    # eval is used to construct a command where each
    # item in choices is a separate argument
    eval {$parent.choices.list insert 0}  $choices
}


proc ListSelectStart { w y } {
    $w select anchor [$w nearest $y]
}
proc ListSelectExtend { w y } {
    $w select set anchor [$w nearest $y]
}
proc ListSelectEnd {w y list} {
    $w select set anchor [$w nearest $y]
    FillListbox $w $list
}

proc ListDeleteEnd {w y list} {
    global current

    set width 20
    $w select set anchor [$w nearest $y]
    $list delete 0 end
    foreach i [$w curselection] {
	set text [$w get $i]
	$list insert end $text
	if {[string length $text] > $width} {
	    set width [string length $text]
	}
    }
    $list select set 0 end
    if {$width > 50} {set width 50}
    $list configure -width $width
    FillListbox $list $w
}

proc FillListbox {source target} { 
    global exists session current verbose edit_list

    set item "No children"
    set child_list2 {}
    set edit_list {}
    $target delete 0 end
    foreach i [$source curselection] {
	if ($verbose) {puts "MIB SUCCESSOR: $i"}
	if {[catch {mib successor [$source get $i] } child_list]} {
	    #	    puts "Error case: $child_list"
	    lappend edit_list [$source get $i]
	    continue
	    #	    return
	}
	if ($verbose) {puts "MIB RET: $child_list"}
	set current [$source get $i]
	if {$exists == 1} {
	    set child_list2 {}
	    foreach item $child_list {
		if ($verbose) {puts "GETNEXT: .$item"}
		if [catch {$session getnext $item} next] {
		    ErrorHandle $next
		    return
		}
		if ($verbose) {puts "RET: $next"}
		set oid [lindex [lindex $next 0] 0]
		set name [mib name $oid]
		if {[has_parent $item $name]} {
		    lappend child_list2 $item
		}
	    }
	} else {
	    set child_list2 $child_list
	}
	if {$child_list2 ==""} {
	    if {$exists == 1} {
		$session walk result [$source get $i] {
		    if ($verbose) {puts "WALK: $result"}
		    foreach object $result {
			if ($verbose) {puts "RET: $object"}
			set oid [lindex $object 0]
			set val [lindex $object 2]
			$target insert end "[mib name $oid] = $val"
		    }
		}
	    } else {
		$target insert end "[$source get $i] has no Children"
	    }
	} else {
	    foreach item $child_list2 {
		$target insert end [ExpandName $item] 
	    }
	}
    }
}



proc ExpandName {name} {
    global verbose

    #    if {$name =="No children"} {return $name}
    if ($verbose) {puts "MIB SUCCESSOR: $name"}
    catch {mib successor $name} n
    if ($verbose) {puts "MIB RET: $n"}
    if {[llength $n] == 1} {
	ExpandName $name.$n
    } else {
	return $name
    }
}

proc has_parent {ancestor child} {
    global verbose

    if {$child == ""} {
	return false 
    }
    if {[regexp $ancestor $child]} {
	return true
    } else {
	if ($verbose) {puts "MIB PARENT: $child"}
	set result [mib parent $child]	
	if ($verbose) {puts "MIB RET: $result"}
	has_parent $ancestor $result
    }
}


# this procedure is a disgusting horrible HACK!!!!!
proc Display_Parent {} {
    global current verbose
    
    if ($verbose) {puts "MIB PARENT: $current"}
    set current [mib parent $current]
    if ($verbose) {puts "MIB RET: $current"}
    if {$current == ""} {set current iso}

    set w .f.choices.list
    set list .f.picked.list
    $w delete 0 end
    $w insert end $current
    $w select set 0 end
    FillListbox $w $list
}

proc Manage_sessions {} {
    global exists session setting verbose

    if {$exists == 0} {
	$session destroy
	if ($verbose) {puts "SNMP SESSION END: $session"}
    } else {
	if [catch {snmp session -address $setting(address)} session] {
	    ErrorHandle $session
	    set $setting(address) 127.0.0.1
	    .menubar.exists deselect
	    return
	}
	if ($verbose) {puts "SNMP SESSION BEGIN: $session"}
	if {[config_session $session] == "cancel"} {
	    $session destroy
	    if ($verbose) {puts "SNMP SESSION END: $session"}
	    set exists 0
	}
    }
}

proc config_session {session} {

    global exit_code setting verbose

    toplevel .d
    wm transient .d
    wm title .d "Snmp session settings"

    foreach config_setting {community writecommunity address \
				port version timeout retries delay} {
	if ($verbose) {puts "SNMP SESSION CGET: $session $config_setting"}
	set setting($config_setting) [$session cget -$config_setting]
	if ($verbose) {puts "SNMP SESSION RET: $setting($config_setting)"}
    }

    ShowEntry .d setting(community) "Community:"
    ShowEntry .d setting(writecommunity) "Write Community:"

    ShowEntry .d setting(address) "Host:"
    ShowEntry .d setting(port) "Port:"

    ShowNumericalEntry .d setting(timeout) "Timeout (secs):" 1
    ShowNumericalEntry .d setting(retries) "Retries: (attempts):" 1
    ShowNumericalEntry .d setting(delay) "Delay (ms):" 50

    ShowChoices .d setting(version) "Version:" {SNMPv1 SNMPv2C SNMPv2U}
    
    frame .d.action_bar -borderwidth 5
    button .d.action_bar.ok -text "OK"  -command {set exit_code 1} -padx 5
    button .d.action_bar.cancel -text "Cancel" -command {set exit_code 0} -padx 5
    pack .d.action_bar.ok .d.action_bar.cancel -side left
    pack .d.action_bar -side bottom

    tkwait visibility .d
    grab .d
    tkwait variable exit_code
    grab release .d
    destroy .d

    if {$exit_code == 1} {
	foreach index [array names setting] {
	    if [catch {$session configure -$index $setting($index)} result] {
		ErrorHandle $result
	    } else {
		if ($verbose) {puts "SNMP SESSION CONFIGURE: $session -$index $setting($index)"}
	    }
	}
    } else {
	return cancel
    }
    return ok
}

proc ShowEntry {parent varname labeltext} {

    set f [frame $parent.$varname]
    label $f.l -text $labeltext
    entry $f.e -textvariable $varname
    pack  $f.l -side left
    pack $f.e -side right
    pack $f -side top -fill x
    return $f
}

proc ShowLabel {parent varname labeltext args} {

    upvar $varname val
#    array set opts $args
    
    set f [frame $parent.$varname]
    label $f.l -text $labeltext
    eval {label $f.e -text $val} $args
#    foreach index [array names opts] {
#	$f.e configure $index $opts($index)
#    }
    pack  $f.l -side left
    pack $f.e -side right
    pack $f -side top -fill x
    return $f
}

proc ShowNumericalEntry {parent varname labeltext changeval} {

    set f [frame $parent.$varname]
    label $f.l -text $labeltext
    entry $f.e -textvariable $varname -width 4
    button $f.plus -text "+$changeval" -command "incr $varname +$changeval"
    button $f.minus -text "-$changeval" -command "incr $varname -$changeval"
    pack  $f.l -side left
    pack $f.plus -side right
    pack $f.e -side right
    pack $f.minus -side right
    pack $f -side top -fill x
    return $f
}

proc ShowChoices { parent varname labeltext choices args} {
    
    set f [frame $parent.$varname]
    label $f.l -text $labeltext
    pack $f.l -side left
    set b 0

#    array set opts $args

    foreach item $choices {
	eval {radiobutton $f.$b -variable $varname \
		  -text $item -value $item } $args
#	foreach index [array names opts] {
#	    $f.$b configure $index $opts($index)
#	}
	pack $f.$b -side right
	incr b
    }
    pack $f -side top -fill x
    return $f
}

proc ErrorHandle {error} {
    global exit_code setting
    
    toplevel .e
    wm transient .e
    wm title .e "Error!!!"

    switch -glob $error {
	noResponse {set text "$setting(address) is not responding. It could be
a) down due to a network failure or a nonexistent host.
b) not running an SNMP deamon.
c) not running the same version of SNMP deamon for which the session is configured.
d) not responding due to a parameter set in the session options.
e) the bug in scotty that occurs when the community and the write community are different. See scotty_bugs.txt.
I suggest you check everything..."}
	missing* {set text "The parameter specified is bad. It could be
a) not set
b) set to a invalid value (e.g. a negative value)
Please check the session settings."}
"no such host*" {set text "The specified host $setting(address) does not exist or cannot be contacted. Please try again."}
default {set text "There is no further info on this message. Sorry."}
}
label .e.l -text "Error Message: $error"
pack .e.l -side top
message .e.msg  -text $text -aspect 400
pack .e.msg -side top
button .e.ok -text "OK" -command {set exit_code 1}
pack .e.ok -side bottom

tkwait visibility .e
grab .e
tkwait variable exit_code
grab release .e
destroy .e
}


# This procedure still has debug comments in it. This is because it
# will need refining, due to the bug in the Scotty code. See
# scotty_bugs.txt for details.

proc Edit_Values {} {
    global exists exit_code edit_list session val verbose

    if {$exists == 0 } {
	return
    }
    if ![info exists edit_list] {return} 
    if {$edit_list == ""} {
	return
    }

    toplevel .edit
    wm transient .edit
    wm title .edit "Edit and update values"

    frame .edit.action_bar -borderwidth 5
    button .edit.action_bar.ok -text "Update"  -command {set exit_code 1} -padx 5
    button .edit.action_bar.cancel -text "Cancel" -command {set exit_code 0} -padx 5
    pack .edit.action_bar.ok .edit.action_bar.cancel -side left
    pack .edit.action_bar -side bottom

#    puts "editlist = $edit_list"
    set b 0
    foreach item $edit_list {
	set oid [lindex $item 0]
	if {[mib access $oid] != "read-write"} {continue}
	if ($verbose) {puts "GET: .$oid"}
	if [catch {$session get $oid} ret] {
	    ErrorHandle $ret
	} else {
	    if ($verbose) {puts "RET: $ret"}
	}

#	set ret [$session get $oid]
	set ret [lindex $ret 0]
	set type($b) [lindex $ret 1]	
	set val($b) [lindex $ret 2]
	set val_oid($b) $oid

	set syntax [mib syntax $oid]

	switch $syntax {
	    INTEGER {
		set tc [mib tc $oid]
		if {$tc != ""} { 
		    set enum [lindex $tc 3]
#		    puts $enum
		    set choice_cmd  "ShowChoices .edit val($b) $oid {"
		    foreach index $enum {
#			puts $index
			set choice_cmd "$choice_cmd [lindex $index 0]"
		    }
		    set choice_cmd "$choice_cmd}"
#		    puts $choice_cmd
		    eval $choice_cmd

		} else {
		    ShowNumericalEntry .edit val($b) $oid 1 
		}
	    }
	    DisplayString {ShowEntry .edit val($b) $oid }
	    PhysAddress {ShowEntry .edit val($b) $oid }
	    NetworkAddress {ShowEntry .edit val($b) $oid }
	    IpAddress {ShowEntry .edit val($b) $oid }
	    default {puts "$syntax : $tc : $ret not dealt with!"}
	}
	incr b 1
    }



    tkwait visibility .edit
    grab .edit
    tkwait variable exit_code
    grab release .edit
    destroy .edit

    if {$exit_code == 1} {
#	puts "Update clicked"
#	puts $b
	for {set i 0} {$i < $b} {incr i 1} {
#	    puts "$val_oid($i) $val($i)"
	    if ($verbose) {puts "SET: $val_oid($i) $val($i)"}
	    if [catch {$session  set [list [list $val_oid($i) "$val($i)"]] } result] {
		ErrorHandle $result
	    } else {
		if ($verbose) {puts "RET: $result"}
	    } 
#	    $session set [list [list $val_oid($i) "$val($i)"]] {puts "Error Status %E"}
	}
    }

    
}
proc Info_Box {} {
    global edit_list info_data

    set box 1
    
    set w .f.choices.list
    set list .f.picked.list
    
    foreach item [$w curselection] {    
	while {[winfo exists .info$box]} {incr box 1}
	toplevel .info$box
	wm transient .info$box
	wm title .info$box "Mib object details"
	
	frame .info$box.action_bar -borderwidth 5
	button .info$box.action_bar.ok -text "OK"  -command "destroy .info$box" -padx 5
	pack .info$box.action_bar.ok -side left
	pack .info$box.action_bar -side bottom
	

	set item [lindex [$w get $item] 0]
	
	set info_data(name) [mib name $item]
	ShowLabel .info$box info_data(name) "Short OID name:"
	set info_data(oid) [mib oid $item]
	ShowLabel .info$box info_data(oid) "Full OID:"
	set info_data(module) [mib module $item]
	ShowLabel .info$box info_data(module) "Module name:"
	set info_data(syntax) [mib syntax $item]
	if {$info_data(syntax) != ""} {
	    ShowLabel .info$box info_data(syntax) "Display syntax:"
	}
	set info_data(description) [mib description $item]
	if {$info_data(description) != ""} {
	    ShowLabel .info$box info_data(description) "Object Description:" -justify left
	}
	set info_data(access) [mib access $item]
	ShowChoices .info$box info_data(access) "Access allowed:" {not-accessible read-only read-create read-write write-only} -state disabled
	set info_data(file) [mib file $item]
	ShowLabel .info$box info_data(file) "Mib file name:"
	set info_data(tc) [mib tc $item]
       	if {$info_data(tc) !=""} {
	    set info_data(tc_name) [lindex $info_data(tc) 0]
	    set info_data(tc_type) [lindex $info_data(tc) 1]
	    set info_data(tc_enum) [lindex $info_data(tc) 3]
	    set info_data(tc_mib) [lindex $info_data(tc) 4]
	    ShowLabel .info$box info_data(tc_name) "Textual convention name:"
	    ShowLabel .info$box info_data(tc_type) "  Underlying ASN.1 type:"
	    ShowChoices .info$box info_data(tc_enum) "  Enumerations allowed:" $info_data(tc_enum) -state disabled
	    ShowLabel .info$box info_data(tc_mib) "  Textual convention definition:"
	    
	}

	#	puts "index=[mib index $item]" # do not quite grasp this. left out.
	incr box 1
    }


}

proc usage {} {
    puts stderr {Usage: mibwander [-D] [hostname]}
}


#Main code

set verbose 0
set exists 0
set setting(address) 127.0.0.1
set session 0
set current iso

frame .menubar 
button .menubar.parent -text "Parent" -command {Display_Parent}
button .menubar.edit -text "Edit" -command {Edit_Values}
button .menubar.info -text "Info" -command {Info_Box}
button .menubar.quit -text "Quit" -command exit
checkbutton .menubar.exists -text "Show only existing values" \
    -variable exists -command {Manage_sessions}
pack .menubar.parent .menubar.edit .menubar.info -side left
pack .menubar.exists -side left
pack .menubar.quit -side right 
pack .menubar -side top -fill x
ListSelect .f [list [ExpandName iso]]
pack .f -expand true -fill both


# command line parameter parsing

if {[lindex $argv 0] == "-D"} {
    set verbose 1
    set argv [lrange $argv 1 [expr $argc - 1]]
    set argc [expr $argc - 1]
    puts "Verbose mode"
}

if {$argc > 0} {
    set setting(address) [lindex $argv 0]
}

## insert any extra mib files you want to load here
# mib load mib.txt





