set Dm_BuildTime {Tue Mar 23 08:50:40 PST 1999}; set Dm_Version 2.0.0
proc vl_GetDynamicCB {sess reqid errStat errIndex vbl} {global Vlan
if {$errStat == "noError"} {set offset [string length [snmpinfo mibprop rcVlanStaticMembers value]]
incr offset
foreach {static notAllow} $vbl {set id [string range [rlindex static 0] $offset end]
if {[set ports [bit print [rlindex static 2]]] != ""} {set Vlan($id.static.$sess) $ports
if {$Vlan($id.stgId) == 0} {global Vl_BRoutePort
foreach p $ports {lappend Vl_BRoutePort($sess) $p}}
set policy ""
foreach p $Vlan($id.ports.$sess) {if {[lsearch $ports $p] == -1} {lappend policy $p}}
set Vlan($id.ports.$sess) $policy}
if {[set ports [bit print [rlindex notAllow 2]]] != ""} {set Vlan($id.notAllow.$sess) $ports}}}}
proc vl_GetTrunksCB {sess reqid errStat errIndex vbl} {global Vl_TrunkPort Vl_Priv
set rcVlanPortType [snmpinfo mibprop rcVlanPortType value]
set iOffset [expr [string length $rcVlanPortType]+1]
foreach vb $vbl {if {[snmpinfo mibprop [lindex $vb 0] value] != $rcVlanPortType} break
if {[lindex $vb 2] == 2} {set ifIndex [string range [lindex $vb 0] $iOffset end]
set Vl_TrunkPort($ifIndex.$sess) [vl_FindPortMembership $ifIndex $sess]}}
incr Vl_Priv(hostsRead)}
proc vl_GetRoutePortsCB {sess reqid errStat errIndex vbl} {if {$errStat == "noError"} {global Vl_RoutePort
set offset [string length [snmpinfo mibprop rcPortPerformRouting value]]
incr offset
foreach vb $vbl {if {[rlindex vb 2] == 1} {set Vl_RoutePort($sess.[string range [rlindex vb 0] $offset end]) 1}}}}
proc vl_GetStgsCB {sess reqid errStat errIndex vbl} {if {$errStat == "noError"} {global Vl_Stg
set offset [string length [snmpinfo mibprop rcStgPortMembers value]]
incr offset
foreach {members mac vlanId} $vbl {set stgId [string range [rlindex members 0] $offset end]
if {$stgId == 0} continue
set Vl_Stg(members.$stgId.$sess) [rlindex members 2]
set Vl_Stg(mac.$stgId.$sess) [rlindex mac 2]
set Vl_Stg(vlanId.$stgId.$sess) [rlindex vlanId 2]}}}
proc vl_GetVlanCB {num sess reqid errStat errIndex vbl} {global Vl_AgentVersion Vlan Dm_Pref Vl_VlanList Vl_StgList Vl_Priv Vl_Dynamic Dm_Status
if {$errStat != "noError"} {vl_Log "$sess: $errStat"
incr Vl_Priv(hostsRead)
return}
set iOffset [string length [snmpinfo mibprop rcVlanType value]]
incr iOffset
set i 0
foreach {type name members color stgId priority protocol subnet userDefProtoId} $vbl {if {$subnet == ""} break
set id [string range [rlindex type 0] $iOffset end]
if {[lsearch $Vl_VlanList $id] == -1} {lappend Vl_VlanList $id}
set n [rlindex name 2]
if [info exists Vlan($id.name)] {if {$Vlan($id.name) != $n} {vl_Log "$sess: '$n'(Id $id) should be named '$Vlan($id.name)' (as in $Vlan($id.master))"}} else {set Vlan($id.name) [rlindex name 2]
set Vlan($id.master) $sess}
set t [rlindex type 2]
if ![info exists Vlan($id.type)] {set Vlan($id.type) [rlindex type 2]
set Vlan($id.protocol) 0
set Vlan($id.userDefProtoId) 0
set Vlan($id.subnet) ""
if {$Vlan($id.type) > 1} {set Vlan($id.protocol) [rlindex protocol 2]
set Vlan($id.userDefProtoId) [rlindex userDefProtoId 2]
set Vlan($id.subnet) [rlindex subnet 2]}} else {if {$Vlan($id.type) != $t} {vl_Log "$sess: '$n'(Id $id) should be type $Vlan($id.type) (as in $Vlan($id.master))"} elseif {$t == 2 && $Vlan($id.subnet) != [rlindex subnet 2]} {vl_Log "$sess: '$n'(Id $id) should use subnet $Vlan($id.subnet) (as in $Vlan($id.master))"} elseif {$t == 3} {if {$Vlan($id.protocol) != [rlindex protocol 2]} {vl_Log "$sess: '$n'(Id $id) should use protocol [vl_GetProtocolName $Vlan($id.protocol)] (as in $Vlan($id.master))"}
if {$Vlan($id.userDefProtoId) != [rlindex userDefProtoId 2]} {vl_Log "$sess: '$n'(Id $id) should use user defined protocol $Vlan($id.userDefProtoId) (as in $Vlan($id.master))"}}}
if {$Vlan($id.type) > 1} {lappend Vl_Dynamic($sess) rcVlanStaticMembers.$id rcVlanNotAllowToJoin.$id}
set Vlan($id.ports.$sess) [bit print [rlindex members 2]]
if $id {set Vlan($id.color) [rlindex Dm_Pref(colors) [expr [rlindex color 2] % 32]]
set sId [rlindex stgId 2]
if {[info exists Vlan($id.stgId)] && $Vlan($id.stgId) != $sId} {vl_Log "$sess: '$Vlan($id.name)'(Id $id) should be in STG $Vlan($id.stgId) (as in $Vlan($id.master))"} else {set Vlan($id.stgId) $sId}} else {set Vlan($id.stgId) 1}
if {![info exists Vlan($id.color)] || $Vlan($id.color) == ""} {set Vlan($id.color) black}
if {[lsearch $Vl_StgList $Vlan($id.stgId).$id] == -1} {if {$Vlan($id.stgId) != 0} {lappend Vl_StgList $Vlan($id.stgId).$id}}
set priority [rlindex priority 2]
if {[info exists Vlan($id.priority)] && $Vlan($id.priority) != $priority} {vl_Log "$sess: '$n'(Id $id) should be [lindex {"" high low} $priority] priority (as in $Vlan($id.master))"} else {set Vlan($id.priority) $priority}
incr i 9}
if {[set count [expr $i/9]] < $num} {incr num -$count
$sess config -maxrept $num
set Dm_Status "$sess: ask for more ($num) VLAN(s)..."
if {$Vl_AgentVersion($sess) == "1.0"} {$sess bulk "vl_GetVlanCB $num" "rcVlanType.$id rcVlanName.$id rcVlanPortMembers.$id rcVlanColor.$id rcVlanStgId.$id rcVlanHighPriority.$id rcVlanProtocolId.$id rcVlanSubnetAddr.$id rcVlanType.$id"} elseif {$Vl_AgentVersion($sess) == "1.1"} {$sess bulk "vl_GetVlanCB $num" "rcVlanType.$id rcVlanName.$id rcVlanActiveMembers.$id rcVlanColor.$id rcVlanStgId.$id rcVlanHighPriority.$id rcVlanProtocolId.$id rcVlanSubnetAddr.$id rcVlanType.$id"} else {$sess bulk "vl_GetVlanCB $num" "rcVlanType.$id rcVlanName.$id rcVlanActiveMembers.$id rcVlanColor.$id rcVlanStgId.$id rcVlanHighPriority.$id rcVlanProtocolId.$id rcVlanSubnetAddr.$id rcVlanUserDefinedPid.$id"}} else {set Vl_StgList [lsort -real $Vl_StgList]
if [info exists Vl_Dynamic($sess)] {set Dm_Status "$sess: ask for Dynamic VLANs..."
$sess get vl_GetDynamicCB $Vl_Dynamic($sess)}
unset vbl
foreach inst $Vlan(0.ports.$sess) {lappend vbl rcPortPerformRouting.$inst}
if [info exists vbl] {set Dm_Status "$sess: ask for Routing ports..."
$sess get vl_GetRoutePortsCB $vbl}
$sess config -maxrept $Vl_Priv($sess.rcStgNumStgs)
$sess bulk vl_GetStgsCB {rcStgPortMembers.0 rcStgTaggedBpduAddress.0 rcStgTaggedBpduVlanId.0}
if {$Vl_Priv($sess.rcChasNumPorts) > 0} {set Dm_Status "$sess: ask for Tagged ports..."
$sess config -maxrept $Vl_Priv($sess.rcChasNumPorts)
$sess bulk vl_GetTrunksCB rcVlanPortType.0} else {incr Vl_Priv(hostsRead)}}}
proc vl_GetNumVlanCB {sess reqid errStat errIndex vbl} {global Vl_Visited Vl_Priv Vl_SessList Vl_AgentVersion Dm_Status
if {$errStat != "noError"} {vl_Log "$sess: $errStat"
$sess destroy
incr Vl_Priv(hostsRead)} else {foreach {objectID sysDescr serialNo numVlans numPorts numStgs} $vbl {if ![string match 1.3.6.1.4.1.2272.* [rlindex objectID 2]] {vl_Log "$sess: unsupported device (sysObjectID=[rlindex objectID 2])"
$sess destroy
incr Vl_Priv(hostsRead)
return}
set sysDescr [rlindex sysDescr 2]
if {[regexp {\([0-9]+.[\.0-9]+\)} $sysDescr v]} {set ver [string range $v 1 [expr [string length $v] - 2]]
if {[set n [scan $ver %d.%d.%d a1 a2 a3]] == 3} {if {$a1 == "1"} {if {$a2 == "1"} {set Vl_AgentVersion($sess) "1.1"} elseif {$a2 >= 2} {set Vl_AgentVersion($sess) "1.3"} else {set Vl_AgentVersion($sess) "1.3"}} else {set Vl_AgentVersion($sess) "1.3"}} else {set Vl_AgentVersion($sess) "1.0"}}
set serialNo [rlindex serialNo 2]
if [info exists Vl_Visited($serialNo)] {vl_Log "$sess: serial# $serialNo already discovered by $Vl_Visited($serialNo)"
$sess destroy
incr Vl_Priv(hostsRead)
return}
set Vl_Visited($serialNo) $sess
set numVlans [rlindex numVlans 2]
set numPorts [rlindex numPorts 2]
set numStgs [rlindex numStgs 2]
if {$numVlans == 0 || $numStgs == 0} {vl_Log "$sess: bad data - numVlans=$numVlans, numPorts=$numPorts, numStgs=$numStgs"
$sess destroy
incr Vl_Priv(hostsRead)
return}
if {[string match noSuch* $numVlans] || [string match noSuch* $numStgs] || [string match noSuch* $numPorts]} {vl_Log "$sess: bad data - numVlans=$numVlans, numPorts=$numPorts"
$sess destroy
incr Vl_Priv(hostsRead)
return}
lappend Vl_SessList $sess
set Vl_Priv($sess.rcChasNumPorts) $numPorts
set Vl_Priv($sess.rcStgNumStgs) $numStgs
set Dm_Status "$sess: ask for $numVlans VLAN(s)..."
$sess config -version 2 -maxrept $numVlans
if {$Vl_AgentVersion($sess) == "1.0"} {$sess bulk "vl_GetVlanCB $numVlans" {rcVlanType. rcVlanName. rcVlanPortMembers. rcVlanColor. rcVlanStgId. rcVlanHighPriority. rcVlanProtocolId. rcVlanSubnetAddr. rcVlanType.}} elseif {$Vl_AgentVersion($sess) == "1.1"} {$sess bulk "vl_GetVlanCB $numVlans" {rcVlanType. rcVlanName. rcVlanActiveMembers. rcVlanColor. rcVlanStgId. rcVlanHighPriority. rcVlanProtocolId. rcVlanSubnetAddr. rcVlanType.}} else {$sess bulk "vl_GetVlanCB $numVlans" {rcVlanType. rcVlanName. rcVlanActiveMembers. rcVlanColor. rcVlanStgId. rcVlanHighPriority. rcVlanProtocolId. rcVlanSubnetAddr. rcVlanUserDefinedPid.}}
.mBar.file.m entryconfig 2 -state normal
.mBar.file.m.dm add command -label $sess -command "vl_StartDM $sess"}}}
proc vl_GetData {c deviceList} {global Vl_Priv Vl_SessList Vlan Vl_Stg Vl_VlanList Vl_StgList Vl_Dynamic Vl_TrunkPort Vl_RoutePort Vl_BRoutePort Dm_Status Vl_Visited
vl_LogClear
catch {unset Vl_Dynamic}
catch {unset Vlan}
catch {unset Vl_Stg}
catch {unset Vl_TrunkPort}
catch {unset Vl_RoutePort}
catch {unset Vl_BRoutePort}
catch {unset Vl_Visited}
.mBar.file.m.dm delete 0 end
foreach s $Vl_SessList {$s destroy}
set Vl_SessList {}
set Vl_VlanList {}
set Vl_StgList {}
set Vl_Priv(hostsRead) 0
set numHosts 0
upvar $deviceList devices
foreach d $devices {set h [rlindex d 0]
if [catch {
			newsnmp $h $h -version 2 -rd [rlindex d 1] -wr [rlindex d 2]
			$h get vl_GetNumVlanCB {sysObjectID.0 sysDescr.0 rcChasSerialNumber.0 rcVlanNumVlans.0 rcChasNumPorts.0 rcStgNumStgs.0}
		} err] {vl_Log "$h: $err"
continue}
incr numHosts}
set progress [$c create rectangle 10 10 210 20]
while {$Vl_Priv(hostsRead) < $numHosts} {vwait Vl_Priv(hostsRead)
lappend progress [$c create rectangle 10 10 [expr 10+int($Vl_Priv(hostsRead)/$numHosts.0*200.0)] 20 -fill blue]
update idletasks}
eval $c delete $progress
set Dm_Status ""
set Vlan(0.name) Unassigned}
proc vl_SnmpError {errMsg} {bell
upvar $errMsg err
set sess [rlindex err 0]
switch [set msg [rlindex err 2]] {
		invalidPortMembers {
			append msg "- the port can't join a Vlan in a different STG"
		}
		invalidVlanId {
			append msg "- the vlan doesn't exist\nor the port can't join a vlan in a different STG"
		}
		invalidStgId {
			append msg "- the Spanning Tree group doesn't exist"
		}
	}
dm_Prompt .err "$sess: $msg" Continue}
proc vl_SetTrunkPort {sess ifIndex vlanIdList} {global Vlan Vl_Stg
foreach id $vlanIdList {if ![info exists Vlan($id.ports.$sess)] {lappend vlans $Vlan($id.name)}
if ![info exists Vl_Stg(members.$Vlan($id.stgId).$sess)] {lappend stgs $Vlan($id.stgId)}}
if [info exists stgs] {if [dm_Prompt .ask "STG $stgs is not defined on $sess\nDo you want to create?" Yes No] {return 0}
foreach id $stgs {if ![vl_SetSTGCreate $id $sess] {return 0}}}
if [info exists vlans] {if [dm_Prompt .ask "$vlans is not defined on $sess\nDo you want to create?" Yes No] {return 0}
foreach id $vlanIdList {if ![info exists Vlan($id.ports.$sess)] {if ![vl_SetVlanCreate $id $Vlan($id.name) $Vlan($id.color) $Vlan($id.priority) 2 $Vlan($id.stgId) $Vlan($id.type) $Vlan($id.subnet) [vl_CalcMask $Vlan($id.subnet)] $Vlan($id.protocol) 0 $sess] {return 0}}}}
if [catch {$sess set null [list "rcVlanPortType.$ifIndex {} 2"]} err] {vl_SnmpError err
return 0}
set stgList ""
foreach id $vlanIdList {set stgId $Vlan($id.stgId)
if {[lsearch $stgList $stgId] == -1} {lappend stgList $stgId
set newPorts [bit parse "$ifIndex [bit print $Vl_Stg(members.$stgId.$sess)]"]
if [catch {$sess set null [list "rcStgPortMembers.$stgId {} $newPorts"]} err] {vl_SnmpError err
return}
set Vl_Stg($id.$sess) $newPorts}}
if [catch {$sess set null [list "rcVlanPortVlanIds.$ifIndex {} [dec2hex $vlanIdList]"]} err] {vl_SnmpError err
return 0}
return 1}
proc vl_SetSTGCreate {id sess} {global Vl_Stg
if [catch {set pos [lindex [array names Vl_Stg mac.$id.*] 0]; set mac $Vl_Stg($pos)}] {set mac ""}
if {$mac == ""} {set mac 01:80:c2:00:00:00}
if [catch {set pos [lindex [array names Vl_Stg vlanId.$id.*] 0]; set vlanId $Vl_Stg($pos)}] {set vlanId ""}
if {$vlanId == ""} {set vlanId [expr $id+4000]}
if [catch {$sess set null [list "rcStgRowStatus.$id {} 4" "rcStgPriority.$id {} 32768" "rcStgBridgeMaxAge.$id {} 2000" "rcStgBridgeHelloTime.$id {} 200" "rcStgBridgeForwardDelay.$id {} 1500" "rcStgTaggedBpduAddress.$id {} $mac" "rcStgTaggedBpduVlanId.$id {} $vlanId"]} err] {vl_SnmpError err
return 0}
set Vl_Stg(members.$id.$sess) 00
return 1}
proc vl_SetTrunking {sess ifIndex on} {if [catch {$sess set null [list "rcVlanPortType.$ifIndex {} $on"]} err] {vl_SnmpError err
return 0}
return 1}
proc vl_SetVlanPort {source dest movePorts} {global Vlan Dm_Pref
if {$dest != 0 && $source == $dest} {return 0}
foreach p $movePorts {lappend host([rlindex p 0]) [rlindex p 1]}
if {$dest > 1} {foreach sess [array names host] {set pos [array names Vlan $dest.ports.$sess]
if {$pos == ""} {if [dm_Prompt .ask "$Vlan($dest.name) does not exist on $sess; create it?" Yes No] {return 0}
if ![vl_SetVlanCreate $dest "$Vlan($dest.name)" $Vlan($dest.color) $Vlan($dest.priority) 2 $Vlan($dest.stgId) 1 "" "" 0 0 $sess] {return 0}}}}
foreach sess [array names host] {set vbl ""
set currSource [vl_RemoveFromVlan $source $sess host($sess)]
set currDest [vl_Add2Vlan $dest $sess host($sess)]
lappend vbl [list rcVlanPortMembers.$dest "" [bit parse "$currDest [vl_FindTrunkPortsInVlan $dest $sess]"]]
if [catch {$sess set null $vbl} err] {vl_SnmpError err
return 0}
set Vlan($source.ports.$sess) $currSource
set Vlan($dest.ports.$sess) [lsort -integer $currDest]}
return 1}
proc vl_RemoveFromVlan {source sess ports} {global Vlan
upvar $ports movePorts
set vlanPorts $Vlan($source.ports.$sess)
foreach p $movePorts {set ifIndex [vl_Port2IfIndex $p]
if {[set i [lsearch $vlanPorts $ifIndex]] >= 0} {set vlanPorts [lreplace $vlanPorts $i $i]}}
return $vlanPorts}
proc vl_Add2Vlan {source sess ports} {global Vlan
upvar $ports movePorts
set vlanPorts $Vlan($source.ports.$sess)
foreach p $movePorts {set ifIndex [vl_Port2IfIndex $p]
if {[set i [lsearch $vlanPorts $ifIndex]] == -1} {lappend vlanPorts $ifIndex}}
return $vlanPorts}
proc vl_SetVlanDelete {vlanId sess} {if [catch {$sess set null [list "rcVlanRowStatus.$vlanId {} 6"]} err] {vl_SnmpError err
vl_Log "$sess unable to delete Vlan $vlanId: [rlindex err 2]"
return 0}
return 1}
proc vl_SetVlanName {vlanId name} {global Vl_SessList
set success 0
foreach sess $Vl_SessList {if [catch {$sess set null [list "rcVlanName.$vlanId {} [list $name]"]} err] {vl_SnmpError err
vl_Log "$sess unable to rename Vlan $name: [rlindex err 2]"} else {set success 1}}
return $success}
proc vl_SetVlanCreate {id name color priority routing stgId type addr mask proto {upid 0} {target ""}} {global Vl_SessList Dm_Pref Vlan Vl_Stg
if {$target == ""} {set sessList $Vl_SessList} else {set sessList $target}
if {[set colorCode [lsearch $Dm_Pref(colors) $color]] == -1} {set colorCode 0}
lappend vbl "rcVlanRowStatus.$id {} 4" "rcVlanType.$id {} $type" [list rcVlanName.$id {} $name] "rcVlanColor.$id {} $colorCode" "rcVlanStgId.$id {} $stgId" "rcVlanHighPriority.$id {} $priority" "rcVlanRoutingEnable.$id {} $routing"
if {$type == 2} {lappend vbl "rcVlanSubnetAddr.$id {} $addr" "rcVlanSubnetMask.$id {} $mask"} elseif {$type == 3} {lappend vbl "rcVlanProtocolId.$id {} $proto"
if {$proto == 15} {scan $upid "%x" udid
lappend vbl "rcVlanUserDefinedPid.$id {} $udid"}}
set success 0
foreach sess $sessList {if ![info exists Vl_Stg(members.$stgId.$sess)] {if ![vl_SetSTGCreate $stgId $sess] {return 0}}
set varList $vbl
if {$type == 2 || $type == 3} {if [catch {set resp [$sess get null rcStgPortMembers.$stgId]} err] {vl_Log "$sess unable to find Stg.$stgId: [rlindex err 2]"} else {set potential [lindex [lindex [rlindex resp 4] 0] 2]
lappend varList "rcVlanPotentialMembers.$id {} $potential"}}
if [catch {$sess set null $vbl} err] {vl_SnmpError err
vl_Log "$sess unable to create Vlan $name: [rlindex err 2]"} else {set success 1
set Vlan($id.ports.$sess) 00}}
return $success}
proc vl_FindTrunkPortsInVlan {vlanId sess} {global Vl_TrunkPort
set members ""
foreach tp [array names Vl_TrunkPort *.$sess] {if {[lsearch $Vl_TrunkPort($tp) $vlanId] >= 0} {scan $tp %d ifIndex
lappend members $ifIndex}}
return $members}
proc vl_FindPortMembership {ifIndex sess} {global Vlan
set vlanIds {}
foreach el [array names Vlan *.$sess] {if {[set i [lsearch $Vlan($el) $ifIndex]] >= 0} {lappend vlanIds [lindex [split $el .] 0]
set Vlan($el) [lreplace $Vlan($el) $i $i]}}
return $vlanIds}
proc vl_MovePort2Stg {ports stgId} {global Vl_Stg
foreach p $ports {lappend host([rlindex p 0]) [vl_Port2IfIndex [rlindex p 1]]}
foreach sess [array names host] {if ![info exists Vl_Stg(members.$stgId.$sess)] {if ![vl_SetSTGCreate $stgId $sess] {return 0}}
set newPorts [bit parse "$host($sess) [bit print $Vl_Stg(members.$stgId.$sess)]"]
if [catch {$sess set null [list "rcStgPortMembers.$stgId {} $newPorts"]} err] {vl_SnmpError err
return}
set Vl_Stg(members.$stgId.$sess) $newPorts}}
proc vl_GetProtocolName {id} {foreach e [snmpinfo mibprop rcVlanProtocolId enums] {if {$id == [rlindex e 0]} {return [rlindex e 1]}}
return $id}
proc vl_newVlan {} {global Vl_VlanList Dm_Pref Dm_Radio Dm_AgentCap
set w .newVlan
set Dm_Pref(vlanId) [expr [lindex [lsort -integer -decreasing $Vl_VlanList] 0]+1]
set Dm_Pref(vlanStgId) 1
set fields {
		{Spin "Id" 1 Dm_Pref(vlanId) 4095 1..4095}
		{Entry "Name"}
		{Combo "Color" {}}
		{Radio "HighPriority" {true false}}
		{Radio "Routing" {true false}}
		{Spin "STG Id" 1 Dm_Pref(vlanStgId) 128 1..128}
		{Radio "Type" {byPort byIpSubnet byProtocolId bySrcMac}}
		{Entry SubnetAddr}
		{Entry SubnetMask}
	}
foreach e [snmpinfo mibprop rcVlanProtocolId enums] {if {[rlindex e 1] != "none"} {lappend protocols [rlindex e 1]}}
lappend fields [list Radio ProtocolId $protocols]
lappend fields {EntryUnit UserDefinedPid " (hex)"}
if [dm_MakeDlg $w "Create VLAN" $fields] return
$w.f.v2 insert 0 [rlindex Dm_Pref(colors) [expr $Dm_Pref(vlanId) % 32]]
set Dm_Radio($w.f.v3) 2
$w.f.v3.r0 config -value 1
$w.f.v3.r1 config -value 2
set Dm_Radio($w.f.v4) 2
$w.f.v4.r0 config -value 1
$w.f.v4.r1 config -value 2
set Dm_Radio($w.f.v6) 1
$w.f.v6.r0 config -value 1 -command "vl_VlanTypeCB $w port"
$w.f.v6.r1 config -value 2 -command "vl_VlanTypeCB $w subnet"
$w.f.v6.r2 config -value 3 -command "vl_VlanTypeCB $w protocol"
set i 0
foreach e [snmpinfo mibprop rcVlanProtocolId enums] {if {[rlindex e 1] != "none"} {$w.f.v9.r$i config -value [rlindex e 0] -command "vl_VlanProtocolCB $w $i"
incr i}}
set Dm_Radio($w.f.v9) [rlindex e 0]
foreach i {7 8 9 10} {grid forget $w.f.l$i $w.f.v$i}
bind $w.f.v7 <Tab> "dmsIPAddrInsertTab $w.f.v7 $w.f.v8"
$w.f.mb2 config -command "vl_VlanInsertColor $w.f.v2"
set Dm_Radio(.color) [$w.f.v2 get]
$w.fb.ok config -text Create -command "vl_newVlanCB $w"
pack forget $w.fb.help
focus $w.f.v1}
proc vl_VlanTypeCB {w type} {global Dm_Radio
if {$type == "port"} {foreach i {7 8 9 10} {grid forget $w.f.l$i $w.f.v$i}} elseif {$type == "subnet"} {grid forget $w.f.l9 $w.f.v9
grid forget $w.f.l10 $w.f.v10
grid $w.f.l7 -row 7 -column 0 -sticky e
grid $w.f.v7 -row 7 -column 1 -sticky w
grid $w.f.l8 -row 8 -column 0 -sticky e
grid $w.f.v8 -row 8 -column 1 -sticky w} else {foreach i {7 8} {grid forget $w.f.l$i $w.f.v$i}
grid $w.f.l9 -row 9 -column 0 -sticky e
grid $w.f.v9 -row 9 -column 1 -sticky w
vl_VlanProtocolCB $w [expr $Dm_Radio($w.f.v9) - 1]}}
proc vl_VlanProtocolCB {w rid} {set rtext [$w.f.v9.r${rid} cget -text]
if {$rtext == "usrDefined"} {grid $w.f.l10 -row 10 -column 0 -sticky e
grid $w.f.v10 -row 10 -column 1 -sticky w} else {grid forget $w.f.l10 $w.f.v10}}
proc vl_VlanInsertColor {e} {global Dm_Radio
dm_RadioBox .color color
$e delete 0 end
$e insert 0 $Dm_Radio(.color)}
proc dmsIPAddrInsertTab {ip mask} {$mask delete 0 end
$mask insert 0 [vl_CalcMask [$ip get]]}
proc vl_CalcMask {subnet} {if {[scan $subnet %d.%d.%d.%d a b c d] == 4} {set mask 255
foreach i "$b $c $d" {if {$i == 0} {append mask .0} else {append mask .255}}
return $mask}
return ""}
proc vl_newVlanCB {w} {global Vlan Vl_VlanList Vl_StgList Vl_SessList Dm_Pref Dm_Radio
set id [$w.f.v0 get]
if {[lsearch $Vl_VlanList $id] != -1} {$w.status config -text "VLAN Id in use"
focus $w.f.v0
bell
return}
set name [$w.f.v1 get]
foreach vId $Vl_VlanList {if {[string compare $Vlan($vId.name) $name] == 0} {$w.status config -text "Duplicate Name"
focus $w.f.v1
bell
return}}
if {[string length [$w.f.v1 get]] == 0} {if {$Dm_Radio($w.f.v6) == 1} {set name "VLAN-$id"} elseif {$Dm_Radio($w.f.v6) == 2} {set name [$w.f.v7 get]} else {set name [vl_GetProtocolName $Dm_Radio($w.f.v9)]}}
set color [$w.f.v2 get]
if [catch {$w.f.v2 config -bg $color} err] {$w.status config -text $err
focus $w.f.v2
bell
return}
$w.f.v2 config -bg [$w.f.v1 cget -bg]
set stgId [$w.f.v5 get]
set subnet [$w.f.v7 get]
set ptmp [$w.f.e10 get]
if {[string first "0x" $ptmp] == -1} {set upid 0x${ptmp}} else {set upid $ptmp}
if ![vl_SetVlanCreate $id "$name" $color $Dm_Radio($w.f.v3) $Dm_Radio($w.f.v4) $stgId $Dm_Radio($w.f.v6) $subnet [$w.f.v8 get] $Dm_Radio($w.f.v9) $upid] {$w.status config -text ""
return}
destroy $w
lappend Vl_VlanList $id
set Vlan($id.name) $name
set Vlan($id.color) $color
set Vlan($id.type) $Dm_Radio($w.f.v6)
set Vlan($id.stgId) $stgId
set Vlan($id.priority) $Dm_Radio($w.f.v3)
set Vlan($id.routing) $Dm_Radio($w.f.v4)
if {$Vlan($id.type) == 2} {set Vlan($id.subnet) $subnet} elseif {$Vlan($id.type) == 3} {set Vlan($id.protocol) $Dm_Radio($w.f.v9)}
lappend Vl_StgList $stgId.$id
set Vl_StgList [lsort -real $Vl_StgList]
foreach sess $Vl_SessList {set Vlan($id.ports.$sess) ""}
vl_tidy .fV.c}
proc vl_delVlan {w} {global Vlan Vl_VlanList Vl_SessList Vl_TrunkPort Vl_StgList Dm_Pref
if {[lsearch [$w itemcget selected -tags] Vlan] == -1} {dm_Prompt .err "Please select a VLAN first" Continue
return}
set id [lindex [$w itemcget selected -tags] 1]
if {$id <= 1} {dm_Prompt .err "Can't delete Default VLAN" Continue
return}
foreach sess $Vl_SessList {if ![info exists Vlan($id.ports.$sess)] continue
foreach tp [array names Vl_TrunkPort *.$sess] {if {[lsearch $Vl_TrunkPort($tp) $id] >= 0} {set portName [vl_IfIndex2Port [lindex [split $tp .] 0]]
dm_Prompt .err "Please remove $Vlan($id.name) from Tagged Port $portName" Continue
return}}
if {$Vlan($id.type) == 1} {if {[llength $Vlan($id.ports.$sess)] > 0} {dm_Prompt .err "Please move ports before deleting $Vlan($id.name) VLAN" Continue
return}} else {set Vlan($id.ports.$sess) ""
catch {unset Vlan($id.static.$sess)}
catch {unset Vlan($id.notAllow.$sess)}}}
set success 1
foreach sess $Vl_SessList {if ![info exists Vlan($id.ports.$sess)] continue
if [vl_SetVlanDelete $id $sess] {unset Vlan($id.ports.$sess)} else {set success 0}}
if $success {set i [lsearch $Vl_VlanList $id]
set Vl_VlanList [lreplace $Vl_VlanList $i $i]
set i [lsearch $Vl_StgList $Vlan($id.stgId).$id]
set Vl_StgList [lreplace $Vl_StgList $i $i]
unset Vlan($id.name) Vlan($id.color) Vlan($id.type) Vlan($id.stgId)}
vl_tidy $w}
proc vl_VlanRename {w} {global Vlan
set vlanId [lindex [$w itemcget tEdit -tags] 1]
if {[string length [set newName [$w itemcget tEdit -text]]] &&
		[vl_SetVlanName $vlanId $newName]} {set Vlan($vlanId.name) $newName} else {$w itemconfig tEdit -text $Vlan($vlanId.name)}
$w focus ""
vl_tidy $w}
proc vl_VlanAttributes {c} {global Vlan
if {[lsearch [$c itemcget selected -tags] Vlan] == -1} {dm_Prompt .err "Please select a VLAN first" Continue
return}
set id [lindex [$c itemcget selected -tags] 1]
set w .vlanAttr
lappend fields "Label Id $id"
lappend fields "Label Name $Vlan($id.name)"
lappend fields "Label Color $Vlan($id.color)"
lappend fields "Label HighPriority [lindex {"" true false} $Vlan($id.priority)]"
lappend fields "Label {STG Id} $Vlan($id.stgId)"
lappend fields "Label Type [lindex {"" byPort byIpSubnet byProtocolId bySrcMac} $Vlan($id.type)]"
if {$Vlan($id.type) == 2} {lappend fields "Label SubnetAddr $Vlan($id.subnet)"
lappend fields "Label SubnetMask [vl_CalcMask $Vlan($id.subnet)]"} elseif {$Vlan($id.type) == 3} {lappend fields "Label Protocol [vl_GetProtocolName $Vlan($id.protocol)]"
if {$Vlan($id.protocol) == 15} {lappend fields "Label UserDefinedPid  [format "%#x" $Vlan($id.userDefProtoId)]"}}
set numFields [llength $fields]
lappend fields "List {Defined on\nDevices}"
if [dm_MakeDlg $w "VLAN Attributes" $fields] return
$w.f.v$numFields config -width 20
foreach i [array names Vlan $id.ports.*] {$w.f.v$numFields insert end [string range $i [string length $id.ports.] end]}
pack forget $w.fb.help $w.fb.ok $w.status}
proc vl_TrunkAttributes {w} {global Vl_TrunkPort
set portItem [$w find withtag current]
set portItemText [expr $portItem+1]
set portInfo [$w itemcget $portItemText -text]
set sess [lindex $portInfo 0]
set ifIndex [vl_Port2IfIndex [lindex $portInfo 1]]
if {[set vList [vl_GetTrunkedVlans 20 20 $Vl_TrunkPort($ifIndex.$sess)]] != ""} {if [vl_SetTrunkPort $sess $ifIndex $vList] {set Vl_TrunkPort($ifIndex.$sess) $vList}}}
proc vl_GetTrunkedVlans {x y currentVlans} {global Vl_StgList Vl_VlanList Vlan tkPriv Dm_Status
set w .trunks
toplevel $w
wm title $w "Set Tagged Port"
wm transient $w .
wm geom $w +[winfo pointerx .]+[winfo pointery .]
frame $w.f
pack [label $w.f.title -text "STGId VLAN_Id Name" -anchor w] -fill x
listbox $w.f.l -selectmode multiple -yscroll "$w.f.sv set"
foreach svid $Vl_StgList {scan $svid %d.%d sid id
if $id {$w.f.l insert end "[format %02d $sid] [format %05d $id] $Vlan($id.name)"
if {[lsearch $currentVlans $id] != -1} {$w.f.l selection set end}}}
if {$currentVlans == ""} {$w.f.l selection set 0 end}
pack [scrollbar $w.f.sv -command "$w.f.l yview"] -side right -fill y
pack $w.f.l -fill both -expand 1
pack $w.f -fill both -expand 1
button $w.ok -text Ok -command "set tkPriv(button) 0"
button $w.close -text Close -command "set tkPriv(button) 1"
pack $w.close $w.ok -side right -pady 5 -pady 5
bind $w <Return> "$w.ok invoke"
bind $w <Escape> "$w.close invoke"
set trunkList ""
while {$trunkList == ""} {vwait tkPriv(button)
if {$tkPriv(button) == 1} break
foreach s [$w.f.l curselection] {lappend trunkList [string trimleft [lindex [$w.f.l get $s] 1] 0]}
if {$trunkList == ""} {bell
set Dm_Status "You must specify at least one VLAN"}}
destroy $w
return $trunkList}
proc vl_ExecDM {w} {if {[set i [$w find withtag selected]] == ""} {return}
vl_StartDM [$w itemcget [incr i] -text]}
proc vl_StartDM {devName} {global Dm_Path Dm_Status tcl_platform
set Dm_Status "Requesting DM to open $devName..."
if {$tcl_platform(platform) == "unix"} {if {[lsearch [winfo interps] dmgr.tcl] != -1} {if ![catch {send dmgr.tcl "wm deiconify .; raise .; dm_RequestOpen $devName public private"}] return}}
exec $Dm_Path/bin/wish42 $Dm_Path/dmgr.tcl $devName &}
proc vl_drawVlan {c} {global Dm_Pref Vlan Vl_SessList Vl_VlanList VlanItem Vl_TrunkPort PortItem Vl_ImagePath Vl_MaxColWidth Vl_RoutePort Vl_StgList Vl_ShowDynamic Vl_BRoutePort
if {$Vl_SessList == ""} return
if ![info exists Vl_MaxColWidth] {set maxLen 0
foreach s $Vl_SessList {if {[set len [string length $s]] > $maxLen} {set maxLen $len
set longest $s}}
set ti [$c create text 1 1 -text "$longest 8/16" -font $Dm_Pref(boldFont)]
scan [$c bbox $ti] "%f%f%f%f" x1 y1 x2 y2
$c delete $ti
set Vl_MaxColWidth [expr int($x2-$x1)+28]}
set x 10
set y 12
set ti [$c create text $x 10 -text "Tagged Ports" -anchor w -font $Dm_Pref(boldFont)]
foreach port [lsort [array names Vl_TrunkPort]] {scan [$c bbox $ti] "%f%f%f%f" x1 y1 x2 y2
incr x [expr int($x2-$x1)+4]
$c create bitmap $x $y -anchor w -tags "TrunkPort Port" -bitmap @$Vl_ImagePath/trunkport.xbm
incr x 18
set pos [string first . $port]
set tPort [string range $port 0 [expr $pos-1]]
set tSess [string range $port [expr $pos+1] end]
set ti [$c create text $x $y -anchor w -font $Dm_Pref(normalFont) -text "$tSess [vl_IfIndex2Port $tPort]"]}
incr x $Vl_MaxColWidth
if {[set cWidth [lindex [$c cget -scrollregion] 2]] < $x} {set cWidth $x}
set cHeight [lindex [$c cget -scrollregion] 3]
set x 4
set lastSid ""
foreach svid $Vl_StgList {set y 60
scan $svid %d.%d sid id
if {$lastSid != $sid} {if {$lastSid != ""} {$c create rectangle $lastSidX 50 [expr $x-4] $cHeight
$c create text $lastSidX 50 -text "STG $lastSid" -anchor sw -font $Dm_Pref(boldFont)}
set lastSidX [expr $x-4]
incr x 6}
if $id {set lastSid $sid}
if {$Vlan($id.type) != 1 && !$Vl_ShowDynamic} continue
if {$Vlan($id.type) == 1} {set tags "StaticVlan $id"
set bMap $Vl_ImagePath/vlan.xbm
set portTags Port} else {set tags "DynamicVlan $id"
set bMap $Vl_ImagePath/dynamicvlan.xbm
set portTags DynamicPort}
if {$id == 0} {set vItem [$c create text $x $y -text Unassigned -anchor w -font $Dm_Pref(boldFont) -tags Unassigned]
set x1 [expr $x+$Vl_MaxColWidth-6]
set VlanItem($id) [$c create rectangle $x [expr $y+8] $x1 $cHeight -fill grey -tags "StaticVlan $id"]} else {$c create bitmap [expr $x+3] $y -foreground $Vlan($id.color) -bitmap @$bMap -anchor w -tags "Vlan $id"
set vItem [$c create text [expr $x+18] $y -text $Vlan($id.name) -anchor w -font $Dm_Pref(boldFont) -tags "VlanName $id"]
set VlanItem($id) [$c create line $x $y $x $cHeight -width 2 -fill $Vlan($id.color) -tags $tags]}
set x1 [expr $x+18]
incr x
incr y 4
foreach sess $Vl_SessList {if {$id == 0 && [info exists Vl_BRoutePort($sess)]} {foreach port $Vl_BRoutePort($sess) {incr y 12
$c create bitmap $x $y -bitmap @$Vl_ImagePath/routeport.xbm -foreground red -anchor w
$c create text $x1 $y -text "$sess [vl_IfIndex2Port $port]" -anchor w -font $Dm_Pref(normalFont)}
incr y 3}
if [info exists Vlan($id.ports.$sess)] {foreach port $Vlan($id.ports.$sess) {incr y 12
if [info exists Vl_RoutePort($sess.$port)] {set PortItem([$c create bitmap $x $y -bitmap @$Vl_ImagePath/routeport.xbm -foreground $Vlan($id.color) -anchor w]) $id} elseif {$Vlan($id.type) > 1} {set PortItem([$c create bitmap $x $y -bitmap @$Vl_ImagePath/activeport.xbm -foreground $Vlan($id.color) -anchor w]) $id} else {set PortItem([$c create bitmap $x $y -bitmap @$Vl_ImagePath/port.xbm -tags $portTags -foreground $Vlan($id.color) -anchor w]) $id}
$c create text $x1 $y -text "$sess [vl_IfIndex2Port $port]" -anchor w -font $Dm_Pref(normalFont)}
incr y 3}
if [info exists Vlan($id.static.$sess)] {foreach port $Vlan($id.static.$sess) {incr y 12
$c create bitmap $x $y -bitmap @$Vl_ImagePath/port.xbm -foreground $Vlan($id.color) -anchor w
$c create text $x1 $y -text "$sess [vl_IfIndex2Port $port]" -anchor w -font $Dm_Pref(normalFont)}
incr y 3}
if [info exists Vlan($id.notAllow.$sess)] {foreach port $Vlan($id.notAllow.$sess) {incr y 12
$c create bitmap $x $y -bitmap @$Vl_ImagePath/notallow.xbm -foreground red -anchor w
$c create text $x1 $y -text "$sess [vl_IfIndex2Port $port]" -anchor w -font $Dm_Pref(normalFont)}
incr y 3}}
if {$y > $cHeight} {set cHeight $y}
scan [$c bbox $vItem] "%f%f%f%f" x1 y1 x2 y2
if {[set vlanLen [expr int($x2-$x1)+20]] > $Vl_MaxColWidth} {incr x $vlanLen} else {incr x $Vl_MaxColWidth}}
if [info exists lastSidX] {$c create rectangle $lastSidX 50 [expr $x-4] $cHeight
$c create text $lastSidX 50 -text "STG $lastSid" -anchor sw -font $Dm_Pref(boldFont)}
if {$x > $cWidth} {set cWidth $x}
incr cHeight 20
$c config -scrollregion "0 0 $cWidth $cHeight"
incr cWidth -10
$c create line 9 22 $cWidth 22 -width 4 -tags Trunk}
proc vl_ViewByDevice {w} {global Dm_Pref Vl_SessList Vl_VlanList Vlan Vl_TrunkPort Vl_ImagePath Vl_Image Vl_RoutePort
set c $w.c
$c delete all
set cHeight [lindex [$c cget -scrollregion] 3]
set x 10
foreach sess $Vl_SessList {set y 10
set x1 [expr $x+20]
$c create bitmap $x $y -bitmap @$Vl_ImagePath/bydevice.xbm -anchor w -tags Device
$c create text $x1 $y -text $sess -anchor w -font $Dm_Pref(boldFont)
$c create line $x $y $x [expr $cHeight-10] -width 2
incr y 4
foreach p [array names Vl_TrunkPort *.$sess] {incr y 14
$c create bitmap $x $y -bitmap @$Vl_ImagePath/port.xbm -anchor w
$c create text $x1 $y -text "[vl_IfIndex2Port [lindex [split $p .] 0]] Trunk" -font $Dm_Pref(normalFont) -anchor w}
incr x
foreach id $Vl_VlanList {if [info exists Vlan($id.ports.$sess)] {foreach port [lsort -integer $Vlan($id.ports.$sess)] {incr y 12
if [info exists Vl_RoutePort($sess.$port)] {set bMap $Vl_ImagePath/routeport.xbm} else {set bMap $Vl_ImagePath/port.xbm}
$c create bitmap $x $y -bitmap @$bMap -foreground $Vlan($id.color) -anchor w
$c create text $x1 $y -text "[vl_IfIndex2Port $port] $Vlan($id.name)" -font $Dm_Pref(normalFont) -anchor w}
incr y 3}}
if {$y > $cHeight} {set cHeight $y}
incr x 150}
$c config -scrollregion "0 0 $x $cHeight"}
proc vl_CreateCanvas {w} {set cScrollWidth 500
set cScrollHeight 444
set cWidth $cScrollWidth
set cHeight [expr $cScrollHeight+500]
frame $w -bd 1 -relief raised
set c $w.c
canvas $c -width $cScrollWidth -height $cScrollHeight -scrollregion "0 0 $cWidth $cHeight" -xscrollcommand "$w.hscroll set" -yscrollcommand "$w.vscroll set"
$c xview moveto 0
$c yview moveto 0
scrollbar $w.hscroll -orient horiz -command "$c xview"
scrollbar $w.vscroll -command "$c yview"
pack $w.hscroll -side bottom -fill x
pack $w.vscroll -side right -fill y
pack $c -fill both -expand 1}
proc vl_DeletePortFromVlan {sess ifIndex vlan} {global Vlan
if {[set i [lsearch $Vlan($vlan.ports.$sess) $ifIndex]] == -1} return
set Vlan($vlan.ports.$sess) [lreplace $Vlan($vlan.ports.$sess) $i $i]}
proc vl_portRelease {w x y} {if [vl_PortAction $w $x $y] {vl_portSpringBack $w}
catch {$w delete TrunkLink}
$w itemconfig selected -background [$w cget -bg]
$w dtag selected
$w dtag selectedText}
proc vl_PortAction {w x y} {global Vl_TrunkPort PortItem Vl_ImagePath Vlan
if ![catch {set dest [lindex [eval $w find overlapping [$w bbox current]] 0]}] {set tags [$w itemcget $dest -tags]} else {set tags ""}
if {[lsearch $tags "StaticVlan"] >= 0} {set destVlanId [lindex [$w itemcget $dest -tags] 1]
set sourceVlanId 0
set moveSess ""
set movePorts ""
set isTrunkPort 0
foreach i [$w find withtag selected] {set portInfo [$w itemcget [expr $i+1] -text]
lappend movePorts $portInfo
set sess [lindex $portInfo 0]
set ifIndex [vl_Port2IfIndex [lindex $portInfo 1]]
if [info exists PortItem($i)] {set sourceVlanId $PortItem($i)}
if {[lsearch [$w itemcget $i -tags] TrunkPort] >= 0} {set isTrunkPort 1
if [vl_SetTrunking $sess $ifIndex 1] {$w itemconfig $i -bitmap @$Vl_ImagePath/port.xbm -tags "Port selected"} else {return 1}
set oldTrunkedVlans $Vl_TrunkPort($ifIndex.$sess)
catch {unset Vl_TrunkPort($ifIndex.$sess)}}}
if {$Vlan($sourceVlanId.stgId) != $Vlan($destVlanId.stgId)} {if {$Vlan($sourceVlanId.stgId) != 0 && $Vlan($destVlanId.stgId) != 0 && [dm_Prompt .ask "$Vlan($sourceVlanId.name) is in a different Spanning Tree Group than $Vlan($destVlanId.name).\nDo you want to move [vl_FormatPorts movePorts] into STG $Vlan($destVlanId.stgId)?" Yes No]} {return 1} else {if [catch {vl_MovePort2Stg $movePorts $Vlan($destVlanId.stgId)} err] {dm_Prompt .err $err Continue
return 1}}}
if [vl_SetVlanPort $sourceVlanId $destVlanId $movePorts] {if {$destVlanId == 0} {$w lower $dest
set fg black} else {$w raise $dest
set fg [$w itemcget $dest -fill]
vl_RepositionPorts $w $dest}
$w itemconfig selected -foreground $fg
foreach i [$w find withtag selected] {set PortItem($i) $destVlanId}} else {if $isTrunkPort {if [vl_SetTrunking $sess $ifIndex 2] {$w itemconfig $i -bitmap @$Vl_ImagePath/trunkport.xbm -tags "TrunkPort Port selected"
set Vl_TrunkPort($ifIndex.$sess) $oldTrunkedVlans}}
return 1}} elseif {[lsearch $tags "Trunk"] >= 0} {set portItem [$w find withtag selected]
if {[llength $portItem] > 1} {dm_Prompt .err "You can only trunk one port at a time" Continue
return 1}
set portItemText [expr $portItem+1]
set portInfo [$w itemcget $portItemText -text]
set sess [lindex $portInfo 0]
set ifIndex [vl_Port2IfIndex [lindex $portInfo 1]]
if [info exists Vl_TrunkPort($ifIndex.$sess)] {set trunkList $Vl_TrunkPort($ifIndex.$sess)} else {set trunkList ""}
if {[set vList [vl_GetTrunkedVlans $x $y $trunkList]] != "" &&
		    [vl_SetTrunkPort $sess $ifIndex $vList]} {$w itemconfig $portItem -foreground black -bitmap @$Vl_ImagePath/trunkport.xbm
$w addtag TrunkPort withtag $portItem
set Vl_TrunkPort($ifIndex.$sess) $vList
if ![catch {set vlanId $PortItem($portItem)}] {vl_DeletePortFromVlan $sess $ifIndex $vlanId
unset PortItem($portItem)}
$w raise $dest
return 0} else {return 1}} else {return 1}
return 0}
proc vl_FormatPorts {portList} {upvar $portList ports
foreach p $ports {lappend dev([rlindex p 0]) [vl_Port2IfIndex [rlindex p 1]]}
set lab ""
foreach d [array names dev] {set src ""
foreach p [bit print [bit parse $dev($d)] range] {if {$p == "-"} {lappend src -} else {lappend src [vl_IfIndex2Port $p]}}
lappend lab "$d: $src"}
return $lab}
proc vl_RepositionPorts {w vlanItem} {set first 1
foreach s [$w find withtag selected] {if $first {set x2 [lindex [$w bbox $vlanItem] 2]
set sx1 [lindex [$w bbox $s] 0]
if ![set offset [expr int($x2-$sx1)-2]] return
set first 0}
$w move $s $offset 0}
foreach s [$w find withtag selectedText] {$w move $s $offset 0}}
proc vl_itemMark {w x y} {if {[$w itemcget current -tags] != ""} return
global vl_port
set vl_port(X) [$w canvasx $x]
set vl_port(Y) [$w canvasy $y]}
proc vl_itemStroke {w x y} {global Dm_Pref vl_port
if {![info exists vl_port(X)] || [$w itemcget current -tags] != ""} return
set x [$w canvasx $x]
set y [$w canvasy $y]
if {$vl_port(X) != $x && $vl_port(Y) != $y} {$w delete area
$w addtag area withtag [$w create rect $vl_port(X) $vl_port(Y) $x $y -outline $Dm_Pref(selectColor) -width 2]
set vl_port(X2) $x
set vl_port(Y2) $y}}
proc vl_itemsUnderArea {w} {if {[lindex [$w itemcget current -tags] 0] != "area"} return
global Dm_Pref vl_port
$w itemconfig selected -background [$w cget -bg]
$w dtag selected
$w dtag selectedText
foreach i [$w find enclosed $vl_port(X) $vl_port(Y) $vl_port(X2) $vl_port(Y2)] {if {[lindex [$w itemcget $i -tags] 0] == "Port"} {$w addtag selected withtag $i
$w itemconfig $i -background $Dm_Pref(selectColor)
$w addtag selectedText withtag [expr $i+1]}}
$w delete area}
proc vl_portDown {w x y} {global Dm_Pref vl_port
if {[lsearch [$w itemcget current -tags] selected] == -1} {if {[$w find withtag selected] != ""} {$w itemconfig selected -background [$w cget -bg]
$w dtag selected
$w dtag selectedText}
$w addtag selected withtag current
$w itemconfig current -background $Dm_Pref(selectColor)
foreach i [$w find withtag selected] {$w addtag selectedText withtag [expr $i+1]}}
$w raise selected
set vl_port(origX) [set vl_port(lastX) [$w canvasx $x]]
set vl_port(origY) [set vl_port(lastY) [$w canvasy $y]]}
proc vl_portMove {w x y} {global vl_port
set x [$w canvasx $x]
set y [$w canvasy $y]
$w move selected [expr $x-$vl_port(lastX)] [expr $y-$vl_port(lastY)]
$w move selectedText [expr $x-$vl_port(lastX)] [expr $y-$vl_port(lastY)]
set vl_port(lastX) $x
set vl_port(lastY) $y}
proc vl_portSpringBack {w} {global vl_port
$w move selected [expr $vl_port(origX)-$vl_port(lastX)] [expr $vl_port(origY)-$vl_port(lastY)]
$w move selectedText [expr $vl_port(origX)-$vl_port(lastX)] [expr $vl_port(origY)-$vl_port(lastY)]}
proc vl_AutoScan {w} {global tkPriv
if ![winfo exists $w] return
set x $tkPriv(x)
set y $tkPriv(y)
if {$y >= [winfo height $w]} {$w yview scroll 1 units} elseif {$y < 0} {$w yview scroll -1 units} elseif {$x >= [winfo width $w]} {$w xview scroll 2 units} elseif {$x < 0} {$w xview scroll -2 units} else {return}
set tkPriv(afterId) [after 50 vl_AutoScan $w]}
proc vl_ShowTrunk {w} {global VlanItem Vl_TrunkPort Dm_Pref
set textItem [$w find withtag current]
incr textItem
set portInfo [$w itemcget $textItem -text]
set sess [lindex $portInfo 0]
set ifIndex [vl_Port2IfIndex [lindex $portInfo 1]]
foreach id $Vl_TrunkPort($ifIndex.$sess) {if {[set pos [lrange [$w coords $VlanItem($id)] 0 1]] != ""} {eval $w create line $pos [lindex $pos 0] 20 -fill $Dm_Pref(selectColor) -width 2 -tags TrunkLink}}}
proc vl_SelectCurrentItem {w} {global Dm_Pref
if {[set s [$w find withtag selected]] != ""} {$w itemconfig selected -background [$w cget -bg]
$w dtag selected}
$w addtag selected withtag current
$w itemconfig selected -background $Dm_Pref(selectColor)}
proc vl_print {w {file ""}} {global Dm_Pref Dm_Status tcl_platform
set fontmap($Dm_Pref(boldFont)) {"-*-helvetica-bold-r-normal--12-8-*-*-*-*-*-*" 12}
set fontmap($Dm_Pref(normalFont)) {"-*-helvetica-medium-r-normal--12-8-*-*-*-*-*-*" 12}
set colormap(white) "1.0 1.0 0.0 setrgbcolor"
set width [lindex [$w cget -scrollregion] 2]
if {[set height [lindex [$w cget -scrollregion] 3]] > 950} {set height 950}
if {$file == ""} {set file $Dm_Pref(/tmp)/vlmgr.ps
if [file exists $file] {if [catch {chmod $file 666} err] {dm_Prompt .err $err Continue}}}
$w postscript -x 0 -y 0 -width $width -height $height -fontmap fontmap -colormap colormap -file $file
return $file}
proc vl_tidy {w} {global PortItem
$w delete all
catch {unset PortItem}
vl_drawVlan $w}
proc vl_bydevice {byDevice} {if $byDevice {pack forget .fV
vl_ViewByDevice .fD
pack .fD -before .status -fill both -expand 1
set state disabled} else {pack forget .fD
pack .fV -before .status -fill both -expand 1
set state normal}
foreach b {tidy newVlan delVlan} {.fTbar.$b config -state $state}}
proc vl_IfIndex2Port {inst} {if [catch {set ifName [expr $inst>>4]/[expr ($inst&15)+1]}] {return $inst}
return $ifName}
proc vl_Port2IfIndex {inst} {scan $inst %d/%d card port
return [expr ($card<<4)+($port-1)]}
proc vl_textInsert {w string} {if {$string == ""} {return}
catch {$w dchars tEdit sel.first sel.last}
$w insert tEdit insert $string}
proc vl_textPaste {w pos} {catch {
        $w insert tEdit $pos [selection get]
    }}
proc vl_textB1Press {w x y} {$w icursor current @$x,$y
$w focus current
focus $w
$w select from current @$x,$y
$w dtag tEdit
$w addtag tEdit withtag current}
proc vl_textB1Move {w x y} {$w select to tEdit @$x,$y}
proc vl_textBs {w} {if ![catch {$w dchars tEdit sel.first sel.last}] {return}
set char [expr {[$w index tEdit insert] - 1}]
if {$char >= 0} {$w dchar tEdit $char}}
proc vl_textDel {w} {if ![catch {$w dchars tEdit sel.first sel.last}] {return}
$w dchars tEdit insert}
proc vl_textEsc {w} {global Vlan
catch {
		set id [lindex [$w itemcget tEdit -tags] 1]
		$w itemconfig tEdit -text $Vlan($id.name)
		$w focus ""
	}}
proc vl_Domain {c} {global Dm_Pref Vl_Domain tcl_platform
set w .domain
if [winfo exists $w] {wm deiconify $w
$w.status config -text ""
raise $w
return}
toplevel $w
wm transient $w .
wm title $w "$Dm_Pref(progName) - Domain"
wm protocol $w WM_DELETE_WINDOW "$w.fBtn.cancel invoke"
frame $w.f -relief raised -bd 1
label $w.f.l0 -text Domains: -bd 0
frame $w.f.fDomain
listbox $w.f.fDomain.l -yscroll "$w.f.fDomain.sv set"
scrollbar $w.f.fDomain.sv -command "$w.f.fDomain.l yview"
pack $w.f.fDomain.sv -side right -fill y
pack $w.f.fDomain.l -expand 1 -fill both
bind $w.f.fDomain.l <ButtonRelease-1> "+vl_DomainExpand $w"
entry $w.f.eDomain
bind $w.f.eDomain <Return> "$w.fBtn.add invoke"
label $w.f.l1 -text Devices: -bd 0
frame $w.f.fDevice
listbox $w.f.fDevice.l -yscroll "$w.f.fDevice.sv set"
scrollbar $w.f.fDevice.sv -command "$w.f.fDevice.l yview"
pack $w.f.fDevice.sv -side right -fill y
pack $w.f.fDevice.l -expand 1 -fill both
entry $w.f.eDevice
label $w.f.lRead -text "Read Community:"
entry $w.f.eRead -width 12
$w.f.eRead insert 0 public
label $w.f.lWrite -text "Write Community:"
entry $w.f.eWrite -width 12
$w.f.eWrite insert 0 private
bind $w.f.eDevice <Return> "$w.fBtn.add invoke"
grid $w.f.l0 -column 0 -row 0 -sticky w
grid $w.f.fDomain -column 0 -row 1
pack $w.f -ipadx 2 -ipady 2 -fill both -expand 1
frame $w.fBtn -class FBtn
button $w.fBtn.edit -text "Edit >>" -command "vl_DomainEdit $w"
button $w.fBtn.add -text Add -command "vl_DomainAdd $w"
button $w.fBtn.remove -text Remove -command "vl_DomainRemove $w"
button $w.fBtn.open -text Open -command "vl_DomainOpenSelected $w $c"
button $w.fBtn.cancel -command "wm withdraw $w"
pack $w.fBtn.edit $w.fBtn.open $w.fBtn.cancel -side left
pack $w.fBtn -pady 5
pack [label $w.status -bd 0 -fg red] -anchor w
wm geom $w "+[winfo x .]+[winfo y .]"
bind $w <Escape> "$w.fBtn.cancel invoke"
focus $w.fBtn.open
if [catch {vl_DomainRead $w} err] {vl_DomainErr $w err} else {set Vl_Domain [$w.f.fDomain.l get 0]
$w.f.fDomain.l selection set 0}}
proc vl_DomainRead {w} {global Dm_Pref
if ![file isdirectory $Dm_Pref(vmdomain)] {if [file exists $Dm_Pref(vmdomain)] {file delete $Dm_Pref(vmdomain)}
file mkdir $Dm_Pref(vmdomain)}
if [catch {set files [glob $Dm_Pref(vmdomain)/*]}] {if [catch {close [open $Dm_Pref(vmdomain)/Default w]} err] {error $err} else {$w.f.fDomain.l insert end Default}} else {foreach f $files {$w.f.fDomain.l insert end [file tail $f]}}}
proc vl_DomainEdit {w} {grid $w.f.eDomain -column 0 -row 2 -sticky ew
grid $w.f.l1 -column 1 -columnspan 2 -row 0 -sticky w
grid $w.f.fDevice -column 1 -columnspan 2 -row 1 -sticky ew
grid $w.f.eDevice -column 1 -columnspan 2 -row 2 -sticky ew
grid $w.f.lRead -column 1 -row 3
grid $w.f.eRead -column 2 -row 3 -sticky ew
grid $w.f.lWrite -column 1 -row 4
grid $w.f.eWrite -column 2 -row 4 -sticky ew
pack forget $w.fBtn.edit
pack $w.fBtn.add $w.fBtn.remove -side left -before $w.fBtn.open}
proc vl_DomainAdd {w} {global Dm_Pref Vl_Domain
if {[set d [$w.f.eDomain get]] != ""} {loop i 0 [$w.f.fDomain.l size] {if {[$w.f.fDomain.l get $i] == $d} {set err "Duplicate name"
vl_DomainErr $w err
return}}
if [catch {close [open $Dm_Pref(vmdomain)/$d w]} err] {vl_DomainErr $w err
return} else {$w.f.fDomain.l insert end $d
$w.f.fDomain.l selection clear 0 end
$w.f.fDomain.l selection set end end
vl_DomainExpand $w
$w.f.eDomain delete 0 end}} elseif {[set d [$w.f.eDevice get]] != ""} {set d [lindex $d 0]
if [catch {getIPAddr $d}] {set err "Invalid device name"
vl_DomainErr $w err
return}
loop i 0 [$w.f.fDevice.l size] {if {[lindex [$w.f.fDevice.l get $i] 0] == $d} {set err "Duplicate name"
vl_DomainErr $w err
return}}
lappend d [$w.f.eRead get] [$w.f.eWrite get]
if ![catch {set fd [open $Dm_Pref(vmdomain)/$Vl_Domain a]} err] {puts $fd $d
close $fd
$w.f.fDevice.l insert end $d
$w.f.eDevice delete 0 end} else {vl_DomainErr $w err
return}}
$w.status config -text ""}
proc vl_DomainRemove {w} {global Dm_Pref Vl_Domain
if {"[set s [$w.f.fDomain.l curselection]]" >= 0} {set d [$w.f.fDomain.l get $s]
if [catch {file delete $Dm_Pref(vmdomain)/$d} err] {vl_DomainErr $w err} else {$w.f.fDomain.l delete $s
if {$d == $Vl_Domain} {$w.f.fDevice.l delete 0 end
$w.f.l1 config -text "Devices:"}}} elseif {"[$w.f.fDevice.l curselection]" >= 0} {if [catch {set fd [open $Dm_Pref(vmdomain)/$Vl_Domain w]} err] {vl_DomainErr $w err
return}
$w.f.fDevice.l delete [$w.f.fDevice.l curselection]
loop i 0 [$w.f.fDevice.l size] {puts $fd [$w.f.fDevice.l get $i]}
close $fd}}
proc vl_DomainExpand {w} {if ![winfo ismapped $w.f.fDevice.l] {$w.fBtn.open invoke
return}
global Dm_Pref Vl_Domain
set d [$w.f.fDomain.l get [$w.f.fDomain.l curselection]]
set f $Dm_Pref(vmdomain)/$d
$w.f.fDevice.l delete 0 end
if ![catch {set fd [open $f r]} err] {while {[set line [gets $fd]] != ""} {$w.f.fDevice.l insert end $line}
close $fd} else {vl_DomainErr $w err}
set Vl_Domain $d
$w.f.l1 config -text "Device, Communities ($Vl_Domain)"}
proc vl_DomainOpenSelected {w c} {if {[set d [$w.f.fDomain.l curselection]] == ""} {dm_Prompt .err "You must select a domain to open" Continue
return}
vl_DomainOpen $w $c $d}
proc vl_DomainOpen {w c d} {global Dm_Pref Dm_Version Vl_ByDevice
set f [$w.f.fDomain.l get $d]
if ![catch {set fd [open $Dm_Pref(vmdomain)/$f r]}] {while {[set line [gets $fd]] != ""} {lappend devices $line}
close $fd}
if ![info exists devices] {dm_Prompt .err "Please add devices to domain $f" Continue
return}
$w.fBtn.cancel invoke
if {$Vl_ByDevice == 1} {.mBar.view.m invoke 0}
vl_GetData $c devices
vl_tidy $c
wm title . "$Dm_Pref(progName) ($Dm_Version) - $f"
set Dm_Pref(lastDomainOpened) $d}
proc vl_DomainErr {w error} {upvar $error err
$w.status config -text $err
bell}
proc vl_Refresh {c} {global Dm_Pref
if [info exists Dm_Pref(lastDomainOpened)] {vl_DomainOpen .domain $c $Dm_Pref(lastDomainOpened)}}
proc vl_Log {{err ""}} {set w .log
if ![winfo exists $w] {global Dm_Pref tcl_platform
toplevel $w
if {$tcl_platform(platform) == "unix"} {wm transient $w .}
wm title $w "$Dm_Pref(progName) - Error Log"
wm geom $w "+[winfo x .]+[winfo y .]"
wm protocol $w WM_DELETE_WINDOW "$w.fBtn.cancel invoke"
frame $w.f -relief raised -bd 1
listbox $w.f.l -width 60 -yscroll "$w.f.sv set" -xscroll "$w.f.sh set"
scrollbar $w.f.sv -command "$w.f.l yview"
scrollbar $w.f.sh -command "$w.f.l xview" -orient horizontal
pack $w.f.sv -side right -fill y
pack $w.f.sh -side bottom -fill x
pack $w.f.l -expand 1 -fill both
pack $w.f -fill both -expand 1
frame $w.fBtn -class FBtn
button $w.fBtn.cancel -command "wm withdraw $w"
button $w.fBtn.clear -text Clear -command "$w.f.l delete 0 end"
pack $w.fBtn.clear $w.fBtn.cancel -pady 5 -side left
pack $w.fBtn
focus $w.fBtn.cancel
bind $w <Escape> "$w.fBtn.cancel invoke"}
if {$err != ""} {$w.f.l insert end $err} else {wm deiconify $w
raise $w}}
proc vl_LogClear {} {set w .log
if [winfo exists $w] {$w.fBtn.clear invoke}}
proc vl_Quit {} {catch {snmpexit}
exit}
proc vl_About {} {global Dm_Path Dm_Pref Dm_BuildTime
set w .about
if [winfo exists $w] {wm deiconify $w
raise $w
return}
toplevel $w
wm title $w "$Dm_Pref(progName) - About"
wm protocol $w WM_DELETE_WINDOW "$w.cancel invoke"
wm geom $w "+[winfo pointerx .]+[winfo pointery .]"
wm resizable $w 0 0
wm transient $w .
canvas $w.c -highlightthickness 0
$w.c xview moveto 0
$w.c xview moveto 0
image create photo logo -file $Dm_Path/bitmaps/logo.gif
set b [$w.c create image 0 0 -anchor nw -image logo]
scan [$w.c bbox $b] "%d%d%d%d" x y width height
$w.c config -width $width -height $height
pack $w.c
pack [label $w.l -text "(c) 1997 Bay Networks, Inc\nBuilt: $Dm_BuildTime"] -side left
pack [button $w.cancel -text Close -command "wm withdraw $w "] -side right
bind $w <Escape> "$w.cancel invoke"}
set Vl_Image(bydevice) [image create bitmap -data {
#define device.xbm_width 20
#define device.xbm_height 20
static unsigned char device.xbm_bits[] = {
0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x00, 0x28, 0x00, 0x00, 0x54, 0x00,
0x00, 0xaa, 0x00, 0x00, 0x55, 0x01, 0x80, 0xaa, 0x01, 0x40, 0xd5, 0x00,
0xa0, 0x6a, 0x00, 0x50, 0x35, 0x00, 0xa8, 0x1a, 0x00, 0x54, 0x0d, 0x00,
0xac, 0x06, 0x00, 0x58, 0xe3, 0x00, 0xb0, 0x61, 0x00, 0xe0, 0xa0, 0x00,
0x40, 0x00, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
}]
set Vl_Image(open) [image create bitmap -data {
#define open_width 20
#define open_height 20
static char open_bits[] = {
   0xe0, 0x3f, 0x00, 0x20, 0x60, 0x00, 0x20, 0xa0, 0x00, 0x20, 0xe0, 0x01,
   0x20, 0x00, 0x01, 0x20, 0x04, 0x01, 0x20, 0x0e, 0x01, 0x20, 0x1f, 0x01,
   0x20, 0x0e, 0x01, 0x20, 0x0e, 0x01, 0x20, 0x00, 0x01, 0xf0, 0xff, 0x0f,
   0xa8, 0xaa, 0x0a, 0xff, 0xff, 0x0d, 0xfe, 0xff, 0x0b, 0xfe, 0xff, 0x07,
   0xfc, 0xff, 0x07, 0xfc, 0xff, 0x07, 0xf8, 0xff, 0x0f, 0xf8, 0xff, 0x0f};
}]
set Vl_Image(tidy) [image create bitmap -data {
#define refresh.xbm_width 20
#define refresh.xbm_height 20
static unsigned char refresh.xbm_bits[] = {
0x00, 0x00, 0x00, 0x00, 0x00, 0x03, 0x00, 0x80, 0x03, 0x00, 0xc0, 0x01,
0x00, 0xe0, 0x00, 0x00, 0x70, 0x00, 0x00, 0x38, 0x00, 0x00, 0x1c, 0x00,
0x00, 0x0e, 0x00, 0x00, 0x07, 0x00, 0x80, 0x03, 0x00, 0x50, 0x01, 0x00,
0xe8, 0x00, 0x00, 0x54, 0x00, 0x00, 0xaa, 0x00, 0x00, 0x54, 0x00, 0x00,
0x2a, 0x00, 0x00, 0x14, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
}]
set Vl_Image(newVlan) [image create bitmap -data {
#define new.xbm_width 20
#define new.xbm_height 20
static unsigned char new.xbm_bits[] = {
0x00, 0x00, 0x00, 0x00, 0x04, 0x00, 0x80, 0x00, 0x00, 0x00, 0x10, 0x00,
0x00, 0x03, 0x00, 0x80, 0x09, 0x00, 0xc0, 0x00, 0x00, 0x60, 0x00, 0x00,
0x30, 0xfe, 0x00, 0x18, 0xfe, 0x00, 0x0c, 0xfe, 0x00, 0x06, 0xfe, 0x00,
0x02, 0x10, 0x00, 0xc0, 0xff, 0x07, 0x00, 0x01, 0x01, 0xc0, 0xef, 0x07,
0xc0, 0xef, 0x07, 0xc0, 0xef, 0x07, 0xc0, 0xef, 0x07, 0x00, 0x00, 0x00};
}]
set Vl_Image(delVlan) [image create bitmap -data {
#define delete.xbm_width 20
#define delete.xbm_height 20
static unsigned char delete.xbm_bits[] = {
0x10, 0x00, 0x00, 0x38, 0x00, 0x00, 0x7c, 0x04, 0x00, 0xfe, 0x6e, 0x00,
0x7f, 0x9f, 0x00, 0xbf, 0x3f, 0x03, 0xdf, 0x1f, 0x02, 0xae, 0x0f, 0x04,
0x74, 0xff, 0x0b, 0xf8, 0x02, 0x02, 0xfc, 0xab, 0x02, 0xfe, 0xaa, 0x02,
0x7c, 0xaa, 0x02, 0x38, 0xaa, 0x02, 0x10, 0xaa, 0x02, 0x00, 0xaa, 0x02,
0x00, 0xaa, 0x02, 0x00, 0x02, 0x02, 0x00, 0xfe, 0x03, 0x00, 0x00, 0x00};
}]
set Vl_Image(print) [image create bitmap -data {
#define print.xbm_width 20
#define print.xbm_height 20
static unsigned char print.xbm_bits[] = {
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x1f, 0x00, 0x10, 0x30, 0x00,
   0x10, 0x50, 0x00, 0x10, 0xf0, 0x00, 0x10, 0x80, 0x00, 0x10, 0x80, 0x00,
   0x10, 0x80, 0x00, 0x10, 0x80, 0x00, 0xf0, 0xff, 0x00, 0x00, 0x00, 0x00,
   0xfc, 0xff, 0x03, 0xfe, 0xff, 0x07, 0xfe, 0xff, 0x07, 0xfe, 0xff, 0x07,
   0xfe, 0xff, 0x07, 0xfc, 0xff, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
}]
set Vl_Image(help) [image create bitmap -data {
#define help_width 20
#define help_height 20
static char help_bits[] = {
   0x00, 0x00, 0x00, 0xe0, 0x3f, 0x00, 0xf0, 0x7f, 0x00, 0xf8, 0xff, 0x00,
   0xf8, 0xf8, 0x00, 0x78, 0xf0, 0x00, 0x78, 0xf0, 0x00, 0x00, 0xf8, 0x00,
   0x00, 0x7c, 0x00, 0x00, 0x3e, 0x00, 0x00, 0x1f, 0x00, 0x80, 0x0f, 0x00,
   0x80, 0x07, 0x00, 0x80, 0x07, 0x00, 0x80, 0x07, 0x00, 0x00, 0x00, 0x00,
   0x80, 0x07, 0x00, 0x80, 0x07, 0x00, 0x80, 0x07, 0x00, 0x00, 0x00, 0x00};
}]
set Vl_Image(reload) [image create bitmap -data {
#define reload_width 20
#define reload_height 20
static char reload_bits[] = {
 0x00,0x00,0xf0,0x00,0x00,0xf0,0xc0,0x3f,0xf0,0x20,0x7d,0xf0,0x10,0xfc,0xf0,
 0x01,0xc0,0xf1,0x02,0xe0,0xf1,0x08,0xfc,0xf1,0x10,0xfe,0xf1,0x20,0xff,0xf1,
 0xc0,0xfb,0xf1,0x80,0xf9,0xf1,0x00,0xf8,0xf5,0x00,0xe0,0xfd,0x00,0xf0,0xf7,
 0x20,0xf5,0xf7,0xe0,0xff,0xf7,0xc0,0xff,0xf3,0x80,0xff,0xf1,0x00,0x00,0xf0
 };
}]
set Dm_Pref(progName) "VLAN Manager"
set SNMPAPI_VERSION 2
set Vl_ByDevice 0
set Vl_ShowDynamic 1
if [catch {set Dm_Path $env(DMPATH)} err] {set Dm_Path [file dirname [file dirname [info nameofexecutable]]]
set env(DMPATH) $Dm_Path}
if [catch {
	source $Dm_Path/dm.ini
	source $Dm_Path/lib/dmdialog.tcl
	source $Dm_Path/lib/dmprint.tcl
	source $Dm_Path/vmid.tcl
   } err] {tk_dialog .err $Dm_Pref(progName) $err error 0 Exit}
if ![info exists env(HOME)] {set env(HOME) $Dm_Path}
if {$tcl_platform(platform) == "unix"} {set Dm_Pref(vmdomain) $env(HOME)/vmdomain} else {set Dm_Pref(vmdomain) [file join [file split $env(HOME)] vmdomain]}
if {$tcl_platform(os) != "AIX"} {if [info exists env(DMOS)] {set bin bin.$env(DMOS)} else {set bin bin}
foreach ext {dms snmp} {if [catch {load $Dm_Path/$bin/$ext[info sharedlibextension]} err] {wm withdraw .
dm_Prompt .err "$Dm_Pref(progName) failure:\n$err" Exit
exit}}}
set Vl_ImagePath $Dm_Pref(vmData)/bitmaps
if [catch {mibload $Dm_Pref(vmData)/mibs/mib.dat} msg] {error $msg
exit}
wm title . "$Dm_Pref(progName) ($Dm_Version)"
wm protocol . WM_DELETE_WINDOW vl_Quit
frame .mBar -class Menubar
menubutton .mBar.file -text File -und 0 -menu .mBar.file.m
menu .mBar.file.m
.mBar.file.m add command -label "Open..." -und 0 -command "vl_Domain .fV.c" -accelerator Ctrl+O
bind . <Control-o> ".mBar.file.m invoke 0"
.mBar.file.m add command -label "Refresh from Network" -und 0 -command "vl_Refresh .fV.c"
.mBar.file.m add command -label "Print..." -und 0 -command {dm_Print "vl_print .fV.c"} -accelerator Ctrl+P
bind . <Control-p> ".mBar.file.m invoke 2"
.mBar.file.m add cascade -label "Launch Device Manager" -und 0 -menu .mBar.file.m.dm -state disabled
menu .mBar.file.m.dm
.mBar.file.m add separator
.mBar.file.m add command -label "Exit" -und 1 -command vl_Quit -accelerator Alt+F4
menubutton .mBar.edit -text Edit -und 0 -menu .mBar.edit.m
menu .mBar.edit.m
.mBar.edit.m add command -label "Create VLAN..." -und 0 -command vl_newVlan
.mBar.edit.m add command -label "Delete VLAN" -und 0 -command "vl_delVlan .fV.c"
.mBar.edit.m add command -label "VLAN Attributes..." -und 0 -command "vl_VlanAttributes .fV.c"
menubutton .mBar.view -text View -und 0 -menu .mBar.view.m
menu .mBar.view.m
.mBar.view.m add checkbutton -label "By Device" -und 0 -variable Vl_ByDevice -command {vl_bydevice $Vl_ByDevice}
.mBar.view.m add checkbutton -label "Policy VLANs" -und 0 -variable Vl_ShowDynamic -command {vl_tidy .fV.c}
.mBar.view.m add command -label "Tidy" -und 0 -command "vl_tidy .fV.c"
.mBar.view.m add command -label "Error Log..." -und 0 -command vl_Log
pack .mBar.file .mBar.edit .mBar.view -side left
menubutton .mBar.help -text Help -und 0 -menu .mBar.help.m
menu .mBar.help.m
.mBar.help.m add command -label "Contents..." -und 0 -command "dm_Help /help/vlanhelp.html"
.mBar.help.m add cascade -label "Legend" -und 0 -menu .mBar.help.m.legend
menu .mBar.help.m.legend -tearoff 1
foreach {file accel} {
	vlan.xbm "Port VLAN"
	dynamicvlan.xbm "Policy VLAN (Protocol/IP Subnet)"
	port.xbm "Static Port"
	trunkport.xbm "Tagged Port"
	routeport.xbm "Routable Port"
	routeport.xbm "BRouter Port"
	activeport.xbm "Policy-activated Port"
	notallow.xbm "Policy-forbidden Port"} {.mBar.help.m.legend add command -bitmap @$Vl_ImagePath/$file -accelerator $accel}
.mBar.help.m.legend entryconfig 6 -foreground red
.mBar.help.m.legend entryconfig end -foreground red
.mBar.help.m add separator
.mBar.help.m add command -label "About..." -und 0 -command vl_About
pack .mBar -fill x
frame .fTbar
checkbutton .fTbar.bydevice -image $Vl_Image(bydevice) -text {View By Device} -variable Vl_ByDevice -selectcolor [. cget -bg] -command {vl_bydevice $Vl_ByDevice} -indicatoron 0
dm_ToolTipBind .fTbar.bydevice
label .fTbar.sep -text " "
pack .fTbar.bydevice .fTbar.sep -side left
foreach {name help cmd} {
	reload {Refresh VLAN Data from Network} {.mBar.file.m invoke 1}
	open {Open Domain} {.mBar.file.m invoke 0}
	tidy {Tidy icons} {.mBar.view.m invoke 2}
	newVlan {New VLAN} {.mBar.edit.m invoke 0}
	delVlan {Delete VLAN} {.mBar.edit.m invoke 1}
	print {Print View} {.mBar.file.m invoke 2}
	help {Help} {.mBar.help.m invoke 0}
	} {pack [button .fTbar.$name -image $Vl_Image($name) -text $help -command $cmd] -side left
dm_ToolTipBind .fTbar.$name}
pack .fTbar -fill x
if {$tcl_platform(platform) == "unix"} {pack .mBar.help -side right
bind . <Alt-F4> vl_Quit
catch {wm iconbitmap . @$Dm_Path/bitmaps/logo.xbm}} else {pack .mBar.help -side left
.fTbar config -relief sunken
catch {info hostname}}
vl_CreateCanvas .fV
set c .fV.c
pack .fV -fill both -expand 1
bind $c <1> "vl_itemMark %W %x %y; tkCancelRepeat"
bind $c <B1-Motion> "vl_itemStroke %W %x %y"
bind $c <ButtonRelease-1> "vl_itemsUnderArea %W"
bind $c <B1-Leave> {
	set tkPriv(x) %x
	set tkPriv(y) %y
	vl_AutoScan %W
}
bind $c <B1-Enter> tkCancelRepeat
$c bind Port <1> "vl_portDown $c %x %y"
$c bind Port <ButtonRelease-1> "vl_portRelease $c %x %y"
$c bind Port <B1-Motion> "vl_portMove $c %x %y"
$c bind TrunkPort <1> "$c itemconfig current -foreground $Dm_Pref(selectColor); vl_ShowTrunk $c"
$c bind TrunkPort <ButtonRelease-1> "catch {$c itemconfig current -foreground black; $c delete TrunkLink}"
$c bind TrunkPort <Double-1> "vl_TrunkAttributes $c"
$c bind Vlan <1> "vl_SelectCurrentItem $c"
$c bind Vlan <Double-1> "vl_VlanAttributes $c"
$c bind VlanName <1> "vl_textB1Press $c %x %y"
$c bind VlanName <B1-Motion> "vl_textB1Move $c %x %y"
$c bind VlanName <Shift-1> "$c select adjust current @%x,%y"
$c bind VlanName <Shift-B1-Motion> "vl_textB1Move $c %x %y"
$c bind VlanName <KeyPress> "vl_textInsert $c %A"
$c bind VlanName <Return> "vl_VlanRename $c"
$c bind VlanName <Control-h> "vl_textBs $c"
$c bind VlanName <BackSpace> "vl_textBs $c"
$c bind VlanName <Delete> "vl_textDel $c"
$c bind VlanName <2> "vl_textPaste $c @%x,%y"
$c bind VlanName <Escape> "vl_textEsc $c"
vl_CreateCanvas .fD
.fD.c bind Device <1> "vl_SelectCurrentItem .fD.c"
.fD.c bind Device <Double-1> "vl_ExecDM .fD.c"
pack [label .status -relief sunken -anchor w -textvariable Dm_Status] -fill x
foreach e [snmpinfo mibprop rcErrorReturnCode enums] {set SnmpPropErrors([rlindex e 0]) [rlindex e 1]}
set Vl_SessList {}
set Vl_VlanList {}
update idletasks
.mBar.file.m invoke 0
