snmpit_lib.pm 39.3 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-2011 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");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
16
@EXPORT = qw( macport portnum portiface Dev vlanmemb vlanid
17
		getTestSwitches getControlSwitches getSwitchesInStack
Weibin Sun's avatar
Weibin Sun committed
18
                getSwitchesInStacks
19
		getVlanPorts
20
		getExperimentTrunks setVlanStack
21
		getExperimentVlans getDeviceNames getDeviceType
22
		getInterfaceSettings mapPortsToDevices getSwitchPrimaryStack
23
		getSwitchStacks getStacksForSwitches
24
		getStackType getStackLeader filterVlansBySwitches
25
		getDeviceOptions getTrunks getTrunksFromSwitches
26
                getTrunkHash 
27
		getExperimentPorts snmpitGet snmpitGetWarn snmpitGetFatal
28
                getExperimentControlPorts
29
30
                getPlannedStacksForVlans getActualStacksForVlans
                filterPlannedVlans
31
		snmpitSet snmpitSetWarn snmpitSetFatal 
32
                snmpitBulkwalk snmpitBulkwalkWarn snmpitBulkwalkFatal
33
	        setPortEnabled setPortTagged
Leigh B. Stoller's avatar
Leigh B. Stoller committed
34
		printVars tbsort getExperimentCurrentTrunks
35
	        getExperimentVlanPorts
36
37
                uniq isSwitchPort getPathVlanIfaces
		reserveVlanTag getReservedVlanTag clearReservedVlanTag
38
39
                convertPortFromString convertPortsFromStrings
                mapVlansToSwitches mapStaleVlansToSwitches
40
);
Mac Newbold's avatar
Mac Newbold committed
41
42

use English;
43
use libdb;
44
use libtestbed;
45
use libtblog qw(tbdie tbwarn tbreport SEV_ERROR);
46
47
use Experiment;
use Lan;
48
use strict;
49
use SNMP;
50
use Port;
51
52

my $TBOPS = libtestbed::TB_OPSEMAIL;
Mac Newbold's avatar
Mac Newbold committed
53
54
55

my $debug = 0;

56
my $DEFAULT_RETRIES = 10;
57

58
59
my $SNMPIT_GET = 0;
my $SNMPIT_SET = 1;
60
my $SNMPIT_BULKWALK = 2;
61

62
63
64
##################################################
# deprecated:

Mac Newbold's avatar
Mac Newbold committed
65
my %Devices=();
66
# Devices maps device names to device IPs
Mac Newbold's avatar
Mac Newbold committed
67
68

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

Leigh B. Stoller's avatar
Leigh B. Stoller committed
71
72
73
my %PortIface=();
# Maps pcX:Y<==>pcX:iface

74
75
76
my %IfaceModPorts=();
# Maps switch:iface <=> switch:card.port

Mac Newbold's avatar
Mac Newbold committed
77
my %Ports=();
78
79
# Ports maps pcX:Y<==>switch:port

80
81
##################################################

82
83
84
85
86
my %vlanmembers=();
# vlanmembers maps id -> members

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

88
89
my $snmpitErrorString;

90
91
92
# Protos
sub getTrunkPath($$$$);

93
#
94
# Initialize the library
95
96
#
sub init($) {
97
    $debug = shift || $debug;    
98
    return 0;
Mac Newbold's avatar
Mac Newbold committed
99
100
}

101
#
102
103
# Very very powerful converter: string -> Port instance
# the string can be iface or card+port format
104
#
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
sub convertPortFromString($;$)
{
    my ($str, $dev) = @_;

    if (ref($str) =~ /Port/) {
	return $str;
    }

    my $p = Port->LookupByIface($str);
    return $p if $p;

    $p = Port->LookupByTriple($str);
    return $p if $p;


    if (defined($dev)) {
	$p = Port->LookupByIface(Port->Tokens2IfaceString($dev, $str));
	return $p if $p;

	my ($card, $port) = Port->ParseCardPortString($str);
	if ($card) {
	    $p = Port->LookupByTriple(Port->Tokens2TripleString($dev, $card, $port));
	    return $p if $p;
	}
    }

    return undef;			      
Mac Newbold's avatar
Mac Newbold committed
132
133
}

134
135
136
137
138
sub convertPortsFromStrings(@;$)
{
    my (@strs, $dev) = @_; 
    
    return grep(defined($_), map(convertPortFromString($_, $dev), @strs)); 
Leigh B. Stoller's avatar
Leigh B. Stoller committed
139
140
141
}

#
142
143
# Deprecated
# Map between interfaces and mac addresses
144
#
145
146
sub macport { 
    return undef;
Mac Newbold's avatar
Mac Newbold committed
147
148
}

149
#
150
151
# Deprecated
# Map between node:iface and port numbers
152
#
153
154
sub portiface { 
    return undef;
Mac Newbold's avatar
Mac Newbold committed
155
156
}

157

158
#
159
160
# Deprecated
# Map between switch interfaces and port numbers
161
#
162
163
sub portnum {
    return undef;
164
165
}

166
#
167
168
# Deprecated
# Map between interfaces and the devices they are attached to
169
#
170
171
sub Dev { 
    return undef;
172
173
}

174
#
175
176
# Deprecated
# Map between ifaces and switch port
177
#
178
179
sub ifacemodport { 
    return undef;
180
181
}

182
183
184
185
186
#
# Get real ifaces on switch node in a VLAN that implements a path
# that consists of two layer 1 connections and also has a switch as
# the middle node.
#
187
sub getPathVlanIfaces($$) {
188
    my $vlanid = shift;
189
    my $ifaces = shift;
190

Leigh B Stoller's avatar
Fixes.    
Leigh B Stoller committed
191
192
    my $vlan  = VLan->Lookup($vlanid);
    my $vname = $vlan->vname();
193
194
195
    my $experiment = $vlan->GetExperiment();
    my $pid = $experiment->pid();
    my $eid = $experiment->eid();
196
197
198
    
    my %ifacesonswitchnode = ();
    
199
200
    # find the underline path of the link
    my $query_result =
201
	DBQueryWarn("select distinct implemented_by_path from ".
Leigh B Stoller's avatar
Fixes.    
Leigh B Stoller committed
202
203
		    "virt_lans where pid='$pid' and eid='$eid' ".
		    "          and vname='$vname'");
204
    if (!$query_result || !$query_result->numrows) {
Leigh B Stoller's avatar
Fixes.    
Leigh B Stoller committed
205
206
207
	# Not an error since encapsulation vlans have generated names.
	%$ifaces = %ifacesonswitchnode;
	return 1;
208
209
210
211
    }

    # default implemented_by is empty
    my ($path) = $query_result->fetchrow_array();
Leigh B Stoller's avatar
Fixes.    
Leigh B Stoller committed
212
213
214
215
    if (!defined($path) || $path eq "") {
	# Also not an error.
	%$ifaces = %ifacesonswitchnode;
	return 1;
216
217
218
    }

    # find the segments of the path
219
    $query_result = DBQueryWarn("select segmentname, segmentindex, layer from virt_paths ".
220
221
222
				"where pid='$pid' and eid='$eid' and pathname='$path';");
    if (!$query_result || !$query_result->numrows) {
	warn "Can't find path $path definition in DB.";
223
	return -1;
224
    }
225
    
226
    if ($query_result->numrows > 2) {
227
228
229
230
231
232
	my ($segname, $segindex, $layer) = $query_result->fetchrow();

	# only print warning msg when we are dealing with layer 1 links
	if ($layer == 1) {
	    warn "We can't handle the path with more than two segments.";
	}
233
	return -1;
234
235
236
237
238
    }
    
    my @vlans = ();
    VLan->ExperimentVLans($experiment, \@vlans);
    
239
    while (my ($segname, $segindex, $layer) = $query_result->fetchrow())
240
    {
241
242
243
244
245
246
247
	#
	# we only deal with layer 1 links
	#
	if ($layer != 1) {
	    return -1;
	}
	
248
249
	foreach my $myvlan (@vlans)
	{	    
250
	    if ($myvlan->vname eq $segname) {
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
		my @members;

		$vlan->MemberList(\@members);		
		foreach my $member (@members) {
		    my ($node,$iface);

		    $member->GetAttribute("node_id",  \$node);
		    $member->GetAttribute("iface", \$iface);

		    if ($myvlan->IsMember($node, $iface)) {
			my @pref;

			$myvlan->PortList(\@pref);

			# only two ports allowed in the vlan
			if (@pref != 2) {
			    warn "Vlan ".$myvlan->id()." doesnot have exact two ports.\n";
268
			    return -1;
269
			}
270
				       
271
			if ($pref[0] eq "$node:$iface") {
272
			    $ifacesonswitchnode{"$node:$iface"} = $pref[1];
273
			} else {
274
			    $ifacesonswitchnode{"$node:$iface"} = $pref[0];
275
276
277
278
279
280
281
			}
		    }
		}
	    }
	}
    }

282
283
    %$ifaces = %ifacesonswitchnode;
    return 0;
284
285
}

286

287
288
289
#
# Returns an array of ports (in node:card form) used by the given VLANs
#
290
sub getVlanPorts (@) { 
291
292
293
294
295
    my @vlans = @_;
    # Silently exit if they passed us no VLANs
    if (!@vlans) {
	return ();
    }
296
    my @ports = ();
297

298
299
300
301
302
303
304
305
306
307
308
309
310
    foreach my $vlanid (@vlans) {	

    	my $vlan = VLan->Lookup($vlanid);
    	if (!defined($vlan)) {
        	die("*** $0:\n".
		    "    No vlanid $vlanid in the DB!\n");
    	}
    	my @members;
    	if ($vlan->MemberList(\@members) != 0) {
        	die("*** $0:\n".
		    "    Unable to load members for $vlan\n");
	}
	my %pathifaces = ();
Leigh B Stoller's avatar
Fixes.    
Leigh B Stoller committed
311
312
313
314
315
316
	my $error = getPathVlanIfaces($vlanid, \%pathifaces);
	if ($error < 0) {
	    die("*** $0:\n".
		"    Error getting path interfaces for $vlan\n");
	}
	if ($error == 0) {
317
318
319
320
321
322
323
324
	    foreach my $k (keys %pathifaces) {
		push(@ports, Port->LookupByIface($pathifaces{$k}));
	    }
	}
	else {
	    foreach my $member (@members) {
	 	my $nodeid;
	 	my $iface;
Leigh B Stoller's avatar
Fixes.    
Leigh B Stoller committed
325

326
327
328
329
330
331
332
333
		if ($member->GetAttribute("node_id", \$nodeid) != 0 ||
		    $member->GetAttribute("iface", \$iface) != 0) {
		    die("*** $0:\n".
			"    Missing attributes for $member in $vlan\n");
		}
		push(@ports, Port->LookupByIface($nodeid, $iface));
	    }
	}
334
    }
335
    return @ports;
336
337
}

338
#
339
340
# Returns an an array of trunked ports (in node:card form) used by an
# experiment
341
342
343
344
345
#
sub getExperimentTrunks($$) {
    my ($pid, $eid) = @_;
    my @ports;

346
347
348
349
350
    my $query_result =
	DBQueryFatal("select distinct r.node_id,i.iface from reserved as r " .
		     "left join interfaces as i on i.node_id=r.node_id " .
		     "where r.pid='$pid' and r.eid='$eid' and " .
		     "      i.trunk!=0");
351

352
    while (my ($node, $iface) = $query_result->fetchrow()) {
353
	$node = Port->LookupByIface($node, $iface);
354
355
	push @ports, $node;
    }
356
    return @ports;
357
358
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
#
# Returns an an array of trunked ports (in node:card form) used by an
# experiment. These are the ports that are actually in trunk mode,
# rather then the ports we want to be in trunk mode (above function).
#
sub getExperimentCurrentTrunks($$) {
    my ($pid, $eid) = @_;
    my @ports;

    my $query_result =
	DBQueryFatal("select distinct r.node_id,i.iface from reserved as r " .
		     "left join interface_state as i on i.node_id=r.node_id " .
		     "where r.pid='$pid' and r.eid='$eid' and " .
		     "      i.tagged!=0");

    while (my ($node, $iface) = $query_result->fetchrow()) {
375
	$node = Port->LookupByIface($node, $iface);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
376
377
	push @ports, $node;
    }
378
    return @ports;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
379
380
381
}

#
382
# Returns an an array of ports that currently in
Leigh B. Stoller's avatar
Leigh B. Stoller committed
383
384
# the given vlan.
#
385
sub getExperimentVlanPorts($) { 
Leigh B. Stoller's avatar
Leigh B. Stoller committed
386
387
388
389
390
391
392
393
394
395
396
    my ($vlanid) = @_;

    my $query_result =
	DBQueryFatal("select members from vlans as v ".
		     "where v.id='$vlanid'");
    return ()
	if (!$query_result->numrows());

    my ($members) = $query_result->fetchrow_array();
    my @members   = split(/\s+/, $members);

397
    return Port->LookupByIfaces(@members); 
Leigh B. Stoller's avatar
Leigh B. Stoller committed
398
399
}

400
401
402
403
#
# Get the list of stacks that the given set of VLANs *will* or *should* exist
# on
#
404
sub getPlannedStacksForVlans(@) { 
405
406
407
408
409
410
    my @vlans = @_;

    # Get VLAN members, then go from there to devices, then from there to
    # stacks
    my @ports = getVlanPorts(@vlans);
    if ($debug) {
411
        print "getPlannedStacksForVlans: got ports " . Port->toStrings(@ports) . "\n";
412
413
414
415
416
417
418
419
420
421
422
423
424
    }
    my @devices = getDeviceNames(@ports);
    if ($debug) {
        print("getPlannedStacksForVlans: got devices " . join(",",@devices)
            . "\n");
    }
    my @stacks = getStacksForSwitches(@devices);
    if ($debug) {
        print("getPlannedStacksForVlans: got stacks " . join(",",@stacks) . "\n");
    }
    return @stacks;
}

425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
#
# Filter a set of vlans by devices; return only those vlans that exist
# on the set of provided stacks. Do not worry about vlans that cross
# stacks; that is caught higher up.
#
sub filterVlansBySwitches($@) {
    my ($devref, @vlans) = @_;
    my @result   = ();
    my %devices  = ();

    if ($debug) {
	print("filterVlansBySwitches: " . join(",", @{ $devref }) . "\n");
    }

    foreach my $device (@{ $devref }) {
	$devices{$device} = $device;
    }
    
    foreach my $vlanid (@vlans) {
	my @ports = getVlanPorts($vlanid);
	if ($debug) {
	    print("filterVlansBySwitches: ".
447
		  "ports for $vlanid: " . Port->toStrings(@ports) . "\n");
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
	}
	my @tmp = getDeviceNames(@ports);
	if ($debug) {
	    print("filterVlansBySwitches: ".
		  "devices for $vlanid: " . join(",",@tmp) . "\n");
	}
	foreach my $device (@tmp) {
	    if (exists($devices{$device})) {
		push(@result, $vlanid);
		last;
	    }
	}
    }
    return @result;
}

464
465
466
467
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
#
# Get the list of stacks that the given VLANs actually occupy
#
sub getActualStacksForVlans(@) {
    my @vlans = @_;

    # Run through all the VLANs and make a list of the stacks they
    # use
    my @stacks;
    foreach my $vlan (@vlans) {
        my ($vlanobj, $stack);
        if ($debug) {
            print("getActualStacksForVlans: looking up ($vlan)\n");
        }
        if (defined($vlanobj = VLan->Lookup($vlan)) &&
            defined($stack = $vlanobj->GetStack())) {

            if ($debug) {
                print("getActualStacksForVlans: found stack $stack in database\n");
            }
            push @stacks, $stack;
        }
    }
    return uniq(@stacks);
}

#
# Ditto for stack that VLAN exists on
#
sub setVlanStack($$) {
    my ($vlan_id, $stack_id) = @_;
    
    my $vlan = VLan->Lookup($vlan_id);
    return ()
	if (!defined($vlan));
    return ()
	if ($vlan->SetStack($stack_id) != 0);

    return 0;
}

505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
#
# Update database to reserve a vlan tag. The tables will be locked to
# make sure we can get it. 
#
sub reserveVlanTag ($$) {
    my ($vlan_id, $tag) = @_;
    
    if (!$vlan_id || !defined($tag)) {
	return 0;
    }

    my $vlan = VLan->Lookup($vlan_id);
    return 0
	if (!defined($vlan));

    return $vlan->ReserveVlanTag($tag);
}

sub clearReservedVlanTag ($) {
    my ($vlan_id) = @_;
    
    my $vlan = VLan->Lookup($vlan_id);
    return -1
	if (!defined($vlan));

    return $vlan->ClearReservedVlanTag();
}

sub getReservedVlanTag ($) {
    my ($vlan_id) = @_;

    my $vlan = VLan->Lookup($vlan_id);
    return 0
	if (!defined($vlan));

    return $vlan->GetReservedVlanTag();
}

543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
#
# Given a list of VLANs, return only the VLANs that are beleived to actually
# exist on the switches
#
sub filterPlannedVlans(@) {
    my @vlans = @_;
    my @out;
    foreach my $vlan (@vlans) {
        my $vlanobj = VLan->Lookup($vlan);
        if (!defined($vlanobj)) {
            warn "snmpit: Warning, tried to check status of non-existant " .
                "VLAN $vlan\n";
            next;
        }
        if ($vlanobj->CreatedOnSwitches()) {
            push @out, $vlan;
        }
    }
    return @out;
}

564
565
566
#
# Update database to mark port as enabled or disabled.
#
567
sub setPortEnabled($$) { 
568
569
    my ($port, $enabled) = @_;

570
    my ($node, $card) = ($port->node_id(), $port->card());
571
572
573
574
575
576
577
    $enabled = ($enabled ? 1 : 0);

    DBQueryFatal("update interface_state set enabled=$enabled ".
		 "where node_id='$node' and card='$card'");
    
    return 0;
}
578

579
# Ditto for trunked.
580
sub setPortTagged($$) { 
581
582
    my ($port, $tagged) = @_;

583
    my ($node, $card) = ($port->node_id(), $port->card());
584
585
586
587
588
589
    $tagged = ($tagged ? 1 : 0);

    DBQueryFatal("update interface_state set tagged=$tagged ".
		 "where node_id='$node' and card='$card'");
}

590
591
592
593
594
#                                                                                    
# If a port is on switch, some port ops in snmpit                                    
# should be avoided.                                                                 
#                                                                                    
sub isSwitchPort($) {
595
596
597
598
599
600
601
602
603
604
605
606
607
	my $port = shift;

	my $node = $port->node_id();	
	my $result = DBQueryFatal("SELECT isswitch FROM node_types WHERE type IN ".
				  "(SELECT type FROM nodes WHERE node_id='$node')");
				  
	if ($result->numrows() != 1) {
	    return 0;
	}
	
	if (($result->fetchrow())[0] == 1) {
	    return 1;
	}
608

609
	return 0;
610
611
}

612
#
613
614
# Returns an array of all VLAN id's used by a given experiment.
# Optional list of vlan ids restricts operation to just those vlans,
615
#
616
617
sub getExperimentVlans ($$@) {
    my ($pid, $eid, @optvlans) = @_;
618

619
620
621
622
623
624
625
626
627
    my $experiment = Experiment->Lookup($pid, $eid);
    if (!defined($experiment)) {
	die("*** $0:\n".
	    "    getExperimentVlans($pid,$eid) - no such experiment\n");
    }
    my @vlans;
    if (VLan->ExperimentVLans($experiment, \@vlans) != 0) {
	die("*** $0:\n".
	    "    Unable to load VLANs for $experiment\n");
628
629
    }

630
631
632
633
634
635
636
    # Convert to how the rest of snmpit wants to see this stuff.
    my @result = ();
    foreach my $vlan (@vlans) {
	push(@result, $vlan->id())
	    if (!@optvlans || grep {$_ == $vlan->id()} @optvlans);
    }
    return @result;
637
638
}

Robert Ricci's avatar
Robert Ricci committed
639
640
641
642
643
644
645
646
647
#
# Returns an array of all ports used by a given experiment
#
sub getExperimentPorts ($$) {
    my ($pid, $eid) = @_;

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

648
649
650
651
652
653
654
655
656
657
658
#
# Returns an array of control net ports used by a given experiment
#
sub getExperimentControlPorts ($$) {
    my ($pid, $eid) = @_;

    # 
    # Get a list of all *physical* nodes in the experiment
    #
    my $exp = Experiment->Lookup($pid,$eid);
    my @nodes = $exp->NodeList(0,0);
659
660
    # plab and related nodes are still in the list, so filter them out
    @nodes = grep {$_->control_iface()} @nodes; 
661
662
663
664

    #
    # Get control net interfaces
    #
665
    my @ports = map { Port->LookupByIface($_->node_id(), $_->control_iface()) } @nodes;
666
667
668
669

    #
    # Convert from iface to port number when we return
    #
670
    return @ports; 
671
672
}

673
674
675
676
677
#
# Usage: getDeviceNames(@ports)
#
# Returns an array of the names of all devices used in the given ports
#
678
sub getDeviceNames(@) { 
679
680
681
    my @ports = @_;
    my %devices = ();
    foreach my $port (@ports) {
682
	my $device = $port->switch_node_id();
Robert Ricci's avatar
Robert Ricci committed
683
684

	$devices{$device} = 1;
685
686

        if ($debug) {
687
            print "getDevicesNames: Mapping ".$port->toTripleString()." to $device\n";
688
        }
Mac Newbold's avatar
Mac Newbold committed
689
    }
690
691
692
693
694
695
696
    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
#
697
sub mapPortsToDevices(@) { 
698
699
700
701
702
703
704
    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;
	}
705
    }
706
    return %map;
Mac Newbold's avatar
Mac Newbold committed
707
708
}

709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
#
# 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
726
727
}

728
729
730
#
# Returns (current_speed,duplex) for the given interface (in node:port form)
#
731
sub getInterfaceSettings ($) { 
732
733
734

    my ($interface) = @_;

735
736
737
738
739
740
    #
    # Switch ports are evil and we don't touch them.
    #
    if (isSwitchPort($interface)) {
	return ();
    }
741
742
743
    
    my $node = $interface->node_id();
    my $port = $interface->port();
744
745

    my $result =
746
747
748
749
750
751
	DBQueryFatal("SELECT i.current_speed,i.duplex,ic.capval ".
		     "  FROM interfaces as i " .
		     "left join interface_capabilities as ic on ".
		     "     ic.type=i.interface_type and ".
		     "     capkey='noportcontrol' ".
		     "WHERE i.node_id='$node' and i.card=$port");
752
753

    # Sanity check - make sure the interface exists
754
    if ($result->numrows() != 1) {
755
	die "No such interface: ".$interface->toString()."\n";
756
    }
757
    my ($speed,$duplex,$noportcontrol) = $result->fetchrow_array();
758

759
760
761
762
763
    # If the port does not support portcontrol, ignore it.
    if (defined($noportcontrol) && $noportcontrol) {
	return ();
    }
    return ($speed,$duplex);
764
765
}

766
767
768
769
770
771
772
773
774
775
776
777
778
779
#
# 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;
}

780
781
782
783
784
785
786
787
788
789
790
791
792
793
#
# 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;
}

794
795
796
797
798
799
800
801
802
803
804
805
806
807
#
# 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;
}
808

809
810
811
812
813
814
815
816
817
818
819
820
821
822
#
# Returns an array with the names of all switches in the given *stacks*, with
# no switches duplicated
#
sub getSwitchesInStacks (@) {
    my @stack_ids = @_;
    my @switches;
    foreach my $stack_id (@stack_ids) {
        push @switches, getSwitchesInStack($stack_id);
    }

    return uniq(@switches);
}

823
#
824
# Returns the stack_id of a switch's primary stack
825
#
826
sub getSwitchPrimaryStack($) {
827
828
    my $switch = shift;
    my $result = DBQueryFatal("SELECT stack_id FROM switch_stacks WHERE " .
829
    		"node_id='$switch' and is_primary=1");
830
    if (!$result->numrows()) {
831
832
833
834
835
	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";
836
837
838
839
840
841
842
	return undef;
    } else {
	my ($stack_id) = ($result->fetchrow());
	return $stack_id;
    }
}

843
844
845
846
847
848
849
850
851
852
853
854
855
856
#
# Returns the stack_ids of the primary stacks for the given switches.
# Surpresses duplicates.
#
sub getStacksForSwitches(@) {
    my (@switches) = @_;
    my @stacks;
    foreach my $switch (@switches) {
        push @stacks, getSwitchPrimaryStack($switch);
    }

    return uniq(@stacks);
}

857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
#
# 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;
    }
}

876
#
Robert Ricci's avatar
Robert Ricci committed
877
# Returns the type of the given stack_id. If called in list context, also
878
879
# returns whether or not the stack supports private VLANs, whether it
# uses a single VLAN domain, and the SNMP community to use.
880
881
882
#
sub getStackType($) {
    my $stack = shift;
883
    my $result = DBQueryFatal("SELECT stack_type, supports_private, " .
884
885
	"single_domain, snmp_community FROM switch_stack_types " .
	"WHERE stack_id='$stack'");
886
887
888
889
    if (!$result->numrows()) {
	print STDERR "No stack found called $stack\n";
	return undef;
    } else {
890
891
	my ($stack_type,$supports_private,$single_domain,$community)
	    = ($result->fetchrow());
Robert Ricci's avatar
Robert Ricci committed
892
	if (defined wantarray) {
893
	    return ($stack_type,$supports_private,$single_domain, $community);
Robert Ricci's avatar
Robert Ricci committed
894
895
896
	} else {
	    return $stack_type;
	}
897
898
899
    }
}

900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
#
# 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;
    }
}

917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
#
# 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, " .
932
	"single_domain, s.snmp_community as device_community, ".
Leigh B Stoller's avatar
Leigh B Stoller committed
933
        "t.min_vlan, t.max_vlan, " .
934
935
	"t.snmp_community as stack_community, ".
	"s.min_vlan as device_min, s.max_vlan as device_max ".
936
937
938
939
940
	"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()) {
941
942
	print STDERR "No switch $switch found, or it is not in a stack\n";
	return undef;
943
944
    }

945
    my ($supports_private, $single_domain, $device_community, $min_vlan,
946
947
	$max_vlan, $stack_community, $device_min, $device_max) =
	    $result->fetchrow();
948
949
950

    $options{'supports_private'} = $supports_private;
    $options{'single_domain'} = $single_domain;
951
    $options{'snmp_community'} =
952
 	$device_community || $stack_community || "public";
953
954
    $options{'min_vlan'} = $device_min || $min_vlan || 2;
    $options{'max_vlan'} = $device_max || $max_vlan || 1000;
955
956
957
958

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

    if ($debug) {
959
960
961
962
	print "Options for $switch:\n";
	while (my ($key,$value) = each %options) {
	    print "$key = $value\n"
	}
963
964
965
966
967
    }

    return \%options;
}

Robert Ricci's avatar
Robert Ricci committed
968
969
970
971
#
# 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
972
973
974
# 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
975
#
976
977
978
# After port refactoring:
# ( 'src' => { 'dst' => [ port1, port2 ] }, ... )
#
Robert Ricci's avatar
Robert Ricci committed
979
980
981
sub getTrunks() {

    my %trunks = ();
982
983
984
985
986
    
    my @ports = Port->LookupByWireType("Trunk");
    
    foreach my $p (@ports) {
	    push @{ $trunks{$p->node_id()}{$p->other_end_node_id()} }, $p;
Robert Ricci's avatar
Robert Ricci committed
987
988
989
990
991
992
993
994
995
996
997
998
    }

    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 
999
#
Robert Ricci's avatar
Robert Ricci committed
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
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
1051
1052
1053
1054
1055
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 ();
	}
    }
}

1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
#
# Given a set of vlans, determine *exactly* what devices are needed
# for the ports and any trunks that need to be crossed. This is done
# in the stack module, but really want to do this before the stack
# is created so that we do not add extra devices if not needed.
#
sub mapVlansToSwitches(@)
{
    my @vlan_ids = @_;
    my %switches = ();

    #
    # This code is lifted from setPortVlan() in snmpit_stack.pm
    #
    foreach my $vlan_id (@vlan_ids) {
1071
	my @ports   = uniq_ports(getVlanPorts($vlan_id),
1072
1073
			   getExperimentVlanPorts($vlan_id));
	my @devices = mapPortsToSwitches(@ports);
1074

1075
1076
1077
	# And update the total set of switches.
	foreach my $device (@devices) {
	    $switches{$device} = 1;
1078
	}
1079
1080
1081
1082
1083
    }
    my @sorted = sort {tbsort($a,$b)} keys %switches;
    print "mapVlansToSwitches: @sorted\n";
    return @sorted;
}
1084

1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
#
# An alternate version for a "stale" vlan; one that is destroyed cause of
# a swapmod (syncVlansFromTables). 
#
sub mapStaleVlansToSwitches(@)
{
    my @vlan_ids = @_;
    my %switches = ();

    foreach my $vlan_id (@vlan_ids) {
1095
	#
1096
	# Get the ports that we think are already in the vlan, since
1097
1098
1099
	# this might be a remove/modify operation. Can probably optimize
	# this. 
	#
1100
1101
	my @ports   = getExperimentVlanPorts($vlan_id);
	my @devices = mapPortsToSwitches(@ports);
1102
1103

	# And update the total set of switches.
1104
	foreach my $device (@devices) {
1105
1106
1107
1108
	    $switches{$device} = 1;
	}
    }
    my @sorted = sort {tbsort($a,$b)} keys %switches;
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
    print "mapStaleVlansToSwitches: @sorted\n";
    return @sorted;
}

#
# Map a set of ports to the devices they are on plus the trunks.
# See above.
#
sub mapPortsToSwitches(@)
{
    my @ports    = @_;
    my %switches = ();
    my %trunks   = getTrunks();
    my %map      = mapPortsToDevices(@ports);
    my %devices  = ();
    
    foreach my $device (keys %map) {
	$devices{$device} = 1;
    }

    #
    # This code is lifted from setPortVlan() in snmpit_stack.pm
    #
    # Find every switch which might have to transit this VLAN through
    # its trunks.
    #
    my @trunks = getTrunksFromSwitches(\%trunks, keys %devices);
    foreach my $trunk (@trunks) {
	my ($src,$dst) = @$trunk;
	$devices{$src} = $devices{$dst} = 1;
    }
    # And update the total set of switches.
    foreach my $device (keys(%devices)) {
	$switches{$device} = 1;
    }
    my @sorted = sort {tbsort($a,$b)} keys %switches;
1145
1146
1147
    return @sorted;
}

1148
1149
1150
1151
1152
1153
#
# 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])
#
1154
sub getTrunksFromPath(@) { 
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
    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
#
1172
sub getUniqueTrunks(@) { 
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
    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)
#
1203
sub getTrunksFromSwitches($@) { 
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
    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;

}

1235
1236
1237
1238
1239
1240
1241
1242
#
# 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'] } )
#
1243
sub getTrunkHash() { 
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
    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;
}

1257
#
1258
# Execute and SNMP command, retrying in case there are transient errors.
1259
#
1260
1261
1262
# usage: snmpitDoIt(getOrSet, session, var, [retries])
# args:  getOrSet - either $SNMPIT_GET or $SNMPIT_SET
#        session - SNMP::Session object, already connected to the SNMP
1263
#                  device
1264
1265
#        var     - An SNMP::Varbind or a reference to a two-element array
#                  (similar to a single Varbind)
1266
#        retries - Number of times to retry in case of failure
1267
# returns: the value on sucess, undef on failure
1268
#
1269
sub snmpitDoIt($$$;$) {
1270

Robert Ricci's avatar
Robert Ricci committed
1271
    my ($getOrSet,$sess,$var,$retries) = @_;
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281

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

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

Robert Ricci's avatar
Robert Ricci committed
1285
1286
1287
    my $array_size;
    if ($getOrSet == $SNMPIT_GET) {
	$array_size = 2;
1288
1289
    } elsif ($getOrSet == $SNMPIT_BULKWALK) {
	$array_size = 1;
Robert Ricci's avatar
Robert Ricci committed
1290
1291
1292
1293
    } else {
	$array_size = 4;
    }

1294
    if (((ref($var) ne "SNMP::Varbind") && (ref($var) ne "SNMP::VarList")) &&
Robert Ricci's avatar
Robert Ricci committed
1295
1296
	    ((ref($var) ne "ARRAY") || ((@$var != $array_size) && (@$var != 4)))) {
	$snmpitErrorString = "Invalid SNMP variable given ($var)!\n";
1297
	return undef;
1298
1299
1300
1301
1302
1303
    }

    #
    # Retry several times
    #
    foreach my $retry ( 1 .. $retries) {
1304
	my $status;
1305
        my @return;
1306
1307
	if ($getOrSet == $SNMPIT_GET) {
	    $status = $sess->get($var);
1308
1309
	} elsif ($getOrSet == $SNMPIT_BULKWALK) {
	    @return = $sess->bulkwalk(0,32,$var);
1310
1311
1312
1313
	} else {
	    $status = $sess->set($var);
	}

1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
	#
	# 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
1326
1327
1328
	    my $type;
	    if ($getOrSet == $SNMPIT_GET) {
		$type = "get";
1329
1330
	    } elsif ($getOrSet == $SNMPIT_BULKWALK) {
		$type = "bulkwalk";
Robert Ricci's avatar
Robert Ricci committed
1331
1332
1333
	    } else {
		$type = "set";
	    }
1334
1335
1336
	    $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
1337
	    $snmpitErrorString .= "Returned $status, ErrorNum was " .
1338
1339
1340
1341
1342
		   "$sess->{ErrorNum}\n";
	    if ($sess->{ErrorStr}) {
		$snmpitErrorString .= "Error string is: $sess->{ErrorStr}\n";
	    }
	} else {
1343
1344
	    if ($getOrSet == $SNMPIT_GET) {
		return $var->[2];
1345
1346
	    } elsif ($getOrSet == $SNMPIT_BULKWALK) {
                return @return;
1347
1348
1349
	    } else {
	        return 1;
	    }
1350
1351
1352
	}

	#
1353
1354
	# 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.
1355
	#
1356
1357
        sleep(1);
	select(undef, undef, undef, rand(1));
1358
1359
1360
1361
1362
    }

    #
    # If we made it out, all of the attempts must have failed
    #
1363
    return undef;
1364
1365
}

1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
#
# 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;
}

1384
1385
1386
1387
#
# Same as snmpitGet, but send mail if any error occur