snmpit_lib.pm 26 KB
Newer Older
1
#!/usr/bin/perl -w
Leigh B. Stoller's avatar
Leigh B. Stoller committed
2
#
3
# EMULAB-LGPL
4
# Copyright (c) 2000-2005 University of Utah and the Flux Group.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
5
6
7
# All rights reserved.
#

Mac Newbold's avatar
Mac Newbold committed
8
#
9
# Module of subroutines useful to snmpit and its modules
Mac Newbold's avatar
Mac Newbold committed
10
11
12
13
14
15
#

package snmpit_lib;

use Exporter;
@ISA = ("Exporter");
16
@EXPORT = qw( macport portnum Dev vlanmemb vlanid
17
		getTestSwitches getControlSwitches getSwitchesInStack
18
		getVlanPorts convertPortsFromIfaces convertPortFromIface
19
		getExperimentVlans getDeviceNames getDeviceType
20
21
		getInterfaceSettings mapPortsToDevices getSwitchPrimaryStack
		getSwitchStacks
22
23
		getStackType getStackLeader
		getDeviceOptions getTrunks getTrunksFromSwitches
24
                getTrunkHash
25
26
		getExperimentPorts snmpitGet snmpitGetWarn snmpitGetFatal
		snmpitSet snmpitSetWarn snmpitSetFatal snmpitWarn snmpitFatal
27
                snmpitBulkwalk snmpitBulkwalkWarn snmpitBulkwalkFatal
28
		printVars tbsort );
Mac Newbold's avatar
Mac Newbold committed
29
30

use English;
31
use libdb;
32
use libtestbed;
33
use strict;
34
35
36
use SNMP;

my $TBOPS = libtestbed::TB_OPSEMAIL;
Mac Newbold's avatar
Mac Newbold committed
37
38
39

my $debug = 0;

40
my $DEFAULT_RETRIES = 10;
41

42
43
my $SNMPIT_GET = 0;
my $SNMPIT_SET = 1;
44
my $SNMPIT_BULKWALK = 2;
45

Mac Newbold's avatar
Mac Newbold committed
46
my %Devices=();
47
# Devices maps device names to device IPs
Mac Newbold's avatar
Mac Newbold committed
48
49

my %Interfaces=();
50
# Interfaces maps pcX:Y<==>MAC
Mac Newbold's avatar
Mac Newbold committed
51
52

my %Ports=();
53
54
55
56
57
58
59
# Ports maps pcX:Y<==>switch:port

my %vlanmembers=();
# vlanmembers maps id -> members

my %vlanids=();
# vlanids maps pid:eid <==> id
Mac Newbold's avatar
Mac Newbold committed
60

61
62
my $snmpitErrorString;

63
#
64
# Initialize the library
65
66
67
68
69
#
sub init($) {
    $debug = shift || $debug;
    &ReadTranslationTable;
    return 0;
Mac Newbold's avatar
Mac Newbold committed
70
71
}

72
73
74
#
# Map between interfaces and mac addresses
#
Mac Newbold's avatar
Mac Newbold committed
75
sub macport {
76
77
    my $val = shift || "";
    return $Interfaces{$val};
Mac Newbold's avatar
Mac Newbold committed
78
79
}

80
81
82
#
# Map between interfaces and port numbers
#
Mac Newbold's avatar
Mac Newbold committed
83
sub portnum {
84
85
    my $val = shift || "";
    return $Ports{$val};
Mac Newbold's avatar
Mac Newbold committed
86
87
}

88
89
90
#
# Map between interfaces and the devices they are attached to
#
Mac Newbold's avatar
Mac Newbold committed
91
sub Dev {
92
93
    my $val = shift || "";
    return $Devices{$val};
Mac Newbold's avatar
Mac Newbold committed
94
95
}

96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
#
# This function fills in %Interfaces and %Ports
# They hold pcX:Y<==>MAC and pcX:Y<==>switch:port respectively
#
sub ReadTranslationTable {
    my $name="";
    my $mac="";
    my $switchport="";

    print "FILLING %Interfaces\n" if $debug;
    my $result = DBQueryFatal("select * from interfaces;");
    while ( @_ = $result->fetchrow_array()) {
	$name = "$_[0]:$_[1]";
	if ($_[2] != 1) {$name .=$_[2]; }
	$mac = "$_[3]";
	$Interfaces{$name} = $mac;
	$Interfaces{$mac} = $name;
	print "Interfaces: $mac <==> $name\n" if $debug > 1;
    }

    print "FILLING %Devices\n" if $debug;
    $result = DBQueryFatal("select i.node_id,i.IP,n.type from interfaces as i ".
	    "left join nodes as n on n.node_id=i.node_id ".
	    "left join node_types as nt on n.type=nt.type ".
120
	    "where n.role!='testnode' and i.iface=nt.control_iface");
121
122
123
124
125
126
127
128
129
    while ( my ($name,$ip,$type) = $result->fetchrow_array()) {
	$Devices{$name} = $ip;
	$Devices{$ip} = $name;
	print "Devices: $name ($type) <==> $ip\n" if $debug > 1;
    }

    print "FILLING %Ports\n" if $debug;
    $result = DBQueryFatal("select node_id1,card1,port1,node_id2,card2,port2 ".
	    "from wires;");
130
131
132
    while ( my @row = $result->fetchrow_array()) {
        my ($node_id1, $card1, $port1, $node_id2, $card2, $port2) = @row;
	$name = "$node_id1:$card1";
133
	print "Name='$name'\t" if $debug > 2;
134
135
	print "Dev='$node_id2'\t" if $debug > 2;
	$switchport = "$node_id2:$card2.$port2";
136
137
138
139
140
141
	print "switchport='$switchport'\n" if $debug > 2;
	$Ports{$name} = $switchport;
	$Ports{$switchport} = $name;
	print "Ports: '$name' <==> '$switchport'\n" if $debug > 1;
    }

142
143
}

144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
#
# Returns an array of ports (in node:card form) used by the given VLANs
#
sub getVlanPorts (@) {
    my @vlans = @_;
    # Silently exit if they passed us no VLANs
    if (!@vlans) {
	return ();
    }

    my $result = DBQueryFatal("SELECT members FROM vlans WHERE " .
	join(' OR ', map("id='$_'",@vlans))); # Join "id='foo'" with ORs
    my @ports;
    while (my @row = $result->fetchrow()) {
	my $members = $row[0];
	# $members is a space-seprated list
	foreach my $port (split /\s+/,$members) {
161
162
163
164
165
166
            # XXX: Temp hack - work around another bug which sometimes
            # puts '(null)' in the table
            if ($port eq "(null)") {
                warn "WARNING: (null) found in VLANS table!\n";
                next;
            }
167
	    push @ports, $port;
168
169
	}
    }
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210

    # Convert from the DB format to the one used by the snmpit modules
    return convertPortsFromIfaces(@ports);
}

#
# Convert an entire list of ports in port:iface format to into port:card -
# returns other port forms unchanged.
#
sub convertPortsFromIfaces(@) {
    my @ports = @_;
    return map {
        if (/(.+):([A-Za-z].*)/) {
            # Seems to be a node:iface line
            convertPortFromIface($_);
        } else {
            $_;
        }
    } @ports;

}

#
# Convert a port in port:iface format to port:card
#
sub convertPortFromIface($) {
    my ($port) = $_;
    if ($port =~ /(.+):(.+)/) {
        my ($node,$iface) =  ($1,$2);
        my $result = DBQueryFatal("SELECT card FROM interfaces " .
            "WHERE node_id='$node' AND iface='$iface'");
        if (!$result->num_rows()) {
            warn "WARNING: convertPortFromIface($port) - Unable to get card\n";
            return $port;
        }
        my $card = ($result->fetchrow())[0];
        return "$node:$card";
    } else {
        warn "WARNING: convertPortFromIface($port) - Bad port format\n";
        return $port;
    }
211
212
}

213
#
214
215
# Returns an array of all VLAN id's used by a given experiment.
# Optional list of vlan ids restricts operation to just those vlans,
216
#
217
218
sub getExperimentVlans ($$@) {
    my ($pid, $eid, @optvlans) = @_;
219
220

    my $result =
221
222
223
224
225
	DBQueryFatal("SELECT id FROM vlans WHERE pid='$pid' AND eid='$eid' ".
		     (@optvlans ?
		      "and (" . join(' OR ', map("id='$_'", @optvlans)) . ")" :
		      ""));
    
226
227
228
229
230
231
    my @vlans = (); 
    while (my @row = $result->fetchrow()) {
	push @vlans, $row[0];
    }

    return @vlans;
232
233
}

Robert Ricci's avatar
Robert Ricci committed
234
235
236
237
238
239
240
241
242
#
# Returns an array of all ports used by a given experiment
#
sub getExperimentPorts ($$) {
    my ($pid, $eid) = @_;

    return getVlanPorts(getExperimentVlans($pid,$eid));
}

243
244
245
246
247
248
249
250
251
#
# Usage: getDeviceNames(@ports)
#
# Returns an array of the names of all devices used in the given ports
#
sub getDeviceNames(@) {
    my @ports = @_;
    my %devices = ();
    foreach my $port (@ports) {
Robert Ricci's avatar
Robert Ricci committed
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
	#
	# Accept either node:port or switch.port
	#
	my $device;
	if ($port =~ /^([^:]+):(.+)$/) {
	    my ($node,$card) = ($1,$2);
	    if (!defined($node) || !defined($card)) { # Oops, $card can be 0
		die "Bad port given: $port\n";
	    }
	    my $result = DBQueryFatal("SELECT node_id2 FROM wires " .
		"WHERE node_id1='$node' AND card1=$card");
	    if (!$result->num_rows()) {
		warn "No database entry found for port $port - Skipping\n";
		next;
	    }
	    # This is a loop, on the off chance chance that a single port on a
	    # node can be connected to multiple ports on the switch.
	    while (my @row = $result->fetchrow()) {
		$device = $row[0];
	    }
	} elsif ($port =~ /^([^.]+)\.\d+(\/\d+)?$/) {
		$device = $1;
	} else {
	    warn "Invalid format for port $port - Skipping\n";
276
277
	    next;
	}
Robert Ricci's avatar
Robert Ricci committed
278
279

	$devices{$device} = 1;
Mac Newbold's avatar
Mac Newbold committed
280
    }
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
    return (sort {tbsort($a,$b)} keys %devices);
}

#
# Returns a hash, keyed by device, of all ports in the given list that are
# on that device
#
sub mapPortsToDevices(@) {
    my @ports = @_;
    my %map = ();
    foreach my $port (@ports) {
	my ($device) = getDeviceNames($port);
	if (defined($device)) { # getDeviceNames does the job of warning users
	    push @{$map{$device}},$port;
	}
296
    }
297
    return %map;
Mac Newbold's avatar
Mac Newbold committed
298
299
}

300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
#
# Returns the device type for the given node_id
#
sub getDeviceType ($) {

    my ($node) = @_;

    my $result =
	DBQueryFatal("SELECT type FROM nodes WHERE node_id='$node'");

    my @row = $result->fetchrow();
    # Sanity check - make sure the node exists
    if (!@row) {
	die "No such node: $node\n";
    }

    return $row[0];
Mac Newbold's avatar
Mac Newbold committed
317
318
}

319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
#
# Returns (current_speed,duplex) for the given interface (in node:port form)
#
sub getInterfaceSettings ($) {

    my ($interface) = @_;

    $interface =~ /^(.+):(\d+)$/;
    my ($node, $port) = ($1, $2);
    if ((!defined $node) || (!defined $port)) {
	die "getInterfaceSettings: Bad interface ($interface) given\n";
    }

    my $result =
	DBQueryFatal("SELECT current_speed, duplex FROM interfaces " .
		     "WHERE node_id='$node' and card=$port");

    my @row = $result->fetchrow();
    # Sanity check - make sure the interface exists
    if (!@row) {
	die "No such interface: $interface\n";
    }

    return @row;
}

345
346
347
348
349
350
351
352
353
354
355
356
357
358
#
# Returns an array with then names of all switches identified as test switches
#
sub getTestSwitches () {
    my $result =
	DBQueryFatal("SELECT node_id FROM nodes WHERE role='testswitch'");
    my @switches = (); 
    while (my @row = $result->fetchrow()) {
	push @switches, $row[0];
    }

    return @switches;
}

359
360
361
362
363
364
365
366
367
368
369
370
371
372
#
# Returns an array with the names of all switches identified as control switches
#
sub getControlSwitches () {
    my $result =
	DBQueryFatal("SELECT node_id FROM nodes WHERE role='ctrlswitch'");
    my @switches = (); 
    while (my @row = $result->fetchrow()) {
	push @switches, $row[0];
    }

    return @switches;
}

373
374
375
376
377
378
379
380
381
382
383
384
385
386
#
# Returns an array with the names of all switches in the given stack
#
sub getSwitchesInStack ($) {
    my ($stack_id) = @_;
    my $result = DBQueryFatal("SELECT node_id FROM switch_stacks " .
	"WHERE stack_id='$stack_id'");
    my @switches = (); 
    while (my @row = $result->fetchrow()) {
	push @switches, $row[0];
    }

    return @switches;
}
387

388
#
389
# Returns the stack_id of a switch's primary stack
390
#
391
sub getSwitchPrimaryStack($) {
392
393
    my $switch = shift;
    my $result = DBQueryFatal("SELECT stack_id FROM switch_stacks WHERE " .
394
    		"node_id='$switch' and is_primary=1");
395
    if (!$result->numrows()) {
396
397
398
399
400
	print STDERR "No primary stack_id found for switch $switch\n";
	return undef;
    } elsif ($result->numrows() > 1) {
	print STDERR "Switch $switch is marked as primary in more than one " .
	    "stack\n";
401
402
403
404
405
406
407
	return undef;
    } else {
	my ($stack_id) = ($result->fetchrow());
	return $stack_id;
    }
}

408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
#
# Returns a list of all stack_ids that a switch belongs to
#
sub getSwitchStacks($) {
    my $switch = shift;
    my $result = DBQueryFatal("SELECT stack_id FROM switch_stacks WHERE " .
    		"node_id='$switch'");
    if (!$result->numrows()) {
	print STDERR "No stack_id found for switch $switch\n";
	return undef;
    } else {
	my @stack_ids;
	while (my ($stack_id) = ($result->fetchrow())) {
	    push @stack_ids, $stack_id;
	}
	return @stack_ids;
    }
}

427
#
Robert Ricci's avatar
Robert Ricci committed
428
# Returns the type of the given stack_id. If called in list context, also
429
430
# returns whether or not the stack supports private VLANs, whether it
# uses a single VLAN domain, and the SNMP community to use.
431
432
433
#
sub getStackType($) {
    my $stack = shift;
434
    my $result = DBQueryFatal("SELECT stack_type, supports_private, " .
435
436
	"single_domain, snmp_community FROM switch_stack_types " .
	"WHERE stack_id='$stack'");
437
438
439
440
    if (!$result->numrows()) {
	print STDERR "No stack found called $stack\n";
	return undef;
    } else {
441
442
	my ($stack_type,$supports_private,$single_domain,$community)
	    = ($result->fetchrow());
Robert Ricci's avatar
Robert Ricci committed
443
	if (defined wantarray) {
444
	    return ($stack_type,$supports_private,$single_domain, $community);
Robert Ricci's avatar
Robert Ricci committed
445
446
447
	} else {
	    return $stack_type;
	}
448
449
450
    }
}

451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
#
# Returns the leader for the given stack - the meaning of this is vendor-
# specific. May be undefined.
#
sub getStackLeader($) {
    my $stack = shift;
    my $result = DBQueryFatal("SELECT leader FROM switch_stack_types " .
	"WHERE stack_id='$stack'");
    if (!$result->numrows()) {
	print STDERR "No stack found called $stack\n";
	return undef;
    } else {
	my ($leader) = ($result->fetchrow());
	return $leader;
    }
}

468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
#
# Get a hash that describes the configuration options for a switch. The idea is
# that the device's object will call this method to get some options.  Right
# now, all this stuff actually comes from the stack, but there could be
# switch-specific configuration in the future. Provides defaults for NULL
# columns
#
# We could probably make this look more like an object, for type checking, but
# that just doesn't seem necessary yet.
#
sub getDeviceOptions($) {
    my $switch = shift;
    my %options;

    my $result = DBQueryFatal("SELECT supports_private, " .
	"single_domain, snmp_community, min_vlan, max_vlan " .
	"FROM switch_stacks AS s left join switch_stack_types AS t " .
	"    ON s.stack_id = t.stack_id ".
	"WHERE s.node_id='$switch'");

    if (!$result->numrows()) {
	print STDERR "No switch $switch found, or it is not in a stack\n";
	return undef;
    }

    my ($supports_private, $single_domain, $snmp_community, $min_vlan,
	$max_vlan) = $result->fetchrow();

    $options{'supports_private'} = $supports_private;
    $options{'single_domain'} = $single_domain;
    $options{'snmp_community'} = $snmp_community || "public";
    $options{'min_vlan'} = $min_vlan || 2;
    $options{'max_vlan'} = $max_vlan || 1000;

    $options{'type'} = getDeviceType($switch);

    if ($debug) {
	print "Options for $switch:\n";
	while (my ($key,$value) = each %options) {
	    print "$key = $value\n"
	}
    }

    return \%options;
}

Robert Ricci's avatar
Robert Ricci committed
514
515
516
517
#
# Returns a structure representing all trunk links. It's a hash, keyed by
# switch, that contains hash references. Each of the second level hashes
# is keyed by destination, with the value being an array reference that
518
519
520
# contains the card.port pairs to which the trunk is conencted. For exammple,
# ('cisco1' => { 'cisco3' => ['1.1','1.2'] },
#  'cisco3' => { 'cisco1' => ['2.1','2.2'] } )
Robert Ricci's avatar
Robert Ricci committed
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
#
sub getTrunks() {

    my %trunks = ();

    my $result = DBQueryFatal("SELECT node_id1, card1, port1, " .
	"node_id2, card2, port2 FROM wires WHERE type='Trunk'");

    while (my @row = $result->fetchrow()) {
	my ($node_id1, $card1, $port1, $node_id2, $card2, $port2)  = @row;
	push @{ $trunks{$node_id1}{$node_id2} }, "$card1.$port1";
	push @{ $trunks{$node_id2}{$node_id1} }, "$card2.$port2";
    }

    return %trunks;
	
}

#
# Find the best path from one switch to another. Returns an empty list if no
# path exists, otherwise returns a list of switch names. Arguments are:
# A reference to a hash, as returned by the getTrunks() function
# A reference to an array of unvisited switches: Use [keys %trunks]
# Two siwtch names, the source and the destination 
545
#
Robert Ricci's avatar
Robert Ricci committed
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
sub getTrunkPath($$$$) {
    my ($trunks, $unvisited, $src,$dst) = @_;
    if ($src eq $dst) {
	#
	# The source and destination are the same
	#
	return ($src);
    } elsif ($trunks->{$src}{$dst}) {
	#
	# The source and destination are directly connected
	#
	return ($src,$dst);
    } else {
	# The source and destination aren't directly connected. We'll need to 
	# recurse across other trunks to find solution
	my @minPath = ();

	#
	# We use the @$unvisited list to pick switches to traverse to, so
	# that we don't re-visit switches we've already been to, which would 
	# cause infinite recursion
	#
	foreach my $i (0 .. $#{$unvisited}) {
	    if ($trunks->{$src}{$$unvisited[$i]}) {

		#
		# We need to pull theswitch out of the unvisted list that we
		# pass to it.
		#
		my @list = @$unvisited;
		splice(@list,$i,1);

		#
		# Check to see if the path we get with this switch is the 
		# best one found so far
		#
		my @path = getTrunkPath($trunks,\@list,$$unvisited[$i],$dst);
		if (@path && ((!@minPath) || (@path < @minPath))) {
		    @minPath = @path;
		}
	    }

	}

	#
	# If we found a path, tack ourselves on the front and return. If not,
	# return the empty list of failure.
	#
	if (@minPath) {
	    return ($src,@minPath);
	} else {
	    return ();
	}
    }
}

602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
#
# Returns a list of trunks, in the form [src, dest], from a path (as returned
# by getTrunkPath() ). For example, if the input is:
# (cisco1, cisco3, cisco4), the return value is:
# ([cisco1, cisco3], [cisco3, cisco4])
#
sub getTrunksFromPath(@) {
    my @path = @_;
    my @trunks = ();
    my $lastswitch = "";
    foreach my $switch (@path) {
	if ($lastswitch) {
	    push @trunks, [$lastswitch, $switch];
	}
	$lastswitch = $switch;
    }

    return @trunks;
}

#
# Given a list of lists of trunks (returned by multiple getTrunksFromPath() 
# calls), return a list of the unique trunks found in this list
#
sub getUniqueTrunks(@) {
    my @trunkLists = @_;
    my @unique = ();
    foreach my $trunkref (@trunkLists) {
	my @trunks = @$trunkref;
	TRUNK: foreach my $trunk (@trunks) {
	    # Since source and destination are interchangable, we have to
	    # check both possible orderings
	    foreach my $unique (@unique) {
		if ((($unique->[0] eq $trunk->[0]) &&
		     ($unique->[1] eq $trunk->[1])) ||
		    (($unique->[0] eq $trunk->[1]) &&
		     ($unique->[1] eq $trunk->[0]))) {
			 # Yep, it's already in the list - go to the next one
			 next TRUNK;
		}
	    }

	    # Made it through, we must not have seen this one before
	    push @unique, $trunk;
	}
    }

    return @unique;
}

#
# Given a trunk structure (as returned by getTrunks() ), and a list of switches,
# return a list of all trunks (in the [src, dest] form) that are needed to span
# all the switches (ie. which trunks the VLAN must be allowed on)
#
sub getTrunksFromSwitches($@) {
    my $trunks = shift;
    my @switches = @_;

    #
    # First, find the paths between each set of switches
    #
    my @paths = ();
    foreach my $switch1 (@switches) {
	foreach my $switch2 (@switches) {
	    push @paths, [ getTrunkPath($trunks, [ keys %$trunks ],
					$switch1, $switch2) ];
	}
    }

    #
    # Now, make a list of all the the trunks used by these paths
    #
    my @trunkList = ();
    foreach my $path (@paths) {
	push @trunkList, [ getTrunksFromPath(@$path) ];
    }

    #
    # Last, remove any duplicates from the list of trunks
    #
    my @trunks = getUniqueTrunks(@trunkList);

    return @trunks;

}

689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
#
# Make a hash of all trunk ports for easy checking - the keys into the hash are
# in the form "switch/mod.port" - the contents are 1 if the port belongs to a
# trunk, and undef if not
#
# ('cisco1' => { 'cisco3' => ['1.1','1.2'] },
#  'cisco3' => { 'cisco1' => ['2.1','2.2'] } )
#
sub getTrunkHash() {
    my %trunks = getTrunks();
    my %trunkhash = ();
    foreach my $switch1 (keys %trunks) {
        foreach my $switch2 (keys %{$trunks{$switch1}}) {
            foreach my $port (@{$trunks{$switch1}{$switch2}}) {
                my $portstr = "$switch1/$port";
                $trunkhash{$portstr} = 1;
            }
        }
    }
    return %trunkhash;
}

711
#
712
# Execute and SNMP command, retrying in case there are transient errors.
713
#
714
715
716
# usage: snmpitDoIt(getOrSet, session, var, [retries])
# args:  getOrSet - either $SNMPIT_GET or $SNMPIT_SET
#        session - SNMP::Session object, already connected to the SNMP
717
#                  device
718
719
#        var     - An SNMP::Varbind or a reference to a two-element array
#                  (similar to a single Varbind)
720
#        retries - Number of times to retry in case of failure
721
# returns: the value on sucess, undef on failure
722
#
723
sub snmpitDoIt($$$;$) {
724

Robert Ricci's avatar
Robert Ricci committed
725
    my ($getOrSet,$sess,$var,$retries) = @_;
726
727
728
729
730
731
732
733
734
735

    if (! defined($retries) ) {
	$retries = $DEFAULT_RETRIES;
    }

    #
    # Make sure we're given valid inputs
    #
    if (!$sess) {
	$snmpitErrorString = "No valid SNMP session given!\n";
736
	return undef;
737
738
    }

Robert Ricci's avatar
Robert Ricci committed
739
740
741
    my $array_size;
    if ($getOrSet == $SNMPIT_GET) {
	$array_size = 2;
742
743
    } elsif ($getOrSet == $SNMPIT_BULKWALK) {
	$array_size = 1;
Robert Ricci's avatar
Robert Ricci committed
744
745
746
747
    } else {
	$array_size = 4;
    }

748
    if ((ref($var) ne "SNMP::Varbind") &&
Robert Ricci's avatar
Robert Ricci committed
749
750
	    ((ref($var) ne "ARRAY") || ((@$var != $array_size) && (@$var != 4)))) {
	$snmpitErrorString = "Invalid SNMP variable given ($var)!\n";
751
	return undef;
752
753
754
755
756
757
    }

    #
    # Retry several times
    #
    foreach my $retry ( 1 .. $retries) {
758
	my $status;
759
        my @return;
760
761
	if ($getOrSet == $SNMPIT_GET) {
	    $status = $sess->get($var);
762
763
	} elsif ($getOrSet == $SNMPIT_BULKWALK) {
	    @return = $sess->bulkwalk(0,32,$var);
764
765
766
767
	} else {
	    $status = $sess->set($var);
	}

768
769
770
771
772
773
774
775
776
777
778
779
	#
	# Avoid unitialized variable warnings when printing errors
	#
	if (! defined($status)) {
	    $status = "(undefined)";
	}

	#
	# We detect errors by looking at the ErrorNumber variable from the
	# session
	#
	if ($sess->{ErrorNum}) {
Robert Ricci's avatar
Robert Ricci committed
780
781
782
	    my $type;
	    if ($getOrSet == $SNMPIT_GET) {
		$type = "get";
783
784
	    } elsif ($getOrSet == $SNMPIT_BULKWALK) {
		$type = "bulkwalk";
Robert Ricci's avatar
Robert Ricci committed
785
786
787
	    } else {
		$type = "set";
	    }
788
789
790
	    $snmpitErrorString  = "SNMPIT $type failed for device " .
                "$sess->{DestHost} (try $retry of $retries)\n";
            $snmpitErrorString .= "Variable was " .  printVars($var) . "\n";
Robert Ricci's avatar
Robert Ricci committed
791
	    $snmpitErrorString .= "Returned $status, ErrorNum was " .
792
793
794
795
796
		   "$sess->{ErrorNum}\n";
	    if ($sess->{ErrorStr}) {
		$snmpitErrorString .= "Error string is: $sess->{ErrorStr}\n";
	    }
	} else {
797
798
	    if ($getOrSet == $SNMPIT_GET) {
		return $var->[2];
799
800
	    } elsif ($getOrSet == $SNMPIT_BULKWALK) {
                return @return;
801
802
803
	    } else {
	        return 1;
	    }
804
805
806
	}

	#
807
808
	# Don't flood requests too fast. Randomize the sleep a little so that
	# we don't end up with all our retries coming in at the same time.
809
	#
810
811
        sleep(1);
	select(undef, undef, undef, rand(1));
812
813
814
815
816
    }

    #
    # If we made it out, all of the attempts must have failed
    #
817
    return undef;
818
819
}

820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
#
# usage: snmpitGet(session, var, [retries])
# args:  session - SNMP::Session object, already connected to the SNMP
#                  device
#        var     - An SNMP::Varbind or a reference to a two-element array
#                  (similar to a single Varbind)
#        retries - Number of times to retry in case of failure
# returns: the value on sucess, undef on failure
#
sub snmpitGet($$;$) {
    my ($sess,$var,$retries) = @_;
    my $result;

    $result = snmpitDoIt($SNMPIT_GET,$sess,$var,$retries);

    return $result;
}

838
839
840
841
#
# Same as snmpitGet, but send mail if any error occur
#
sub snmpitGetWarn($$;$) {
842
    my ($sess,$var,$retries) = @_;
843
844
    my $result;

845
    $result = snmpitDoIt($SNMPIT_GET,$sess,$var,$retries);
846

847
    if (! defined $result) {
848
849
850
851
852
853
854
855
856
857
	snmpitWarn("SNMP GET failed");
    }
    return $result;
}

#
# Same as snmpitGetWarn, but also exits from the program if there is a 
# failure.
#
sub snmpitGetFatal($$;$) {
858
    my ($sess,$var,$retries) = @_;
859
860
    my $result;

861
    $result = snmpitDoIt($SNMPIT_GET,$sess,$var,$retries);
862

863
    if (! defined $result) {
864
865
866
867
868
	snmpitFatal("SNMP GET failed");
    }
    return $result;
}

869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
#
# usage: snmpitSet(session, var, [retries])
# args:  session - SNMP::Session object, already connected to the SNMP
#                  device
#        var     - An SNMP::Varbind or a reference to a two-element array
#                  (similar to a single Varbind)
#        retries - Number of times to retry in case of failure
# returns: true on success, undef on failure
#
sub snmpitSet($$;$) {
    my ($sess,$var,$retries) = @_;
    my $result;

    $result = snmpitDoIt($SNMPIT_SET,$sess,$var,$retries);

    return $result;
}

#
# Same as snmpitSet, but send mail if any error occur
#
sub snmpitSetWarn($$;$) {
    my ($sess,$var,$retries) = @_;
    my $result;

    $result = snmpitDoIt($SNMPIT_SET,$sess,$var,$retries);

896
    if (! defined $result) {
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
	snmpitWarn("SNMP SET failed");
    }
    return $result;
}

#
# Same as snmpitSetWarn, but also exits from the program if there is a 
# failure.
#
sub snmpitSetFatal($$;$) {
    my ($sess,$var,$retries) = @_;
    my $result;

    $result = snmpitDoIt($SNMPIT_SET,$sess,$var,$retries);

912
    if (! defined $result) {
913
914
915
916
917
	snmpitFatal("SNMP SET failed");
    }
    return $result;
}

918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
#
# usage: snmpitBulkwalk(session, var, [retries])
# args:  session - SNMP::Session object, already connected to the SNMP
#                  device
#        var     - An SNMP::Varbind or a reference to a single-element array
#        retries - Number of times to retry in case of failure
# returns: an array of values on success, undef on failure
#
sub snmpitBulkwalk($$;$) {
    my ($sess,$var,$retries) = @_;
    my @result;

    @result = snmpitDoIt($SNMPIT_BULKWALK,$sess,$var,$retries);

    return @result;
}

#
# Same as snmpitBulkwalk, but send mail if any errors occur
#
sub snmpitBulkwalkWarn($$;$) {
    my ($sess,$var,$retries) = @_;
    my @result;

    @result = snmpitDoIt($SNMPIT_BULKWALK,$sess,$var,$retries);

    if (! defined @result) {
	snmpitWarn("SNMP Bulkwalk failed");
    }
    return @result;
}

#
# Same as snmpitBulkwalkWarn, but also exits from the program if there is a 
# failure.
#
sub snmpitBulkwalkFatal($$;$) {
    my ($sess,$var,$retries) = @_;
    my @result;

    @result = snmpitDoIt($SNMPIT_BULKWALK,$sess,$var,$retries);

    if (! defined @result) {
	snmpitFatal("SNMP Bulkwalk failed");
    }
    return @result;
}

966
967
968
969
970
#
# Print out SNMP::VarList and SNMP::Varbind structures. Useful for debugging
#
sub printVars($) {
    my ($vars) = @_;
971
972
973
    if (!defined($vars)) {
	return "[(undefined)]";
    } elsif (ref($vars) eq "SNMP::VarList") {
Robert Ricci's avatar
Robert Ricci committed
974
	return "[" . join(", ",map( {"[".join(",",@$_)."\]";}  @$vars)) . "]";
975
    } elsif (ref($vars) eq "SNMP::Varbind") {
Robert Ricci's avatar
Robert Ricci committed
976
977
	return "[" . join(",",@$vars) . "]";
    } elsif (ref($vars) eq "ARRAY") {
978
979
	return "[" . join(",",map( {defined($_)? $_ : "(undefined)"} @$vars))
		. "]";
980
    } else {
Robert Ricci's avatar
Robert Ricci committed
981
	return "[unknown value]";
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
    }
}

#
# Both print out an error message and mail it to the testbed ops. Prints out
# the snmpitErrorString set by snmpitGet.
#
# usage: snmpitWarn(message)
#
sub snmpitWarn($) {

    my ($message) = @_;

    #
    # Untaint $PRORAM_NAME
    #
    my $progname;
    if ($PROGRAM_NAME =~ /^([-\w.\/]+)$/) {
	$progname = $1;
    } else {
	$progname = "Tainted";
    }

    my $text = "$message - In $progname\n" .
    	       "$snmpitErrorString\n";
	
    print STDERR "*** $text";

    libtestbed::SENDMAIL($TBOPS, "snmpitError - $message", $text);
}

#
# Like snmpitWarn, but die too
#
sub snmpitFatal($) {
    my ($message) = @_;
    snmpitWarn($message);
    die("\n");
}

1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
#
# Used to sort a set of nodes in testbed order (ie. pc2 < pc10)
#
# usage: tbsort($a,$b)
#        returns -1 if $a < $b
#        returns  0 if $a == $b
#        returns  1 if $a > $b
#
sub tbsort { 
    my ($a,$b) = @_;
    $a =~ /^([a-z]*)([0-9]*):?([0-9]*)/;
    my $a_let = ($1 || "");
    my $a_num = ($2 || 0);
    my $a_num2 = ($3 || 0);
    $b =~ /^([a-z]*)([0-9]*):?([0-9]*)/;
    my $b_let = ($1 || "");
    my $b_num = ($2 || 0);
    my $b_num2 = ($3 || 0);
    if ($a_let eq $b_let) {
	if ($a_num == $b_num) {
	    return $a_num2 <=> $b_num2;
	} else {
	    return $a_num <=> $b_num;
	}
    } else {
	return $a_let cmp $b_let;
    }
    return 0;
}
Mac Newbold's avatar
Mac Newbold committed
1051
1052
1053
# End with true
1;