Foundry and mixed-type stack support.

Contributed by Keith Sklower at Berkeley.

tbsetup/GNUmakefile.in

@@ -46,6 +46,7 @@ LIBEXEC_STUFF	= rmproj wanlinksolve wanlinkinfo \
 LIB_STUFF       = libtbsetup.pm exitonwarn.pm libtestbed.pm snmpit_intel.pm \
                   snmpit_cisco.pm snmpit_lib.pm snmpit_apc.pm power_rpc27.pm \
 		  snmpit_cisco_stack.pm snmpit_intel_stack.pm \
+		  snmpit_foundry.pm snmpit_stack.pm \
 		  libaudit.pm libreboot.pm libosload.pm libtestbed.py 
 
 #

tbsetup/checkports.in

@@ -114,6 +114,12 @@ foreach my $name (keys %portMap) {
 	    last;
 	};
 
+	/foundry/ && do {
+	    require snmpit_foundry;
+	    $device = new snmpit_foundry($name,0);
+	    last;
+	};
+
 	# 'default' case
 	die "Unknown switch type ($type) for $name\n";
     }

tbsetup/portstats.in

@@ -242,6 +242,11 @@ foreach my $name (keys %portMap) {
 	    $device = new snmpit_intel($name);
 	    last;
 	};
+	/foundry/ && do {
+	    require snmpit_foundry;
+	    $device = new snmpit_foundry($name);
+	    last;
+	};
 
 	# 'default' case
 	die "Unknown switch type ($type) for $name\n";

tbsetup/snmpit.in

@@ -2,7 +2,7 @@
 
 #
 # EMULAB-LGPL
-# Copyright (c) 2000-2003 University of Utah and the Flux Group.
+# Copyright (c) 2000-2004 University of Utah and the Flux Group.
 # All rights reserved.
 #
 
@@ -47,7 +47,7 @@ Usage: $0 [-h] [-v] [-n] [-i device]
           [-r pid eid]
 	  [-t pid eid]
 	  [-d ports] [-e ports] [-a ports]
-	  [-p <10|100> ports] [-u <half|full> ports]
+	  [-p <10|100|1000> ports] [-u <half|full> ports]
 	  [-c]
 General:
   -h          Display this help message
@@ -189,12 +189,14 @@ if ($opt{p}) {
     #
     # We'll put the argument in the form needed by the portControl function
     #
-    if ($opt{p} =~ /^100/) {
+    if ($opt{p} =~ /^1000/) {
+	push @commands, ["portcontrol","1000mbit"];
+    } elsif ($opt{p} =~ /^100/) {
 	push @commands, ["portcontrol","100mbit"];
     } elsif ($opt{p} =~ /^10/) {
 	push @commands, ["portcontrol","10mbit"];
     } else {
-	die "Bad port speed: $opt{p}. Valid values are 10 and 100\n";
+	die "Bad port speed: $opt{p}. Valid values are 10, 100, and 1000\n";
     }
 }
 if ($opt{u}) {
@@ -429,6 +431,12 @@ foreach my $command (@commands) {
 		    @{$stacks{$stack_id}});
 		last;
 	    };
+	    /generic/ && do {
+		require snmpit_stack;
+		$stack = new snmpit_stack($stack_id,$debug,
+		    @{$stacks{$stack_id}});
+		last;
+	    }; # /generic/
 
 	    # 'default' case
 	    die "Unknown stack type $stack_type for stack $stack_id\n";
@@ -789,7 +797,7 @@ sub doReset($@) {
 
     my $errors = 0;
     #
-    # Just remove the VLAN from evey satck on which it exists. We keep a
+    # Just remove the VLAN from evey stack on which it exists. We keep a
     # list and do them all at once for efficiency.
     #
     foreach my $stack (@$stacks) {

tbsetup/snmpit_stack.pm

+#!/usr/bin/perl -w
+
+#
+# EMULAB-LGPL
+# Copyright (c) 2004, Regents, University of California.
+# Modified from an Netbed/Emulab module, Copyright (c) 2000-2003, University of
+# Utah
+#
+
+package snmpit_stack;
+use strict;
+
+$| = 1; # Turn off line buffering on output
+
+use English;
+use SNMP;
+use snmpit_lib;
+
+use libdb;
+
+#
+# Creates a new object. A list of devices that will be operated on is given
+# so that the object knows which to connect to. A future version may not 
+# require the device list, and dynamically connect to devices as appropriate
+#
+# the stack_id happens to also be the name of the stack leader.
+#
+# usage: new(string name, string stack_id, int debuglevel, list of devicenames)
+# returns a new object blessed into the snmpit_stack class
+#
+
+sub new($$$@) {
+
+    # The next two lines are some voodoo taken from perltoot(1)
+    my $proto = shift;
+    my $class = ref($proto) || $proto;
+
+    my $stack_id = shift;
+    my $debugLevel = shift;
+    my @devicenames = @_;
+
+    #
+    # Create the actual object
+    #
+    my $self = {};
+    my $device;
+
+    #
+    # Set up some defaults
+    #
+    if (defined $debugLevel) {
+	$self->{DEBUG} = $debugLevel;
+    } else {
+	$self->{DEBUG} = 0;
+    }
+
+    #
+    # The stackid just happens to also be leader of the stack
+    # 
+    $self->{STACKID} = $stack_id;
+    $self->{MAX_VLAN} = 4095;
+    $self->{MIN_VLAN} = 2;
+
+    #
+    # Store the list of devices we're supposed to operate on
+    #
+    @{$self->{DEVICENAMES}} = @devicenames;
+
+    foreach my $devicename (@devicenames) {
+	print("Making device object for $devicename\n") if $self->{DEBUG};
+	my $type = getDeviceType($devicename);
+	my $device;
+
+	#
+	# Check to see if this is a duplicate
+	#
+	if (defined($self->{DEVICES}{$devicename})) {
+	    warn "WARNING: Device $device was specified twice, skipping\n";
+	    next;
+	}
+
+	#
+	# We check the type for two reasons: to determine which kind of
+	# object to create, and for some sanity checking to make sure
+	# we weren't given devicenames for devices that aren't switches.
+	#
+	SWITCH: for ($type) {
+	    (/cisco65\d\d/ || /cisco40\d\d/ || /cisco29\d\d/ || /cisco55\d\d/)
+		    && do {
+		use snmpit_cisco;
+		$device = new snmpit_cisco($devicename,$self->{DEBUG});
+		last;
+		}; # /cisco/
+	    (/foundry1500/ || /foundry9604/)
+		    && do {
+		use snmpit_foundry;
+		$device = new snmpit_foundry($devicename,$self->{DEBUG});
+		last;
+		}; # /foundry.*/
+	    die "Device $devicename is not of a known type, skipping\n";
+	}
+	unless ($device) {
+		warn "WARNING: Couldn't create device object for $devicename\n";
+		next;
+	}
+	$self->{DEVICES}{$devicename} = $device;
+	if ($devicename eq $self->{STACKID}) {
+	    $self->{LEADER} = $device;
+	}
+	if (defined($device->{MIN_VLAN}) &&
+	    ($self->{MIN_VLAN} < $device->{MIN_VLAN}))
+		{ $self->{MIN_VLAN} = $device->{MIN_VLAN}; }
+	if (defined($device->{MAX_VLAN}) &&
+	    ($self->{MAX_VLAN} > $device->{MAX_VLAN}))
+		{ $self->{MAX_VLAN} = $device->{MAX_VLAN}; }
+
+    }
+
+    bless($self,$class);
+    return $self;
+}
+
+sub lock($) {
+    my $self = shift;
+    my $stackid = $self->{STACKID};
+    foreach my $i (1 .. 20) {
+	if (symlink("./$$", "/tmp/$stackid")) {
+		return 1;
+	} else {
+		$self->debug("sleeping on lock (/tmp/$stackid)\n");
+		sleep(3);
+	}
+    }
+    die "Can't lock /tmp/$stackid\n" ;
+}
+
+sub unlock($) {
+    my $self = shift;
+    my $stackid = $self->{STACKID};
+    return unlink("/tmp/$stackid");
+}
+
+
+#
+# List all VLANs on all switches in the stack
+#
+# usage: listVlans(self)
+#
+# returns: A list of VLAN information. Each entry is an array reference. The
+#	array is in the form [id, num, members] where:
+#		id is the VLAN identifier, as stored in the database
+#		num is the 802.1Q vlan tag number.
+#		members is a reference to an array of VLAN members
+#
+sub listVlans($) {
+    my $self = shift;
+
+    #
+    # We need to 'coallate' the results from each switch by putting together
+    # the results from each switch, based on the VLAN identifier
+    #
+    my %vlans = ();
+    foreach my $devicename (sort {tbsort($a,$b)} keys %{$self->{DEVICES}}) {
+	my $device = $self->{DEVICES}{$devicename};
+	foreach my $line ($device->listVlans()) {
+	    my ($vlan_id, $vlan_number, $memberRef) = @$line;
+	    ${$vlans{$vlan_id}}[0] = $vlan_number;
+	    push @{${$vlans{$vlan_id}}[1]}, @$memberRef;
+	}
+    }
+
+    #
+    # Now, we put the information we've found in the format described by
+    # the header comment for this function
+    #
+    my @vlanList;
+    foreach my $vlan (sort {tbsort($a,$b)} keys %vlans) {
+	push @vlanList, [$vlan, @{$vlans{$vlan}}];
+    } 
+    return @vlanList;
+}
+
+#
+# List all ports on all switches in the stack
+#
+# usage: listPorts(self)
+#
+# returns: A list of port information. Each entry is an array reference. The
+#	array is in the form [id, enabled, link, speed, duplex] where:
+#		id is the port identifier (in node:port form)
+#		enabled is "yes" if the port is enabled, "no" otherwise
+#		link is "up" if the port has carrier, "down" otherwise
+#		speed is in the form "XMbps"
+#		duplex is "full" or "half"
+#
+sub listPorts($) {
+    my $self = shift;
+
+    #
+    # All we really need to do here is coallate the results of listing the
+    # ports on all devices
+    #
+    my %portinfo = (); 
+    foreach my $devicename (sort {tbsort($a,$b)} keys %{$self->{DEVICES}}) {
+	my $device = $self->{DEVICES}{$devicename};
+	foreach my $line ($device->listPorts()) {
+	    my $port = $$line[0];
+	    if (defined $portinfo{$port}) {
+		warn "WARNING: Two ports found for $port\n";
+	    }
+	    $portinfo{$port} = $line;
+	}
+    }
+
+    return map $portinfo{$_}, sort {tbsort($a,$b)} keys %portinfo;
+}
+
+#
+# Puts ports in the VLAN with the given identifier. Contacts the device
+# appropriate for each port.
+#
+# usage: setPortVlan(self, vlan_id, list of ports)
+# returns: the number of errors encountered in processing the request
+#
+sub setPortVlan($$@) {
+    my $self = shift;
+    my $vlan_id = shift;
+    my @ports = @_;
+
+    my $errors = 0;
+    my %mapping = $self->findVlans();
+    my %map;
+
+    #
+    # Grab the VLAN number
+    #
+    my $vlan_number = $mapping{$vlan_id};
+    if (!$vlan_number) {
+	print STDERR "ERROR: VLAN with identifier $vlan_id does not exist!\n";
+	return 1;
+    }
+
+    #
+    # Split up the ports among the devices involved
+    #
+    %map = mapPortsToDevices(@ports);
+    foreach my $devicename (keys %map) {
+	my $device = $self->{DEVICES}{$devicename};
+    	if (!defined($device)) {
+    	    warn "Unable to find device entry for $devicename - some ports " .
+	    	"will not be set up properly\n";
+    	    $errors++;
+    	    next;
+    	}
+	#
+	# We might be adding ports to a switch which doesn't have this
+	# VLAN yet . . .
+	#
+	if (!($device->findVlan($vlan_id)))
+	    { $errors += !($device->createVlan($vlan_id,$vlan_number)); }
+	$errors += $device->setPortVlan($vlan_number,@{$map{$devicename}});
+    }
+
+    $errors += (!$self->setVlanOnTrunks($vlan_number,1,@ports));
+
+    return $errors;
+}
+
+#
+# Allocate a vlan number currently not in use on the stack.
+# Is called from createVlan, here for  clarity and to
+# lower the lines of diff from snmpit_cisco_stack.pm
+#
+# usage: newVlanNumber(self, vlan_identifier)
+#
+# returns a number in $self->{VLAN_MIN} ... $self->{VLAN_MAX}
+# or zero indicating failure: either that the id exists,
+# or the number space is full.
+#
+sub newVlanNumber($$) {
+    my $self = shift;
+    my $vlan_id = shift;
+    my @vlans = $self->listVlans();
+    my @numbers = ();
+    $self->debug("newVlanNumber: vlans @vlans\n");
+    if ((grep {@$_[0] eq $vlan_id} @vlans) > 0) {
+	return 0;
+    }
+#    foreach my $ref (@vlans) {
+#	my ($name , $number , $c) = @$ref;
+#	push @numbers, $number;
+#    }
+    @numbers = map { @$_[1] } @vlans ;
+    $self->debug("newVlanNumbers: numbers ". "@numbers" . " \n");
+    my $number = $self->{MIN_VLAN}-1;
+    my $lim = $self->{MAX_VLAN};
+    do { ++$number }
+	until (!(grep {$_ == $number} @numbers) || ($number > $lim));
+    return $number <= $lim ? $number : 0;
+}
+
+#
+# Creates a VLAN with the given VLAN identifier on the stack. If ports are
+# given, puts them into the newly created VLAN. It is an error to create a
+# VLAN that already exists.
+#
+# usage: createVlan(self, vlan identfier, port list)
+#
+# returns: 1 on success
+# returns: 0 on failure
+#
+sub createVlan($$$;$$$) {
+    my $self = shift;
+    my $vlan_id = shift;
+    my @ports = @{shift()};
+    my @otherargs = @_;
+    my $okay = 1;
+    my %map;
+
+
+    # We ignore other args for now, since generic stacks don't support
+    # private VLANs and VTP;
+
+    $self->lock();
+    LOCKBLOCK: {
+	#
+	# We need to create the VLAN on all pertinent devices
+	#
+	my ($vlan_number, $res, $devicename, $device);
+	$vlan_number = $self->newVlanNumber($vlan_id);
+	if ($vlan_number == 0) { last LOCKBLOCK;}
+	%map = mapPortsToDevices(@ports);
+	foreach $devicename (sort {tbsort($a,$b)} keys %map) {
+	    $self->debug( "Creating VLAN $vlan_id , number $vlan_number " .
+	     "on member switch $devicename\n") ;
+	    $device = $self->{DEVICES}{$devicename};
+	    $res = $device->createVlan($vlan_id, $vlan_number);
+	    if (!$res) {
+		#
+		# Ooops, failed. Don't try any more
+		#
+		$okay = 0;
+		last;
+	    }
+	}
+
+	#
+	# We need to populate each VLAN on each switch.
+	#
+	$self->debug( "adding ports @ports to VLAN $vlan_id \n");
+	if ($okay && @ports) {
+	    if ($self->setPortVlan($vlan_id,@ports)) {
+		$okay = 0;
+	    }
+	}
+
+    }
+    $self->unlock();
+    return $okay;
+}
+
+sub findVlans($@) {
+    my $self = shift;
+    my @vlan_ids = @_;
+    my ($device, $devicename);
+    my %mapping = ();
+
+    $self->debug("snmpit_stack::findVlans( @vlan_ids )\n",2);
+    foreach $devicename (sort {tbsort($a,$b)} keys %{$self->{DEVICES}}) {
+	$device = $self->{DEVICES}->{$devicename};
+	my %dev_map = $device->findVlans(@vlan_ids);
+	my ($id,$num,$oldnum);
+	while (($id,$num) = each %dev_map) {
+		if (defined($mapping{$id})) {
+		    $oldnum = $mapping{$id};
+		    if (defined($num) && ($num != $oldnum))
+			{ warn "incompatible 802.1Q tag assignments for $id\n";}
+		} else
+		    { $mapping{$id} = $num; }
+	}
+    }
+    return %mapping;
+}
+
+#
+# Check to see if the given VLAN exists in the stack
+#
+# usage: vlanExists(self, vlan identifier)
+#
+# returns 1 if the VLAN exists
+#         0 otherwise
+#
+sub vlanExists($$) {
+    my $self = shift;
+    my $vlan_id = shift;
+    my %mapping = $self->findVlans();
+
+    if (defined($mapping{$vlan_id})) {
+	return 1;
+    } else {
+	return 0;
+    }
+
+}
+
+#
+# Return a list of which VLANs from the input set exist on this stack
+#
+# usage: existantVlans(self, vlan identifiers)
+#
+# returns: a list containing the VLANs from the input set that exist on this
+# 	stack
+#
+sub existantVlans($@) {
+    my $self = shift;
+    my @vlan_ids = @_;
+
+    my %mapping = $self->findVlans(@vlan_ids);
+
+    my @existant = ();
+    foreach my $vlan_id (@vlan_ids) {
+	if (defined $mapping{$vlan_id}) {
+	    push @existant, $vlan_id;
+	}
+    }
+
+    return @existant;
+
+}
+
+#
+# Removes a VLAN from the stack. This implicitly removes all ports from the
+# VLAN. It is an error to remove a VLAN that does not exist.
+#
+# usage: removeVlan(self, vlan identifiers)
+#
+# returns: 1 on success
+# returns: 0 on failure
+#
+sub removeVlan($@) {
+    my $self = shift;
+    my @vlan_ids = @_;
+    my $errors = 0;
+
+    #
+    # Exit early if no VLANs given
+    #
+    if (!@vlan_ids) {
+	return 1;
+    }
+
+    my %vlan_numbers = $self->findVlans(@vlan_ids);
+    foreach my $vlan_id (@vlan_ids) {
+	#
+	# First, make sure that the VLAN really does exist
+	#
+	my $vlan_number = $vlan_numbers{$vlan_id};
+	if (!$vlan_number) {
+	    warn "ERROR: VLAN $vlan_id not found on switch!";
+	    return 0;
+	}
+
+	#
+	# Prevent the VLAN from being sent across trunks.
+	#
+	if (!$self->setVlanOnTrunks($vlan_number,0)) {
+	    warn "ERROR: Unable to set up VLANs on trunks!\n";
+	    #
+	    # We can keep going, 'cause we can still remove the VLAN
+	    #
+	}
+	
+    }
+
+    #
+    # Now, we go through each device and remove all ports from the VLAN
+    # on that device. Note the reverse sort order! This way, we do not
+    # interfere with another snmpit processes, since createVlan tries
+    # in 'forward' order (we will remove the VLAN from the 'last' switch
+    # first, so the other snmpit will not see it free until it's been
+    # removed from all switches)
+    #
+    LOOP: foreach my $devicename (sort {tbsort($b,$a)} keys %{$self->{DEVICES}})
+    {
+	my $device = $self->{DEVICES}{$devicename};
+	my @existant_vlans = ();
+	my %vlan_numbers = $device->findVlans(@vlan_ids);
+	foreach my $vlan_id (@vlan_ids) {
+
+	    #
+	    # Only remove ports from the VLAN if it exists on this
+	    # device. Do it in one pass for efficiency
+	    #
+	    if (defined $vlan_numbers{$vlan_id}) {
+		push @existant_vlans, $vlan_numbers{$vlan_id};
+	    }
+	}
+	next LOOP if (scalar(@existant_vlans) == 0);
+
+	print "Removing ports on $devicename from VLANS " . 
+	    join(",",@existant_vlans)."\n" if $self->{DEBUG};
+
+	$errors += $device->removePortsFromVlan(@existant_vlans);
+
+	#
+	# Since mixed stacks doesn't use VTP, delete the VLAN, too.
+	#
+	my $ok = $device->removeVlan(@existant_vlans);
+	if (!$ok) { $errors++; }
+    }
+
+    return ($errors == 0);
+}
+
+#
+# Set a variable associated with a port. 
+# TODO: Need a list of variables here
+#
+sub portControl ($$@) { 
+    my $self = shift;
+    my $cmd = shift;
+    my @ports = @_;
+    my %portDeviceMap = mapPortsToDevices(@ports);
+    my $errors = 0;
+    # XXX: each
+    while (my ($devicename,$ports) = each %portDeviceMap) {
+	$errors += $self->{DEVICES}{$devicename}->portControl($cmd,@$ports);
+    }
+    return $errors;
+}
+
+#
+# Get port statistics for all devices in the stack
+#
+sub getStats($) {
+    my $self = shift;
+