<commit_before>#!/usr/bin/perl -w

#
# {{{EMULAB-LGPL
# 
# This file is part of the Emulab network testbed software.
# 
# This file is free software; you can redistribute it and/or modify it
# under the terms of the GNU Lesser General Public License as published by
# the Free Software Foundation; either version 2.1 of the License, or (at
# your option) any later version.
# 
# This file is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
# License for more details.
# 
# You should have received a copy of the GNU Lesser General Public License
# along with this file.  If not, see <http://www.gnu.org/licenses/>.
# 
# }}}
#
# Copyright (c) 2000-2014 University of Utah and the Flux Group.
# Copyright (c) 2004-2014 Regents, University of California.
# All rights reserved.
#

#
# snmpit module for HP procurve and flexfabric (comware) switches.
# The Comware module (snmpit_h3c) inherits from the base (snmpit_hp) class.
#

# XXX: krw: Rename base HP module here so that we don't actually use
#      this for the procurve models until I have more time to integrate.
package snmpit_hpupd;
use strict;

$| = 1; # Turn off line buffering on output

use English;
use SNMP;
use Carp qw(cluck);
use lib '/usr/testbed/lib';
use snmpit_lib;

use libtestbed;
use Lan;
use Port;

#
# These are the commands that can be passed to the portControl function
# below
#
my %cmdOIDs =
(
    "enable" => ["ifAdminStatus","up"],
    "disable"=> ["ifAdminStatus","down"],
    "1000mbit"=> ["hpSwitchPortFastEtherMode","auto-1000Mbits"],
    "100mbit"=> ["hpSwitchPortFastEtherMode","auto-100Mbits"],
    "10mbit" => ["hpSwitchPortFastEtherMode","auto-10Mbits"],
    "auto"   => ["hpSwitchPortFastEtherMode","auto-neg"],
    "full"   => ["hpSwitchPortFastEtherMode","full"],
    "half"   => ["hpSwitchPortFastEtherMode","half"],
);

#
# some long OIDs that get used frequently.
#
my $normOID = "dot1qVlanStaticUntaggedPorts";
my $forbidOID = "dot1qVlanForbiddenEgressPorts";
my $egressOID = "dot1qVlanStaticEgressPorts";
my $aftOID = "dot1qPortAcceptableFrameTypes";
my $createOID = "dot1qVlanStaticRowStatus";

#
# Enterprise OID for toggling jumbo frame support on a vlan
#
my $jumboOID = '1.3.6.1.4.1.11.2.14.11.5.1.12.1.8.1.1.1';

#
# Openflow OIDs, only number format now.
#
#my $ofOID = 'iso.org.dod.internet.private.enterprises.172.16.58.3.5.1.7.1.35';
my $ofOID = '1.3.6.1.4.1.11.2.14.11.5.1.7.1.35';
my $ofEnableOID     = $ofOID.'.1.1.2';
my $ofControllerOID = $ofOID.'.1.1.3';
my $ofListenerOID   = $ofOID.'.1.1.4';
my $ofFailModeOID   = $ofOID.'.1.1.11';
my $ofSupportOID    = $ofOID.'.2.1.0';

# This string is enough now, but the Openflow OID may change in future. 
# The maintainers should keep in mind of this ID. 
my $ofListenerVarNameMarker = '35.1.1.4';

#
# Ports can be passed around in three formats:
# ifindex: positive integer corresponding to the interface index (eg. 42)
# modport: dotted module.port format, following the physical reality of
#	Cisco switches (eg. 5.42)
# nodeport: node:port pair, referring to the node that the switch port is
# 	connected to (eg. "pc42:1")
#
# See the function convertPortFormat below for conversions between these
# formats
#
my $PORT_FORMAT_IFINDEX  = 1;
my $PORT_FORMAT_MODPORT  = 2;
my $PORT_FORMAT_NODEPORT = 3;  # XXX - not used anymore here.
my $PORT_FORMAT_PORT = 4;

#
# Creates a new object.
#
# usage: new($classname,$devicename,$debuglevel,$community)
#        returns a new object, blessed into the snmpit_intel class.
#
sub new($$$;$) {

    # The next two lines are some voodoo taken from perltoot(1)
    my $proto = shift;
    my $class = ref($proto) || $proto;

    my $name = shift;
    my $debugLevel = shift;
    my $community = shift;

    #
    # Create the actual object
    #
    my $self = {};

    #
    # Set the defaults for this object
    # 
    if (defined($debugLevel)) {
	$self->{DEBUG} = $debugLevel;
    } else {
	$self->{DEBUG} = 0;
    }
    $self->{BLOCK} = 1;
    $self->{CONFIRM} = 1;
    $self->{NAME} = $name;

    #
    # Get config options from the database
    #
    my $options = getDeviceOptions($self->{NAME});
    if (!$options) {
	warn "ERROR: Getting switch options for $self->{NAME}\n";
	return undef;
    }

    $self->{MIN_VLAN}         = $options->{'min_vlan'};
    $self->{MAX_VLAN}         = $options->{'max_vlan'};

    if ($community) { # Allow this to over-ride the default
	$self->{COMMUNITY}    = $community;
    } else {
	$self->{COMMUNITY}    = $options->{'snmp_community'};
    }

    # Use jumbo frames?
    if (exists($options->{'use_jumbo'}) 
	&& $options->{'use_jumbo'} == 1) {
	$self->{DOJUMBO} = 1;
    } else {
	$self->{DOJUMBO} = 0;
    }

    #
    # set up hashes for internal use
    #
    $self->{IFINDEX} = {};
    $self->{TRUNKINDEX} = {};
    $self->{TRUNKS} = {};
    $self->{cmdOIDs} = \%cmdOIDs;

    # other global variables
    $self->{DOALLPORTS} = 0;
    $self->{DOALLPORTS} = 1;
    $self->{SKIPIGMP} = 1;

    if ($self->{DEBUG}) {
	print "snmpit_hp initializing $self->{NAME}, " .
	    "debug level $self->{DEBUG}\n" ;   
    }


    #
    # Set up SNMP module variables, and connect to the device
    #
    $SNMP::debugging = ($self->{DEBUG} - 2) if $self->{DEBUG} > 2;
    my $mibpath = '/usr/local/share/snmp/mibs';
    &SNMP::addMibDirs($mibpath);
    &SNMP::addMibFiles("$mibpath/SNMPv2-SMI.txt", "$mibpath/SNMPv2-TC.txt", 
	               "$mibpath/SNMPv2-MIB.txt", "$mibpath/IANAifType-MIB.txt",
		       "$mibpath/IF-MIB.txt", "$mibpath/BRIDGE-MIB.txt", 
		       "$mibpath/IEEE8023-LAG-MIB.txt",
		       "$mibpath/HP-ICF-OID.txt", "$mibpath/HH3C-OID-MIB.txt",
		       "$mibpath/HH3C-SPLAT-INF.txt", 
		       "$mibpath/HH3C-PRODUCT-ID.txt");
    $SNMP::save_descriptions = 1; # must be set prior to mib initialization
    SNMP::initMib();		  # parses default list of Mib modules 
    $SNMP::use_enums = 1;	  # use enum values instead of only ints

    warn ("Opening SNMP session to $self->{NAME}...") if ($self->{DEBUG});

    $self->{SESS} = new SNMP::Session(DestHost => $self->{NAME},Version => "2c",
	Timeout => 3000000, Retries=> 9, Community => $self->{COMMUNITY});

    if (!$self->{SESS}) {
	#
	# Bomb out if the session could not be established
	#
	warn "WARNING: Unable to connect via SNMP to $self->{NAME}\n";
	return undef;
    }
    #
    # The bless needs to occur before readifIndex(), since it's a class 
    # method
    #

    #
    # Sometimes the SNMP session gets created when there is no connectivity
    # to the device so let's try something simple
    #
    my $test_case = snmpitGet($self->{SESS}, ["sysObjectID", 0], 1);
    if (!defined($test_case)) {
	warn "WARNING: Unable to retrieve via SNMP from $self->{NAME}\n";
	return undef;
    }
    $self->{HPTYPE} = SNMP::translateObj($test_case);

    warn ("Queried switch type: $self->{HPTYPE}\n") if ($self->{DEBUG});

    $class = $self->{H3C} = 'snmpit_h3c'
	if ($test_case =~ '^.1.3.6.1.4.1.25506');
    bless($self,$class);
    $self->readifIndex();

    return $self;
}

# Attempt to repeat an action until it succeeds

sub hammer($$$;$) {
    my ($self, $closure, $id, $retries) = @_;

    if (!defined($retries)) { $retries = 12; }
    for my $i (1 .. $retries) {
	my $result = $closure->();
	if (defined($result) || ($retries == 1)) { return $result; }
	warn $id . " ... will try again\n";
	sleep 1;
    }
    warn  $id . " .. giving up\n";
    return undef;
}

# shorthand

sub printSnmpErr($$) {
    my ($sess, $id) = @_;
    if ($sess->{ErrorNum}) {
	print "$id had error number " . $sess->{ErrorNum} .
		  " and had error string " . $sess->{ErrorStr} . "\n";
    }
}

sub get1($$$) {
    my ($self, $obj, $instance) = @_;
    my $id = $self->{NAME} . "::get1($obj.$instance)";
    my $closure = sub () {
	my $RetVal = snmpitGet($self->{SESS}, [$obj, $instance], 1);
	if (!defined($RetVal)) { sleep 4;}
	return $RetVal;
    };
    my $RetVal = $self->hammer($closure, $id, 40);
    printSnmpErr($self->{SESS}, $id)
	if (!defined($RetVal));
    return $RetVal;
}

sub set($$;$$) {
    my ($self, $varbind, $id, $retries) = @_;
    if (!defined($id)) { $id = $self->{NAME} . ":set "; }
    if (!defined($retries)) { $retries = 2; }
    my $sess = $self->{SESS};
    my $closure = sub () {
	my $RetVal = $sess->set($varbind);
	my $status = $RetVal;
	if (!defined($RetVal)) {
	    $status = "(undefined)";
	    printSnmpErr($sess, $id);
	}
	return $RetVal;
    };
    my $RetVal = $self->hammer($closure, $id, $retries);
    return $RetVal;
}

sub mirvPortSet($) {
    my ($bitfield) = @_;
    $bitfield = substr($bitfield,0,127);
    my $unpacked = unpack("B*",$bitfield);
    return [split //, $unpacked];
}

sub testPortSet($$) {
    my ($bitfield, $index) = @_;
    return @{mirvPortSet($bitfield)}[$index];
}

#
# opPortSet($op, $bitfield, @indices)
# set or clear bits in a port set,  $op > 0 means set, otherwise clear
#
sub opPortSet($$@) {
    my ($op, $bitfield, @indices) = @_;
    my @bits = mirvPortSet($bitfield);

    foreach my $index (@indices) { $bits[$index] = $op > 0 ? 1 : 0; }

    return pack("B*", join('',@bits));
}

# Translate a list of ifIndexes to a PortSet

sub listToPortSet($@)
{
    my $self = shift;
    my @ports = @_;

    my ($max, $portbitstring, $portSet, $port);
    my @portbits;

    $self->debug("listToPortsSet: input @ports\n",2);
    if (scalar @ports) {
	@ports = sort { $b <=> $a} @ports;
	$max = ($ports[0] | 7);
    } else { $max = 7 ; }
    $port = 0;
    while ($port <= $max) { $portbits[$port] = 48 ; $port++; }
    while (scalar @ports) { $port = pop @ports; $portbits[$port - 1] = 49; }
    $self->debug("portbits after insertions: @portbits\n",2);
    $portbitstring = pack "C*", @portbits;
    $self->debug("listToPortSet output string $portbitstring \n");
    $portSet = pack "B*", $portbitstring ;
    return $portSet;
}

# Translate a PortSet to a list of ifIndexes

sub bitSetToList($)
{
    my ($arrayref) = @_;
    my @ports = ();
    my $max = scalar (@$arrayref);

    for (my $port = 0; $port < $max; $port++)
	{ if (@$arrayref[$port]) { push @ports, (1 + $port); } }
    return @ports;
}

sub portSetToList($$) {
    my ($self, $portset) = @_;
    return bitSetToList(mirvPortSet($portset));
}

sub getOidToMappedList($$$) {
    my ($self, $oid, $idx) = @_;
    if (my $bits = $self->get1($oid,$idx)) {
	return $self->portSetToList($bits);
    } else { return (); }
}

sub trunkedPorts($@) {
    my ($self, @ports) = @_;
    my ($trunks, $dualPorts, $modes, $pids, $j, @nports) = ({}, {});
    @$dualPorts{$self->portSetToList($self->get1($forbidOID,1))} = undef;
    if (@ports) {
	$modes = [ map { [ $aftOID, $_ ] } @ports ];
	$j = $self->{SESS}->get($modes);
    } else {
	($modes) = $self->{SESS}->bulkwalk(0,32, [$aftOID]);
    }
    foreach my $aref (@$modes) {
	my ($name, $ifIndex, $val) = @$aref;
	if ($val eq 'admitOnlyVlanTagged') {
	    $$trunks{$ifIndex} = 1;
	} elsif (exists($$dualPorts{$ifIndex})) {
	    $$trunks{$ifIndex} = $self->get1('dot1qPvid', $ifIndex);
	}
    }
    return ($trunks);
}

#
# Set a variable associated with a port. The commands to execute are given
# in the cmdOIs hash above
#
# usage: portControl($self, $command, @ports)
#	 returns 0 on success.
#	 returns number of failed ports on failure.
#	 returns -1 if the operation is unsupported
#
sub portControl ($$@) {
    my $self = shift;

    my $cmd = shift;
    my @ports = @_;
    my $cmdOIDs = $self->{cmdOIDs};

    $self->debug("portControl: $cmd -> (@ports)\n");

    #
    # Find the command in the %cmdOIDs hash (defined at the top of this file).
    # Some commands involve multiple SNMP commands, so we need to make sure
    # we get all of them
    #
    if (defined $$cmdOIDs{$cmd}) {
	my @oid = @{$$cmdOIDs{$cmd}};
	my $errors = 0;

	while (@oid) {
	    my $myoid = shift @oid;
	    my $myval = shift @oid;
	    $errors += $self->UpdateField($myoid,$myval,@ports);
	}
	return $errors;
    } else {
	#
	# Command not supported
	#
	$self->debug("Unsupported port control command '$cmd' ignored.\n");
	return 0;
    }
}

#
# Get a vlan's ifindex given it's tag
#
sub getVlanIfindexFromTag($$) {
    my ($self, $tag) = @_;
    my $id = $self->{NAME} . "::getVlanIfindexFromTag";

    my ($rows) = snmpitBulkwalkFatal($self->{SESS}, ["ifDescr"]);

    if (!@$rows) {
	warn "$id: ERROR: No interface description rows returned ".
	     "while attempting to search for vlan ifindex!\n";
	return undef;
    }

    foreach my $rowref (@$rows) {
	my ($name,$ifindex,$descr) = @$rowref;
	next unless $descr =~ /VLAN(\d+)/i;
	if ($tag == $1) {
	    return $ifindex;
	}
    }

    warn "$id: no ifindex found for vlan with tag: $tag\n";
    return undef;
}

#
# Set jumbo frames on a vlan
#
sub setVlanJumbo($$) {
    my ($self, $tag) = @_;
    my $id = $self->{NAME} . "::setVlanJumbo";

    my $vifindex = $self->getVlanIfindexFromTag($tag);
    goto bad if !defined($vifindex);

    $self->debug("id: Enabling jumbo frames on vlan $tag (ifindex: $vifindex)\n");

    my $res = $self->set([$jumboOID,$vifindex,1,"INTEGER"], $id);
    goto bad if !defined($res);

    return 0;

  bad:
    warn "$id: Could not enable jumbo frames for vlan with tag: $tag\n";
    return 1;
}



#
# HP's refuse to create vlans with display names that can
# be interpreted as vlan numbers
#
sub convertVlanName($) {
	my $id = shift;
	my $new;
	if ( $id =~ /^_(\d+)$/) {
	    $new = $1;
	    return ((($new > 0) && ($new  < 4095)) ? $new : $id);
	}
	if ( $id =~ /^(\d+)$/) {
	    $new = $1;
	    return ((($new > 0) && ($new  < 4095)) ? "_$new" : $id);
	}
	return $id;
}

#
# Try to pull a VLAN number out of a long OID string
#
sub parseVlanNumberFromOID($) {
    my ($oid) = @_;
    # OID must be a dotted string
    my (@elts) = split /\./, $oid;
    if (scalar(@elts) < 2) {
        return undef;
    }
    # Second-to-last element must be the right text string or numeric ID
    if ($elts[$#elts-1] eq "dot1qVlanStaticName" || $elts[$#elts-1] eq "1") {
        # Last element must be numeric
        if ($elts[$#elts] =~ /\d+/) {
            return $elts[$#elts];
        } else {
            return undef;
        }
    } else {
        return undef;
    }
}

sub checkLACP($$) {
   my ($self, $port) = @_;
   if (my $j = $self->{TRUNKINDEX}{$port})
       { $port = $j + $self->{TRUNKOFFSET}; }
   return $port;
}

#
# Convert a set of ports to an alternate format. The input format is detected
# automatically. See the declarations of the constants at the top of this
# file for a description of the different port formats.
#
# usage: convertPortFormat($self, $output format, @ports)
#        returns a list of ports in the specified output format
#        returns undef if the output format is unknown
#
# TODO: Add debugging output, better comments, more sanity checking
#
sub convertPortFormat($$@) {
    my $self = shift;
    my $output = shift;
    my @ports = @_;
    my @results = ();

    #
    # Avoid warnings by exiting if no ports given
    # 
    if (!@ports) {
	return ();
    }

    #
    # We determine the type by sampling the first port given
    #
    my $sample = $ports[0];
    if (!defined($sample)) {
	warn "convertPortFormat: Given a bad list of ports\n";
	return undef;
    }

    my $input;
    SWITCH: for ($sample) {
    	(Port->isPort($sample)) && do { $input = $PORT_FORMAT_PORT; last; };
	(/^\d+$/) && do { $input = $PORT_FORMAT_IFINDEX; last; };
	(/^\d+\.\d+$/) && do { $input = $PORT_FORMAT_MODPORT; last; };
	(/^$self->{NAME}\.\d+\/\d+$/) && do { $input = $PORT_FORMAT_MODPORT;
		@ports = map {/^$self->{NAME}\.(\d+)\/(\d+)$/; "$1.$2";} @ports; last; };
	warn "convertPortFormat: Unknown input port format: $sample\n"; 
	return ();
    }

    #
    # It's possible the ports are already in the right format
    #
    if ($input == $output) {
	if ($input == $PORT_FORMAT_IFINDEX) {
	    @results = map $self->checkLACP($_), @ports;
	    goto done;
	}
	$self->debug("Not converting, input format = output format\n",3);
	return @ports;
    }

    my $name = $self->{NAME};
    if ($input == $PORT_FORMAT_IFINDEX) {
	my $ifxModport = sub ($) {
	    my ($port, $modport) = ($_, $self->{IFINDEX}{$_});
	    print "$name: no modport for ifindex $port\n" unless ($modport);
	    return $modport ? $modport : "1.$port";
	};
	my @modports = map $ifxModport->($_), @ports;
	if ($output == $PORT_FORMAT_MODPORT) {
	    $self->debug("Converting ifindex to modport\n",3);
	    @results = @modports;
	    goto done;
	} elsif ($output == $PORT_FORMAT_PORT) {
	    $self->debug("Converting ifindex to Port object\n",3);
	    @results = map Port->LookupByStringForced("$name:$_"), @modports;
	    goto done;
	}
    } elsif ($input == $PORT_FORMAT_MODPORT) {
	if ($output == $PORT_FORMAT_IFINDEX) {
	    $self->debug("Converting modport to ifindex\n",3);
	    @results = map $self->{IFINDEX}{$_}, @ports;
	    goto done;
	} elsif ($output == $PORT_FORMAT_PORT) {
	    $self->debug("Converting ifindex to Port object\n",3);
	    @results = map Port->LookupByStringForced("$name:$_"), @ports;
	    goto done;
	}
    } elsif ($input == $PORT_FORMAT_PORT) { 
    	if ($output == $PORT_FORMAT_IFINDEX) {
            $self->debug("Converting Port object to ifindex\n",3);
            @results = map $self->{IFINDEX}{(split /:/,
                                         ($_->node_id() eq $self->{NAME})?
                                         $_->toTripleString():
                                         $_->getOtherEndTripleString()
                )[1]}, @ports;
	    goto done;
        } elsif ($output == $PORT_FORMAT_MODPORT) {
            $self->debug("Converting Port object to modport\n",3);
            @results = map { (split /:/,
                          ($_->node_id() eq $self->{NAME})?
                          $_->toTripleString():
                          $_->getOtherEndTripleString()
                )[1]} @ports;
	    goto done;
	}
    }

    #
    # Some combination we don't know how to handle
    #
    warn "convertPortFormat: Bad input/output combination ($input/$output)\n";
    return ();

  done:
    #
    # The control flow change was to facilitate trying to debug an
    # odd problem in Utah on the procuve-geni switches.
    #
    if (@results) {
	foreach my $port (@results) {
	    my $inport = shift(@ports);
	    if (!defined($port)) {
		print STDERR "convertPortFormat: Bad conversion for $inport ".
		    "($input/$output)\n";
		return ();
	    }
	    #print STDERR "convertPortFormat: $inport/$port\n";
	}
    }
    return @results;
}
# 
# Check to see if the given 802.1Q VLAN tag exists on the switch
#
# usage: vlanNumberExists($self, $vlan_number)
#        returns 1 if the VLAN exists, 0 otherwise
#
sub vlanNumberExists($$) {
    my ($self, $vlan_number) = @_;

    my $rv = $self->get1("dot1qVlanStaticRowStatus", $vlan_number);
    if (!defined($rv) || !$rv || $rv ne "active") {
	return 0;
    }
    return 1;
}

#
# Given VLAN indentifiers from the database, finds the 802.1Q VLAN
# number for them. If not VLAN id is given, returns mappings for the entire
# switch.
# 
# usage: findVlans($self, @vlan_ids)
#        returns a hash mapping VLAN ids to 802.1Q VLAN numbers
#        any VLANs not found have NULL VLAN numbers
#
sub findVlans($@) { 
    my $self = shift;
    my @vlan_ids = @_;
    my %mapping = ();
    my $id = $self->{NAME} . "::findVlans";
    my ($count, $name, $vlan_number, $vlan_name) = (scalar(@vlan_ids));
    $self->debug("$id\n");

    if ($count > 0) { @mapping{@vlan_ids} = undef; }

    #
    # Find all VLAN names. Do one to get the first field...
    #
    my ($rows) = $self->{SESS}->bulkwalk(0,32, ["dot1qVlanStaticName"]);
    foreach my $rowref (@$rows) {
	($name,$vlan_number,$vlan_name) = @$rowref;
	$self->debug("$id: Got $name $vlan_number $vlan_name\n",2);
        # Hack to get around some strange behavior
        if ((!defined($vlan_number) || $vlan_number eq "") &&
                defined(parseVlanNumberFromOID($name))) {
            $vlan_number = parseVlanNumberFromOID($name);
            $self->debug("Changed vlan_number to $vlan_number\n",3);
        }
	$vlan_name = convertVlanName($vlan_name);
	#
	# We only want the names - we ignore everything else
	#
	    if (!@vlan_ids || exists $mapping{$vlan_name}) {
		$self->debug("$id: $vlan_name=>$vlan_number\n",2);
		$mapping{$vlan_name} = $vlan_number;
	    }
    }

    return %mapping;
}

#
# Given a VLAN identifier from the database, find the 802.1Q VLAN
# number that is assigned to that VLAN. Retries several times (to account
# for propagation delays) unless the $no_retry option is given.
#
# usage: findVlan($self, $vlan_id,$no_retry)
#        returns the VLAN number for the given vlan_id if it exists
#        returns undef if the VLAN id is not found
#
sub findVlan($$;$) { 
    my $self = shift;
    my $vlan_id = shift;
    my $no_retry = shift;
    my $id = $self->{NAME} . ":findVlan";

    $self->debug("$id ( $vlan_id )\n",2);
    my $max_tries = $no_retry ? 1 : 5;
    #
    # We try this a few times, with 5 second sleeps, since it can take
    # a while for VLAN information to propagate
    #
    my $closure = sub () {
	my %mapping = $self->findVlans($vlan_id);
	my $vlan_number = $mapping{$vlan_id};
	if (defined($vlan_number)) { return $vlan_number; }
	sleep 4;
	return undef;
    };
    return $self->hammer($closure,$id,$max_tries);
}

#   
# Create a VLAN on this switch, with the given identifier (which comes from
# the database) and given 802.1Q tag number.
#
# usage: createVlan($self, $vlan_id, $vlan_number)
#        returns the new VLAN number on success
#        returns 0 on failure
#
sub createVlan($$$) {
    my $self = shift;
    my $vlan_id = shift;
    my $vlan_number = shift;
    my $id = $self->{NAME} . ":createVlan";

    if (!defined($vlan_number)) {
	warn "$id called without supplying vlan_number";
	return 0;
    }
    my $check_number = $self->findVlan($vlan_id,1);
    if (defined($check_number)) {
	if ($check_number != $vlan_number) {
		warn "$id: recreating vlan id $vlan_id which has ".
		     "existing vlan number $check_number with the new number ".
		     "$vlan_number\n";
		     return 0;
	}
     }
    my $vlan ="$vlan_number";
    my $hpvlan_id = convertVlanName("$vlan_id");
    my $VlanName = 'dot1qVlanStaticName'; # vlan # is index
    $self->debug("createVlan: name $vlan_id number $vlan_number \n");
    #
    # Perform the actual creation. Yes, this next line MUST happen all in
    # one set command....
    #
    my $closure = sub () {
    	my $RetVal = $self->set
	       ([[$VlanName,$vlan,$hpvlan_id,"OCTETSTR"],
	     [$createOID,$vlan, "createAndGo","INTEGER"]], "$id: creation");
	if (defined($RetVal)) { return $RetVal; }
	#
	# Sometimes we loose responses, or on the second time around
	# it might refuse to create a vlan that's already there, so wait
	# a bit to see if it exists (also so as to not get too agressive
	# with the switch which caused nortels to crash with IGMP stuff)
	#
	sleep (2);
	$RetVal = $self->get1($createOID, $vlan);
	if (defined($RetVal) && ($RetVal ne "active")) { return undef ;}
	return $RetVal;
    };
    my $RetVal = $self->hammer($closure, "$id: creation");
    if (!defined($RetVal)) { return 0; }
    print "  Creating VLAN $vlan_id as VLAN #$vlan_number on " .
	    "$self->{NAME} ...\n";

    #
    # Check that it happened.
    #
    $RetVal = $self->get1($VlanName, $vlan);
    if (!defined($RetVal) || ("$RetVal" ne $hpvlan_id)) {
	warn "$id: created vlan $vlan_id with name $RetVal" .
	  "instead of $hpvlan_id\n";
    }

    #
    # Enable jumbo frames, if switch option is set.
    #
    if ($self->{DOJUMBO}) {
	if ($self->setVlanJumbo($vlan_number) != 0) {
	    warn "$id: enable jumbo failed for vlan $vlan_id ...\n";
	}
    }

    if ($self->{SKIPIGMP}) { return $vlan_number ; }

    my $IgmpEnable = 'hpSwitchIgmpState';
    $RetVal = $self->get1($IgmpEnable, $vlan);

    $closure = sub () {
	my $check = $self->set([[$IgmpEnable,$vlan,"enable","INTEGER"]]);
	if (!defined($check)) { sleep (5);}
	return $check;
    };
    $RetVal = $self->hammer($closure, "$id: setting snooping", 3);
    if (!defined($RetVal)) { return 0; }

    $closure = sub () {
	my $check = $self->get1($IgmpEnable, $vlan);
	if (!defined($check) || ($check ne "enable"))
		{ sleep (4); return undef ;}
	return $check;
    };
    $RetVal = $self->hammer($closure, "$id: checking snooping");
    if (!defined($RetVal)) { return 0; }

    return $vlan_number;
}
#
# gets the forbidden, untagged, and egress lists for a vlan
# sends back as a 3 element array of lists.  (Thats the order
# the packet traces for the HP had them in).
#
sub getVlanLists($$) {
    my ($self, $vlan) = @_;
    my $ret = [0, 0, 0];
    @$ret[0] = $self->{H3C} ? [0] : mirvPortSet($self->get1($forbidOID, $vlan));
    @$ret[1] = mirvPortSet($self->get1($normOID, $vlan));
    @$ret[2] = mirvPortSet($self->get1($egressOID, $vlan));
    return $ret;
}

#
# sets the forbidden, untagged, and egress lists for a vlan
# sends back as a 3 element array of lists.
# (Thats the order we saw in a tcpdump of vlan creation.)
# (or in some cases 6 elements for 2 vlans).
#
sub setVlanLists($@) {
    my ($self, @args) = @_;
    my $oids = [$forbidOID, $normOID, $egressOID];
    my $j = 0; my $todo = [ 0 ];
    while (@args) {
	my $vlan = shift @args;
	my $arrayref = shift @args;
	foreach my $i (0, 1, 2) {
	    next if (($i != 2) && $self->{H3C});
	    @$todo[$j++] = [ @$oids[$i], $vlan,
		    pack("B*",join('', @{@$arrayref[$i]})), "OCTETSTR"];
	}
    }
    $j = $self->set($todo);
    if (!defined($j)) { cluck "vlists failed\n";}
    return $j;
}

#
# Some design comments about HP switch conventions:

# This code was written after having observed packet traces while
# running the HP management tool, which appeared to remove a port
# from a vlan merely by getting and setting the 3 OID in getVlanLists
# or transferred it between vlans by setting a pair of the 3 OIDS.

# It seems that a port may be an untagged member of at most one vlan
# but may be a tagged member of several others,  i.e. the packets
# ared rx'd from the port or tx'd to the port with vlan tags added.

# If a port appears only in the $egressOIDs and never in a $normOID
# (so that it is like a normal interswitch single wire trunk), the
# The $aftOID = admitOnlyVlanTagged, without our having to set it.

# The OID describing the PVID of a port seem to correspond to
# the untagged membership of the port in some vlan, and it does
# not seem necessary to set this OID either.

# In this case, the port has $aftOID (dot1QPortAceptableFrameType) = admitAll.

# If we want the port to be like dual mode port on a foundry or cisco, we can
# merely add the port to the egress OID of any additonal vlan.

# However, if a switch belongs to a unique vlan, and is an untagged member,
# there would be no way to determine if the intent was to be a dual mode port
# or for the port have the semantics of most other switches, i.e. adding it
# to one vlan takes it out of the first.

# Since this is the common case, we record the dual mode intent
# by marking the port as being forbidden to join vlan 1.

#
# Put the given ports in the given VLAN. The VLAN is given as an 802.1Q 
# tag number.
#
# usage: setPortVlan($self, $vlan_number, @ports)
#	 returns 0 on sucess.
#	 returns the number of failed ports on failure.
#
sub setPortVlan($$@) {
    my $self = shift;
    my $vlan_number = shift;
    my @ports = @_;

    my $id = $self->{NAME} . "::setPortVlan($vlan_number)";
    $self->debug($id);
    my %vlansToPorts; # i.e. bumpedVlansToListOfPorts
    my @newTaggedPorts = ();
    my ($errors, $portIndex, $pvid, $rv, @protoTrunks) = (0);
	   
    #
    # Run the port list through portmap to find the ports on the switch that
    # we are concerned with
    #

    return 0 unless(@ports);
    my @portlist = $self->convertPortFormat($PORT_FORMAT_IFINDEX, @ports);
    return -1
	if (!@portlist);
    $self->debug("ports: " . join(",",@ports) . "\n");
    $self->debug("as ifIndexes: " . join(",",@portlist) . "\n");

    #
    # Need to determine status and remove ports from default_vlan
    # before adding to other.  This is a read_modify_write so lock out
    # other instances of snmpit_hp.

    my $defaultInfo = $self->getVlanLists(1);
    foreach $portIndex (@portlist) {
	# check for three easy cases
	# a. known dual port.
	# b. the ports is not allocated
	# c. the port is a trunk

	# case a: This is a dual port, so it doesn't have to leave its PVID.
	if (@{@$defaultInfo[0]}[$portIndex - 1]) {
	    push @newTaggedPorts, $portIndex;
	    next;
	}
	# case b: Unallocated untrunked port.
	if (@{@$defaultInfo[1]}[$portIndex - 1]) {
	    $pvid = 1;
	} else {
	    my $tagOnly = $self->get1($aftOID,$portIndex);
	    if ($tagOnly eq "admitOnlyVlanTagged") {
		# case c: Trunk Port
		if (@{@$defaultInfo[2]}[$portIndex - 1]) {
		    # Total grot - happens when port was made an equal trunk
		    # having no vlans, so is on vlan 1, and might be disabled.
		    # It might also be the case that this version of the driver
		    # is being run for the first time on a switch where
		    # we were previously sloppier about membership in vlan 1.
		    push @protoTrunks, $portIndex;
		}
		push @newTaggedPorts, $portIndex;
		next;
	    } else {
		# case d: untrunked port leaving another vlan.
		# a little more work - get its PVID and assume that
		# is the vlan which it is leaviing. and toss it
		# into the bumpedVlan hash.
		$pvid = $self->get1("dot1qPvid", $portIndex);
	    }
	}
	push @{$vlansToPorts{$pvid}}, $portIndex # autovivifies if null
	    if (defined($pvid) && ($pvid != $vlan_number));
    }
    @{$self->{DISPLACED_VLANS}} = grep {$_ != 1;} keys %vlansToPorts;
 
    $self->lock();
    my $newInfo = $self->getVlanLists($vlan_number);
    foreach my $vlan (keys %vlansToPorts) {
	my $oldInfo = $self->getVlanLists($vlan) ;
	foreach $portIndex (@{$vlansToPorts{$vlan}}) {
	    @{@$oldInfo[1]}[$portIndex-1] = 0;
	    @{@$newInfo[1]}[$portIndex-1] = 1;
	    @{@$oldInfo[2]}[$portIndex-1] = 0;
	    @{@$newInfo[2]}[$portIndex-1] = 1;
	}
	$self->setVlanLists($vlan, $oldInfo, $vlan_number, $newInfo);
    }

    # Now add tagged ports separately, just to be safe.

    if (@newTaggedPorts) {
	foreach $portIndex (@newTaggedPorts)
		{ @{@$newInfo[2]}[$portIndex-1] = 1; }
	$self->setVlanLists($vlan_number, $newInfo);
    }
    $self->unlock();

    # We need to make sure the ports get enabled, and protoTrunks cleaned up.

    if (@protoTrunks) {
	$rv = $self->delPortVlan(1, @protoTrunks) +
		    $self->portControl("enable", @protoTrunks);
	$errors += $rv;
	warn "$id: $rv failures with protoTrunks\n"
	     if ($rv);
    }

    my $onoroff = ($vlan_number ne "1") ? "enable" : "disable";
    $self->debug("$id; will $onoroff"  . join(',',@ports) . "...\n");
    if ( $rv = $self->portControl($onoroff, @ports) ) {
	warn "$id: Port enable had $rv failures.\n";
	$errors += $rv;
    }

    return $errors;
}

sub not_in($$@) {
    my $self = shift;
    my $value = shift;
    my @list = @_;

    return 0 == scalar(grep {$_ == $value;} @list);
}

#
# Remove the given ports from the given VLAN. The VLAN is given as an 802.1Q 
# tag number.
#
# usage: delPortVlan($self, $vlan_number, @ports)
#	 returns 0 on sucess.
#	 returns the number of failed ports on failure.
#
sub delPortVlan($$@) {
    my $self = shift;
    my $vlan_number = shift;
    my @ports = @_;

    return $self->updateOneVlan(0,0,0,$vlan_number,@ports);
}

sub updateOneVlan($$$$$@)
{
    my ($self,$forbid,$untag,$mem,$vlan_number,@ports) = @_;

    $self->debug($self->{NAME} . "::updateOneVlan($untag,$mem,$vlan_number) ");
	   
    #
    # Run the port list through portmap to find the ports on the switch that
    # we are concerned with
    #

    $self->lock();
    my @portlist = $self->convertPortFormat($PORT_FORMAT_IFINDEX, @ports);
    return -1
	if (!@portlist);
    $self->debug("ports: " . join(",",@ports) . "\n");
    $self->debug("as ifIndexes: " . join(",",@portlist) . "\n");

    my $vlist = $self->getVlanLists($vlan_number);
    foreach my $port (@portlist) {
	next if ($self->{ifx2didx} && !($port = $self->{ifx2d1dx}));
	@{@$vlist[0]}[$port - 1] = $forbid if ($vlan_number eq "1");
	@{@$vlist[1]}[$port - 1] = $untag;
	@{@$vlist[2]}[$port - 1] = $mem;
    }
    my $result = $self->setVlanLists($vlan_number, $vlist);
    if (!defined($result)) {
	print STDERR $self->{NAME} .
	    ": updateOneVlan($forbid,$untag,$mem,$vlan_number) failed for: ";
	foreach my $port (@ports) {
	    my $ifindex = shift(@portlist);
	    print STDERR "$port:$ifindex ";
	}
	print STDERR "\n";
    }
    $self->unlock();
    return defined($result) ? 0 : 1;
}

#
# Disables all ports in the given VLANS. Each VLAN is given as a VLAN
# 802.1Q tag value.
#
# usage: removePortsFromVlan(self,@vlan)
#	 returns 0 on sucess.
#	 returns the number of failed ports on failure.
#
sub removePortsFromVlan($@) {
    my $self = shift;
    my @vlan_numbers = @_;
    my $errors = 0;
    my $id = $self->{NAME} . "::removePortsFromVlan";

    foreach my $vlan_number (@vlan_numbers) {
	my @ports = $self->portSetToList($self->get1($egressOID, $vlan_number));
	if (@ports) {
	    $errors += $self->removeSomePortsFromVlan($vlan_number, @ports);
	}
    }
    return $errors;
}

#
# Removes and disables some ports in a given VLAN.
# The VLAN is given as a VLAN 802.1Q tag value.
#
# usage: removeSomePortsFromVlan(self,vlan,@ports)
#	 returns 0 on sucess.
#	 returns the number of failed ports on failure.
#
sub removeSomePortsFromVlan($$@) {
    my ($self, $vlan_number, @ports) = @_;
    my ($errors, $changes, $id, %porthash, $tagOnly, $pvid) =
	(0, 0, $self->{NAME} . "::removeSomePortsFromVlan");

    # Callers should know better.
    return 0
	if (!@ports);

    @ports = $self->convertPortFormat($PORT_FORMAT_IFINDEX,@ports);
    return -1
	if (! @ports);
    @porthash{@ports} = @ports;
    my $dualPorts = mirvPortSet($self->get1($forbidOID, 1)); # array

    foreach my $portIndex (@ports) {
	if (@$dualPorts[$portIndex-1]) {
	    # We make any dual ports whose PVID is this vlan into equaltrunks.
	    # A dualtrunked port whose primary vlan is not this vlan
	    # can be deleted by the code dealing with normal ports
	    $pvid = $self->get1("dot1qPvid", $portIndex);
	    next if ("$pvid" ne $vlan_number);
	    $self->updateOneVlan(0,0,1,$vlan_number,$portIndex); #make tagged
	    $self->updateOneVlan(0,0,0,1,$portIndex); # clear dual marker.
	    # fall through to next case
	}
	$tagOnly = $self->get1($aftOID,$portIndex);
	if ($tagOnly eq "admitOnlyVlanTagged") {
	    if ($self->delPortVlan($vlan_number, $portIndex)) {
		# assume it failed because it belonged to no other vlans
		# so add it to vlan 1 and try again.
		$self->updateOneVlan(0,0,1,1,$portIndex);
		if ($self->delPortVlan($vlan_number, $portIndex)) {
		    warn "$id: failed to remove ifIndex $portIndex\n";
		}
	    }
	    delete $porthash{$portIndex};
	}
    }

    # Now, remove the remaining ports from the vlan.
    $self->lock();
    my $defaultLists = $self->getVlanLists(1);
    my $vLists = $self->getVlanLists($vlan_number);
    my @portlist = bitSetToList(@$vLists[2]);
    $self->debug("$id $vlan_number: @portlist\n",2);

    foreach my $portIndex (@portlist) {
	next unless exists($porthash{$portIndex});
	if (@{@$vLists[1]}[$portIndex - 1]) {
	    # otherwise, port is tagged.

	    @{@$defaultLists[1]}[$portIndex - 1] = 1;
	    @{@$defaultLists[2]}[$portIndex - 1] = 1;
	    $self->debug("disabling port $portIndex  "
			    . "from vlan $vlan_number \n" );
	    $self->set(["ifAdminStatus",$portIndex,"down","INTEGER"],$id);
	}
	@{@$vLists[1]}[$portIndex - 1] = 0;
	@{@$vLists[2]}[$portIndex - 1] = 0;
	$changes++;
    }
    $errors += $self->setVlanLists($vlan_number, $vLists, 1, $defaultLists)
	    if ($changes > 0);
    $self->unlock();
    return $errors;
}

#
# Remove the given VLANs from this switch. Removes all ports from the VLAN,
# The VLAN is given as a VLAN identifier from the database.
#
# usage: removeVlan(self,int vlan)
#	 returns 1 on success
#	 returns 0 on failure
#
#
sub removeVlan($@) {
    my $self = shift;
    my @vlan_numbers = @_;
    my $errors = 0;
    my $name = $self->{NAME};

    $self->removePortsFromVlan(@vlan_numbers);
    foreach my $vlan_number (@vlan_numbers) {
	#
	# Perform the actual removal
	#
	print "  Removing VLAN # $vlan_number ... ";
	my $RetVal = $self->set([[$createOID,$vlan_number,"destroy","INTEGER"]]);
	if ($RetVal) {
	    print "Removed VLAN $vlan_number on switch $name.\n";
	} else {
	    print STDERR "Removing VLAN $vlan_number failed on switch $name.\n";
	    $errors++;
	}
	# The next call would buy time to let switch consolidate itself
	# Nortels have bizarre failures when quickly creating and destroying
	# vlans with IGMP snooping enabled.
	# $self->{SESS}->bulkwalk(0,32,[$createOID]);
    }
    return ($errors == 0) ? 1 : 0;
}

#
# XXX: Major cleanup
#
sub UpdateField($$$@) {
    my ($self, $OID, $val, @ports)= @_;
    my $id = $self->{NAME} . "::UpdateField OID $OID value $val";
    $self->debug("$id: ports @ports\n");

    my $result = 0;
    my $oidval = $val;
    my ($Status, $portname, $row);


    foreach $portname (@ports) {
	my ($row) = $self->convertPortFormat($PORT_FORMAT_IFINDEX,$portname);
	next
	    if (!defined($row));
	$self->debug("checking row $row for $val ...\n");
	$Status = $self->get1($OID,$row);
	if (!defined($Status)) {
	    print STDERR "id: Port $portname No answer from device\n";
	    next;
	}
	$self->debug("Port $portname, row $row was $Status\n");
	if ($OID eq "hpSwitchPortFastEtherMode") {
	    #
	    # Procurves use the same mib variable to set both
	    # speed and duplex concurrently; only certain
	    # combinations are permitted.  (We won't support
	    # auto-10-100MBits. And at least the 5400 series
	    # doesn't seem to support full-duplex-1000Mbits.)
	    #
	    my @state = split "-", $Status;
	    if (($val eq "half") || ($val eq "full")) {
		if ($state[0] eq "auto") {
		    if (($state[1] eq "neg") || ($state[1] eq "10")) {
			# can't autospeed with specific duplex.
			$oidval = ($val eq "half") ?
			   "half-duplex-100Mbits" : "full-duplex-100Mbits";
		    } elsif ($state[1] eq "1000Mbits") {
			$oidval = $Status;
		    } else {
			$oidval = $val . "-duplex-" . $state[1] ;
		    }
		} else {
			$oidval = $val . "-duplex-" . $state[2] ;
		}
	    } else {
		if (($val eq "auto-neg") || ($val eq "auto-1000Mbits") ||
			($state[1] ne "duplex")) {
		    $oidval = $val;
		} else {
		    my @valarr = split "-", $val;
		    $oidval = $state[0] . "-duplex-" . "$valarr[1]";
		}
	    }
	}
	if ($Status ne $oidval) {
	    $self->debug("Setting $portname (r $row) to $oidval...");
	    $Status = $self->set([[$OID,$row,$oidval,"INTEGER"]]);
	    $result =  (defined($Status)) ? 0 : -1;
	    $self->debug($result ? "failed.\n" : "succeeded.\n");
	}
    }
    return $result;
}

#
# Determine if a VLAN has any members 
# (Used by stack->switchesWithPortsInVlan())
#
sub vlanHasPorts($$) {
    my ($self, $vlan_number) = @_;

    my $portset = $self->get1($egressOID,$vlan_number);
    if (defined($portset)) {
	my @ports = $self->portSetToList($portset);
	if (@ports) { return 1; }
    }
    return 0;
}

#
# List all VLANs on the device
#
# usage: listVlans($self)
# see snmpit_cisco_stack.pm for a description of return value format
#
sub listVlans($) {
    my $self = shift;

    my (%Names, %Numbers, %Members, %Normports);
    my ($vlan_name, $oid, $vlan_number, $value, $rowref);
    my ($modport, $node, $ifIndex, @portlist, @memberlist);
    $self->debug($self->{NAME} . "::listVlans()\n",1);
    my $maxport = $self->{MAXPORT};

    #
    # Walk the tree to find the VLAN names
    #
    my ($rows) = $self->{SESS}->bulkwalk(0,32,["dot1qVlanStaticName"]);
    foreach $rowref (@$rows) {
	($oid, $vlan_number, $vlan_name) = @$rowref;
	$self->debug("Got $oid $vlan_number $vlan_name\n",3);
        # Hack to get around some strange behavior
        if ((!defined($vlan_number) || $vlan_number eq "") &&
                defined(parseVlanNumberFromOID($oid))) {
            $vlan_number = parseVlanNumberFromOID($oid);
            $self->debug("Changed vlan_number to $vlan_number\n",3);
        }
	next if ("$vlan_number" eq "1");
	$vlan_name = convertVlanName($vlan_name);
	if (!$Names{$vlan_number}) {
	    $Names{$vlan_number} = $vlan_name;
	    @{$Members{$vlan_number}} = ();
	}
    }

    #
    #  Walk the tree for the VLAN members
    #
    ($rows) = $self->{SESS}->bulkwalk(0,32,["dot1qVlanStaticEgressPorts"]);
    foreach $rowref (@$rows) {
	($oid,$vlan_number,$value) = @$rowref;
	next if ("$vlan_number" eq "1");
	@portlist = $self->portSetToList($value);
	if ($self->{d1dx2ifx}) {
	    @portlist = map { $self->{d1dx2ifx}{$_}} @portlist ;
	}
	$self->debug("Got $oid $vlan_number @portlist\n",3);

	foreach $ifIndex (@portlist) {
	    ($node) = $self->convertPortFormat($PORT_FORMAT_PORT,$ifIndex);
	    if (!$node) {
		($modport) = $self->convertPortFormat
				    ($PORT_FORMAT_MODPORT,$ifIndex);
		$node = Port->LookupByStringForced($self->{NAME} . ":$modport");
	    }
	    # Let's be clear about what kind of connection this is and
	    # get the right port object.  If there is an endpoint here,
	    # get that.  If this is a trunk, then the member we want to
	    # put in the list is the "local" side (this switch's port).
	    my $mbrport;
	    if ($node->is_trunk_port()) {
		$mbrport = $node;
	    } else {
		# getOtherEndPort() will return the object upon which the
		# method is invoked if it fails to lookup the other side.
		$mbrport = $node->getOtherEndPort();
	    }
	    push @{$Members{$vlan_number}}, $mbrport;
	    $self->debug("$self->{NAME}:$vlan_number $node:$mbrport\n", 3);

	    if (!$Names{$vlan_number}) {
		$self->debug("listVlans: WARNING: port $node in non-existant " .
		    "VLAN $vlan_number\n", 1);
	    }
	}
    }

    #
    # Build a list from the name and membership lists
    #
    my @list = ();
    foreach my $vlan_id (sort keys %Names) {
	push @list, [$Names{$vlan_id},$vlan_id,$Members{$vlan_id}];
    }

    #$self->debug($self->{NAME} .":". join("\n",(map {join ",", @$_} @list))."\n");
    return @list;
}

#
# List all ports on the device
#
# usage: listPorts($self)
# see snmpit_cisco_stack.pm for a description of return value format
#
sub listPorts($) {
    my $self = shift;

    my %Able = ();
    my %Link = ();
    my %auto = ();
    my %speed = ();
    my %duplex = ();

    my $ifTable = ["ifAdminStatus",0];

    #
    # Get the ifAdminStatus (enabled/disabled) and ifOperStatus
    # (up/down)
    #
    my ($varname, $modport, $ifIndex, $portIndex, $status, $portname);
    $self->{SESS}->getnext($ifTable);
    do {
	($varname,$ifIndex,$status) = @{$ifTable};
	$self->debug("$varname $ifIndex $status\n");
	if (($ifIndex <= $self->{MAXPORT}) && ($varname =~ /AdminStatus/)) { 
	    $Able{$ifIndex} = ($status =~/up/ ? "yes" : "no");
	}
	$self->{SESS}->getnext($ifTable);
    } while ( $varname =~ /^ifAdminStatus$/) ;

    #
    # Get the port configuration, including speed, duplex, and whether or not
    # it is autoconfiguring
    #
    foreach $ifIndex (keys %Able) {
	if ($status = $self->{SESS}->get(["ifOperStatus",$ifIndex])) {
	    $Link{$ifIndex} = $status;
	}
	# HP combines speed and duplex and it has to be teased apart lexically.
	if ($status = $self->get1("hpSwitchPortFastEtherMode",$ifIndex)) {
	    my @parse = split("-duplex-", $status);
	    if (2 == scalar(@parse)) {
		$duplex{$ifIndex} = $parse[0];
		$speed{$ifIndex} = $parse[1];
	    } else {
		@parse = split("auto-",$status);
		$duplex{$ifIndex} = "auto";
		$speed{$ifIndex} = $parse[1];
		if ($speed{$ifIndex} eq "neg") {
		    $speed{$ifIndex} = "auto";
		}
	    }
	}
    };

    #
    # Put all of the data gathered in the loop into a list suitable for
    # returning
    #
    my @rv = ();
    foreach my $id ( keys %Able ) {
	$modport = $self->{IFINDEX}{$id};
	$portname = $self->{NAME} . ":$modport";
	my $port = Port->LookupByTriple($portname); 
	if (defined($port)) {
		$port = $port->getOtherEndPort();
	}

	#
	# Skip ports that don't seem to have anything interesting attached
	#
	if (!$port && $self->{DOALLPORTS}) {
		$modport =~ s/\./\//;
		$port = Port->LookupByStringForced($self->{NAME} . ":$modport");
	}
	if (!$port) {
	    $self->debug("$id ($modport) not connected, skipping\n");
	    next;
	}
	if (! defined ($speed{$id}) ) { $speed{$id} = " "; }
	if (! defined ($duplex{$id}) ) { $duplex{$id} = " "; }
	push @rv, [$port,$Able{$id},$Link{$id},$speed{$id},$duplex{$id}];
    }
    return @rv;
}

# 
# Get statistics for ports on the switch
#
# usage: getStats($self)
# see snmpit_cisco_stack.pm for a description of return value format
#
#
sub getStats() {
    my $self = shift;

    #
    # Walk the tree for the VLAN members
    #
    my $vars = new SNMP::VarList(['ifInOctets'],['ifInUcastPkts'],
    				 ['ifInNUcastPkts'],['ifInDiscards'],
				 ['ifInErrors'],['ifInUnknownProtos'],
				 ['ifOutOctets'],['ifOutUcastPkts'],
				 ['ifOutNUcastPkts'],['ifOutDiscards'],
				 ['ifOutErrors'],['ifOutQLen']);
    my @stats = $self->{SESS}->bulkwalk(0,32,$vars);

    #
    # We need to flip the two-dimentional array we got from bulkwalk on
    # its side, and convert ifindexes into node:port
    #
    my $i = 0;
    my %stats;
    foreach my $array (@stats) {
	while (@$array) {
	    my ($name,$ifindex,$value) = @{shift @$array};

            # See comments in walkTable above.

            if (! defined $self->{IFINDEX}{$ifindex}) { next; }
            my $po = convertPortFromString("$self->{NAME}:".$self->{IFINDEX}{$ifindex});
            if (! defined $po) { next; } # Skip if we don't know about it
            my $port = $po->getOtherEndPort()->toTripleString();
            
	    ${$stats{$port}}[$i] = $value;
	}
	$i++;
    }

    return map [convertPortFromString($_),@{$stats{$_}}], sort {tbsort($a,$b)} keys %stats;
}

#
# Used to flush FDB entries easily
#
# usage: resetVlanIfOnTrunk(self, modport, vlan)
#
sub resetVlanIfOnTrunk($$$) {
    my ($self, $modport, $vlan) = @_;
    my ($ifIndex) = $self->convertPortFormat($PORT_FORMAT_IFINDEX,$modport);
    return -1
	if (!$ifIndex);
    $self->debug($self->{NAME} . "::resetVlanIfOnTrunk m $modport "
		    . "vlan $vlan ifIndex $ifIndex\n",1);
    if ($self->{d1dx2ifx}) { $ifIndex = $self->{d1x2ifx}{$ifIndex}; }
    my $vlan_ports = $self->get1($egressOID, $vlan);
    if (testPortSet($vlan_ports, $ifIndex - 1)) {
	$self->setVlansOnTrunk($modport,0,$vlan);
	$self->setVlansOnTrunk($modport,1,$vlan);
    }
    return 0;
}

#
# Get the ifindex for an EtherChannel (trunk given as a list of ports)
#
# usage: getChannelIfIndex(self, ports)
#        Returns: undef if more than one port is given, and no channel is found
#           an ifindex if a channel is found and/or only one port is given
#
# N.B. by Sklower - cisco's use this to put vlans on multiwire trunks;
# it gets called from _stack.pm
#
# HP's also require a different ifindex for putting a vlan on a multiwire
# trunk from the individual ifindex from any constituent port.
#
# although <NAME>'s vision is that this would only get called when putting
# vlans on multi-wire interswitch trunks and the check would happen in
# _stack, it is 1.) possible to use snmpit -i Switch <mod>/<port> to do<commit_msg>snmpit_h3c module: Fix some typos/bugs.<commit_after>#!/usr/bin/perl -w

#
# {{{EMULAB-LGPL
# 
# This file is part of the Emulab network testbed software.
# 
# This file is free software; you can redistribute it and/or modify it
# under the terms of the GNU Lesser General Public License as published by
# the Free Software Foundation; either version 2.1 of the License, or (at
# your option) any later version.
# 
# This file is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
# License for more details.
# 
# You should have received a copy of the GNU Lesser General Public License
# along with this file.  If not, see <http://www.gnu.org/licenses/>.
# 
# }}}
#
# Copyright (c) 2000-2014 University of Utah and the Flux Group.
# Copyright (c) 2004-2014 Regents, University of California.
# All rights reserved.
#

#
# snmpit module for HP procurve and flexfabric (comware) switches.
# The Comware module (snmpit_h3c) inherits from the base (snmpit_hp) class.
#

# XXX: krw: Rename base HP module here so that we don't actually use
#      this for the procurve models until I have more time to integrate.
package snmpit_hpupd;
use strict;

$| = 1; # Turn off line buffering on output

use English;
use SNMP;
use Carp qw(cluck);
use lib '/usr/testbed/lib';
use snmpit_lib;

use libtestbed;
use Lan;
use Port;

#
# These are the commands that can be passed to the portControl function
# below
#
my %cmdOIDs =
(
    "enable" => ["ifAdminStatus","up"],
    "disable"=> ["ifAdminStatus","down"],
    "1000mbit"=> ["hpSwitchPortFastEtherMode","auto-1000Mbits"],
    "100mbit"=> ["hpSwitchPortFastEtherMode","auto-100Mbits"],
    "10mbit" => ["hpSwitchPortFastEtherMode","auto-10Mbits"],
    "auto"   => ["hpSwitchPortFastEtherMode","auto-neg"],
    "full"   => ["hpSwitchPortFastEtherMode","full"],
    "half"   => ["hpSwitchPortFastEtherMode","half"],
);

#
# some long OIDs that get used frequently.
#
my $normOID = "dot1qVlanStaticUntaggedPorts";
my $forbidOID = "dot1qVlanForbiddenEgressPorts";
my $egressOID = "dot1qVlanStaticEgressPorts";
my $aftOID = "dot1qPortAcceptableFrameTypes";
my $createOID = "dot1qVlanStaticRowStatus";

#
# Enterprise OID for toggling jumbo frame support on a vlan
#
my $jumboOID = '1.3.6.1.4.1.11.2.14.11.5.1.12.1.8.1.1.1';

#
# Openflow OIDs, only number format now.
#
#my $ofOID = 'iso.org.dod.internet.private.enterprises.172.16.58.3.5.1.7.1.35';
my $ofOID = '1.3.6.1.4.1.11.2.14.11.5.1.7.1.35';
my $ofEnableOID     = $ofOID.'.1.1.2';
my $ofControllerOID = $ofOID.'.1.1.3';
my $ofListenerOID   = $ofOID.'.1.1.4';
my $ofFailModeOID   = $ofOID.'.1.1.11';
my $ofSupportOID    = $ofOID.'.2.1.0';

# This string is enough now, but the Openflow OID may change in future. 
# The maintainers should keep in mind of this ID. 
my $ofListenerVarNameMarker = '35.1.1.4';

#
# Ports can be passed around in three formats:
# ifindex: positive integer corresponding to the interface index (eg. 42)
# modport: dotted module.port format, following the physical reality of
#	Cisco switches (eg. 5.42)
# nodeport: node:port pair, referring to the node that the switch port is
# 	connected to (eg. "pc42:1")
#
# See the function convertPortFormat below for conversions between these
# formats
#
my $PORT_FORMAT_IFINDEX  = 1;
my $PORT_FORMAT_MODPORT  = 2;
my $PORT_FORMAT_NODEPORT = 3;  # XXX - not used anymore here.
my $PORT_FORMAT_PORT = 4;

#
# Creates a new object.
#
# usage: new($classname,$devicename,$debuglevel,$community)
#        returns a new object, blessed into the snmpit_intel class.
#
sub new($$$;$) {

    # The next two lines are some voodoo taken from perltoot(1)
    my $proto = shift;
    my $class = ref($proto) || $proto;

    my $name = shift;
    my $debugLevel = shift;
    my $community = shift;

    #
    # Create the actual object
    #
    my $self = {};

    #
    # Set the defaults for this object
    # 
    if (defined($debugLevel)) {
	$self->{DEBUG} = $debugLevel;
    } else {
	$self->{DEBUG} = 0;
    }
    $self->{BLOCK} = 1;
    $self->{CONFIRM} = 1;
    $self->{NAME} = $name;

    #
    # Get config options from the database
    #
    my $options = getDeviceOptions($self->{NAME});
    if (!$options) {
	warn "ERROR: Getting switch options for $self->{NAME}\n";
	return undef;
    }

    $self->{MIN_VLAN}         = $options->{'min_vlan'};
    $self->{MAX_VLAN}         = $options->{'max_vlan'};

    if ($community) { # Allow this to over-ride the default
	$self->{COMMUNITY}    = $community;
    } else {
	$self->{COMMUNITY}    = $options->{'snmp_community'};
    }

    # Use jumbo frames?
    if (exists($options->{'use_jumbo'}) 
	&& $options->{'use_jumbo'} == 1) {
	$self->{DOJUMBO} = 1;
    } else {
	$self->{DOJUMBO} = 0;
    }

    #
    # set up hashes for internal use
    #
    $self->{IFINDEX} = {};
    $self->{TRUNKINDEX} = {};
    $self->{TRUNKS} = {};
    $self->{cmdOIDs} = \%cmdOIDs;

    # other global variables
    $self->{DOALLPORTS} = 0;
    $self->{DOALLPORTS} = 1;
    $self->{SKIPIGMP} = 1;

    if ($self->{DEBUG}) {
	print "snmpit_hp initializing $self->{NAME}, " .
	    "debug level $self->{DEBUG}\n" ;   
    }


    #
    # Set up SNMP module variables, and connect to the device
    #
    $SNMP::debugging = ($self->{DEBUG} - 2) if $self->{DEBUG} > 2;
    my $mibpath = '/usr/local/share/snmp/mibs';
    &SNMP::addMibDirs($mibpath);
    &SNMP::addMibFiles("$mibpath/SNMPv2-SMI.txt", "$mibpath/SNMPv2-TC.txt", 
	               "$mibpath/SNMPv2-MIB.txt", "$mibpath/IANAifType-MIB.txt",
		       "$mibpath/IF-MIB.txt", "$mibpath/BRIDGE-MIB.txt", 
		       "$mibpath/IEEE8023-LAG-MIB.txt",
		       "$mibpath/HP-ICF-OID.txt", "$mibpath/HH3C-OID-MIB.txt",
		       "$mibpath/HH3C-SPLAT-INF.txt", 
		       "$mibpath/HH3C-PRODUCT-ID.txt");
    $SNMP::save_descriptions = 1; # must be set prior to mib initialization
    SNMP::initMib();		  # parses default list of Mib modules 
    $SNMP::use_enums = 1;	  # use enum values instead of only ints

    warn ("Opening SNMP session to $self->{NAME}...") if ($self->{DEBUG});

    $self->{SESS} = new SNMP::Session(DestHost => $self->{NAME},Version => "2c",
	Timeout => 3000000, Retries=> 9, Community => $self->{COMMUNITY});

    if (!$self->{SESS}) {
	#
	# Bomb out if the session could not be established
	#
	warn "WARNING: Unable to connect via SNMP to $self->{NAME}\n";
	return undef;
    }
    #
    # The bless needs to occur before readifIndex(), since it's a class 
    # method
    #

    #
    # Sometimes the SNMP session gets created when there is no connectivity
    # to the device so let's try something simple
    #
    my $test_case = snmpitGet($self->{SESS}, ["sysObjectID", 0], 1);
    if (!defined($test_case)) {
	warn "WARNING: Unable to retrieve via SNMP from $self->{NAME}\n";
	return undef;
    }
    $self->{HPTYPE} = SNMP::translateObj($test_case);

    warn ("Queried switch type: $self->{HPTYPE}\n") if ($self->{DEBUG});

    $class = $self->{H3C} = 'snmpit_h3c'
	if ($test_case =~ '^.1.3.6.1.4.1.25506');
    bless($self,$class);
    $self->readifIndex();

    return $self;
}

# Attempt to repeat an action until it succeeds

sub hammer($$$;$) {
    my ($self, $closure, $id, $retries) = @_;

    if (!defined($retries)) { $retries = 12; }
    for my $i (1 .. $retries) {
	my $result = $closure->();
	if (defined($result) || ($retries == 1)) { return $result; }
	warn $id . " ... will try again\n";
	sleep 1;
    }
    warn  $id . " .. giving up\n";
    return undef;
}

# shorthand

sub printSnmpErr($$) {
    my ($sess, $id) = @_;
    if ($sess->{ErrorNum}) {
	print "$id had error number " . $sess->{ErrorNum} .
		  " and had error string " . $sess->{ErrorStr} . "\n";
    }
}

sub get1($$$) {
    my ($self, $obj, $instance) = @_;
    my $id = $self->{NAME} . "::get1($obj.$instance)";
    my $closure = sub () {
	my $RetVal = snmpitGet($self->{SESS}, [$obj, $instance], 1);
	if (!defined($RetVal)) { sleep 4;}
	return $RetVal;
    };
    my $RetVal = $self->hammer($closure, $id, 40);
    printSnmpErr($self->{SESS}, $id)
	if (!defined($RetVal));
    return $RetVal;
}

sub set($$;$$) {
    my ($self, $varbind, $id, $retries) = @_;
    if (!defined($id)) { $id = $self->{NAME} . ":set "; }
    if (!defined($retries)) { $retries = 2; }
    my $sess = $self->{SESS};
    my $closure = sub () {
	my $RetVal = $sess->set($varbind);
	my $status = $RetVal;
	if (!defined($RetVal)) {
	    $status = "(undefined)";
	    printSnmpErr($sess, $id);
	}
	return $RetVal;
    };
    my $RetVal = $self->hammer($closure, $id, $retries);
    return $RetVal;
}

sub mirvPortSet($) {
    my ($bitfield) = @_;
    #$bitfield = substr($bitfield,0,127); XXX: yuck.
    my $unpacked = unpack("B*",$bitfield);
    return [split //, $unpacked];
}

sub testPortSet($$) {
    my ($bitfield, $index) = @_;
    return @{mirvPortSet($bitfield)}[$index];
}

#
# opPortSet($op, $bitfield, @indices)
# set or clear bits in a port set,  $op > 0 means set, otherwise clear
#
sub opPortSet($$@) {
    my ($op, $bitfield, @indices) = @_;
    my @bits = mirvPortSet($bitfield);

    foreach my $index (@indices) { $bits[$index] = $op > 0 ? 1 : 0; }

    return pack("B*", join('',@bits));
}

# Translate a list of ifIndexes to a PortSet

sub listToPortSet($@)
{
    my $self = shift;
    my @ports = @_;

    my ($max, $portbitstring, $portSet, $port);
    my @portbits;

    $self->debug("listToPortsSet: input @ports\n",2);
    if (scalar @ports) {
	@ports = sort { $b <=> $a} @ports;
	$max = ($ports[0] | 7);
    } else { $max = 7 ; }
    $port = 0;
    while ($port <= $max) { $portbits[$port] = 48 ; $port++; }
    while (scalar @ports) { $port = pop @ports; $portbits[$port - 1] = 49; }
    $self->debug("portbits after insertions: @portbits\n",2);
    $portbitstring = pack "C*", @portbits;
    $self->debug("listToPortSet output string $portbitstring \n");
    $portSet = pack "B*", $portbitstring ;
    return $portSet;
}

# Translate a PortSet to a list of ifIndexes

sub bitSetToList($)
{
    my ($arrayref) = @_;
    my @ports = ();
    my $max = scalar (@$arrayref);

    for (my $port = 0; $port < $max; $port++)
	{ if (@$arrayref[$port]) { push @ports, (1 + $port); } }
    return @ports;
}

sub portSetToList($$) {
    my ($self, $portset) = @_;
    return bitSetToList(mirvPortSet($portset));
}

sub getOidToMappedList($$$) {
    my ($self, $oid, $idx) = @_;
    if (my $bits = $self->get1($oid,$idx)) {
	return $self->portSetToList($bits);
    } else { return (); }
}

sub trunkedPorts($@) {
    my ($self, @ports) = @_;
    my ($trunks, $dualPorts, $modes, $pids, $j, @nports) = ({}, {});
    @$dualPorts{$self->portSetToList($self->get1($forbidOID,1))} = undef;
    if (@ports) {
	$modes = [ map { [ $aftOID, $_ ] } @ports ];
	$j = $self->{SESS}->get($modes);
    } else {
	($modes) = $self->{SESS}->bulkwalk(0,32, [$aftOID]);
    }
    foreach my $aref (@$modes) {
	my ($name, $ifIndex, $val) = @$aref;
	if ($val eq 'admitOnlyVlanTagged') {
	    $$trunks{$ifIndex} = 1;
	} elsif (exists($$dualPorts{$ifIndex})) {
	    $$trunks{$ifIndex} = $self->get1('dot1qPvid', $ifIndex);
	}
    }
    return ($trunks);
}

#
# Set a variable associated with a port. The commands to execute are given
# in the cmdOIs hash above
#
# usage: portControl($self, $command, @ports)
#	 returns 0 on success.
#	 returns number of failed ports on failure.
#	 returns -1 if the operation is unsupported
#
sub portControl ($$@) {
    my $self = shift;

    my $cmd = shift;
    my @ports = @_;
    my $cmdOIDs = $self->{cmdOIDs};

    $self->debug("portControl: $cmd -> (@ports)\n");

    #
    # Find the command in the %cmdOIDs hash (defined at the top of this file).
    # Some commands involve multiple SNMP commands, so we need to make sure
    # we get all of them
    #
    if (defined $$cmdOIDs{$cmd}) {
	my @oid = @{$$cmdOIDs{$cmd}};
	my $errors = 0;

	while (@oid) {
	    my $myoid = shift @oid;
	    my $myval = shift @oid;
	    $errors += $self->UpdateField($myoid,$myval,@ports);
	}
	return $errors;
    } else {
	#
	# Command not supported
	#
	$self->debug("Unsupported port control command '$cmd' ignored.\n");
	return 0;
    }
}

#
# Get a vlan's ifindex given it's tag
#
sub getVlanIfindexFromTag($$) {
    my ($self, $tag) = @_;
    my $id = $self->{NAME} . "::getVlanIfindexFromTag";

    my ($rows) = snmpitBulkwalkFatal($self->{SESS}, ["ifDescr"]);

    if (!@$rows) {
	warn "$id: ERROR: No interface description rows returned ".
	     "while attempting to search for vlan ifindex!\n";
	return undef;
    }

    foreach my $rowref (@$rows) {
	my ($name,$ifindex,$descr) = @$rowref;
	next unless $descr =~ /VLAN(\d+)/i;
	if ($tag == $1) {
	    return $ifindex;
	}
    }

    warn "$id: no ifindex found for vlan with tag: $tag\n";
    return undef;
}

#
# Set jumbo frames on a vlan
#
sub setVlanJumbo($$) {
    my ($self, $tag) = @_;
    my $id = $self->{NAME} . "::setVlanJumbo";

    my $vifindex = $self->getVlanIfindexFromTag($tag);
    goto bad if !defined($vifindex);

    $self->debug("id: Enabling jumbo frames on vlan $tag (ifindex: $vifindex)\n");

    my $res = $self->set([$jumboOID,$vifindex,1,"INTEGER"], $id);
    goto bad if !defined($res);

    return 0;

  bad:
    warn "$id: Could not enable jumbo frames for vlan with tag: $tag\n";
    return 1;
}



#
# HP's refuse to create vlans with display names that can
# be interpreted as vlan numbers
#
sub convertVlanName($) {
	my $id = shift;
	my $new;
	if ( $id =~ /^_(\d+)$/) {
	    $new = $1;
	    return ((($new > 0) && ($new  < 4095)) ? $new : $id);
	}
	if ( $id =~ /^(\d+)$/) {
	    $new = $1;
	    return ((($new > 0) && ($new  < 4095)) ? "_$new" : $id);
	}
	return $id;
}

#
# Try to pull a VLAN number out of a long OID string
#
sub parseVlanNumberFromOID($) {
    my ($oid) = @_;
    # OID must be a dotted string
    my (@elts) = split /\./, $oid;
    if (scalar(@elts) < 2) {
        return undef;
    }
    # Second-to-last element must be the right text string or numeric ID
    if ($elts[$#elts-1] eq "dot1qVlanStaticName" || $elts[$#elts-1] eq "1") {
        # Last element must be numeric
        if ($elts[$#elts] =~ /\d+/) {
            return $elts[$#elts];
        } else {
            return undef;
        }
    } else {
        return undef;
    }
}

sub checkLACP($$) {
   my ($self, $port) = @_;
   if (my $j = $self->{TRUNKINDEX}{$port})
       { $port = $j + $self->{TRUNKOFFSET}; }
   return $port;
}

#
# Convert a set of ports to an alternate format. The input format is detected
# automatically. See the declarations of the constants at the top of this
# file for a description of the different port formats.
#
# usage: convertPortFormat($self, $output format, @ports)
#        returns a list of ports in the specified output format
#        returns undef if the output format is unknown
#
# TODO: Add debugging output, better comments, more sanity checking
#
sub convertPortFormat($$@) {
    my $self = shift;
    my $output = shift;
    my @ports = @_;
    my @results = ();

    #
    # Avoid warnings by exiting if no ports given
    # 
    if (!@ports) {
	return ();
    }

    #
    # We determine the type by sampling the first port given
    #
    my $sample = $ports[0];
    if (!defined($sample)) {
	warn "convertPortFormat: Given a bad list of ports\n";
	return undef;
    }

    my $input;
    SWITCH: for ($sample) {
    	(Port->isPort($sample)) && do { $input = $PORT_FORMAT_PORT; last; };
	(/^\d+$/) && do { $input = $PORT_FORMAT_IFINDEX; last; };
	(/^\d+\.\d+$/) && do { $input = $PORT_FORMAT_MODPORT; last; };
	(/^$self->{NAME}\.\d+\/\d+$/) && do { $input = $PORT_FORMAT_MODPORT;
		@ports = map {/^$self->{NAME}\.(\d+)\/(\d+)$/; "$1.$2";} @ports; last; };
	warn "convertPortFormat: Unknown input port format: $sample\n"; 
	return ();
    }

    #
    # It's possible the ports are already in the right format
    #
    if ($input == $output) {
	if ($input == $PORT_FORMAT_IFINDEX) {
	    @results = map $self->checkLACP($_), @ports;
	    goto done;
	}
	$self->debug("Not converting, input format = output format\n",3);
	return @ports;
    }

    my $name = $self->{NAME};
    if ($input == $PORT_FORMAT_IFINDEX) {
	my $ifxModport = sub ($) {
	    my ($port, $modport) = ($_, $self->{IFINDEX}{$_});
	    print "$name: no modport for ifindex $port\n" unless ($modport);
	    return $modport ? $modport : "1.$port";
	};
	my @modports = map $ifxModport->($_), @ports;
	if ($output == $PORT_FORMAT_MODPORT) {
	    $self->debug("Converting ifindex to modport\n",3);
	    @results = @modports;
	    goto done;
	} elsif ($output == $PORT_FORMAT_PORT) {
	    $self->debug("Converting ifindex to Port object\n",3);
	    @results = map Port->LookupByStringForced("$name:$_"), @modports;
	    goto done;
	}
    } elsif ($input == $PORT_FORMAT_MODPORT) {
	if ($output == $PORT_FORMAT_IFINDEX) {
	    $self->debug("Converting modport to ifindex\n",3);
	    @results = map $self->{IFINDEX}{$_}, @ports;
	    goto done;
	} elsif ($output == $PORT_FORMAT_PORT) {
	    $self->debug("Converting ifindex to Port object\n",3);
	    @results = map Port->LookupByStringForced("$name:$_"), @ports;
	    goto done;
	}
    } elsif ($input == $PORT_FORMAT_PORT) { 
    	if ($output == $PORT_FORMAT_IFINDEX) {
            $self->debug("Converting Port object to ifindex\n",3);
            @results = map $self->{IFINDEX}{(split /:/,
                                         ($_->node_id() eq $self->{NAME})?
                                         $_->toTripleString():
                                         $_->getOtherEndTripleString()
                )[1]}, @ports;
	    goto done;
        } elsif ($output == $PORT_FORMAT_MODPORT) {
            $self->debug("Converting Port object to modport\n",3);
            @results = map { (split /:/,
                          ($_->node_id() eq $self->{NAME})?
                          $_->toTripleString():
                          $_->getOtherEndTripleString()
                )[1]} @ports;
	    goto done;
	}
    }

    #
    # Some combination we don't know how to handle
    #
    warn "convertPortFormat: Bad input/output combination ($input/$output)\n";
    return ();

  done:
    #
    # The control flow change was to facilitate trying to debug an
    # odd problem in Utah on the procuve-geni switches.
    #
    if (@results) {
	foreach my $port (@results) {
	    my $inport = shift(@ports);
	    if (!defined($port)) {
		print STDERR "convertPortFormat: Bad conversion for $inport ".
		    "($input/$output)\n";
		return ();
	    }
	    #print STDERR "convertPortFormat: $inport/$port\n";
	}
    }
    return @results;
}
# 
# Check to see if the given 802.1Q VLAN tag exists on the switch
#
# usage: vlanNumberExists($self, $vlan_number)
#        returns 1 if the VLAN exists, 0 otherwise
#
sub vlanNumberExists($$) {
    my ($self, $vlan_number) = @_;

    my $rv = $self->get1("dot1qVlanStaticRowStatus", $vlan_number);
    if (!defined($rv) || !$rv || $rv ne "active") {
	return 0;
    }
    return 1;
}

#
# Given VLAN indentifiers from the database, finds the 802.1Q VLAN
# number for them. If not VLAN id is given, returns mappings for the entire
# switch.
# 
# usage: findVlans($self, @vlan_ids)
#        returns a hash mapping VLAN ids to 802.1Q VLAN numbers
#        any VLANs not found have NULL VLAN numbers
#
sub findVlans($@) { 
    my $self = shift;
    my @vlan_ids = @_;
    my %mapping = ();
    my $id = $self->{NAME} . "::findVlans";
    my ($count, $name, $vlan_number, $vlan_name) = (scalar(@vlan_ids));
    $self->debug("$id\n");

    if ($count > 0) { @mapping{@vlan_ids} = undef; }

    #
    # Find all VLAN names. Do one to get the first field...
    #
    my ($rows) = $self->{SESS}->bulkwalk(0,32, ["dot1qVlanStaticName"]);
    foreach my $rowref (@$rows) {
	($name,$vlan_number,$vlan_name) = @$rowref;
	$self->debug("$id: Got $name $vlan_number $vlan_name\n",2);
        # Hack to get around some strange behavior
        if ((!defined($vlan_number) || $vlan_number eq "") &&
                defined(parseVlanNumberFromOID($name))) {
            $vlan_number = parseVlanNumberFromOID($name);
            $self->debug("Changed vlan_number to $vlan_number\n",3);
        }
	$vlan_name = convertVlanName($vlan_name);
	#
	# We only want the names - we ignore everything else
	#
	    if (!@vlan_ids || exists $mapping{$vlan_name}) {
		$self->debug("$id: $vlan_name=>$vlan_number\n",2);
		$mapping{$vlan_name} = $vlan_number;
	    }
    }

    return %mapping;
}

#
# Given a VLAN identifier from the database, find the 802.1Q VLAN
# number that is assigned to that VLAN. Retries several times (to account
# for propagation delays) unless the $no_retry option is given.
#
# usage: findVlan($self, $vlan_id,$no_retry)
#        returns the VLAN number for the given vlan_id if it exists
#        returns undef if the VLAN id is not found
#
sub findVlan($$;$) { 
    my $self = shift;
    my $vlan_id = shift;
    my $no_retry = shift;
    my $id = $self->{NAME} . ":findVlan";

    $self->debug("$id ( $vlan_id )\n",2);
    my $max_tries = $no_retry ? 1 : 5;
    #
    # We try this a few times, with 5 second sleeps, since it can take
    # a while for VLAN information to propagate
    #
    my $closure = sub () {
	my %mapping = $self->findVlans($vlan_id);
	my $vlan_number = $mapping{$vlan_id};
	if (defined($vlan_number)) { return $vlan_number; }
	sleep 4;
	return undef;
    };
    return $self->hammer($closure,$id,$max_tries);
}

#   
# Create a VLAN on this switch, with the given identifier (which comes from
# the database) and given 802.1Q tag number.
#
# usage: createVlan($self, $vlan_id, $vlan_number)
#        returns the new VLAN number on success
#        returns 0 on failure
#
sub createVlan($$$) {
    my $self = shift;
    my $vlan_id = shift;
    my $vlan_number = shift;
    my $id = $self->{NAME} . ":createVlan";

    if (!defined($vlan_number)) {
	warn "$id called without supplying vlan_number";
	return 0;
    }
    my $check_number = $self->findVlan($vlan_id,1);
    if (defined($check_number)) {
	if ($check_number != $vlan_number) {
		warn "$id: recreating vlan id $vlan_id which has ".
		     "existing vlan number $check_number with the new number ".
		     "$vlan_number\n";
		     return 0;
	}
     }
    my $vlan ="$vlan_number";
    my $hpvlan_id = convertVlanName("$vlan_id");
    my $VlanName = 'dot1qVlanStaticName'; # vlan # is index
    $self->debug("createVlan: name $vlan_id number $vlan_number \n");
    #
    # Perform the actual creation. Yes, this next line MUST happen all in
    # one set command....
    #
    my $closure = sub () {
    	my $RetVal = $self->set
	       ([[$VlanName,$vlan,$hpvlan_id,"OCTETSTR"],
	     [$createOID,$vlan, "createAndGo","INTEGER"]], "$id: creation");
	if (defined($RetVal)) { return $RetVal; }
	#
	# Sometimes we loose responses, or on the second time around
	# it might refuse to create a vlan that's already there, so wait
	# a bit to see if it exists (also so as to not get too agressive
	# with the switch which caused nortels to crash with IGMP stuff)
	#
	sleep (2);
	$RetVal = $self->get1($createOID, $vlan);
	if (defined($RetVal) && ($RetVal ne "active")) { return undef ;}
	return $RetVal;
    };
    my $RetVal = $self->hammer($closure, "$id: creation");
    if (!defined($RetVal)) { return 0; }
    print "  Creating VLAN $vlan_id as VLAN #$vlan_number on " .
	    "$self->{NAME} ...\n";

    #
    # Check that it happened.
    #
    $RetVal = $self->get1($VlanName, $vlan);
    if (!defined($RetVal) || ("$RetVal" ne $hpvlan_id)) {
	warn "$id: created vlan $vlan_id with name $RetVal" .
	  "instead of $hpvlan_id\n";
    }

    #
    # Enable jumbo frames, if switch option is set.
    #
    if ($self->{DOJUMBO}) {
	if ($self->setVlanJumbo($vlan_number) != 0) {
	    warn "$id: enable jumbo failed for vlan $vlan_id ...\n";
	}
    }

    if ($self->{SKIPIGMP}) { return $vlan_number ; }

    my $IgmpEnable = 'hpSwitchIgmpState';
    $RetVal = $self->get1($IgmpEnable, $vlan);

    $closure = sub () {
	my $check = $self->set([[$IgmpEnable,$vlan,"enable","INTEGER"]]);
	if (!defined($check)) { sleep (5);}
	return $check;
    };
    $RetVal = $self->hammer($closure, "$id: setting snooping", 3);
    if (!defined($RetVal)) { return 0; }

    $closure = sub () {
	my $check = $self->get1($IgmpEnable, $vlan);
	if (!defined($check) || ($check ne "enable"))
		{ sleep (4); return undef ;}
	return $check;
    };
    $RetVal = $self->hammer($closure, "$id: checking snooping");
    if (!defined($RetVal)) { return 0; }

    return $vlan_number;
}
#
# gets the forbidden, untagged, and egress lists for a vlan
# sends back as a 3 element array of lists.  (Thats the order
# the packet traces for the HP had them in).
#
sub getVlanLists($$) {
    my ($self, $vlan) = @_;
    my $ret = [0, 0, 0];
    @$ret[0] = $self->{H3C} ? [0] : mirvPortSet($self->get1($forbidOID, $vlan));
    @$ret[1] = mirvPortSet($self->get1($normOID, $vlan));
    @$ret[2] = mirvPortSet($self->get1($egressOID, $vlan));
    return $ret;
}

#
# sets the forbidden, untagged, and egress lists for a vlan
# sends back as a 3 element array of lists.
# (Thats the order we saw in a tcpdump of vlan creation.)
# (or in some cases 6 elements for 2 vlans).
#
sub setVlanLists($@) {
    my ($self, @args) = @_;
    my $oids = [$forbidOID, $normOID, $egressOID];
    my $j = 0; my $todo = [ 0 ];
    while (@args) {
	my $vlan = shift @args;
	my $arrayref = shift @args;
	foreach my $i (0, 1, 2) {
	    next if (($i != 2) && $self->{H3C});
	    @$todo[$j++] = [ @$oids[$i], $vlan,
		    pack("B*",join('', @{@$arrayref[$i]})), "OCTETSTR"];
	}
    }
    $j = $self->set($todo);
    if (!defined($j)) { cluck "vlists failed\n";}
    return $j;
}

#
# Some design comments about HP switch conventions:

# This code was written after having observed packet traces while
# running the HP management tool, which appeared to remove a port
# from a vlan merely by getting and setting the 3 OID in getVlanLists
# or transferred it between vlans by setting a pair of the 3 OIDS.

# It seems that a port may be an untagged member of at most one vlan
# but may be a tagged member of several others,  i.e. the packets
# ared rx'd from the port or tx'd to the port with vlan tags added.

# If a port appears only in the $egressOIDs and never in a $normOID
# (so that it is like a normal interswitch single wire trunk), the
# The $aftOID = admitOnlyVlanTagged, without our having to set it.

# The OID describing the PVID of a port seem to correspond to
# the untagged membership of the port in some vlan, and it does
# not seem necessary to set this OID either.

# In this case, the port has $aftOID (dot1QPortAceptableFrameType) = admitAll.

# If we want the port to be like dual mode port on a foundry or cisco, we can
# merely add the port to the egress OID of any additonal vlan.

# However, if a switch belongs to a unique vlan, and is an untagged member,
# there would be no way to determine if the intent was to be a dual mode port
# or for the port have the semantics of most other switches, i.e. adding it
# to one vlan takes it out of the first.

# Since this is the common case, we record the dual mode intent
# by marking the port as being forbidden to join vlan 1.

#
# Put the given ports in the given VLAN. The VLAN is given as an 802.1Q 
# tag number.
#
# usage: setPortVlan($self, $vlan_number, @ports)
#	 returns 0 on sucess.
#	 returns the number of failed ports on failure.
#
sub setPortVlan($$@) {
    my $self = shift;
    my $vlan_number = shift;
    my @ports = @_;

    my $id = $self->{NAME} . "::setPortVlan($vlan_number)";
    $self->debug($id);
    my %vlansToPorts; # i.e. bumpedVlansToListOfPorts
    my @newTaggedPorts = ();
    my ($errors, $portIndex, $pvid, $rv, @protoTrunks) = (0);
	   
    #
    # Run the port list through portmap to find the ports on the switch that
    # we are concerned with
    #

    return 0 unless(@ports);
    my @portlist = $self->convertPortFormat($PORT_FORMAT_IFINDEX, @ports);
    return -1
	if (!@portlist);
    $self->debug("ports: " . join(",",@ports) . "\n");
    $self->debug("as ifIndexes: " . join(",",@portlist) . "\n");

    #
    # Need to determine status and remove ports from default_vlan
    # before adding to other.  This is a read_modify_write so lock out
    # other instances of snmpit_hp.

    my $defaultInfo = $self->getVlanLists(1);
    foreach $portIndex (@portlist) {
	# check for three easy cases
	# a. known dual port.
	# b. the ports is not allocated
	# c. the port is a trunk

	# case a: This is a dual port, so it doesn't have to leave its PVID.
	if (@{@$defaultInfo[0]}[$portIndex - 1]) {
	    push @newTaggedPorts, $portIndex;
	    next;
	}
	# case b: Unallocated untrunked port.
	if (@{@$defaultInfo[1]}[$portIndex - 1]) {
	    $pvid = 1;
	} else {
	    my $tagOnly = $self->get1($aftOID,$portIndex);
	    if ($tagOnly eq "admitOnlyVlanTagged") {
		# case c: Trunk Port
		if (@{@$defaultInfo[2]}[$portIndex - 1]) {
		    # Total grot - happens when port was made an equal trunk
		    # having no vlans, so is on vlan 1, and might be disabled.
		    # It might also be the case that this version of the driver
		    # is being run for the first time on a switch where
		    # we were previously sloppier about membership in vlan 1.
		    push @protoTrunks, $portIndex;
		}
		push @newTaggedPorts, $portIndex;
		next;
	    } else {
		# case d: untrunked port leaving another vlan.
		# a little more work - get its PVID and assume that
		# is the vlan which it is leaviing. and toss it
		# into the bumpedVlan hash.
		$pvid = $self->get1("dot1qPvid", $portIndex);
	    }
	}
	push @{$vlansToPorts{$pvid}}, $portIndex # autovivifies if null
	    if (defined($pvid) && ($pvid != $vlan_number));
    }
    @{$self->{DISPLACED_VLANS}} = grep {$_ != 1;} keys %vlansToPorts;
 
    $self->lock();
    my $newInfo = $self->getVlanLists($vlan_number);
    foreach my $vlan (keys %vlansToPorts) {
	my $oldInfo = $self->getVlanLists($vlan) ;
	foreach $portIndex (@{$vlansToPorts{$vlan}}) {
	    @{@$oldInfo[1]}[$portIndex-1] = 0;
	    @{@$newInfo[1]}[$portIndex-1] = 1;
	    @{@$oldInfo[2]}[$portIndex-1] = 0;
	    @{@$newInfo[2]}[$portIndex-1] = 1;
	}
	$self->setVlanLists($vlan, $oldInfo, $vlan_number, $newInfo);
    }

    # Now add tagged ports separately, just to be safe.

    if (@newTaggedPorts) {
	foreach $portIndex (@newTaggedPorts)
		{ @{@$newInfo[2]}[$portIndex-1] = 1; }
	$self->setVlanLists($vlan_number, $newInfo);
    }
    $self->unlock();

    # We need to make sure the ports get enabled, and protoTrunks cleaned up.

    if (@protoTrunks) {
	$rv = $self->delPortVlan(1, @protoTrunks) +
		    $self->portControl("enable", @protoTrunks);
	$errors += $rv;
	warn "$id: $rv failures with protoTrunks\n"
	     if ($rv);
    }

    my $onoroff = ($vlan_number ne "1") ? "enable" : "disable";
    $self->debug("$id; will $onoroff"  . join(',',@ports) . "...\n");
    if ( $rv = $self->portControl($onoroff, @ports) ) {
	warn "$id: Port enable had $rv failures.\n";
	$errors += $rv;
    }

    return $errors;
}

sub not_in($$@) {
    my $self = shift;
    my $value = shift;
    my @list = @_;

    return 0 == scalar(grep {$_ == $value;} @list);
}

#
# Remove the given ports from the given VLAN. The VLAN is given as an 802.1Q 
# tag number.
#
# usage: delPortVlan($self, $vlan_number, @ports)
#	 returns 0 on sucess.
#	 returns the number of failed ports on failure.
#
sub delPortVlan($$@) {
    my $self = shift;
    my $vlan_number = shift;
    my @ports = @_;

    return $self->updateOneVlan(0,0,0,$vlan_number,@ports);
}

sub updateOneVlan($$$$$@)
{
    my ($self,$forbid,$untag,$mem,$vlan_number,@ports) = @_;

    $self->debug($self->{NAME} . "::updateOneVlan($untag,$mem,$vlan_number) ");
	   
    #
    # Run the port list through portmap to find the ports on the switch that
    # we are concerned with
    #

    $self->lock();
    my @portlist = $self->convertPortFormat($PORT_FORMAT_IFINDEX, @ports);
    return -1
	if (!@portlist);
    $self->debug("ports: " . join(",",@ports) . "\n");
    $self->debug("as ifIndexes: " . join(",",@portlist) . "\n");

    my $vlist = $self->getVlanLists($vlan_number);
    foreach my $port (@portlist) {
	next if ($self->{ifx2d1dx} && !($port = $self->{ifx2d1dx}{$port}));
	@{@$vlist[0]}[$port - 1] = $forbid if ($vlan_number eq "1");
	@{@$vlist[1]}[$port - 1] = $untag;
	@{@$vlist[2]}[$port - 1] = $mem;
    }
    my $result = $self->setVlanLists($vlan_number, $vlist);
    if (!defined($result)) {
	print STDERR $self->{NAME} .
	    ": updateOneVlan($forbid,$untag,$mem,$vlan_number) failed for: ";
	foreach my $port (@ports) {
	    my $ifindex = shift(@portlist);
	    print STDERR "$port:$ifindex ";
	}
	print STDERR "\n";
    }
    $self->unlock();
    return defined($result) ? 0 : 1;
}

#
# Disables all ports in the given VLANS. Each VLAN is given as a VLAN
# 802.1Q tag value.
#
# usage: removePortsFromVlan(self,@vlan)
#	 returns 0 on sucess.
#	 returns the number of failed ports on failure.
#
sub removePortsFromVlan($@) {
    my $self = shift;
    my @vlan_numbers = @_;
    my $errors = 0;
    my $id = $self->{NAME} . "::removePortsFromVlan";

    foreach my $vlan_number (@vlan_numbers) {
	my @ports = $self->portSetToList($self->get1($egressOID, $vlan_number));
	if (@ports) {
	    $errors += $self->removeSomePortsFromVlan($vlan_number, @ports);
	}
    }
    return $errors;
}

#
# Removes and disables some ports in a given VLAN.
# The VLAN is given as a VLAN 802.1Q tag value.
#
# usage: removeSomePortsFromVlan(self,vlan,@ports)
#	 returns 0 on sucess.
#	 returns the number of failed ports on failure.
#
sub removeSomePortsFromVlan($$@) {
    my ($self, $vlan_number, @ports) = @_;
    my ($errors, $changes, $id, %porthash, $tagOnly, $pvid) =
	(0, 0, $self->{NAME} . "::removeSomePortsFromVlan");

    # Callers should know better.
    return 0
	if (!@ports);

    @ports = $self->convertPortFormat($PORT_FORMAT_IFINDEX,@ports);
    return -1
	if (! @ports);
    @porthash{@ports} = @ports;
    my $dualPorts = mirvPortSet($self->get1($forbidOID, 1)); # array

    foreach my $portIndex (@ports) {
	if (@$dualPorts[$portIndex-1]) {
	    # We make any dual ports whose PVID is this vlan into equaltrunks.
	    # A dualtrunked port whose primary vlan is not this vlan
	    # can be deleted by the code dealing with normal ports
	    $pvid = $self->get1("dot1qPvid", $portIndex);
	    next if ("$pvid" ne $vlan_number);
	    $self->updateOneVlan(0,0,1,$vlan_number,$portIndex); #make tagged
	    $self->updateOneVlan(0,0,0,1,$portIndex); # clear dual marker.
	    # fall through to next case
	}
	$tagOnly = $self->get1($aftOID,$portIndex);
	if ($tagOnly eq "admitOnlyVlanTagged") {
	    if ($self->delPortVlan($vlan_number, $portIndex)) {
		# assume it failed because it belonged to no other vlans
		# so add it to vlan 1 and try again.
		$self->updateOneVlan(0,0,1,1,$portIndex);
		if ($self->delPortVlan($vlan_number, $portIndex)) {
		    warn "$id: failed to remove ifIndex $portIndex\n";
		}
	    }
	    delete $porthash{$portIndex};
	}
    }

    # Now, remove the remaining ports from the vlan.
    $self->lock();
    my $defaultLists = $self->getVlanLists(1);
    my $vLists = $self->getVlanLists($vlan_number);
    my @portlist = bitSetToList(@$vLists[2]);
    $self->debug("$id $vlan_number: @portlist\n",2);

    foreach my $portIndex (@portlist) {
	next unless exists($porthash{$portIndex});
	if (@{@$vLists[1]}[$portIndex - 1]) {
	    # otherwise, port is tagged.

	    @{@$defaultLists[1]}[$portIndex - 1] = 1;
	    @{@$defaultLists[2]}[$portIndex - 1] = 1;
	    $self->debug("disabling port $portIndex  "
			    . "from vlan $vlan_number \n" );
	    $self->set(["ifAdminStatus",$portIndex,"down","INTEGER"],$id);
	}
	@{@$vLists[1]}[$portIndex - 1] = 0;
	@{@$vLists[2]}[$portIndex - 1] = 0;
	$changes++;
    }
    $errors += $self->setVlanLists($vlan_number, $vLists, 1, $defaultLists)
	    if ($changes > 0);
    $self->unlock();
    return $errors;
}

#
# Remove the given VLANs from this switch. Removes all ports from the VLAN,
# The VLAN is given as a VLAN identifier from the database.
#
# usage: removeVlan(self,int vlan)
#	 returns 1 on success
#	 returns 0 on failure
#
#
sub removeVlan($@) {
    my $self = shift;
    my @vlan_numbers = @_;
    my $errors = 0;
    my $name = $self->{NAME};

    $self->removePortsFromVlan(@vlan_numbers);
    foreach my $vlan_number (@vlan_numbers) {
	#
	# Perform the actual removal
	#
	print "  Removing VLAN # $vlan_number ... ";
	my $RetVal = $self->set([[$createOID,$vlan_number,"destroy","INTEGER"]]);
	if ($RetVal) {
	    print "Removed VLAN $vlan_number on switch $name.\n";
	} else {
	    print STDERR "Removing VLAN $vlan_number failed on switch $name.\n";
	    $errors++;
	}
	# The next call would buy time to let switch consolidate itself
	# Nortels have bizarre failures when quickly creating and destroying
	# vlans with IGMP snooping enabled.
	# $self->{SESS}->bulkwalk(0,32,[$createOID]);
    }
    return ($errors == 0) ? 1 : 0;
}

#
# XXX: Major cleanup
#
sub UpdateField($$$@) {
    my ($self, $OID, $val, @ports)= @_;
    my $id = $self->{NAME} . "::UpdateField OID $OID value $val";
    $self->debug("$id: ports @ports\n");

    my $result = 0;
    my $oidval = $val;
    my ($Status, $portname, $row);


    foreach $portname (@ports) {
	my ($row) = $self->convertPortFormat($PORT_FORMAT_IFINDEX,$portname);
	next
	    if (!defined($row));
	$self->debug("checking row $row for $val ...\n");
	$Status = $self->get1($OID,$row);
	if (!defined($Status)) {
	    print STDERR "id: Port $portname No answer from device\n";
	    next;
	}
	$self->debug("Port $portname, row $row was $Status\n");
	if ($OID eq "hpSwitchPortFastEtherMode") {
	    #
	    # Procurves use the same mib variable to set both
	    # speed and duplex concurrently; only certain
	    # combinations are permitted.  (We won't support
	    # auto-10-100MBits. And at least the 5400 series
	    # doesn't seem to support full-duplex-1000Mbits.)
	    #
	    my @state = split "-", $Status;
	    if (($val eq "half") || ($val eq "full")) {
		if ($state[0] eq "auto") {
		    if (($state[1] eq "neg") || ($state[1] eq "10")) {
			# can't autospeed with specific duplex.
			$oidval = ($val eq "half") ?
			   "half-duplex-100Mbits" : "full-duplex-100Mbits";
		    } elsif ($state[1] eq "1000Mbits") {
			$oidval = $Status;
		    } else {
			$oidval = $val . "-duplex-" . $state[1] ;
		    }
		} else {
			$oidval = $val . "-duplex-" . $state[2] ;
		}
	    } else {
		if (($val eq "auto-neg") || ($val eq "auto-1000Mbits") ||
			($state[1] ne "duplex")) {
		    $oidval = $val;
		} else {
		    my @valarr = split "-", $val;
		    $oidval = $state[0] . "-duplex-" . "$valarr[1]";
		}
	    }
	}
	if ($Status ne $oidval) {
	    $self->debug("Setting $portname (r $row) to $oidval...");
	    $Status = $self->set([[$OID,$row,$oidval,"INTEGER"]]);
	    $result =  (defined($Status)) ? 0 : -1;
	    $self->debug($result ? "failed.\n" : "succeeded.\n");
	}
    }
    return $result;
}

#
# Determine if a VLAN has any members 
# (Used by stack->switchesWithPortsInVlan())
#
sub vlanHasPorts($$) {
    my ($self, $vlan_number) = @_;

    my $portset = $self->get1($egressOID,$vlan_number);
    if (defined($portset)) {
	my @ports = $self->portSetToList($portset);
	if (@ports) { return 1; }
    }
    return 0;
}

#
# List all VLANs on the device
#
# usage: listVlans($self)
# see snmpit_cisco_stack.pm for a description of return value format
#
sub listVlans($) {
    my $self = shift;

    my (%Names, %Numbers, %Members, %Normports);
    my ($vlan_name, $oid, $vlan_number, $value, $rowref);
    my ($modport, $node, $ifIndex, @portlist, @memberlist);
    $self->debug($self->{NAME} . "::listVlans()\n",1);
    my $maxport = $self->{MAXPORT};

    #
    # Walk the tree to find the VLAN names
    #
    my ($rows) = $self->{SESS}->bulkwalk(0,32,["dot1qVlanStaticName"]);
    foreach $rowref (@$rows) {
	($oid, $vlan_number, $vlan_name) = @$rowref;
	$self->debug("Got $oid $vlan_number $vlan_name\n",3);
        # Hack to get around some strange behavior
        if ((!defined($vlan_number) || $vlan_number eq "") &&
                defined(parseVlanNumberFromOID($oid))) {
            $vlan_number = parseVlanNumberFromOID($oid);
            $self->debug("Changed vlan_number to $vlan_number\n",3);
        }
	next if ("$vlan_number" eq "1");
	$vlan_name = convertVlanName($vlan_name);
	if (!$Names{$vlan_number}) {
	    $Names{$vlan_number} = $vlan_name;
	    @{$Members{$vlan_number}} = ();
	}
    }

    #
    #  Walk the tree for the VLAN members
    #
    ($rows) = $self->{SESS}->bulkwalk(0,32,["dot1qVlanStaticEgressPorts"]);
    foreach $rowref (@$rows) {
	($oid,$vlan_number,$value) = @$rowref;
	next if ("$vlan_number" eq "1");
	@portlist = $self->portSetToList($value);
	if ($self->{d1dx2ifx}) {
	    @portlist = map { $self->{d1dx2ifx}{$_}} @portlist ;
	}
	$self->debug("Got $oid $vlan_number @portlist\n",3);

	foreach $ifIndex (@portlist) {
	    ($node) = $self->convertPortFormat($PORT_FORMAT_PORT,$ifIndex);
	    if (!$node) {
		($modport) = $self->convertPortFormat
				    ($PORT_FORMAT_MODPORT,$ifIndex);
		$node = Port->LookupByStringForced($self->{NAME} . ":$modport");
	    }
	    # Let's be clear about what kind of connection this is and
	    # get the right port object.  If there is an endpoint here,
	    # get that.  If this is a trunk, then the member we want to
	    # put in the list is the "local" side (this switch's port).
	    my $mbrport;
	    if ($node->is_trunk_port()) {
		$mbrport = $node;
	    } else {
		# getOtherEndPort() will return the object upon which the
		# method is invoked if it fails to lookup the other side.
		$mbrport = $node->getOtherEndPort();
	    }
	    push @{$Members{$vlan_number}}, $mbrport;
	    $self->debug("$self->{NAME}:$vlan_number $node:$mbrport\n", 3);

	    if (!$Names{$vlan_number}) {
		$self->debug("listVlans: WARNING: port $node in non-existant " .
		    "VLAN $vlan_number\n", 1);
	    }
	}
    }

    #
    # Build a list from the name and membership lists
    #
    my @list = ();
    foreach my $vlan_id (sort keys %Names) {
	push @list, [$Names{$vlan_id},$vlan_id,$Members{$vlan_id}];
    }

    #$self->debug($self->{NAME} .":". join("\n",(map {join ",", @$_} @list))."\n");
    return @list;
}

#
# List all ports on the device
#
# usage: listPorts($self)
# see snmpit_cisco_stack.pm for a description of return value format
#
sub listPorts($) {
    my $self = shift;

    my %Able = ();
    my %Link = ();
    my %auto = ();
    my %speed = ();
    my %duplex = ();

    my $ifTable = ["ifAdminStatus",0];

    #
    # Get the ifAdminStatus (enabled/disabled) and ifOperStatus
    # (up/down)
    #
    my ($varname, $modport, $ifIndex, $portIndex, $status, $portname);
    $self->{SESS}->getnext($ifTable);
    do {
	($varname,$ifIndex,$status) = @{$ifTable};
	$self->debug("$varname $ifIndex $status\n");
	if (($ifIndex <= $self->{MAXPORT}) && ($varname =~ /AdminStatus/)) { 
	    $Able{$ifIndex} = ($status =~/up/ ? "yes" : "no");
	}
	$self->{SESS}->getnext($ifTable);
    } while ( $varname =~ /^ifAdminStatus$/) ;

    #
    # Get the port configuration, including speed, duplex, and whether or not
    # it is autoconfiguring
    #
    foreach $ifIndex (keys %Able) {
	if ($status = $self->{SESS}->get(["ifOperStatus",$ifIndex])) {
	    $Link{$ifIndex} = $status;
	}
	# HP combines speed and duplex and it has to be teased apart lexically.
	if ($status = $self->get1("hpSwitchPortFastEtherMode",$ifIndex)) {
	    my @parse = split("-duplex-", $status);
	    if (2 == scalar(@parse)) {
		$duplex{$ifIndex} = $parse[0];
		$speed{$ifIndex} = $parse[1];
	    } else {
		@parse = split("auto-",$status);
		$duplex{$ifIndex} = "auto";
		$speed{$ifIndex} = $parse[1];
		if ($speed{$ifIndex} eq "neg") {
		    $speed{$ifIndex} = "auto";
		}
	    }
	}
    };

    #
    # Put all of the data gathered in the loop into a list suitable for
    # returning
    #
    my @rv = ();
    foreach my $id ( keys %Able ) {
	$modport = $self->{IFINDEX}{$id};
	$portname = $self->{NAME} . ":$modport";
	my $port = Port->LookupByTriple($portname); 
	if (defined($port)) {
		$port = $port->getOtherEndPort();
	}

	#
	# Skip ports that don't seem to have anything interesting attached
	#
	if (!$port && $self->{DOALLPORTS}) {
		$modport =~ s/\./\//;
		$port = Port->LookupByStringForced($self->{NAME} . ":$modport");
	}
	if (!$port) {
	    $self->debug("$id ($modport) not connected, skipping\n");
	    next;
	}
	if (! defined ($speed{$id}) ) { $speed{$id} = " "; }
	if (! defined ($duplex{$id}) ) { $duplex{$id} = " "; }
	push @rv, [$port,$Able{$id},$Link{$id},$speed{$id},$duplex{$id}];
    }
    return @rv;
}

# 
# Get statistics for ports on the switch
#
# usage: getStats($self)
# see snmpit_cisco_stack.pm for a description of return value format
#
#
sub getStats() {
    my $self = shift;

    #
    # Walk the tree for the VLAN members
    #
    my $vars = new SNMP::VarList(['ifInOctets'],['ifInUcastPkts'],
    				 ['ifInNUcastPkts'],['ifInDiscards'],
				 ['ifInErrors'],['ifInUnknownProtos'],
				 ['ifOutOctets'],['ifOutUcastPkts'],
				 ['ifOutNUcastPkts'],['ifOutDiscards'],
				 ['ifOutErrors'],['ifOutQLen']);
    my @stats = $self->{SESS}->bulkwalk(0,32,$vars);

    #
    # We need to flip the two-dimentional array we got from bulkwalk on
    # its side, and convert ifindexes into node:port
    #
    my $i = 0;
    my %stats;
    foreach my $array (@stats) {
	while (@$array) {
	    my ($name,$ifindex,$value) = @{shift @$array};

            # See comments in walkTable above.

            if (! defined $self->{IFINDEX}{$ifindex}) { next; }
            my $po = convertPortFromString("$self->{NAME}:".$self->{IFINDEX}{$ifindex});
            if (! defined $po) { next; } # Skip if we don't know about it
            my $port = $po->getOtherEndPort()->toTripleString();
            
	    ${$stats{$port}}[$i] = $value;
	}
	$i++;
    }

    return map [convertPortFromString($_),@{$stats{$_}}], sort {tbsort($a,$b)} keys %stats;
}

#
# Used to flush FDB entries easily
#
# usage: resetVlanIfOnTrunk(self, modport, vlan)
#
sub resetVlanIfOnTrunk($$$) {
    my ($self, $modport, $vlan) = @_;
    my ($ifIndex) = $self->convertPortFormat($PORT_FORMAT_IFINDEX,$modport);
    return -1
	if (!$ifIndex);
    $self->debug($self->{NAME} . "::resetVlanIfOnTrunk m $modport "
		    . "vlan $vlan ifIndex $ifIndex\n",1);
    if ($self->{d1dx2ifx}) { $ifIndex = $self->{d1dx2ifx}{$ifIndex}; }
    my $vlan_ports = $self->get1($egressOID, $vlan);
    if (testPortSet($vlan_ports, $ifIndex - 1)) {
	$self->setVlansOnTrunk($modport,0,$vlan);
	$self->setVlansOnTrunk($modport,1,$vlan);
    }
    return 0;
}

#
# Get the ifindex for an EtherChannel (trunk given as a list of ports)
#
# usage: getChannelIfIndex(self, ports)
#        Returns: undef if more than one port is given, and no channel is found
#           an ifindex if a channel is found and/or only one port is given
#
# N.B. by Sklower - cisco's use this to put vlans on multiwire trunks;
# it gets called from _stack.pm
#
# HP's also require a different ifindex for putting a vlan on a multiwire
# trunk from the individual ifindex from any constituent port.
#
# although <NAME>'s vision is that this would only get called when putting
# vlans on multi-wire interswitch trunks and the check would happen in
# _stack, it is 1.) possible to use snmpit -i Switch <mod>/<port> to do
{'fraction_non_alphanumeric': 0.1700271504640835, 'fraction_numerical': 0.011617873003178078, 'mean_word_length': 3.115148103239217, 'pattern_counts': {'":': 38, '<': 25, '<?xml version=': 0, '>': 591, 'https://': 0, 'lorem ipsum': 0, 'www.': 2, 'xml': 0}, 'pii_count': 22, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 12, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5196305', 'n_tokens_mistral': 36194, 'n_tokens_neox': 34380, 'n_words': 9635}