# snmp.tcl --
#
# This file useful utilities for programming SNMP based applications
# in Tcl. Previous versions were written for the tkined(1) editor.
# These versions contain no tkined specific code anymore.
#
# Copyright (c) 1994-1996 Technical University of Braunschweig.
# Copyright (c) 1996-1997 University of Twente.
#
# 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 require TnmDialog $tnm(version)
package provide TnmSnmp $tnm(version)

# TnmSnmpGetIp --
#
# Return the IP destination address of a SNMP session. We also define 
# the writeln proc to a reasonable default if it is not defined yet.
#
# Arguments:
# s -		The SNMP session handle

proc TnmSnmpGetIp {s} {
    if {[info proc writeln] == ""} {
	proc writeln args { puts [join $args] }
    }
    return [$s cget -address]
}

# Tnm_SnmpWalk --
#
# Walk through a MIB tree and show the contents of the MIB variables.
#
# Arguments:
# s -		The SNMP session to use.
# oid -		The object identifier of the MIB subtree.

proc Tnm_SnmpWalk {s oid} {

    set ip [TnmSnmpGetIp $s]
    if {[catch {nslook $ip} host]} { set host "" }
    set host [lindex $host 0]

    writeln "$host \[$ip\] \[[clock format [clock seconds]]\]:"

    set maxl 0
    if {[catch {
	set n 0
	$s walk vbl $oid {
	    set vb [lindex $vbl 0]
	    set name($n)  [mib name [lindex $vb 0]]
	    set value($n) [lindex $vb 2]
	    if {$maxl < [string length $name($n)]} {
		set maxl [string length $name($n)]
	    }
	    incr n
	}
    } msg]} {
	writeln $msg
	return
    }

    set txt ""
    for {set i 0} {$i < $n} {incr i} {
	append txt [format "  %-*s : %s\n" $maxl $name($i) $value($i)]
    }
    writeln $txt
}


# Tnm_SnmpScalars --
#
# Retrieve all scalar variables of a MIB group into an array.
#
# Arguments:
# s -		The SNMP session to use.
# path -	The object identifier of the MIB group.
# name -	The name of an array where we store the values.

proc Tnm_SnmpScalars {s path name} {

    upvar $name value
    catch {unset value}

    # Make sure value is an array and the path is a valid object
    # identifier and not an instance or a table. This is a hack.

    set value(foo) bar
    unset value(foo)
    if {[mib syntax $path] != ""} return

    set exception(noSuchObject)   1
    set exception(noSuchInstance) 1
    set exception(endOfMibView)   1

    # Build a list of all variables in this group that do not have any
    # sucessors (to avoid embedded tables).

    set varlist ""
    foreach var [mib children [mib oid $path]] {
	if {[mib access $var] != "not-accessible"} {
	    lappend varlist "$var.0"
	}
    }

    # Try to retrieve the varlist in one get request. If this fails,
    # we use a get request to retrieve variables individually.
    # Note, I would like to honor noSuchName or tooBig errors, but
    # unfortunately some agents do not send this error code.

    if {[catch {$s get $varlist} vbl]} {
	set vbl ""
	foreach var $varlist {
	    if {[catch {$s get $var} v]} continue
	    lappend vbl [lindex $v 0]
	}
    }

    # This commented version below does it asynchonously. Fast on 
    # fast reliable networks but problematic if the net has problems.

#    if {[catch {$s get $varlist} vbl]} {
#	global _vbl_
#	foreach var $varlist {
#	    $s get $var {
#		if {"%E" == "noError"} {
#		    lappend _vbl_ [lindex "%V" 0]
#		}
#	    }
#	}
#	$s wait
#	set vbl $_vbl_
#	unset _vbl_
#    }

    set result ""
    foreach vb $vbl {
	set oid [lindex $vb 0]
	set syn [lindex $vb 1]
	set val [lindex $vb 2]
	if {[info exists exception($syn)]} continue
	set name [mib name $oid]
	set value($name) $val
	lappend result $name
    }
    return $result
}


# Tnm_SnmpShowScalars --
#
# Show all scalar variables of a MIB group.
#
# Arguments:
# s -		The SNMP session to use.
# path -	The object identifier of the MIB group.

proc Tnm_SnmpShowScalars {s path} {

    set ip [TnmSnmpGetIp $s]
    if {[catch {nslook $ip} host]} { set host "" }
    set host [lindex $host 0]

    set txt "$host \[$ip\] \[[clock format [clock seconds]]\]:\n"

#    if {[catch {Tnm_SnmpScalars $s $path values} msg]} {
#	append txt "$msg\n"
#	writeln $txt
#	return
#    }

    if {[catch {$s scalars $path values} msg]} {
	append txt "$msg\n"
	writeln $txt
	return
    }

    set maxl 0
    foreach name $msg {
	if {$maxl < [string length $name.0]} {
	    set maxl [string length $name.0]
	}
    }

    foreach name $msg {
	append txt [format "  %-*s : %s\n" $maxl $name.0 $values($name)]
    }
    writeln $txt
}


# Tnm_SnmpShowTable --
#
# Show a complete MIB table. First determine which rows are supported
# by an agent and then walk through the table. The formating code is
# ugly and should be replaced by a better version.
#
# Arguments:
# s -		The SNMP session to use.
# table -	The object identifier of an snmp table.

proc Tnm_SnmpShowTable {s table} {

    set ip [TnmSnmpGetIp $s]
    if {[catch {nslook $ip} host]} { set host "" }
    set host [lindex $host 0]

    set table [mib oid $table]
    if {[mib syntax $table] == "SEQUENCE"} {
	set table [mib parent $table]
    }
    if {[mib syntax $table] != "SEQUENCE OF"} return

    set exception(noSuchObject)   1
    set exception(noSuchInstance) 1
    set exception(endOfMibView)   1

    writeln "$host \[$ip\] \[[clock format [clock seconds]]\]:"

    # Check if we can walk the rows simultaneously. We start a walk and
    # if we get a result, we will be happy. Otherwise, we will start a
    # very silly walk to collect the table element by element.

    set rows ""
    foreach var [mib children [mib children $table]] {
	if {[mib access $var] != "not-accessible"} {
	    lappend rows $var
	}
    }
    catch {
	$s walk vbl $rows {
	    set table $rows
	    break
	}
    }

    # Now walk through the table and fill the array named value,
    # indexed by row name : instance identifier, e.g.
    #	value(ifType:1) "le0"
    #	value(ifType:2) "le1"
    # The lists xorder and yorder contain the order of the row
    # names (xorder) and the instance identifier (yorder).

    set xorder ""
    set yorder ""
    if [catch {
	$s walk vbl $table {
	    foreach vb $vbl {
		set oid  [lindex $vb 0]
		set syn  [lindex $vb 1]
		set val  [lindex $vb 2]
		if {[info exists exception($syn)]} continue
		
		set lname [split [mib name $oid] .]
		set pfx [lindex $lname 0]
		set idx [join [lrange $lname 1 end] .]
		
		if {[lsearch $xorder $pfx] < 0} {
		    lappend xorder $pfx
		}
		if {[lsearch $yorder $idx] < 0} {
		    lappend yorder $idx
		}
		set value($pfx:$idx) $val
	    }
	}
    } msg] {
	writeln $msg
	return
    }

    if {![info exists xorder] || ![info exists yorder]} {
	return
    }
    
    # Calculate the max. length of all values for every row.

    foreach pfx $xorder {
	set xindex($pfx) [string length $pfx]
	foreach n [array names value $pfx:*] {
	    set len [string length $value($n)]
	    if {$len > $xindex($pfx)} {
		set xindex($pfx) $len
	    }
	}
    }

    # Try to display the table as a table. This is still no good solution... 

    while {[array names xindex] != ""} {
	set foo ""
	set total 0
	set fmt ""
	set txt ""
	foreach pfx $xorder {
	    incr total $xindex($pfx)
	    incr total 2
	    set fmt "  %$xindex($pfx)s"
	    append txt [format $fmt $pfx]
	    lappend foo $pfx
	}
	writeln $txt
	foreach idx $yorder {
	    set txt ""
	    foreach pfx $foo {
		set fmt "  %$xindex($pfx)s"
		# note, large table may be inconsistend
		if [catch {format $fmt $value($pfx:$idx)} xxx] {
		    set xxx [format $fmt "?"]
		}
		append txt $xxx
	    }
	    writeln $txt
	}
	foreach pfx $foo {
	    unset xindex($pfx) 
	}
    }

    writeln
}


# Tnm_SnmpSetValue --
#
# Set a value of a MIB variable. A check is made if the MIB variable
# is an enumeration. If yes
#
# Arguments:
# s -		The SNMP session to use.
# oid -		The object identifier of the variable to set.
# w -		The root widget name or empty if running with tkined.

proc Tnm_SnmpSetValue {s oid {w ""}} {
    $s walk x $oid {
	set x [lindex $x 0]
	set value([mib name [lindex $x 0]]) [lindex $x 2]
    }
    set name [array names value]
    if {[llength $name] > 1} {
	if {$w != ""} {
	    set res [Tnm_DialogSelect $w.l questhead "Select an instance:" \
		    [lsort [array names value]] "select cancel"]
	} else {
	    set res [ined list "Select an instance:" \
		    [lsort [array names value]] "select cancel"]
	}
	if {[lindex $res 0] != "select"} return
	set name [lindex $res 1]
    }
    if {$name == ""} return

    set enums ""
    catch {
	foreach {label number} [mib enums [mib type $name]] {
	    lappend enums $label
	}
    }

    if {$w != ""} {
	if {$enums != ""} {
	    set res [Tnm_DialogSelect $w.l questhead \
		    "Select a value (current = $value($name)):" \
		    $enums "ok cancel"]
	} else {
	    set res [Tnm_DialogRequest $w.r questhead \
		    "Enter new value for $name:" $value($name) "ok cancel"]
	}
    } else {
	if {$enums != ""} {
	    set res [ined list "Select a value (current = $value($name)):" \
		    $enums "ok cancel"]
	} else {
	    set res [ined request "Enter new value for $name:" \
		    [list [list $name $value($name) entry 20]] "ok cancel"]
	}
    }
    if {[lindex $res 0] != "ok"} return
    set new [lindex $res 1]
    if [catch {$s set [list [list $name $new]]} msg] {
	error $msg
    }
}


# Tnm_SnmpCreateInstance --
#
# Set a value of a MIB variable.
#
# Arguments:
# s -		The SNMP session to use.
# oid -		The object identifier of the variable to set.
# w -		The root widget name or empty if running with tkined.

proc Tnm_SnmpCreateInstance {s oid {w ""}} {
    if {$w != ""} {
	set res [Tnm_DialogRequest $w.l questhead \
		"Enter an instance identifier:" [mib name $oid]. \
		"create cancel"]
    } else {
	set res [ined request "Enter an instance identifier:" \
		[list [list Instance [mib name $oid] entry 20]] \
		"create cancel"]
    }
    if {[lindex $res 0] != "create"} return
    set name [lindex $res 1]
    if {$w != ""} {
	set res [Tnm_DialogRequest $w.r questhead \
		"Enter new value for $name:" "" "ok cancel"]
    } else {
	set res [ined request "Enter new value for $name:" \
		[list [list Value "" entry 20]] "ok cancel"]
    }
    if {[lindex $res 0] != "ok"} return
    set new [lindex $res 1]
    if [catch {$s set [list [list $name $new]]} msg] {
	error $msg
    }
}


# Tnm_SnmpDescribeMibNode --
#
# Give a description of a node in the MIB tree.
#
# Arguments:
# oid -		The oid of the MIB node to describe.

proc Tnm_SnmpDescribeMibNode oid {

    if {[info proc writeln] == ""} {
        proc writeln args { puts [join $args] }
    }
    
    writeln "Label:\t\t\t[mib label $oid]"
    if {[mib module $oid] != ""} {
	writeln "MIB Module:\t\t[mib module $oid]"
    }
    writeln "Identifier:\t\t[mib oid $oid]"
    if {[mib macro $oid] != ""} {
	writeln "SMI Macro:\t\t[mib macro $oid]"
    }
    set idx [mib index $oid]
    if {$idx != ""} {
	writeln "Table Index:\t\t$idx"
    }
    writeln "Max. Access:\t\t[mib access $oid]"
    set type [mib type $oid]
    if {[mib macro $type] == ""} {
	if {[mib syntax $oid] != ""} {
	    writeln "ASN.1 Syntax:\t\t[mib syntax $oid]"
	}
    } else {
	writeln "ASN.1 Syntax:\t\t[mib syntax $type]"
	if {[mib displayhint $type] != ""} {
	    writeln "Textual Convention:\t$type"
	    writeln "Display-Hint:\t\t[mib displayhint $type]"
	} elseif {[mib enums $type] != ""} {
	    foreach {label number} [mib enums $type] {
		append txt $label
		append txt "($number), "
	    }
	    writeln "Enumeration:\t\t[string trim $txt {, }]"
	} else {
	    writeln "Textual Convention:\t$type"
        }
    }
    writeln "File:\t\t\t[mib file $oid]"
    set description [mib description $oid]
    if {$description != ""} {
	writeln "\n$description"
    }
    writeln
}
