snmpit_lib.pm 42.1 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
18
                getSwitchesInStacks getVlanIfaces
19
		getVlanPorts convertPortsFromIfaces convertPortFromIface
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
		mapVlansToSwitches mapStaleVlansToSwitches
39
);
Mac Newbold's avatar
Mac Newbold committed
40
41

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

my $TBOPS = libtestbed::TB_OPSEMAIL;
Mac Newbold's avatar
Mac Newbold committed
51
52
53

my $debug = 0;

54
my $DEFAULT_RETRIES = 10;
55

56
57
my $SNMPIT_GET = 0;
my $SNMPIT_SET = 1;
58
my $SNMPIT_BULKWALK = 2;
59

Mac Newbold's avatar
Mac Newbold committed
60
my %Devices=();
61
# Devices maps device names to device IPs
Mac Newbold's avatar
Mac Newbold committed
62
63

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

Leigh B. Stoller's avatar
Leigh B. Stoller committed
66
67
68
my %PortIface=();
# Maps pcX:Y<==>pcX:iface

69
70
71
my %IfaceModPorts=();
# Maps switch:iface <=> switch:card.port

Mac Newbold's avatar
Mac Newbold committed
72
my %Ports=();
73
74
75
76
77
78
79
# 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
80

81
82
my $snmpitErrorString;

83
84
85
# Protos
sub getTrunkPath($$$$);

86
#
87
# Initialize the library
88
89
90
91
92
#
sub init($) {
    $debug = shift || $debug;
    &ReadTranslationTable;
    return 0;
Mac Newbold's avatar
Mac Newbold committed
93
94
}

95
96
97
#
# Map between interfaces and mac addresses
#
Mac Newbold's avatar
Mac Newbold committed
98
sub macport {
99
100
    my $val = shift || "";
    return $Interfaces{$val};
Mac Newbold's avatar
Mac Newbold committed
101
102
}

103
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
104
105
106
107
108
109
110
111
112
# Map between node:iface and port numbers
#
sub portiface {
    my $val = shift || "";
    return $PortIface{$val};
}

#
# Map between switch interfaces and port numbers
113
#
Mac Newbold's avatar
Mac Newbold committed
114
sub portnum {
115
116
    my $val = shift || "";
    return $Ports{$val};
Mac Newbold's avatar
Mac Newbold committed
117
118
}

119
120
121
#
# Map between interfaces and the devices they are attached to
#
Mac Newbold's avatar
Mac Newbold committed
122
sub Dev {
123
124
    my $val = shift || "";
    return $Devices{$val};
Mac Newbold's avatar
Mac Newbold committed
125
126
}

127
128
129
130
131
132
133
134
#
# Map between ifaces and switch port
#
sub ifacemodport {
    my $val = shift || "";
    return $IfaceModPorts{$val};
}

135
136
137
138
139
140
141
#
# This function fills in %Interfaces and %Ports
# They hold pcX:Y<==>MAC and pcX:Y<==>switch:port respectively
#
sub ReadTranslationTable {
    my $name="";
    my $mac="";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
142
    my $iface="";
143
144
145
    my $switchport="";

    print "FILLING %Interfaces\n" if $debug;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
146
147
    my $result =
	DBQueryFatal("select node_id,card,port,mac,iface from interfaces");
148
149
    while ( @_ = $result->fetchrow_array()) {
	$name = "$_[0]:$_[1]";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
150
	$iface = "$_[0]:$_[4]";
151
152
153
154
	if ($_[2] != 1) {$name .=$_[2]; }
	$mac = "$_[3]";
	$Interfaces{$name} = $mac;
	$Interfaces{$mac} = $name;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
155
156
	$PortIface{$name} = $iface;
	$PortIface{$iface} = $name;
Weibin Sun's avatar
Weibin Sun committed
157
158
	$IfaceModPorts{$iface} = "$_[0]:$_[1].$_[2]";
	$IfaceModPorts{"$_[0]:$_[1].$_[2]"} = $iface;
159
160
161
162
163
164
	print "Interfaces: $mac <==> $name\n" if $debug > 1;
    }

    print "FILLING %Ports\n" if $debug;
    $result = DBQueryFatal("select node_id1,card1,port1,node_id2,card2,port2 ".
	    "from wires;");
165
166
167
    while ( my @row = $result->fetchrow_array()) {
        my ($node_id1, $card1, $port1, $node_id2, $card2, $port2) = @row;
	$name = "$node_id1:$card1";
168
	print "Name='$name'\t" if $debug > 2;
169
170
	print "Dev='$node_id2'\t" if $debug > 2;
	$switchport = "$node_id2:$card2.$port2";
171
172
173
174
175
176
	print "switchport='$switchport'\n" if $debug > 2;
	$Ports{$name} = $switchport;
	$Ports{$switchport} = $name;
	print "Ports: '$name' <==> '$switchport'\n" if $debug > 1;
    }

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
#
# Return different(union(@lhs,@rhs), intersection(@lhs,@rhs))
#
sub arraySub($$) {
    my ($l,$r) = @_;
    my @lhs = @$l;
    my @rhs = @$r;
    my @result = ();

    my %count = ();
    foreach my $e (@lhs, @rhs) {
	$count{$e}++;
    }
    
    foreach my $e (keys %count) {
	if ($count{$e} == 1) {
	    push @result, $e;
	}
    }

    return @result;
}

202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
#
# Return an array of ifaces belonging to the VLAN
#
sub getVlanIfaces($) {
    my $vlanid = shift;
    my @ports = ();

    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");
218
219
220
221
222
    }
    my %pathifaces = ();
    if (!getPathVlanIfaces($vlanid, \%pathifaces)) {
	foreach my $k (keys %pathifaces) {
	    push(@ports, $pathifaces{$k});
223
	}
224
225
226
227
228
229
230
231
232
233
234
235
    }
    else {
	foreach my $member (@members) {
	    my $nodeid;
	    my $iface;
	    
	    if ($member->GetAttribute("node_id", \$nodeid) != 0 ||
		$member->GetAttribute("iface", \$iface) != 0) {
		die("*** $0:\n".
		    "    Missing attributes for $member in $vlan\n");
	    }
	    push(@ports, "$nodeid:$iface");
236
237
238
239
240
241
	}
    }

    return @ports;
}

242
243
244
245
246
#
# 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.
#
247
sub getPathVlanIfaces($$) {
248
    my $vlanid = shift;
249
    my $ifaces = shift;
250
251
252
253
254

    my $vlan = VLan->Lookup($vlanid);
    my $experiment = $vlan->GetExperiment();
    my $pid = $experiment->pid();
    my $eid = $experiment->eid();
255
256
257
    
    my %ifacesonswitchnode = ();
    
258
259
    # find the underline path of the link
    my $query_result =
260
	DBQueryWarn("select distinct implemented_by_path from ".
261
262
263
264
		    "virt_lans where pid='$pid' and eid='$eid' and vname='".
		    $vlan->vname()."';");
    if (!$query_result || !$query_result->numrows) {
	warn "Can't find VLAN $vlanid definition in DB.";
265
	return -1;
266
267
268
269
    }

    # default implemented_by is empty
    my ($path) = $query_result->fetchrow_array();
270
    if (!$path || $path eq "") {
271
	print "VLAN $vlanid is not implemented by a path\n" if $debug;
272
	return -1;
273
274
275
276
277
278
279
    }

    # find the segments of the path
    $query_result = DBQueryWarn("select segmentname, segmentindex from virt_paths ".
				"where pid='$pid' and eid='$eid' and pathname='$path';");
    if (!$query_result || !$query_result->numrows) {
	warn "Can't find path $path definition in DB.";
280
	return -1;
281
282
    }

283
    if ($query_result->numrows > 2) {
284
	warn "We can't handle the path with more than two segments.";
285
	return -1;
286
287
288
289
290
291
292
293
294
    }
    
    my @vlans = ();
    VLan->ExperimentVLans($experiment, \@vlans);
    
    while (my ($segname, $segindex) = $query_result->fetchrow())
    {
	foreach my $myvlan (@vlans)
	{	    
295
	    if ($myvlan->vname eq $segname) {
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
		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";
313
			    return -1;
314
315
			}

316
			if ($pref[0] eq "$node:$iface") {
317
318
319
320
321
322
323
324
325
326
			    $ifacesonswitchnode{"$node:$iface"} = $pref[1];
			} else {
			    $ifacesonswitchnode{"$node:$iface"} = $pref[0];
			}
		    }
		}
	    }
	}
    }

327
328
    %$ifaces = %ifacesonswitchnode;
    return 0;
329
330
}

331

332
333
334
335
336
337
338
339
340
#
# 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 ();
    }
341
    my @ports = ();
342

343
    foreach my $vlanid (@vlans) {
344
345
	my @ifaces = getVlanIfaces($vlanid);
	push @ports, @ifaces;
346
    }
347
348
349
350
    # Convert from the DB format to the one used by the snmpit modules
    return convertPortsFromIfaces(@ports);
}

351
#
352
353
# Returns an an array of trunked ports (in node:card form) used by an
# experiment
354
355
356
357
358
#
sub getExperimentTrunks($$) {
    my ($pid, $eid) = @_;
    my @ports;

359
360
361
362
363
    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");
364

365
    while (my ($node, $iface) = $query_result->fetchrow()) {
366
367
368
369
370
371
	$node = $node . ":" . $iface;
	push @ports, $node;
    }
    return convertPortsFromIfaces(@ports);
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
#
# 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()) {
	$node = $node . ":" . $iface;
	push @ports, $node;
    }
    return convertPortsFromIfaces(@ports);
}

#
395
# Returns an an array of ports (in node:card form) that are currently in
Leigh B. Stoller's avatar
Leigh B. Stoller committed
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
# the given vlan.
#
sub getExperimentVlanPorts($) {
    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);

    return convertPortsFromIfaces(@members);
}

413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
#
# Get the list of stacks that the given set of VLANs *will* or *should* exist
# on
#
sub getPlannedStacksForVlans(@) {
    my @vlans = @_;

    # Get VLAN members, then go from there to devices, then from there to
    # stacks
    my @ports = getVlanPorts(@vlans);
    if ($debug) {
        print "getPlannedStacksForVlans: got ports " . join(",",@ports) . "\n";
    }
    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;
}

438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
#
# 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: ".
		  "ports for $vlanid: " . join(",",@ports) . "\n");
	}
	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;
}

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
514
515
516
517
#
# 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;
}

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
543
544
545
546
547
548
549
550
551
552
553
554
555
#
# 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();
}

556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
#
# 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;
}

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
602
603
#
# Update database to mark port as enabled or disabled.
#
sub setPortEnabled($$) {
    my ($port, $enabled) = @_;

    $port =~ /^(.+):(\d+)$/;
    my ($node, $card) = ($1, $2);
    $enabled = ($enabled ? 1 : 0);

    DBQueryFatal("update interface_state set enabled=$enabled ".
		 "where node_id='$node' and card='$card'");
    
    return 0;
}
# Ditto for trunked.
sub setPortTagged($$) {
    my ($port, $tagged) = @_;

    $port =~ /^(.+):(\d+)$/;
    my ($node, $card) = ($1, $2);
    $tagged = ($tagged ? 1 : 0);

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

604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
#
# 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 =~ /(.+):(.+)/) {
627
628
629
	my ($node,$iface) =  ($1,$2);
        my $result = DBQueryFatal("SELECT card, port FROM interfaces " .
				  "WHERE node_id='$node' AND iface='$iface'");
630
631
632
633
        if (!$result->num_rows()) {
            warn "WARNING: convertPortFromIface($port) - Unable to get card\n";
            return $port;
        }
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
        my @row = $result->fetchrow();
        my $card = $row[0];
        my $cport = $row[1];

        $result = DBQueryFatal("SELECT isswitch FROM node_types WHERE type IN ".
                               "(SELECT type FROM nodes WHERE node_id='$node')");

        if (!$result->num_rows()) {
            warn "WARNING: convertPortFromIface($port) -".
                " Uable to decide if $node is a switch or not\n";
            return $port;
        }

        if (($result->fetchrow())[0] == 1) {
	    #
	    # Should return the later one, but many places in snmpit
	    # and this file depend on the old format...
	    #
            return "$node:$card";
            #return "$node:$card.$cport";                                            
        }

656
        return "$node:$card";
657

658
659
660
661
    } else {
        warn "WARNING: convertPortFromIface($port) - Bad port format\n";
        return $port;
    }
662
663
}

664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
#                                                                                    
# If a port is on switch, some port ops in snmpit                                    
# should be avoided.                                                                 
#                                                                                    
sub isSwitchPort($) {
    my $port = shift;

    if ($port =~ /^(.+):(.+)/) {
        my $node = $1;

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

        if (($result->fetchrow())[0] == 1) {
            return 1;
        }
    }

    return 0;
}

685
#
686
687
# Returns an array of all VLAN id's used by a given experiment.
# Optional list of vlan ids restricts operation to just those vlans,
688
#
689
690
sub getExperimentVlans ($$@) {
    my ($pid, $eid, @optvlans) = @_;
691

692
693
694
695
696
697
698
699
700
    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");
701
702
    }

703
704
705
706
707
708
709
    # 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;
710
711
}

Robert Ricci's avatar
Robert Ricci committed
712
713
714
715
716
717
718
719
720
#
# Returns an array of all ports used by a given experiment
#
sub getExperimentPorts ($$) {
    my ($pid, $eid) = @_;

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

721
722
723
724
725
726
727
728
729
730
731
#
# 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);
732
733
    # plab and related nodes are still in the list, so filter them out
    @nodes = grep {$_->control_iface()} @nodes; 
734
735
736
737
738
739
740
741
742
743
744
745

    #
    # Get control net interfaces
    #
    my @ports =  map { $_->node_id() . ":" . $_->control_iface() } @nodes;

    #
    # Convert from iface to port number when we return
    #
    return convertPortsFromIfaces(@ports);
}

746
747
748
749
750
751
752
753
754
#
# 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
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
	#
	# 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";
779
780
	    next;
	}
Robert Ricci's avatar
Robert Ricci committed
781
782

	$devices{$device} = 1;
783
784
785
786

        if ($debug) {
            print "getDevicesNames: Mapping $port to $device\n";
        }
Mac Newbold's avatar
Mac Newbold committed
787
    }
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
    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;
	}
803
    }
804
    return %map;
Mac Newbold's avatar
Mac Newbold committed
805
806
}

807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
#
# 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
824
825
}

826
827
828
829
830
831
832
#
# Returns (current_speed,duplex) for the given interface (in node:port form)
#
sub getInterfaceSettings ($) {

    my ($interface) = @_;

833
834
835
836
837
838
839
    #
    # Switch ports are evil and we don't touch them.
    #
    if (isSwitchPort($interface)) {
	return ();
    }

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

    my $result =
847
848
849
850
851
852
	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");
853
854

    # Sanity check - make sure the interface exists
855
    if ($result->numrows() != 1) {
856
857
	die "No such interface: $interface\n";
    }
858
    my ($speed,$duplex,$noportcontrol) = $result->fetchrow_array();
859

860
861
862
863
864
    # If the port does not support portcontrol, ignore it.
    if (defined($noportcontrol) && $noportcontrol) {
	return ();
    }
    return ($speed,$duplex);
865
866
}

867
868
869
870
871
872
873
874
875
876
877
878
879
880
#
# 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;
}

881
882
883
884
885
886
887
888
889
890
891
892
893
894
#
# 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;
}

895
896
897
898
899
900
901
902
903
904
905
906
907
908
#
# 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;
}
909

910
911
912
913
914
915
916
917
918
919
920
921
922
923
#
# 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);
}

924
#
925
# Returns the stack_id of a switch's primary stack
926
#
927
sub getSwitchPrimaryStack($) {
928
929
    my $switch = shift;
    my $result = DBQueryFatal("SELECT stack_id FROM switch_stacks WHERE " .
930
    		"node_id='$switch' and is_primary=1");
931
    if (!$result->numrows()) {
932
933
934
935
936
	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";
937
938
939
940
941
942
943
	return undef;
    } else {
	my ($stack_id) = ($result->fetchrow());
	return $stack_id;
    }
}

944
945
946
947
948
949
950
951
952
953
954
955
956
957
#
# 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);
}

958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
#
# 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;
    }
}

977
#
Robert Ricci's avatar
Robert Ricci committed
978
# Returns the type of the given stack_id. If called in list context, also
979
980
# returns whether or not the stack supports private VLANs, whether it
# uses a single VLAN domain, and the SNMP community to use.
981
982
983
#
sub getStackType($) {
    my $stack = shift;
984
    my $result = DBQueryFatal("SELECT stack_type, supports_private, " .
985
986
	"single_domain, snmp_community FROM switch_stack_types " .
	"WHERE stack_id='$stack'");
987
988
989
990
    if (!$result->numrows()) {
	print STDERR "No stack found called $stack\n";
	return undef;
    } else {
991
992
	my ($stack_type,$supports_private,$single_domain,$community)
	    = ($result->fetchrow());
Robert Ricci's avatar
Robert Ricci committed
993
	if (defined wantarray) {
994
	    return ($stack_type,$supports_private,$single_domain, $community);
Robert Ricci's avatar
Robert Ricci committed
995
996
997
	} else {
	    return $stack_type;
	}
998
999
1000
    }
}

1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
#
# 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;
    }
}

1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
#
# 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, " .
1033
	"single_domain, s.snmp_community as device_community, ".
Leigh B Stoller's avatar
Leigh B Stoller committed
1034
        "t.min_vlan, t.max_vlan, " .
1035
1036
	"t.snmp_community as stack_community, ".
	"s.min_vlan as device_min, s.max_vlan as device_max ".
1037
1038
1039
1040
1041
	"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()) {
1042
1043
        print STDERR "No switch $switch found, or it is not in a stack\n";
        return undef;
1044
1045
    }

1046
    my ($supports_private, $single_domain, $device_community, $min_vlan,
1047
1048
	$max_vlan, $stack_community, $device_min, $device_max) =
	    $result->fetchrow();
1049
1050
1051

    $options{'supports_private'} = $supports_private;
    $options{'single_domain'} = $single_domain;
1052
    $options{'snmp_community'} =
1053
 	$device_community || $stack_community || "public";
1054
1055
    $options{'min_vlan'} = $device_min || $min_vlan || 2;
    $options{'max_vlan'} = $device_max || $max_vlan || 1000;
1056
1057
1058
1059

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

    if ($debug) {
1060
1061
1062
1063
        print "Options for $switch:\n";
        while (my ($key,$value) = each %options) {
            print "$key = $value\n"
        }
1064
1065
1066
1067
1068
    }

    return \%options;
}

Robert Ricci's avatar
Robert Ricci committed
1069
1070
1071
1072
#
# 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
1073
1074
1075
# 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
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
#
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 
1100
#
Robert Ricci's avatar
Robert Ricci committed
1101
1102
1103
1104
1105
1106
1107
1108
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
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
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 ();
	}
    }
}

1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
#
# 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) {
1172
1173
1174
	my @ports   = uniq(getVlanPorts($vlan_id),
			   getExperimentVlanPorts($vlan_id));
	my @devices = mapPortsToSwitches(@ports);
1175

1176
1177
1178
	# And update the total set of switches.
	foreach my $device (@devices) {
	    $switches{$device} = 1;
1179
	}
1180
1181
1182
1183
1184
    }
    my @sorted = sort {tbsort($a,$b)} keys %switches;
    print "mapVlansToSwitches: @sorted\n";
    return @sorted;
}
1185

1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
#
# 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) {
1196
	#
1197
	# Get the ports that we think are already in the vlan, since
1198
1199
1200
	# this might be a remove/modify operation. Can probably optimize
	# this. 
	#
1201
1202
	my @ports   = getExperimentVlanPorts($vlan_id);
	my @devices = mapPortsToSwitches(@ports);
1203
1204

	# And update the total set of switches.
1205
	foreach my $device (@devices) {
1206
1207
1208
1209
	    $switches{$device} = 1;
	}
    }
    my @sorted = sort {tbsort($a,$b)} keys %switches;
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
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
    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;
1246
1247
1248
    return @sorted;
}

1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
#
# 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;

}

1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
#
# 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;
}

1358
#
1359
# Execute and SNMP command, retrying in case there are transient errors.
1360
#
1361
1362
1363
# usage: snmpitDoIt(getOrSet, session, var, [retries])
# args:  getOrSet - either $SNMPIT_GET or $SNMPIT_SET
#        session - SNMP::Session object, already connected to the SNMP
1364
#                  device
1365
1366
#        var     - An SNMP::Varbind or a reference to a two-element array
#                  (similar to a single Varbind)
1367
#        retries - Number of times to retry in case of failure
1368
# returns: the value on sucess, undef on failure
1369
#
1370
sub snmpitDoIt($$$;$) {
1371

Robert Ricci's avatar
Robert Ricci committed
1372
    my ($getOrSet,$sess,$var,$retries) = @_;
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382

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

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

Robert Ricci's avatar
Robert Ricci committed
1386
1387
1388
    my $array_size;
    if ($getOrSet == $SNMPIT_GET) {
	$array_size = 2;
1389
1390
    } elsif ($getOrSet == $SNMPIT_BULKWALK) {
	$array_size = 1;
Robert Ricci's avatar
Robert Ricci committed
1391
1392
1393
1394
    } else {
	$array_size = 4;
    }

1395
    if (((ref($var) ne "SNMP::Varbind") && (ref($var) ne "SNMP::VarList")) &&
Robert Ricci's avatar
Robert Ricci committed
1396
1397
	    ((ref($var) ne "ARRAY") || ((@$var != $array_size) && (@$var != 4)))) {
	$snmpitErrorString = "Invalid SNMP variable given ($var)!\n";
1398
	return undef;
1399
1400
1401
1402
1403
1404
    }

    #
    # Retry several times
    #
    foreach my $retry ( 1 .. $retries) {
1405
	my $status;
1406
        my @return;
1407
1408
	if ($getOrSet == $SNMPIT_GET) {
	    $status = $sess->get($var);
1409
1410
	} elsif ($getOrSet == $SNMPIT_BULKWALK) {
	    @return = $sess->bulkwalk(0,32,$var);
1411
1412
1413
1414
	} else {
	    $status = $sess->set($var);
	}

1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
	#
	# 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
1427
1428
1429
	    my $type;
	    if ($getOrSet == $SNMPIT_GET) {
		$type = "get";
1430
1431
	    } elsif ($getOrSet == $SNMPIT_BULKWALK) {
		$type = "bulkwalk";
Robert Ricci's avatar
Robert Ricci committed
1432
1433
1434
	    } else {
		$type = "set";
	    }
1435
1436
1437
	    $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
1438
	    $snmpitErrorString .= "Returned $status, ErrorNum was " .
1439
1440
1441
1442
1443
		   "$sess->{ErrorNum}\n";
	    if ($sess->{ErrorStr}) {
		$snmpitErrorString .= "Error string is: $sess->{ErrorStr}\n";
	    }
	} else {
1444
1445
	    if ($getOrSet == $SNMPIT_GET) {
		return $var->[2];
1446
1447
	    } elsif ($getOrSet == $SNMPIT_BULKWALK) {
                return @return;
1448
1449
1450
	    } else {
	        return 1;
	    }
1451
1452
1453
	}

	#
1454
1455
	# 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.
1456
	#
1457
1458
        sleep(1);
	select(undef, undef, undef, rand(1));
1459
1460
1461
1462
1463
    }

    #
    # If we made it out, all of the attempts must have failed
    #
1464
    return undef;
1465
1466
}

1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
#
# 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;
}

1485
1486
1487
1488
#
# Same as snmpitGet, but send mail if any error occur
#
sub snmpitGetWarn($$;$) {
1489
    my ($sess,$var,$retries) = @_;
1490
1491
    my $result;

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

1494
    if (! defined $result) {
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
	snmpitWarn("SNMP GET failed");
    }
    return $result;
}

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

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

1510
    if (! defined $result) {
1511
	tbreport(SEV_ERROR, 'snmp_get_fatal');
1512
1513
1514
1515
1516
	snmpitFatal("SNMP GET failed");
    }
    return $result;
}

1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
#
# 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);

1544
    if (! defined $result) {