File Coverage

blib/lib/Cisco/Management.pm
Criterion Covered Total %
statement 60 1090 5.5
branch 14 496 2.8
condition 4 148 2.7
subroutine 9 50 18.0
pod 39 39 100.0
total 126 1823 6.9


line stmt bran cond sub pod time code
1             package Cisco::Management;
2              
3             ########################################################
4             # AUTHOR = Michael Vincent
5             # www.VinsWorld.com
6             ########################################################
7              
8 2     2   19484 use strict;
  2         4  
  2         60  
9 2     2   7 use warnings;
  2         2  
  2         47  
10 2     2   5 use Exporter;
  2         5  
  2         82  
11              
12             our $VERSION = '0.09';
13              
14 2     2   767 use Sys::Hostname;
  2         1437  
  2         82  
15 2     2   1008 use Socket qw(inet_ntoa AF_INET IPPROTO_TCP);
  2         5298  
  2         297  
16 2     2   1385 use Net::SNMP qw(:asn1 :snmp DEBUG_ALL);
  2         103786  
  2         21364  
17             # use Net::IPv6Addr;
18             my $HAVE_Net_IPv6Addr = 0;
19             if ($Socket::VERSION >= 1.94) {
20 2     2   1123 eval "use Net::IPv6Addr 0.2";
  2         242871  
  2         94  
21             if(!$@) {
22             $HAVE_Net_IPv6Addr = 1
23             }
24             }
25              
26             my $AF_INET6 = eval { Socket::AF_INET6() };
27             my $AF_UNSPEC = eval { Socket::AF_UNSPEC() };
28             my $AI_NUMERICHOST = eval { Socket::AI_NUMERICHOST() };
29             my $NI_NUMERICHOST = eval { Socket::NI_NUMERICHOST() };
30              
31             our @ISA = qw(Exporter);
32             our @EXPORT = qw();
33             our %EXPORT_TAGS = (
34             'password' => [qw(password_decrypt password_encrypt)],
35             'hashkeys' => [qw(@IPKEYS @IFKEYS @LINEKEYS @SESSIONKEYS @IFMETRICUSERKEYS @IFMETRICKEYS @CPUKEYS @MEMKEYS @INVENTORYKEYS)]
36             );
37             our @EXPORT_OK = map {@{$EXPORT_TAGS{$_}}} keys(%EXPORT_TAGS);
38             $EXPORT_TAGS{ALL} = [ @EXPORT_OK ];
39              
40             ########################################################
41             # Start Variables
42             ########################################################
43             # Cisco's XOR key
44             my @xlat = ( 0x64, 0x73, 0x66, 0x64, 0x3B, 0x6B, 0x66, 0x6F, 0x41, 0x2C,
45             0x2E, 0x69, 0x79, 0x65, 0x77, 0x72, 0x6B, 0x6C, 0x64, 0x4A,
46             0x4B, 0x44, 0x48, 0x53, 0x55, 0x42, 0x73, 0x67, 0x76, 0x63,
47             0x61, 0x36, 0x39, 0x38, 0x33, 0x34, 0x6E, 0x63, 0x78, 0x76,
48             0x39, 0x38, 0x37, 0x33, 0x32, 0x35, 0x34, 0x6B, 0x3B, 0x66,
49             0x67, 0x38, 0x37
50             );
51              
52             our @IFKEYS = qw(Index Description Type MTU Speed PhysAddress AdminStatus OperStatus LastChange Duplex);
53             our @IPKEYS = qw(IPAddress IPMask);
54              
55             our @LINEKEYS = qw(Active Type Autobaud SpeedIn SpeedOut Flow Modem Location Term ScrLen ScrWid Esc Tmo Sestmo Rotary Uses Nses User Noise Number TimeActive);
56             our @SESSIONKEYS = qw(Type Direction Address Name Current Idle Line);
57              
58             our @IFMETRICUSERKEYS = qw(Multicasts Broadcasts Octets Unicasts Discards Errors Unknowns);
59             our @IFMETRICKEYS = qw(InMulticasts OutMulticasts InBroadcasts OutBroadcasts InOctets OutOctets InUnicasts OutUnicasts InDiscards OutDiscards InErrors OutErrors InUnknowns);
60              
61             our @CPUKEYS = qw(Name 5sec 1min 5min);
62             our @MEMKEYS = qw(Name Alternate Valid Used Free LargestFree Total);
63              
64             our @INVENTORYKEYS = qw(Descr VendorType ContainedIn Class ParentRelPos Name HardwareRev FirmwareRev SoftwareRev SerialNum MfgName ModelName Alias AssetID IsFRU);
65              
66             our $LASTERROR;
67             ########################################################
68             # End Variables
69             ########################################################
70              
71             ########################################################
72             # Start Public Module
73             ########################################################
74              
75             sub new {
76 0     0 1 0 my $self = shift;
77 0   0     0 my $class = ref($self) || $self;
78              
79 0         0 my $family;
80 0         0 my %params = (
81             version => 1,
82             port => 161,
83             timeout => 10
84             );
85              
86 0         0 my %args;
87 0 0       0 if (@_ == 1) {
88 0         0 ($params{'hostname'}) = @_
89             } else {
90 0         0 %args = @_;
91 0         0 for (keys(%args)) {
92 0 0 0     0 if (/^-?port$/i) {
    0          
    0          
    0          
    0          
    0          
93 0         0 $params{'port'} = $args{$_}
94             } elsif (/^-?community$/i) {
95 0         0 $params{'community'} = $args{$_}
96             } elsif (/^-?family$/i) {
97 0 0       0 if ($args{$_} =~ /^(?:(?:(:?ip)?v?(?:4|6))|${\AF_INET}|$AF_INET6)$/) {
  0         0  
98 0 0       0 if ($args{$_} =~ /^(?:(?:(:?ip)?v?4)|${\AF_INET})$/) {
  0         0  
99 0         0 $params{'domain'} = 'udp';
100 0         0 $family = AF_INET
101             } else {
102 0         0 $params{'domain'} = 'udp6';
103 0         0 $family = $AF_INET6
104             }
105             } else {
106 0         0 $LASTERROR = "Invalid family `$args{$_}'";
107             return(undef)
108 0         0 }
109             } elsif ((/^-?hostname$/i) || (/^-?(?:de?st|peer)?addr$/i)) {
110 0         0 $params{'hostname'} = $args{$_}
111             } elsif (/^-?timeout$/i) {
112 0         0 $params{'timeout'} = $args{$_}
113             } elsif (/^-?version$/i) {
114 0         0 $params{'version'} = $args{$_}
115             # pass through
116             } else {
117 0         0 $params{$_} = $args{$_}
118             }
119             }
120             }
121              
122             # set default community string if not provided and SNMP version 1 or 2
123 0 0 0     0 if (($params{'version'} <= 2) && !defined($params{'community'})) {
124 0         0 $params{'community'} = 'private'
125             }
126              
127             # hostname must be defined
128 0 0       0 if (!defined($params{'hostname'})) {
129 0         0 $params{'hostname'} = hostname
130             }
131              
132             # resolve hostname our way
133 0 0       0 if (defined(my $ret = _resolv($params{'hostname'}, $family))) {
134 0         0 $params{'hostname'} = $ret->{'addr'};
135 0         0 $family = $ret->{'family'};
136 0 0       0 if ($family == AF_INET) {
137 0         0 $params{'domain'} = 'udp'
138             } else {
139 0         0 $params{'domain'} = 'udp6'
140             }
141             } else {
142             return undef
143 0         0 }
144              
145 0         0 my ($session, $error) = Net::SNMP->session(%params);
146              
147 0 0       0 if (!defined($session)) {
148 0         0 $LASTERROR = "Error creating Net::SNMP object: $error";
149             return(undef)
150 0         0 }
151              
152 0         0 return bless {
153             %params, # merge user parameters
154             'family' => $family,
155             '_SESSION_' => $session
156             }, $class
157             }
158              
159             sub session {
160 0     0 1 0 my $self = shift;
161 0         0 return $self->{'_SESSION_'}
162             }
163              
164             sub config_copy {
165 0     0 1 0 my $self = shift;
166 0   0     0 my $class = ref($self) || $self;
167              
168 0         0 my $session = $self->{'_SESSION_'};
169              
170 0         0 my $cc;
171 0         0 foreach my $key (keys(%{$self})) {
  0         0  
172             # everything but '_xxx_'
173 0 0       0 $key =~ /^\_.+\_$/ and next;
174 0         0 $cc->{$key} = $self->{$key}
175             }
176              
177 0         0 my %params = (
178             op => 'wr',
179             catos => 0,
180             timeout => 10,
181             source => 4,
182             dest => 3
183             );
184              
185 0         0 my %args;
186 0 0       0 if (@_ == 1) {
187 0         0 $LASTERROR = "Insufficient number of args";
188             return(undef)
189 0         0 } else {
190 0         0 %args = @_;
191 0         0 for (keys(%args)) {
192 0 0 0     0 if ((/^-?(?:tftp)?server$/i) || (/^-?tftp$/)) {
    0          
    0          
    0          
    0          
    0          
193 0         0 $params{'tftpserver'} = $args{$_}
194             } elsif (/^-?catos$/i) {
195 0 0       0 if ($args{$_} == 1) {
196 0         0 $params{'catos'} = 1
197             }
198             } elsif (/^-?timeout$/i) {
199 0         0 $params{'timeout'} = $args{$_}
200             } elsif (/^-?family$/i) {
201 0 0       0 if ($args{$_} =~ /^(?:(?:(:?ip)?v?(?:4|6))|${\AF_INET}|$AF_INET6)$/) {
  0         0  
202 0 0       0 if ($args{$_} =~ /^(?:(?:(:?ip)?v?4)|${\AF_INET})$/) {
  0         0  
203 0         0 $params{'family'} = AF_INET
204             } else {
205 0         0 $params{'family'} = $AF_INET6
206             }
207             } else {
208 0         0 $LASTERROR = "Invalid family `$args{$_}'";
209             return(undef)
210 0         0 }
211             } elsif (/^-?source$/i) {
212 0 0       0 if ($args{$_} =~ /^run(?:ning)?(?:-config)?$/i) {
    0          
213 0         0 $params{'source'} = 4
214             } elsif ($args{$_} =~ /^start(?:up)?(?:-config)?$/i) {
215 0         0 $params{'source'} = 3
216             } else {
217 0         0 $params{'source'} = 1;
218 0         0 $params{'op'} = 'put';
219 0         0 $params{'file'} = $args{$_}
220             }
221             } elsif (/^-?dest(?:ination)?$/i) {
222 0 0       0 if ($args{$_} =~ /^run(?:ning)?(?:-config)?$/i) {
    0          
223 0         0 $params{'dest'} = 4
224             } elsif ($args{$_} =~ /^start(?:up)?(?:-config)?$/i) {
225 0         0 $params{'dest'} = 3
226             } else {
227 0         0 $params{'dest'} = 1;
228 0         0 $params{'op'} = 'get';
229 0         0 $params{'file'} = $args{$_}
230             }
231             }
232             }
233             }
234 0         0 $cc->{'_CONFIGCOPY_'}{'_params_'} = \%params;
235              
236 0 0       0 if ($params{'source'} == $params{'dest'}) {
237 0         0 $LASTERROR = "Source and destination cannot be same";
238             return(undef)
239 0         0 }
240              
241             # tftpserver must be defined if put/get
242 0 0 0     0 if (($params{'op'} ne "wr") && !defined($params{'tftpserver'})) {
243 0         0 $params{'tftpserver'} = hostname
244             }
245              
246             # inherit from new()
247 0 0       0 if (!defined($params{'family'})) {
248 0         0 $params{'family'} = $self->{'family'};
249             }
250              
251             # resolve tftpserver our way
252 0 0       0 if (defined($params{'tftpserver'})) {
253 0 0       0 if (defined(my $ret = _resolv($params{'tftpserver'}, $params{'family'}))) {
254 0         0 $params{'tftpserver'} = $ret->{'addr'};
255 0         0 $params{'family'} = $ret->{'family'}
256             } else {
257             return undef
258 0         0 }
259 0 0 0     0 if ($params{'catos'} && ($params{'family'} == $AF_INET6)) {
260 0         0 $LASTERROR = "CatOS does not support IPv6";
261             return undef
262 0         0 }
263             }
264              
265 0         0 my $response;
266 0         0 my $instance = int(rand(1024)+1024);
267 0         0 my %ioserr = (
268             1 => "Unknown",
269             2 => "Bad file name",
270             3 => "Timeout",
271             4 => "No memory",
272             5 => "No config",
273             6 => "Unsupported protocol",
274             7 => "Config apply fail",
275             8 => "System not ready",
276             9 => "Request abort"
277             );
278              
279             # wr mem
280 0 0       0 if ($params{'op'} eq 'wr') {
281 0 0       0 if ($params{'catos'}) {
282 0         0 $LASTERROR = "CatOS does not support `copy run start'";
283             return(undef)
284 0         0 }
285             # ccCopyEntryRowStatus (5 = createAndWait, 6 = destroy)
286 0         0 $response = $session->set_request('1.3.6.1.4.1.9.9.96.1.1.1.1.14.' . $instance, INTEGER, 6);
287              
288 0 0       0 if (!defined($response)) {
289 0         0 $LASTERROR = "`copy run start' NOT SUPPORTED - trying old way";
290 0         0 $response = $session->set_request('1.3.6.1.4.1.9.2.1.54.0', INTEGER, 1);
291 0 0       0 if (defined($response)) {
292 0         0 return bless $cc, $class
293             } else {
294 0         0 $LASTERROR = "`copy run start' FAILED (new and old)";
295             return(undef)
296 0         0 }
297             }
298              
299             # ccCopySourceFileType (1 = networkFile, 3 = startupConfig, 4 = runningConfig)
300 0         0 $response = $session->set_request('1.3.6.1.4.1.9.9.96.1.1.1.1.3.' . $instance, INTEGER, $params{'source'});
301             # ccCopyDestFileType (1 = networkFile, 3 = startupConfig, 4 = runningConfig)
302 0         0 $response = $session->set_request('1.3.6.1.4.1.9.9.96.1.1.1.1.4.' . $instance, INTEGER, $params{'dest'})
303              
304             # TFTP PUT/GET (to/from device)
305             } else {
306 0         0 $response = _config_copy(\%params, $session, $instance);
307 0 0       0 if ($response == 0) {
    0          
308 0         0 return bless $cc, $class
309             } elsif ($response == -1) {
310             return(undef)
311 0         0 }
312             # $response == 1, continue ...
313             }
314              
315             # ccCopyEntryRowStatus (4 = createAndGo, 6 = destroy)
316 0         0 $response = $session->set_request('1.3.6.1.4.1.9.9.96.1.1.1.1.14.' . $instance, INTEGER, 1);
317              
318             # Check status, wait done
319 0         0 $response = $session->get_request('1.3.6.1.4.1.9.9.96.1.1.1.1.10.' . $instance);
320 0 0       0 if (!defined($response)) {
321 0         0 $LASTERROR = "tftp NOT SUPPORTED (after setup)";
322             return(undef)
323 0         0 }
324              
325             # loop and check response - error if timeout
326 0         0 my $loop = 0;
327 0         0 while ($response->{'1.3.6.1.4.1.9.9.96.1.1.1.1.10.' . $instance} <= 2) {
328 0         0 $response = $session->get_request('1.3.6.1.4.1.9.9.96.1.1.1.1.10.' . $instance);
329 0 0       0 if (!defined($response)) {
330 0         0 $LASTERROR = "IOS TFTP `$params{'op'}' FAILED - cannot verify completion";
331             return(undef)
332 0         0 }
333 0 0       0 if ($loop++ == $params{'timeout'}) {
334 0         0 $LASTERROR = "IOS TFTP `$params{'op'}' FAILED - timeout during completion verification";
335             return(undef)
336 0         0 }
337 0         0 sleep 1
338             }
339              
340             # Success
341 0 0       0 if ($response->{'1.3.6.1.4.1.9.9.96.1.1.1.1.10.' . $instance} == 3) {
    0          
342 0         0 $response = $session->get_request('1.3.6.1.4.1.9.9.96.1.1.1.1.11.' . $instance);
343 0         0 $cc->{'_CONFIGCOPY_'}{'StartTime'} = $response->{'1.3.6.1.4.1.9.9.96.1.1.1.1.11.' . $instance};
344 0         0 $response = $session->get_request('1.3.6.1.4.1.9.9.96.1.1.1.1.12.' . $instance);
345 0         0 $cc->{'_CONFIGCOPY_'}{'EndTime'} = $response->{'1.3.6.1.4.1.9.9.96.1.1.1.1.12.' . $instance};
346 0         0 $session->set_request('1.3.6.1.4.1.9.9.96.1.1.1.1.14.' . $instance, INTEGER, 6);
347 0         0 return bless $cc, $class
348             # Error
349             } elsif ($response->{'1.3.6.1.4.1.9.9.96.1.1.1.1.10.' . $instance} == 4) {
350 0         0 $response = $session->get_request('1.3.6.1.4.1.9.9.96.1.1.1.1.13.' . $instance);
351 0         0 $session->set_request('1.3.6.1.4.1.9.9.96.1.1.1.1.14.' . $instance, INTEGER, 6);
352 0         0 $LASTERROR = "IOS TFTP `$params{'op'}' FAILED - " . $ioserr{$response->{'1.3.6.1.4.1.9.9.96.1.1.1.1.13.' . $instance}};
353             return(undef)
354 0         0 } else {
355 0         0 $LASTERROR = "Cannot determine success or failure";
356             return(undef)
357 0         0 }
358             }
359              
360             sub config_copy_starttime {
361 0     0 1 0 my $self = shift;
362 0         0 return $self->{'_CONFIGCOPY_'}{'StartTime'}
363             }
364              
365             sub config_copy_endtime {
366 0     0 1 0 my $self = shift;
367 0         0 return $self->{'_CONFIGCOPY_'}{'EndTime'}
368             }
369              
370             sub cpu_info {
371 0     0 1 0 my $self = shift;
372 0   0     0 my $class = ref($self) || $self;
373              
374 0         0 my $session = $self->{'_SESSION_'};
375              
376 0         0 my ($type, $cpu5min);
377             # IOS releases < 12.0(3)T
378 0 0 0     0 if (($cpu5min = &_snmpgetnext($session,"1.3.6.1.4.1.9.2.1.58")) && (defined($cpu5min->[0]))) {
    0 0        
    0 0        
379 0         0 $type = 1
380             # 12.0(3)T < IOS releases < 12.2(3.5)
381             } elsif (($cpu5min = &_snmpgetnext($session,"1.3.6.1.4.1.9.9.109.1.1.1.1.5")) && (defined($cpu5min->[0]))) {
382 0         0 $type = 2
383             # IOS releases > 12.2(3.5)
384             } elsif (($cpu5min = &_snmpgetnext($session,"1.3.6.1.4.1.9.9.109.1.1.1.1.8")) && (defined($cpu5min->[0]))) {
385 0         0 $type = 3
386             } else {
387 0         0 $LASTERROR = "Cannot determine CPU type";
388             return(undef)
389 0         0 }
390              
391 0         0 my %cpuType = (
392             1 => 'IOS releases < 12.0(3)T',
393             2 => '12.0(3)T < IOS releases < 12.2(3.5)',
394             3 => 'IOS releases > 12.2(3.5)'
395             );
396              
397 0         0 my @cpuName;
398             # Get multiple CPU names
399 0 0       0 if ($type > 1) {
400 0         0 my $temp = &_snmpgetnext($session,"1.3.6.1.4.1.9.9.109.1.1.1.1.2");
401 0         0 for (0..$#{$temp}) {
  0         0  
402 0 0       0 if (defined(my $result = $session->get_request( -varbindlist => ['1.3.6.1.2.1.47.1.1.1.1.7.' . $temp->[$_]] ))) {
403 0         0 $cpuName[$_] = $result->{'1.3.6.1.2.1.47.1.1.1.1.7.' . $temp->[$_]}
404             } else {
405 0         0 $LASTERROR = "Cannot get CPU name for type `$cpuType{$type}'";
406             return(undef)
407 0         0 }
408             }
409             }
410              
411 0         0 my ($cpu5sec, $cpu1min);
412 0 0       0 if ($type == 1) {
    0          
    0          
413 0         0 $cpu5min = &_snmpgetnext($session,"1.3.6.1.4.1.9.2.1.58");
414 0         0 $cpu5sec = &_snmpgetnext($session,"1.3.6.1.4.1.9.2.1.56");
415 0         0 $cpu1min = &_snmpgetnext($session,"1.3.6.1.4.1.9.2.1.57")
416             } elsif ($type == 2) {
417 0         0 $cpu5min = &_snmpgetnext($session,"1.3.6.1.4.1.9.9.109.1.1.1.1.5");
418 0         0 $cpu5sec = &_snmpgetnext($session,"1.3.6.1.4.1.9.9.109.1.1.1.1.3");
419 0         0 $cpu1min = &_snmpgetnext($session,"1.3.6.1.4.1.9.9.109.1.1.1.1.4")
420             } elsif ($type == 3) {
421 0         0 $cpu5min = &_snmpgetnext($session,"1.3.6.1.4.1.9.9.109.1.1.1.1.8");
422 0         0 $cpu5sec = &_snmpgetnext($session,"1.3.6.1.4.1.9.9.109.1.1.1.1.6");
423 0         0 $cpu1min = &_snmpgetnext($session,"1.3.6.1.4.1.9.9.109.1.1.1.1.7")
424             } else { }
425              
426 0         0 my @CPUInfo;
427 0         0 for my $cpu (0..$#{$cpu5min}) {
  0         0  
428 0         0 my %CPUInfoHash;
429 0         0 $CPUInfoHash{'Name'} = $cpuName[$cpu];
430 0         0 $CPUInfoHash{'5sec'} = $cpu5sec->[$cpu];
431 0         0 $CPUInfoHash{'1min'} = $cpu1min->[$cpu];
432 0         0 $CPUInfoHash{'5min'} = $cpu5min->[$cpu];
433 0         0 $CPUInfoHash{'_type_'} = $cpuType{$type};
434 0         0 push @CPUInfo, \%CPUInfoHash
435             }
436             return \@CPUInfo
437 0         0 }
438              
439             sub interface_getbyindex {
440 0     0 1 0 my $self = shift;
441 0   0     0 my $class = ref($self) || $self;
442              
443 0         0 my $session = $self->{'_SESSION_'};
444              
445 0         0 my $uIfx;
446             my %args;
447 0 0       0 if (@_ == 1) {
448 0         0 ($uIfx) = @_;
449 0 0       0 if ($uIfx !~ /^\d+$/) {
450 0         0 $LASTERROR = "Invalid ifIndex `$uIfx'";
451             return(undef)
452 0         0 }
453             } else {
454 0         0 %args = @_;
455 0         0 for (keys(%args)) {
456 0 0 0     0 if ((/^-?interface$/i) || (/^-?index$/i)) {
457 0 0       0 if ($args{$_} =~ /^\d+$/) {
458 0         0 $uIfx = $args{$_}
459             } else {
460 0         0 $LASTERROR = "Invalid ifIndex `$args{$_}'";
461             return(undef)
462 0         0 }
463             }
464             }
465             }
466 0 0       0 if (!defined($uIfx)) {
467 0         0 $LASTERROR = "No ifIndex provided";
468             return(undef)
469 0         0 }
470 0         0 my $rIf = &_snmpgetnext($session, '1.3.6.1.2.1.2.2.1.2');
471 0 0       0 if (!defined($rIf)) {
472 0         0 $LASTERROR = "Cannot get interface names from device";
473             return(undef)
474 0         0 }
475 0         0 my $rIfx = &_snmpgetnext($session, '1.3.6.1.2.1.2.2.1.1');
476              
477 0         0 for (0..$#{$rIfx}) {
  0         0  
478 0 0       0 if ($rIfx->[$_] == $uIfx) {
479 0         0 return $rIf->[$_]
480             }
481             }
482 0         0 $LASTERROR = "Cannot get interface for ifIndex `$uIfx'";
483             return(undef)
484 0         0 }
485              
486             sub interface_getbyname {
487 0     0 1 0 my $self = shift;
488 0   0     0 my $class = ref($self) || $self;
489              
490 0         0 my $session = $self->{'_SESSION_'};
491              
492 0         0 my %params = (
493             'index' => 0
494             );
495              
496 0         0 my %args;
497 0 0       0 if (@_ == 1) {
498 0         0 ($params{'uIf'}) = @_;
499             } else {
500 0         0 %args = @_;
501 0         0 for (keys(%args)) {
502 0 0       0 if (/^-?interface$/i) {
    0          
503 0         0 $params{'uIf'} = $args{$_}
504             } elsif (/^-?index$/i) {
505 0 0       0 if ($args{$_} == 1) {
506 0         0 $params{'index'} = 1
507             }
508             }
509             }
510             }
511 0 0       0 if (!exists($params{'uIf'})) {
512 0         0 $LASTERROR = "No interface provided";
513             return(undef)
514 0         0 }
515              
516 0         0 my $rIf = &_snmpgetnext($session, '1.3.6.1.2.1.2.2.1.2');
517 0 0       0 if (!defined($rIf)) {
518 0         0 $LASTERROR = "Cannot get interface names from device";
519             return(undef)
520 0         0 }
521 0         0 my $rIfx = &_snmpgetnext($session, '1.3.6.1.2.1.2.2.1.1');
522              
523             # user Provided
524 0         0 my @parts = split /([0-9])/, $params{'uIf'}, 2;
525 0         0 my $uIfNamePart = shift @parts;
526 0         0 my $uIfNumPart = "@parts";
527 0         0 $uIfNumPart =~ s/\s+//;
528              
529 0         0 my @matches;
530             my $idx;
531 0         0 for (0..$#{$rIf}) {
  0         0  
532             # Real Names
533 0         0 @parts = split /([0-9])/, $rIf->[$_], 2;
534 0         0 my $rIfNamePart = shift @parts;
535 0         0 my $rIfNumPart = "@parts";
536 0         0 $rIfNumPart =~ s/\s+//;
537 0 0 0     0 if (($rIfNamePart =~ /^$uIfNamePart/i) && ($rIfNumPart eq $uIfNumPart)) {
538 0         0 push @matches, $rIf->[$_];
539 0         0 $idx = $rIfx->[$_]
540             }
541             }
542 0 0       0 if (@matches == 1) {
    0          
543 0 0       0 if ($params{'index'} == 0) {
544 0         0 return "@matches"
545             } else {
546 0         0 return $idx
547             }
548             } elsif (@matches == 0) {
549 0         0 $LASTERROR = "Cannot find interface `$params{'uIf'}'";
550             return(undef)
551 0         0 } else {
552 0         0 print "Interface `$params{'uIf'}' not specific enough - [@matches]";
553             return(undef)
554 0         0 }
555             }
556              
557             sub interface_info {
558 0     0 1 0 my $self = shift;
559 0   0     0 my $class = ref($self) || $self;
560              
561 0         0 my $session = $self->{'_SESSION_'};
562              
563 0         0 my %params = (
564             'ifs' => [-1]
565             );
566              
567 0         0 my %args;
568 0 0       0 if (@_ == 1) {
569 0         0 ($params{'ifs'}) = @_;
570 0 0       0 if (!defined($params{'ifs'} = _get_range($params{'ifs'}))) {
571             return(undef)
572 0         0 }
573             } else {
574 0         0 %args = @_;
575 0         0 for (keys(%args)) {
576 0 0       0 if (/^-?interface(?:s)?$/i) {
577 0 0       0 if (!defined($params{'ifs'} = _get_range($args{$_}))) {
578             return(undef)
579 0         0 }
580             }
581             }
582             }
583              
584 0         0 my %IfInfo;
585 0         0 for my $ifs (@{$params{'ifs'}}) {
  0         0  
586              
587 0         0 my $interface;
588 0 0       0 if ($ifs == -1) {
589 0         0 $interface = ''
590             } else {
591 0         0 $interface = '.' . $ifs
592             }
593              
594 0         0 my %ret;
595 0         0 for my $oid (1..$#IFKEYS) {
596 0         0 $ret{$IFKEYS[$oid-1]} = &_snmpgetnext($session, '1.3.6.1.2.1.2.2.1.' . $oid . $interface);
597 0 0       0 if (!defined($ret{$IFKEYS[$oid-1]})) {
598 0         0 $LASTERROR = "Cannot get interface `$interface' `$IFKEYS[$oid-1]'";
599             return(undef)
600 0         0 }
601             }
602             # Duplex is different OID
603 0         0 my $OIDS;
604 0         0 ($OIDS, $ret{$IFKEYS[9]}) = &_snmpgetnext($session, '1.3.6.1.2.1.10.7.2.1.19' . $interface);
605 0         0 my %duplexIfs;
606 0         0 for (0..$#{$OIDS}) {
  0         0  
607             # split the OID at dots
608 0         0 my @if = split /\./, $OIDS->[$_];
609             # take the last value, which is the ifIndex equal to value returned
610 0         0 $duplexIfs{$if[$#if]} = $ret{$IFKEYS[9]}->[$_]
611             }
612              
613 0         0 my %UpDownStatus = (
614             1 => 'UP',
615             2 => 'DOWN',
616             3 => 'TEST',
617             4 => 'UNKNOWN',
618             5 => 'DORMANT',
619             6 => 'NOTPRESENT',
620             7 => 'LOWLAYERDOWN'
621             );
622 0         0 my %DuplexType = (
623             1 => 'UNKNOWN',
624             2 => 'HALF',
625             3 => 'FULL'
626             );
627 0         0 for my $idx (0..$#{$ret{$IFKEYS[0]}}) {
  0         0  
628 0         0 my %IfInfoHash;
629 0         0 $IfInfoHash{$IFKEYS[0]} = $ret{$IFKEYS[0]}->[$idx];
630 0         0 $IfInfoHash{$IFKEYS[1]} = $ret{$IFKEYS[1]}->[$idx];
631 0         0 $IfInfoHash{$IFKEYS[2]} = $ret{$IFKEYS[2]}->[$idx];
632 0         0 $IfInfoHash{$IFKEYS[3]} = $ret{$IFKEYS[3]}->[$idx];
633 0         0 $IfInfoHash{$IFKEYS[4]} = $ret{$IFKEYS[4]}->[$idx];
634 0 0       0 $IfInfoHash{$IFKEYS[5]} = ($ret{$IFKEYS[5]}->[$idx] =~ /^\0/) ? unpack('H12', $ret{$IFKEYS[5]}->[$idx]) : (($ret{$IFKEYS[5]}->[$idx] =~ /^0x/) ? substr($ret{$IFKEYS[5]}->[$idx],2) : $ret{$IFKEYS[5]}->[$idx]);
    0          
635 0 0       0 $IfInfoHash{$IFKEYS[6]} = exists($UpDownStatus{$ret{$IFKEYS[6]}->[$idx]}) ? $UpDownStatus{$ret{$IFKEYS[6]}->[$idx]} : $ret{$IFKEYS[6]}->[$idx];
636 0 0       0 $IfInfoHash{$IFKEYS[7]} = exists($UpDownStatus{$ret{$IFKEYS[7]}->[$idx]}) ? $UpDownStatus{$ret{$IFKEYS[7]}->[$idx]} : $ret{$IFKEYS[7]}->[$idx];
637 0         0 $IfInfoHash{$IFKEYS[8]} = $ret{$IFKEYS[8]}->[$idx];
638             # if $duplexIfs{ifIndex}, not necessarily the current array index
639 0 0       0 if (exists $duplexIfs{$ret{$IFKEYS[0]}->[$idx]}) {
640 0 0       0 $IfInfoHash{$IFKEYS[9]} = exists($DuplexType{$duplexIfs{$ret{$IFKEYS[0]}->[$idx]}}) ? $DuplexType{$duplexIfs{$ret{$IFKEYS[0]}->[$idx]}} : $duplexIfs{$ret{$IFKEYS[0]}->[$idx]}
641             } else {
642 0         0 $IfInfoHash{$IFKEYS[9]} = ''
643             }
644 0         0 $IfInfo{$ret{$IFKEYS[0]}->[$idx]} = \%IfInfoHash
645             }
646             }
647 0         0 return bless \%IfInfo, $class
648             }
649              
650             sub interface_ip {
651 0     0 1 0 my ($self, $arg) = @_;
652 0   0     0 my $class = ref($self) || $self;
653              
654 0         0 my $session = $self->{'_SESSION_'};
655              
656             # IP Info
657 0         0 my $IPIndex = &_snmpgetnext($session, '1.3.6.1.2.1.4.20.1.2');
658 0 0       0 if (!defined($IPIndex)) {
659 0         0 $LASTERROR = "Cannot get interface IP info";
660             return(undef)
661 0         0 }
662 0         0 my %ret;
663 0         0 $ret{$IPKEYS[0]} = &_snmpgetnext($session, '1.3.6.1.2.1.4.20.1.1');
664 0         0 $ret{$IPKEYS[1]} = &_snmpgetnext($session, '1.3.6.1.2.1.4.20.1.3');
665              
666 0         0 my %mask = (
667             "0.0.0.0" => 0, "128.0.0.0" => 1, "192.0.0.0" => 2,
668             "224.0.0.0" => 3, "240.0.0.0" => 4, "248.0.0.0" => 5,
669             "252.0.0.0" => 6, "254.0.0.0" => 7, "255.0.0.0" => 8,
670             "255.128.0.0" => 9, "255.192.0.0" => 10, "255.224.0.0" => 11,
671             "255.240.0.0" => 12, "255.248.0.0" => 13, "255.252.0.0" => 14,
672             "255.254.0.0" => 15, "255.255.0.0" => 16, "255.255.128.0" => 17,
673             "255.255.192.0" => 18, "255.255.224.0" => 19, "255.255.240.0" => 20,
674             "255.255.248.0" => 21, "255.255.252.0" => 22, "255.255.254.0" => 23,
675             "255.255.255.0" => 24, "255.255.255.128" => 25, "255.255.255.192" => 26,
676             "255.255.255.224" => 27, "255.255.255.240" => 28, "255.255.255.248" => 29,
677             "255.255.255.252" => 30, "255.255.255.254" => 31, "255.255.255.255" => 32
678             );
679              
680 0         0 my %IPInfo;
681 0         0 for (0..$#{$IPIndex}) {
  0         0  
682 0         0 my %IPInfoHash;
683 0         0 $IPInfoHash{$IPKEYS[0]} = $ret{$IPKEYS[0]}->[$_];
684 0 0 0     0 if (defined($arg) && ($arg >= 1)) {
685 0         0 $IPInfoHash{$IPKEYS[1]} = $mask{$ret{$IPKEYS[1]}->[$_]}
686             } else {
687 0         0 $IPInfoHash{$IPKEYS[1]} = $ret{$IPKEYS[1]}->[$_]
688             }
689 0         0 push @{$IPInfo{$IPIndex->[$_]}}, \%IPInfoHash
  0         0  
690             }
691 0         0 return bless \%IPInfo, $class
692             }
693              
694             sub interface_metrics {
695 0     0 1 0 my $self = shift;
696 0   0     0 my $class = ref($self) || $self;
697              
698 0         0 my $session = $self->{'_SESSION_'};
699              
700 0         0 my %params = (
701             'ifs' => [-1],
702             );
703             # assume all metrics
704 0         0 for (@IFMETRICUSERKEYS) {
705 0         0 $params{$_} = 1
706             }
707              
708 0         0 my %args;
709 0 0       0 if (@_ == 1) {
710 0         0 ($params{'ifs'}) = @_;
711 0 0       0 if (!defined($params{'ifs'} = _get_range($params{'ifs'}))) {
712             return(undef)
713 0         0 }
714             } else {
715 0         0 %args = @_;
716 0         0 for (keys(%args)) {
717 0 0       0 if (/^-?interface(?:s)?$/i) {
    0          
718 0 0       0 if (!defined($params{'ifs'} = _get_range($args{$_}))) {
719             return(undef)
720 0         0 }
721             } elsif (/^-?metric(?:s)?$/i) {
722             # metrics provided - only use provided
723 0         0 for (@IFMETRICUSERKEYS) {
724 0         0 $params{$_} = 0
725             }
726 0 0       0 if (ref($args{$_}) eq 'ARRAY') {
727 0         0 $params{'oids'} = '';
728 0         0 for my $mets (@{$args{$_}}) {
  0         0  
729 0 0       0 if (exists($params{ucfirst(lc($mets))})) {
730 0         0 $params{ucfirst(lc($mets))} = 1
731             } else {
732 0         0 $LASTERROR = "Invalid metric `$mets'";
733             return(undef)
734 0         0 }
735             }
736             } else {
737 0         0 $params{'oids'} = '';
738 0 0       0 if (exists($params{ucfirst(lc($args{$_}))})) {
739 0         0 $params{ucfirst(lc($args{$_}))} = 1
740             } else {
741 0         0 $LASTERROR = "Invalid metric `$args{$_}'";
742             return(undef)
743 0         0 }
744             }
745             }
746             }
747             }
748              
749 0         0 my %IfMetric;
750 0         0 for my $ifs (@{$params{'ifs'}}) {
  0         0  
751              
752 0         0 my $interface;
753 0 0       0 if ($ifs == -1) {
754 0         0 $interface = ''
755             } else {
756 0         0 $interface = '.' . $ifs
757             }
758              
759 0         0 my %ret;
760 0         0 $ret{'Index'} = &_snmpgetnext($session, '1.3.6.1.2.1.2.2.1.1' . $interface);
761 0 0       0 if (!defined($ret{'Index'})) {
762 0         0 $LASTERROR = "Cannot get ifIndex `$interface'";
763             return(undef)
764 0         0 }
765             # multicasts
766 0 0       0 if ($params{$IFMETRICUSERKEYS[0]}) {
767             # In
768 0         0 $ret{$IFMETRICKEYS[0]} = &_snmpgetnext($session, '1.3.6.1.2.1.31.1.1.1.2' . $interface);
769 0 0       0 if (!defined($ret{$IFMETRICKEYS[0]})) {
770 0         0 $LASTERROR = "Cannot get interface `$interface' `$IFMETRICKEYS[0]'";
771             return(undef)
772 0         0 }
773             # Out
774 0         0 $ret{$IFMETRICKEYS[1]} = &_snmpgetnext($session, '1.3.6.1.2.1.31.1.1.1.4' . $interface);
775 0 0       0 if (!defined($ret{$IFMETRICKEYS[1]})) {
776 0         0 $LASTERROR = "Cannot get interface `$interface' `$IFMETRICKEYS[1]'";
777             return(undef)
778 0         0 }
779             }
780             # broadcasts
781 0 0       0 if ($params{$IFMETRICUSERKEYS[1]}) {
782             # In
783 0         0 $ret{$IFMETRICKEYS[2]} = &_snmpgetnext($session, '1.3.6.1.2.1.31.1.1.1.3' . $interface);
784 0 0       0 if (!defined($ret{$IFMETRICKEYS[2]})) {
785 0         0 $LASTERROR = "Cannot get interface `$interface' `$IFMETRICKEYS[2]'";
786             return(undef)
787 0         0 }
788             # Out
789 0         0 $ret{$IFMETRICKEYS[3]} = &_snmpgetnext($session, '1.3.6.1.2.1.31.1.1.1.5' . $interface);
790 0 0       0 if (!defined($ret{$IFMETRICKEYS[3]})) {
791 0         0 $LASTERROR = "Cannot get interface `$interface' `$IFMETRICKEYS[3]'";
792             return(undef)
793 0         0 }
794             }
795             # octets
796 0 0       0 if ($params{$IFMETRICUSERKEYS[2]}) {
797             # In
798 0         0 $ret{$IFMETRICKEYS[4]} = &_snmpgetnext($session, '1.3.6.1.2.1.2.2.1.10' . $interface);
799 0 0       0 if (!defined($ret{$IFMETRICKEYS[4]})) {
800 0         0 $LASTERROR = "Cannot get interface `$interface' `$IFMETRICKEYS[4]'";
801             return(undef)
802 0         0 }
803             # Out
804 0         0 $ret{$IFMETRICKEYS[5]} = &_snmpgetnext($session, '1.3.6.1.2.1.2.2.1.16' . $interface);
805 0 0       0 if (!defined($ret{$IFMETRICKEYS[5]})) {
806 0         0 $LASTERROR = "Cannot get interface `$interface' `$IFMETRICKEYS[5]'";
807             return(undef)
808 0         0 }
809             }
810             # unicasts
811 0 0       0 if ($params{$IFMETRICUSERKEYS[3]}) {
812             # In
813 0         0 $ret{$IFMETRICKEYS[6]} = &_snmpgetnext($session, '1.3.6.1.2.1.2.2.1.11' . $interface);
814 0 0       0 if (!defined($ret{$IFMETRICKEYS[6]})) {
815 0         0 $LASTERROR = "Cannot get interface `$interface' `$IFMETRICKEYS[6]'";
816             return(undef)
817 0         0 }
818             # Out
819 0         0 $ret{$IFMETRICKEYS[7]} = &_snmpgetnext($session, '1.3.6.1.2.1.2.2.1.17' . $interface);
820 0 0       0 if (!defined($ret{$IFMETRICKEYS[7]})) {
821 0         0 $LASTERROR = "Cannot get interface `$interface' `$IFMETRICKEYS[7]'";
822             return(undef)
823 0         0 }
824             }
825             # discards
826 0 0       0 if ($params{$IFMETRICUSERKEYS[4]}) {
827             # In
828 0         0 $ret{$IFMETRICKEYS[8]} = &_snmpgetnext($session, '1.3.6.1.2.1.2.2.1.13' . $interface);
829 0 0       0 if (!defined($ret{$IFMETRICKEYS[8]})) {
830 0         0 $LASTERROR = "Cannot get interface `$interface' `$IFMETRICKEYS[8]'";
831             return(undef)
832 0         0 }
833             # Out
834 0         0 $ret{$IFMETRICKEYS[9]} = &_snmpgetnext($session, '1.3.6.1.2.1.2.2.1.19' . $interface);
835 0 0       0 if (!defined($ret{$IFMETRICKEYS[9]})) {
836 0         0 $LASTERROR = "Cannot get interface `$interface' `$IFMETRICKEYS[9]'";
837             return(undef)
838 0         0 }
839             }
840             # errors
841 0 0       0 if ($params{$IFMETRICUSERKEYS[5]}) {
842             # In
843 0         0 $ret{$IFMETRICKEYS[10]} = &_snmpgetnext($session, '1.3.6.1.2.1.2.2.1.14' . $interface);
844 0 0       0 if (!defined($ret{$IFMETRICKEYS[10]})) {
845 0         0 $LASTERROR = "Cannot get interface `$interface' `$IFMETRICKEYS[10]'";
846             return(undef)
847 0         0 }
848             # Out
849 0         0 $ret{$IFMETRICKEYS[11]} = &_snmpgetnext($session, '1.3.6.1.2.1.2.2.1.20' . $interface);
850 0 0       0 if (!defined($ret{$IFMETRICKEYS[11]})) {
851 0         0 $LASTERROR = "Cannot get interface `$interface' `$IFMETRICKEYS[11]'";
852             return(undef)
853 0         0 }
854             }
855             # unknowns
856 0 0       0 if ($params{$IFMETRICUSERKEYS[6]}) {
857             # In
858 0         0 $ret{$IFMETRICKEYS[12]} = &_snmpgetnext($session, '1.3.6.1.2.1.2.2.1.15' . $interface);
859 0 0       0 if (!defined($ret{$IFMETRICKEYS[12]})) {
860 0         0 $LASTERROR = "Cannot get interface `$interface' `$IFMETRICKEYS[12]'";
861             return(undef)
862 0         0 }
863             }
864              
865 0         0 for my $idx (0..$#{$ret{'Index'}}) {
  0         0  
866 0         0 my %IfMetricHash;
867 0         0 $IfMetricHash{$IFMETRICKEYS[0]} = $ret{$IFMETRICKEYS[0]}->[$idx];
868 0         0 $IfMetricHash{$IFMETRICKEYS[1]} = $ret{$IFMETRICKEYS[1]}->[$idx];
869 0         0 $IfMetricHash{$IFMETRICKEYS[2]} = $ret{$IFMETRICKEYS[2]}->[$idx];
870 0         0 $IfMetricHash{$IFMETRICKEYS[3]} = $ret{$IFMETRICKEYS[3]}->[$idx];
871 0         0 $IfMetricHash{$IFMETRICKEYS[4]} = $ret{$IFMETRICKEYS[4]}->[$idx];
872 0         0 $IfMetricHash{$IFMETRICKEYS[5]} = $ret{$IFMETRICKEYS[5]}->[$idx];
873 0         0 $IfMetricHash{$IFMETRICKEYS[6]} = $ret{$IFMETRICKEYS[6]}->[$idx];
874 0         0 $IfMetricHash{$IFMETRICKEYS[7]} = $ret{$IFMETRICKEYS[7]}->[$idx];
875 0         0 $IfMetricHash{$IFMETRICKEYS[8]} = $ret{$IFMETRICKEYS[8]}->[$idx];
876 0         0 $IfMetricHash{$IFMETRICKEYS[9]} = $ret{$IFMETRICKEYS[9]}->[$idx];
877 0         0 $IfMetricHash{$IFMETRICKEYS[10]} = $ret{$IFMETRICKEYS[10]}->[$idx];
878 0         0 $IfMetricHash{$IFMETRICKEYS[11]} = $ret{$IFMETRICKEYS[11]}->[$idx];
879 0         0 $IfMetricHash{$IFMETRICKEYS[12]} = $ret{$IFMETRICKEYS[12]}->[$idx];
880 0         0 $IfMetric{$ret{'Index'}->[$idx]} = \%IfMetricHash
881             }
882             }
883 0         0 return bless \%IfMetric, $class
884             }
885              
886             sub interface_utilization {
887 0     0 1 0 my $self = shift;
888 0   0     0 my $class = ref($self) || $self;
889              
890 0         0 my $session = $self->{'_SESSION_'};
891              
892 0         0 my %params = (
893             'polling' => 10
894             );
895              
896 0         0 my %args;
897 0 0       0 if (@_ != 1) {
898 0         0 %args = @_;
899 0         0 for (keys(%args)) {
900 0 0 0     0 if ((/^-?polling$/i) || (/^-?interval$/i)) {
    0          
901 0 0 0     0 if (($args{$_} =~ /^\d+$/) && ($args{$_} > 0)) {
902 0         0 $params{'polling'} = $args{$_}
903             } else {
904 0         0 $LASTERROR = "Invalid polling interval `$args{$_}'";
905             return(undef)
906 0         0 }
907             } elsif (/^-?recursive$/i) {
908 0         0 $params{'recur'} = $args{$_}
909             }
910             }
911             }
912              
913 0         0 my $prev;
914 0 0 0     0 if (exists($params{'recur'}) && (ref($params{'recur'}) eq __PACKAGE__)) {
915 0         0 $prev = $params{'recur'}
916             } else {
917 0 0       0 if (!defined($prev = $self->interface_metrics(@_))) {
918 0         0 $LASTERROR = "Cannot get initial utilization: " . $LASTERROR;
919             return(undef)
920 0         0 }
921             }
922 0         0 sleep $params{'polling'};
923 0         0 my $curr;
924 0 0       0 if (!defined($curr = $self->interface_metrics(@_))) {
925 0         0 $LASTERROR = "Cannot get current utilization: " . $LASTERROR;
926             return(undef)
927 0         0 }
928              
929 0         0 my %IfUtil;
930 0         0 for my $ifs (sort {$a <=> $b} (keys(%{$prev}))) {
  0         0  
  0         0  
931 0         0 my %IfUtilHash;
932 0 0       0 $IfUtilHash{$IFMETRICKEYS[0]} = defined($curr->{$ifs}->{$IFMETRICKEYS[0]}) ? ($curr->{$ifs}->{$IFMETRICKEYS[0]} - $prev->{$ifs}->{$IFMETRICKEYS[0]}) / $params{'polling'} : undef;
933 0 0       0 $IfUtilHash{$IFMETRICKEYS[1]} = defined($curr->{$ifs}->{$IFMETRICKEYS[1]}) ? ($curr->{$ifs}->{$IFMETRICKEYS[1]} - $prev->{$ifs}->{$IFMETRICKEYS[1]}) / $params{'polling'} : undef;
934 0 0       0 $IfUtilHash{$IFMETRICKEYS[2]} = defined($curr->{$ifs}->{$IFMETRICKEYS[2]}) ? ($curr->{$ifs}->{$IFMETRICKEYS[2]} - $prev->{$ifs}->{$IFMETRICKEYS[2]}) / $params{'polling'} : undef;
935 0 0       0 $IfUtilHash{$IFMETRICKEYS[3]} = defined($curr->{$ifs}->{$IFMETRICKEYS[3]}) ? ($curr->{$ifs}->{$IFMETRICKEYS[3]} - $prev->{$ifs}->{$IFMETRICKEYS[3]}) / $params{'polling'} : undef;
936 0 0       0 $IfUtilHash{$IFMETRICKEYS[4]} = defined($curr->{$ifs}->{$IFMETRICKEYS[4]}) ? (($curr->{$ifs}->{$IFMETRICKEYS[4]} - $prev->{$ifs}->{$IFMETRICKEYS[4]}) * 8) / $params{'polling'} : undef;
937 0 0       0 $IfUtilHash{$IFMETRICKEYS[5]} = defined($curr->{$ifs}->{$IFMETRICKEYS[5]}) ? (($curr->{$ifs}->{$IFMETRICKEYS[5]} - $prev->{$ifs}->{$IFMETRICKEYS[5]}) * 8) / $params{'polling'} : undef;
938 0 0       0 $IfUtilHash{$IFMETRICKEYS[6]} = defined($curr->{$ifs}->{$IFMETRICKEYS[6]}) ? ($curr->{$ifs}->{$IFMETRICKEYS[6]} - $prev->{$ifs}->{$IFMETRICKEYS[6]}) / $params{'polling'} : undef;
939 0 0       0 $IfUtilHash{$IFMETRICKEYS[7]} = defined($curr->{$ifs}->{$IFMETRICKEYS[7]}) ? ($curr->{$ifs}->{$IFMETRICKEYS[7]} - $prev->{$ifs}->{$IFMETRICKEYS[7]}) / $params{'polling'} : undef;
940 0 0       0 $IfUtilHash{$IFMETRICKEYS[8]} = defined($curr->{$ifs}->{$IFMETRICKEYS[8]}) ? ($curr->{$ifs}->{$IFMETRICKEYS[8]} - $prev->{$ifs}->{$IFMETRICKEYS[8]}) / $params{'polling'} : undef;
941 0 0       0 $IfUtilHash{$IFMETRICKEYS[9]} = defined($curr->{$ifs}->{$IFMETRICKEYS[9]}) ? ($curr->{$ifs}->{$IFMETRICKEYS[9]} - $prev->{$ifs}->{$IFMETRICKEYS[9]}) / $params{'polling'} : undef;
942 0 0       0 $IfUtilHash{$IFMETRICKEYS[10]} = defined($curr->{$ifs}->{$IFMETRICKEYS[10]}) ? ($curr->{$ifs}->{$IFMETRICKEYS[10]} - $prev->{$ifs}->{$IFMETRICKEYS[10]}) / $params{'polling'} : undef;
943 0 0       0 $IfUtilHash{$IFMETRICKEYS[11]} = defined($curr->{$ifs}->{$IFMETRICKEYS[11]}) ? ($curr->{$ifs}->{$IFMETRICKEYS[11]} - $prev->{$ifs}->{$IFMETRICKEYS[11]}) / $params{'polling'} : undef;
944 0 0       0 $IfUtilHash{$IFMETRICKEYS[12]} = defined($curr->{$ifs}->{$IFMETRICKEYS[12]}) ? ($curr->{$ifs}->{$IFMETRICKEYS[12]} - $prev->{$ifs}->{$IFMETRICKEYS[12]}) / $params{'polling'} : undef;
945 0         0 $IfUtil{$ifs} = \%IfUtilHash
946             }
947 0         0 $prev = bless \%IfUtil, $class;
948 0 0       0 return wantarray ? ($prev, $curr) : $prev
949             }
950              
951             sub interface_updown {
952 0     0 1 0 my $self = shift;
953 0   0     0 my $class = ref($self) || $self;
954              
955 0         0 my $session = $self->{'_SESSION_'};
956              
957 0         0 my %op = (
958             'UP' => 1,
959             'DOWN' => 2
960             );
961 0         0 my %params = (
962             'oper' => $op{'UP'}
963             );
964              
965 0         0 my %args;
966 0         0 my $oper = 'UP';
967 0 0       0 if (@_ == 1) {
968 0         0 ($params{'ifs'}) = @_;
969 0 0       0 if (!defined($params{'ifs'} = _get_range($params{'ifs'}))) {
970             return(undef)
971 0         0 }
972             } else {
973 0         0 %args = @_;
974 0         0 for (keys(%args)) {
975 0 0 0     0 if (/^-?interface(?:s)?$/i) {
    0          
976 0 0       0 if (!defined($params{'ifs'} = _get_range($args{$_}))) {
977             return(undef)
978 0         0 }
979             } elsif ((/^-?operation$/i) || (/^-?command$/i)) {
980 0 0       0 if (exists($op{uc($args{$_})})) {
981 0         0 $params{'oper'} = $op{uc($args{$_})};
982 0         0 $oper = uc($args{$_})
983             } else {
984 0         0 $LASTERROR = "Invalid operation `$args{$_}'";
985             return(undef)
986 0         0 }
987             }
988             }
989             }
990              
991 0 0       0 if (!defined($params{'ifs'})) {
992 0         0 $params{'ifs'} = &_snmpgetnext($session, '1.3.6.1.2.1.2.2.1.1');
993 0 0       0 if (!defined($params{'ifs'})) {
994 0         0 $LASTERROR = "Cannot get interfaces to $oper";
995             return(undef)
996 0         0 }
997             }
998              
999 0         0 my @intf;
1000 0         0 for (@{$params{'ifs'}}) {
  0         0  
1001 0 0       0 if (defined($session->set_request('1.3.6.1.2.1.2.2.1.7.' . $_, INTEGER, $params{'oper'}))) {
1002 0         0 push @intf, $_
1003             } else {
1004 0         0 $LASTERROR = "Failed to $oper interface $_";
1005             return(undef)
1006 0         0 }
1007             }
1008             return \@intf
1009 0         0 }
1010              
1011             sub line_clear {
1012 0     0 1 0 my $self = shift;
1013 0   0     0 my $class = ref($self) || $self;
1014              
1015 0         0 my $session = $self->{'_SESSION_'};
1016              
1017 0         0 my %params;
1018             my %args;
1019 0 0       0 if (@_ == 1) {
1020 0         0 ($params{'lines'}) = @_;
1021 0 0       0 if (!defined($params{'lines'} = _get_range($params{'lines'}))) {
1022             return(undef)
1023 0         0 }
1024             } else {
1025 0         0 %args = @_;
1026 0         0 for (keys(%args)) {
1027 0 0 0     0 if ((/^-?range$/i) || (/^-?line(?:s)?$/i)) {
1028 0 0       0 if (!defined($params{'lines'} = _get_range($args{$_}))) {
1029             return(undef)
1030 0         0 }
1031             }
1032             }
1033             }
1034              
1035 0 0       0 if (!defined($params{'lines'})) {
1036 0         0 $params{'lines'} = &_snmpgetnext($session, '1.3.6.1.4.1.9.2.9.2.1.20');
1037 0 0       0 if (!defined($params{'lines'})) {
1038 0         0 $LASTERROR = "Cannot get lines to clear";
1039             return(undef)
1040 0         0 }
1041             }
1042              
1043 0         0 my @lines;
1044 0         0 for (@{$params{'lines'}}) {
  0         0  
1045 0 0       0 if (defined($session->set_request('1.3.6.1.4.1.9.2.9.10.0', INTEGER, $_))) {
1046 0         0 push @lines, $_
1047             } else {
1048 0         0 $LASTERROR = "Failed to clear line $_";
1049             return(undef)
1050 0         0 }
1051             }
1052             return \@lines
1053 0         0 }
1054              
1055             sub line_info {
1056 0     0 1 0 my $self = shift;
1057 0   0     0 my $class = ref($self) || $self;
1058              
1059 0         0 my $session = $self->{'_SESSION_'};
1060              
1061 0         0 my %ret;
1062 0         0 for my $oid (1..$#LINEKEYS + 1) {
1063 0         0 $ret{$LINEKEYS[$oid-1]} = &_snmpgetnext($session, '1.3.6.1.4.1.9.2.9.2.1.' . $oid);
1064 0 0       0 if (!defined($ret{$LINEKEYS[$oid-1]})) {
1065 0         0 $LASTERROR = "Cannot get line `$LINEKEYS[$oid-1]' info";
1066             return(undef)
1067 0         0 }
1068             }
1069              
1070 0         0 my %LineTypes = (
1071             2 => 'CON',
1072             3 => 'TRM',
1073             4 => 'LNP',
1074             5 => 'VTY',
1075             6 => 'AUX'
1076             );
1077 0         0 my %LineModem = (
1078             2 => 'none',
1079             3 => 'callin',
1080             4 => 'callout',
1081             5 => 'cts-reqd',
1082             6 => 'ri-is-cd',
1083             7 => 'inout'
1084             );
1085 0         0 my %LineFlow = (
1086             2 => 'none',
1087             3 => 'sw-in',
1088             4 => 'sw-out',
1089             5 => 'sw-both',
1090             6 => 'hw-in',
1091             7 => 'hw-out',
1092             8 => 'hw-both'
1093             );
1094 0         0 my %LineInfo;
1095 0         0 for my $lines (0..$#{$ret{$LINEKEYS[19]}}) {
  0         0  
1096 0         0 my %LineInfoHash;
1097 0         0 $LineInfoHash{$LINEKEYS[20]} = $ret{$LINEKEYS[20]}->[$lines];
1098 0         0 $LineInfoHash{$LINEKEYS[19]} = $ret{$LINEKEYS[19]}->[$lines];
1099 0         0 $LineInfoHash{$LINEKEYS[18]} = $ret{$LINEKEYS[18]}->[$lines];
1100 0         0 $LineInfoHash{$LINEKEYS[17]} = $ret{$LINEKEYS[17]}->[$lines];
1101 0         0 $LineInfoHash{$LINEKEYS[16]} = $ret{$LINEKEYS[16]}->[$lines];
1102 0         0 $LineInfoHash{$LINEKEYS[15]} = $ret{$LINEKEYS[15]}->[$lines];
1103 0         0 $LineInfoHash{$LINEKEYS[14]} = $ret{$LINEKEYS[14]}->[$lines];
1104 0         0 $LineInfoHash{$LINEKEYS[13]} = $ret{$LINEKEYS[13]}->[$lines];
1105 0         0 $LineInfoHash{$LINEKEYS[12]} = $ret{$LINEKEYS[12]}->[$lines];
1106 0         0 $LineInfoHash{$LINEKEYS[11]} = $ret{$LINEKEYS[11]}->[$lines];
1107 0         0 $LineInfoHash{$LINEKEYS[10]} = $ret{$LINEKEYS[10]}->[$lines];
1108 0         0 $LineInfoHash{$LINEKEYS[9]} = $ret{$LINEKEYS[9]}->[$lines];
1109 0         0 $LineInfoHash{$LINEKEYS[8]} = $ret{$LINEKEYS[8]}->[$lines];
1110 0         0 $LineInfoHash{$LINEKEYS[7]} = $ret{$LINEKEYS[7]}->[$lines];
1111 0 0       0 $LineInfoHash{$LINEKEYS[6]} = exists($LineModem{$ret{$LINEKEYS[6]}->[$lines]}) ? $LineModem{$ret{$LINEKEYS[6]}->[$lines]} : $ret{$LINEKEYS[6]}->[$lines];
1112 0 0       0 $LineInfoHash{$LINEKEYS[5]} = exists($LineFlow{$ret{$LINEKEYS[5]}->[$lines]}) ? $LineFlow{$ret{$LINEKEYS[5]}->[$lines]} : $ret{$LINEKEYS[5]}->[$lines];
1113 0         0 $LineInfoHash{$LINEKEYS[4]} = $ret{$LINEKEYS[4]}->[$lines];
1114 0         0 $LineInfoHash{$LINEKEYS[3]} = $ret{$LINEKEYS[3]}->[$lines];
1115 0         0 $LineInfoHash{$LINEKEYS[2]} = $ret{$LINEKEYS[2]}->[$lines];
1116 0 0       0 $LineInfoHash{$LINEKEYS[1]} = exists($LineTypes{$ret{$LINEKEYS[1]}->[$lines]}) ? $LineTypes{$ret{$LINEKEYS[1]}->[$lines]} : $ret{$LINEKEYS[1]}->[$lines];
1117 0         0 $LineInfoHash{$LINEKEYS[0]} = $ret{$LINEKEYS[0]}->[$lines];
1118 0         0 $LineInfo{$ret{$LINEKEYS[19]}->[$lines]} = \%LineInfoHash
1119             }
1120 0         0 return bless \%LineInfo, $class
1121             }
1122              
1123             sub line_sessions {
1124 0     0 1 0 my $self = shift;
1125 0   0     0 my $class = ref($self) || $self;
1126              
1127 0         0 my $session = $self->{'_SESSION_'};
1128              
1129 0         0 my %ret;
1130 0         0 for my $oid (1..$#SESSIONKEYS + 1) {
1131 0         0 $ret{$SESSIONKEYS[$oid-1]} = &_snmpgetnext($session, '1.3.6.1.4.1.9.2.9.3.1.' . $oid);
1132 0 0       0 if (!defined($ret{$SESSIONKEYS[$oid-1]})) {
1133 0         0 $LASTERROR = "Cannot get session `$SESSIONKEYS[$oid-1]' info";
1134             return(undef)
1135 0         0 }
1136             }
1137              
1138 0         0 my %SessionTypes = (
1139             1 => 'unknown',
1140             2 => 'PAD',
1141             3 => 'stream',
1142             4 => 'rlogin',
1143             5 => 'telnet',
1144             6 => 'TCP',
1145             7 => 'LAT',
1146             8 => 'MOP',
1147             9 => 'SLIP',
1148             10 => 'XRemote',
1149             11 => 'rshell'
1150             );
1151 0         0 my %SessionDir = (
1152             1 => 'unknown',
1153             2 => 'IN',
1154             3 => 'OUT'
1155             );
1156 0         0 my %SessionInfo;
1157 0         0 for my $sess (0..$#{$ret{$SESSIONKEYS[6]}}) {
  0         0  
1158 0         0 my %SessionInfoHash;
1159 0         0 $SessionInfoHash{$SESSIONKEYS[6]} = $ret{$SESSIONKEYS[6]}->[$sess];
1160 0         0 $SessionInfoHash{$SESSIONKEYS[5]} = $ret{$SESSIONKEYS[5]}->[$sess];
1161 0         0 $SessionInfoHash{$SESSIONKEYS[4]} = $ret{$SESSIONKEYS[4]}->[$sess];
1162 0         0 $SessionInfoHash{$SESSIONKEYS[3]} = $ret{$SESSIONKEYS[3]}->[$sess];
1163 0         0 $SessionInfoHash{$SESSIONKEYS[2]} = $ret{$SESSIONKEYS[2]}->[$sess];
1164 0 0       0 $SessionInfoHash{$SESSIONKEYS[1]} = exists($SessionDir{$ret{$SESSIONKEYS[1]}->[$sess]}) ? $SessionDir{$ret{$SESSIONKEYS[1]}->[$sess]} : $ret{$SESSIONKEYS[1]}->[$sess];
1165 0 0       0 $SessionInfoHash{$SESSIONKEYS[0]} = exists($SessionTypes{$ret{$SESSIONKEYS[0]}->[$sess]}) ? $SessionTypes{$ret{$SESSIONKEYS[0]}->[$sess]} : $ret{$SESSIONKEYS[0]}->[$sess];
1166 0         0 push @{$SessionInfo{$ret{$SESSIONKEYS[6]}->[$sess]}}, \%SessionInfoHash
  0         0  
1167             }
1168 0         0 return bless \%SessionInfo, $class
1169             }
1170              
1171             sub line_message {
1172 0     0 1 0 my $self = shift;
1173 0   0     0 my $class = ref($self) || $self;
1174              
1175 0         0 my $session = $self->{'_SESSION_'};
1176              
1177 0         0 my %params = (
1178             message => 'Test Message.',
1179             lines => [-1]
1180             );
1181              
1182 0         0 my %args;
1183 0 0       0 if (@_ == 1) {
1184 0         0 ($params{'message'}) = @_
1185             } else {
1186 0         0 %args = @_;
1187 0         0 for (keys(%args)) {
1188 0 0       0 if (/^-?message$/i) {
    0          
1189 0         0 $params{'message'} = $args{$_}
1190             } elsif (/^-?line(?:s)?$/i) {
1191 0 0       0 if (!defined($params{'lines'} = _get_range($args{$_}))) {
1192             return(undef)
1193 0         0 }
1194             }
1195             }
1196             }
1197              
1198 0         0 my $response;
1199             my @lines;
1200 0         0 for (@{$params{'lines'}}) {
  0         0  
1201             # Lines
1202 0         0 my $response = $session->set_request("1.3.6.1.4.1.9.2.9.4.0", INTEGER, $_);
1203             # Interval (reissue)
1204 0         0 $response = $session->set_request("1.3.6.1.4.1.9.2.9.5.0", INTEGER, 0);
1205             # Duration
1206 0         0 $response = $session->set_request("1.3.6.1.4.1.9.2.9.6.0", INTEGER, 0);
1207             # Text (256 chars)
1208 0         0 $response = $session->set_request("1.3.6.1.4.1.9.2.9.7.0", OCTET_STRING, $params{'message'});
1209             # Temp Banner (1=no 2=append)
1210 0         0 $response = $session->set_request("1.3.6.1.4.1.9.2.9.8.0", INTEGER, 1);
1211             # Send
1212 0         0 $response = $session->set_request("1.3.6.1.4.1.9.2.9.9.0", INTEGER, 1);
1213 0 0       0 if (defined($response)) {
1214 0         0 push @lines, $_
1215             } else {
1216 0         0 $LASTERROR = "Failed to send message to line $_";
1217             return(undef)
1218 0         0 }
1219             }
1220             # clear message
1221 0         0 $session->set_request("1.3.6.1.4.1.9.2.9.7.0", OCTET_STRING, "");
1222 0 0       0 if ($lines[0] == -1) { $lines[0] = "ALL" }
  0         0  
1223             return \@lines
1224 0         0 }
1225              
1226             sub line_numberof {
1227 0     0 1 0 my $self = shift;
1228 0   0     0 my $class = ref($self) || $self;
1229              
1230 0         0 my $session = $self->{'_SESSION_'};
1231              
1232 0         0 my $response;
1233 0 0       0 if (!defined($response = $session->get_request( -varbindlist => ['1.3.6.1.4.1.9.2.9.1.0'] ))) {
1234 0         0 $LASTERROR = "Cannot get number of lines";
1235             return(undef)
1236 0         0 } else {
1237 0         0 return $response->{'1.3.6.1.4.1.9.2.9.1.0'}
1238             }
1239             }
1240              
1241             sub memory_info {
1242 0     0 1 0 my $self = shift;
1243 0   0     0 my $class = ref($self) || $self;
1244              
1245 0         0 my $session = $self->{'_SESSION_'};
1246              
1247 0         0 my %ret;
1248             # only +1 because last key (Total) isn't an OID; rather, calculated from 2 other OIDs
1249 0         0 for my $oid (2..$#MEMKEYS + 1) {
1250 0         0 $ret{$MEMKEYS[$oid-2]} = &_snmpgetnext($session, '1.3.6.1.4.1.9.9.48.1.1.1.' . $oid);
1251 0 0       0 if (!defined($ret{$MEMKEYS[$oid-2]})) {
1252 0         0 $LASTERROR = "Cannot get memory `$MEMKEYS[$oid-2]' info";
1253             return(undef)
1254 0         0 }
1255             }
1256              
1257 0         0 my @MemInfo;
1258 0         0 for my $mem (0..$#{$ret{$MEMKEYS[0]}}) {
  0         0  
1259 0         0 my %MemInfoHash;
1260 0         0 $MemInfoHash{$MEMKEYS[0]} = $ret{$MEMKEYS[0]}->[$mem];
1261 0         0 $MemInfoHash{$MEMKEYS[1]} = $ret{$MEMKEYS[1]}->[$mem];
1262 0 0       0 $MemInfoHash{$MEMKEYS[2]} = ($ret{$MEMKEYS[2]}->[$mem] == 1) ? 'TRUE' : 'FALSE';
1263 0         0 $MemInfoHash{$MEMKEYS[3]} = $ret{$MEMKEYS[3]}->[$mem];
1264 0         0 $MemInfoHash{$MEMKEYS[4]} = $ret{$MEMKEYS[4]}->[$mem];
1265 0         0 $MemInfoHash{$MEMKEYS[5]} = $ret{$MEMKEYS[5]}->[$mem];
1266 0         0 $MemInfoHash{$MEMKEYS[6]} = $ret{$MEMKEYS[3]}->[$mem] + $ret{$MEMKEYS[4]}->[$mem];
1267 0         0 push @MemInfo, \%MemInfoHash
1268             }
1269             return \@MemInfo
1270 0         0 }
1271              
1272             sub proxy_ping {
1273 0     0 1 0 my $self = shift;
1274 0   0     0 my $class = ref($self) || $self;
1275              
1276 0         0 my $session = $self->{'_SESSION_'};
1277              
1278 0         0 my $pp;
1279 0         0 foreach my $key (keys(%{$self})) {
  0         0  
1280             # everything but '_xxx_'
1281 0 0       0 $key =~ /^\_.+\_$/ and next;
1282 0         0 $pp->{$key} = $self->{$key}
1283             }
1284              
1285 0         0 my %params = (
1286             count => 1,
1287             size => 64,
1288             wait => 1,
1289             );
1290              
1291 0         0 my %args;
1292 0 0       0 if (@_ == 1) {
1293 0         0 ($params{'host'}) = @_;
1294             } else {
1295 0         0 %args = @_;
1296 0         0 for (keys(%args)) {
1297 0 0 0     0 if ((/^-?host(?:name)?$/i) || (/^-?dest(?:ination)?$/i)) {
    0 0        
    0          
    0          
    0          
    0          
1298 0         0 $params{'host'} = $args{$_};
1299             } elsif (/^-?size$/i) {
1300 0 0       0 if ($args{$_} =~ /^\d+$/) {
1301 0         0 $params{'size'} = $args{$_}
1302             } else {
1303 0         0 $LASTERROR = "Invalid size `$args{$_}'";
1304             return(undef)
1305 0         0 }
1306             } elsif (/^-?family$/i) {
1307 0 0       0 if ($args{$_} =~ /^(?:(?:(:?ip)?v?(?:4|6))|${\AF_INET}|$AF_INET6)$/) {
  0         0  
1308 0 0       0 if ($args{$_} =~ /^(?:(?:(:?ip)?v?4)|${\AF_INET})$/) {
  0         0  
1309 0         0 $params{'family'} = AF_INET
1310             } else {
1311 0         0 $params{'family'} = $AF_INET6
1312             }
1313             } else {
1314 0         0 $LASTERROR = "Invalid family `$args{$_}'";
1315             return(undef)
1316 0         0 }
1317             } elsif (/^-?count$/i) {
1318 0 0       0 if ($args{$_} =~ /^\d+$/) {
1319 0         0 $params{'count'} = $args{$_}
1320             } else {
1321 0         0 $LASTERROR = "Invalid count `$args{$_}'";
1322             return(undef)
1323 0         0 }
1324             } elsif ((/^-?wait$/i) || (/^-?timeout$/i)) {
1325 0 0       0 if ($args{$_} =~ /^\d+$/) {
1326 0         0 $params{'wait'} = $args{$_}
1327             } else {
1328 0         0 $LASTERROR = "Invalid wait time `$args{$_}'";
1329             return(undef)
1330 0         0 }
1331             } elsif (/^-?vrf(?:name)?$/i) {
1332 0         0 $params{'vrf'} = $args{$_}
1333             }
1334             }
1335             }
1336 0         0 $pp->{_PROXYPING_}{'_params_'} = \%params;
1337              
1338             # host must be defined
1339 0 0       0 if (!defined($params{'host'})) {
1340 0         0 $params{'host'} = hostname
1341             }
1342              
1343             # inherit from new()
1344 0 0       0 if (!defined($params{'family'})) {
1345 0         0 $params{'family'} = $self->{'family'};
1346             }
1347              
1348             # resolve host our way
1349 0 0       0 if (defined(my $ret = _resolv($params{'host'}, $params{'family'}))) {
1350 0         0 $params{'host'} = $ret->{'addr'};
1351 0         0 $params{'family'} = $ret->{'family'}
1352             } else {
1353             return undef
1354 0         0 }
1355              
1356 0         0 my $instance = int(rand(1024)+1024);
1357             # Prepare object by clearing row
1358 0         0 my $response = $session->set_request('1.3.6.1.4.1.9.9.16.1.1.1.16.' . $instance, INTEGER, 6);
1359 0 0       0 if (!defined($response)) {
1360 0         0 $LASTERROR = "proxy ping NOT SUPPORTED";
1361             return(undef)
1362 0         0 }
1363              
1364             # Convert destination to Hex equivalent
1365 0         0 my $dest;
1366 0 0       0 if ($params{'family'} == AF_INET) {
1367 0         0 for (split(/\./, $params{'host'})) {
1368 0         0 $dest .= sprintf("%02x",$_)
1369             }
1370             } else {
1371 0 0       0 if ($HAVE_Net_IPv6Addr) {
1372 0         0 my $addr = Net::IPv6Addr->new($params{'host'});
1373 0         0 my @dest = $addr->to_array;
1374 0         0 $dest .= join '', $_ for (@dest)
1375             } else {
1376 0         0 $LASTERROR = "Socket > 1.94 and Net::IPv6Addr required";
1377             return(undef)
1378 0         0 }
1379             }
1380              
1381             # ciscoPingEntryStatus (5 = createAndWait, 6 = destroy)
1382 0         0 $response = $session->set_request('1.3.6.1.4.1.9.9.16.1.1.1.16.' . $instance, INTEGER, 6);
1383 0         0 $response = $session->set_request('1.3.6.1.4.1.9.9.16.1.1.1.16.' . $instance, INTEGER, 5);
1384             # ciscoPingEntryOwner ()
1385 0         0 $response = $session->set_request('1.3.6.1.4.1.9.9.16.1.1.1.15.' . $instance, OCTET_STRING, __PACKAGE__);
1386             # ciscoPingProtocol (1 = IP, 20 = IPv6)
1387 0 0       0 $response = $session->set_request('1.3.6.1.4.1.9.9.16.1.1.1.2.' . $instance, INTEGER, ($params{'family'} == AF_INET) ? 1 : 20);
1388 0 0       0 if (!defined($response)) {
1389 0         0 $LASTERROR = "Device does not support ciscoPingProtocol 20 (IPv6)";
1390             return(undef)
1391 0         0 }
1392             # ciscoPingAddress (NOTE: hex string, not regular IP)
1393 0         0 $response = $session->set_request('1.3.6.1.4.1.9.9.16.1.1.1.3.' . $instance, OCTET_STRING, pack('H*', $dest));
1394             # ciscoPingPacketTimeout (in ms)
1395 0         0 $response = $session->set_request('1.3.6.1.4.1.9.9.16.1.1.1.6.' . $instance, INTEGER32, $params{'wait'}*100);
1396             # ciscoPingDelay (Set gaps (in ms) between successive pings)
1397 0         0 $response = $session->set_request('1.3.6.1.4.1.9.9.16.1.1.1.7.' . $instance, INTEGER32, $params{'wait'}*100);
1398             # ciscoPingPacketCount
1399 0         0 $response = $session->set_request('1.3.6.1.4.1.9.9.16.1.1.1.4.' . $instance, INTEGER, $params{'count'});
1400             # ciscoPingPacketSize (protocol dependent)
1401 0         0 $response = $session->set_request('1.3.6.1.4.1.9.9.16.1.1.1.5.' . $instance, INTEGER, $params{'size'});
1402              
1403 0 0       0 if (exists($params{'vrf'})) {
1404             # ciscoPingVrfName ()
1405 0         0 $response = $session->set_request('1.3.6.1.4.1.9.9.16.1.1.1.17.' . $instance, OCTET_STRING, $params{'vrf'})
1406             }
1407             # Verify ping is ready (ciscoPingEntryStatus = 2)
1408 0         0 $response = $session->get_request('1.3.6.1.4.1.9.9.16.1.1.1.16.' . $instance);
1409 0 0       0 if (defined($response->{'1.3.6.1.4.1.9.9.16.1.1.1.16.' . $instance})) {
1410 0 0       0 if ($response->{'1.3.6.1.4.1.9.9.16.1.1.1.16.' . $instance} != 2) {
1411 0         0 $LASTERROR = "Ping not ready";
1412             return(undef)
1413 0         0 }
1414             } else {
1415 0         0 $LASTERROR = "proxy ping NOT SUPPORTED (after setup)";
1416             return(undef)
1417 0         0 }
1418              
1419             # ciscoPingEntryStatus (1 = activate)
1420 0         0 $response = $session->set_request('1.3.6.1.4.1.9.9.16.1.1.1.16.' . $instance, INTEGER, 1);
1421              
1422             # Wait sample interval
1423 0         0 sleep $params{'wait'};
1424              
1425             # Get results
1426 0         0 $response = $session->get_table('1.3.6.1.4.1.9.9.16.1.1.1');
1427 0   0     0 $pp->{'_PROXYPING_'}{'Sent'} = $response->{'1.3.6.1.4.1.9.9.16.1.1.1.9.' . $instance} || 0;
1428 0   0     0 $pp->{'_PROXYPING_'}{'Received'} = $response->{'1.3.6.1.4.1.9.9.16.1.1.1.10.' . $instance} || 0;
1429 0   0     0 $pp->{'_PROXYPING_'}{'Minimum'} = $response->{'1.3.6.1.4.1.9.9.16.1.1.1.11.' . $instance} || 0;
1430 0   0     0 $pp->{'_PROXYPING_'}{'Average'} = $response->{'1.3.6.1.4.1.9.9.16.1.1.1.12.' . $instance} || 0;
1431 0   0     0 $pp->{'_PROXYPING_'}{'Maximum'} = $response->{'1.3.6.1.4.1.9.9.16.1.1.1.13.' . $instance} || 0;
1432              
1433             # destroy entry
1434 0         0 $response = $session->set_request('1.3.6.1.4.1.9.9.16.1.1.1.16.' . $instance, INTEGER, 6);
1435 0         0 return bless $pp, $class
1436             }
1437              
1438             sub proxy_ping_sent {
1439 0     0 1 0 my $self = shift;
1440 0         0 return $self->{'_PROXYPING_'}{'Sent'}
1441             }
1442              
1443             sub proxy_ping_received {
1444 0     0 1 0 my $self = shift;
1445 0         0 return $self->{'_PROXYPING_'}{'Received'}
1446             }
1447              
1448             sub proxy_ping_minimum {
1449 0     0 1 0 my $self = shift;
1450 0         0 return $self->{'_PROXYPING_'}{'Minimum'}
1451             }
1452              
1453             sub proxy_ping_average {
1454 0     0 1 0 my $self = shift;
1455 0         0 return $self->{'_PROXYPING_'}{'Average'}
1456             }
1457              
1458             sub proxy_ping_maximum {
1459 0     0 1 0 my $self = shift;
1460 0         0 return $self->{'_PROXYPING_'}{'Maximum'}
1461             }
1462              
1463             sub system_info {
1464 0     0 1 0 my $self = shift;
1465 0   0     0 my $class = ref($self) || $self;
1466              
1467 0         0 my $session = $self->{'_SESSION_'};
1468              
1469 0         0 my $sysinfo;
1470 0         0 foreach my $key (keys(%{$self})) {
  0         0  
1471             # everything but '_xxx_'
1472 0 0       0 $key =~ /^\_.+\_$/ and next;
1473 0         0 $sysinfo->{$key} = $self->{$key}
1474             }
1475              
1476 0         0 my $response = &_snmpgetnext($session, '1.3.6.1.2.1.1');
1477 0 0       0 if (defined($response)) {
1478              
1479 0 0       0 if (defined($response->[0])) { $sysinfo->{'_SYSINFO_'}{'Description'} = $response->[0] }
  0         0  
1480 0 0       0 if (defined($response->[1])) { $sysinfo->{'_SYSINFO_'}{'ObjectID'} = $response->[1] }
  0         0  
1481 0 0       0 if (defined($response->[2])) { $sysinfo->{'_SYSINFO_'}{'Uptime'} = $response->[2] }
  0         0  
1482 0 0       0 if (defined($response->[3])) { $sysinfo->{'_SYSINFO_'}{'Contact'} = $response->[3] }
  0         0  
1483 0 0       0 if (defined($response->[4])) { $sysinfo->{'_SYSINFO_'}{'Name'} = $response->[4] }
  0         0  
1484 0 0       0 if (defined($response->[5])) { $sysinfo->{'_SYSINFO_'}{'Location'} = $response->[5] }
  0         0  
1485 0 0       0 if (defined($response->[6])) { $sysinfo->{'_SYSINFO_'}{'Services'} = $response->[6] }
  0         0  
1486              
1487 0         0 return bless $sysinfo, $class
1488             } else {
1489 0         0 $LASTERROR = "Cannot read system MIB";
1490             return(undef)
1491 0         0 }
1492             }
1493              
1494             sub system_info_description {
1495 0     0 1 0 my $self = shift;
1496 0         0 return $self->{'_SYSINFO_'}{'Description'}
1497             }
1498              
1499             sub system_info_objectID {
1500 0     0 1 0 my $self = shift;
1501 0         0 return $self->{'_SYSINFO_'}{'ObjectID'}
1502             }
1503              
1504             sub system_info_uptime {
1505 0     0 1 0 my $self = shift;
1506 0         0 return $self->{'_SYSINFO_'}{'Uptime'}
1507             }
1508              
1509             sub system_info_contact {
1510 0     0 1 0 my $self = shift;
1511 0         0 return $self->{'_SYSINFO_'}{'Contact'}
1512             }
1513              
1514             sub system_info_name {
1515 0     0 1 0 my $self = shift;
1516 0         0 return $self->{'_SYSINFO_'}{'Name'}
1517             }
1518              
1519             sub system_info_location {
1520 0     0 1 0 my $self = shift;
1521 0         0 return $self->{'_SYSINFO_'}{'Location'}
1522             }
1523              
1524             sub system_info_services {
1525 0     0 1 0 my ($self, $arg) = @_;
1526              
1527 0 0 0     0 if (defined($arg) && ($arg >= 1)) {
1528 0         0 return $self->{'_SYSINFO_'}{'Services'}
1529             } else {
1530 0         0 my %Services = (
1531             1 => 'Physical',
1532             2 => 'Datalink',
1533             4 => 'Network',
1534             8 => 'Transport',
1535             16 => 'Session',
1536             32 => 'Presentation',
1537             64 => 'Application'
1538             );
1539 0         0 my @Svcs;
1540 0         0 for (sort {$b <=> $a} (keys(%Services))) {
  0         0  
1541 0 0       0 push @Svcs, $Services{$_} if ($self->{'_SYSINFO_'}{'Services'} & int($_))
1542             }
1543             return \@Svcs
1544 0         0 }
1545             }
1546              
1547             sub system_info_osversion {
1548 0     0 1 0 my $self = shift;
1549              
1550 0 0       0 if ($self->{'_SYSINFO_'}{'Description'} =~ /Version ([^ ,\n\r]+)/) {
1551 0         0 return $1
1552             } else {
1553 0         0 return "Cannot determine OS Version"
1554             }
1555             }
1556              
1557             sub system_inventory {
1558 0     0 1 0 my $self = shift;
1559 0   0     0 my $class = ref($self) || $self;
1560              
1561 0         0 my $session = $self->{'_SESSION_'};
1562              
1563 0         0 my $inventory;
1564 0         0 foreach my $key (keys(%{$self})) {
  0         0  
1565             # everything but '_xxx_'
1566 0 0       0 $key =~ /^\_.+\_$/ and next;
1567 0         0 $inventory->{$key} = $self->{$key}
1568             }
1569              
1570 0         0 my %ret;
1571 0         0 for my $oid (2..$#INVENTORYKEYS + 2) {
1572 0         0 $ret{$INVENTORYKEYS[$oid-2]} = &_snmpgetnext($session, '1.3.6.1.2.1.47.1.1.1.1.' . $oid);
1573 0 0       0 if (!defined($ret{$INVENTORYKEYS[$oid-2]})) {
1574 0         0 $LASTERROR = "Cannot get inventory `$INVENTORYKEYS[$oid-2]' info";
1575             return(undef)
1576 0         0 }
1577             }
1578              
1579 0         0 my @Inventory;
1580 0         0 for my $unit (0..$#{$ret{$INVENTORYKEYS[5]}}) {
  0         0  
1581 0         0 my %InventoryHash;
1582 0         0 $InventoryHash{$INVENTORYKEYS[0]} = $ret{$INVENTORYKEYS[0]}->[$unit];
1583 0         0 $InventoryHash{$INVENTORYKEYS[1]} = $ret{$INVENTORYKEYS[1]}->[$unit];
1584 0         0 $InventoryHash{$INVENTORYKEYS[2]} = $ret{$INVENTORYKEYS[2]}->[$unit];
1585 0         0 $InventoryHash{$INVENTORYKEYS[3]} = $ret{$INVENTORYKEYS[3]}->[$unit];
1586 0         0 $InventoryHash{$INVENTORYKEYS[4]} = $ret{$INVENTORYKEYS[4]}->[$unit];
1587 0         0 $InventoryHash{$INVENTORYKEYS[5]} = $ret{$INVENTORYKEYS[5]}->[$unit];
1588 0         0 $InventoryHash{$INVENTORYKEYS[6]} = $ret{$INVENTORYKEYS[6]}->[$unit];
1589 0         0 $InventoryHash{$INVENTORYKEYS[7]} = $ret{$INVENTORYKEYS[7]}->[$unit];
1590 0         0 $InventoryHash{$INVENTORYKEYS[8]} = $ret{$INVENTORYKEYS[8]}->[$unit];
1591 0         0 $InventoryHash{$INVENTORYKEYS[9]} = $ret{$INVENTORYKEYS[9]}->[$unit];
1592 0         0 $InventoryHash{$INVENTORYKEYS[10]} = $ret{$INVENTORYKEYS[10]}->[$unit];
1593 0         0 $InventoryHash{$INVENTORYKEYS[11]} = $ret{$INVENTORYKEYS[11]}->[$unit];
1594 0         0 $InventoryHash{$INVENTORYKEYS[12]} = $ret{$INVENTORYKEYS[12]}->[$unit];
1595 0         0 $InventoryHash{$INVENTORYKEYS[13]} = $ret{$INVENTORYKEYS[13]}->[$unit];
1596 0         0 $InventoryHash{$INVENTORYKEYS[14]} = $ret{$INVENTORYKEYS[14]}->[$unit];
1597 0         0 push @Inventory, \%InventoryHash
1598             }
1599             return \@Inventory
1600 0         0 }
1601              
1602             ########################################################
1603             # Subroutines
1604             ########################################################
1605              
1606             sub password_decrypt {
1607              
1608 53     53 1 517 my $self = shift;
1609 53   33     110 my $class = ref($self) || $self;
1610              
1611 53         30 my $passwd;
1612              
1613 53 50       49 if ($self ne __PACKAGE__) {
1614 0         0 $passwd = $self
1615             } else {
1616 53         68 ($passwd) = @_
1617             }
1618              
1619 53 50 33     190 if (($passwd =~ /^[\da-f]+$/i) && (length($passwd) > 2)) {
1620 53 50       64 if (!(length($passwd) & 1)) {
1621 53         32 my $dec = "";
1622 53         92 my ($s, $e) = ($passwd =~ /^(..)(.+)/o);
1623              
1624 53         66 for (my $i = 0; $i < length($e); $i+=2) {
1625             # If we move past the end of the XOR key, reset
1626 265 100       282 if ($s > $#xlat) { $s = 0 }
  4         5  
1627 265         479 $dec .= sprintf "%c",hex(substr($e,$i,2))^$xlat[$s++]
1628             }
1629 53         85 return $dec
1630             }
1631             }
1632 0         0 $LASTERROR = "Invalid password `$passwd'";
1633 0         0 return(0)
1634             }
1635              
1636             sub password_encrypt {
1637              
1638 3     3 1 658 my $self = shift;
1639 3   33     13 my $class = ref($self) || $self;
1640              
1641 3         2 my ($cleartxt, $index);
1642              
1643 3 50       6 if ($self ne __PACKAGE__) {
1644 0         0 $cleartxt = $self;
1645 0         0 ($index) = @_
1646             } else {
1647 3         5 ($cleartxt, $index) = @_
1648             }
1649              
1650 3         3 my $start = 0;
1651 3         5 my $end = $#xlat;
1652              
1653 3 100       8 if (defined($index)) {
1654 2 100       10 if ($index =~ /^\d+$/) {
    50          
1655 1 50 33     8 if (($index < 0) || ($index > $#xlat)) {
1656 0         0 $LASTERROR = "Index out of range 0-$#xlat: $index";
1657 0         0 return(0)
1658             } else {
1659 1         2 $start = $index;
1660 1         3 $end = $index
1661             }
1662             } elsif ($index eq "") {
1663             # Do them all - currently set for that.
1664             } else {
1665 1         58 my $random = int(rand($#xlat + 1));
1666 1         2 $start = $random;
1667 1         2 $end = $random
1668             }
1669             }
1670              
1671 3         4 my @passwds;
1672 3         7 for (my $j = $start; $j <= $end; $j++) {
1673 55         55 my $encrypt = sprintf "%02i", $j;
1674 55         28 my $s = $j;
1675              
1676 55         63 for (my $i = 0; $i < length($cleartxt); $i++) {
1677             # If we move past the end of the XOR key, reset
1678 275 100       297 if ($s > $#xlat) { $s = 0 }
  4         4  
1679 275         424 $encrypt .= sprintf "%02X", ord(substr($cleartxt,$i,1))^$xlat[$s++]
1680             }
1681 55         90 push @passwds, $encrypt
1682             }
1683             return \@passwds
1684 3         11 }
1685              
1686             sub close {
1687 0     0 1   my $self = shift;
1688 0           $self->{_SESSION_}->close();
1689             }
1690              
1691             sub error {
1692 0     0 1   return($LASTERROR)
1693             }
1694              
1695             ########################################################
1696             # End Public Module
1697             ########################################################
1698              
1699             ########################################################
1700             # Start Private subs
1701             ########################################################
1702              
1703             # Return:
1704             # -1 = error
1705             # 0 = DONE
1706             # 1 = continue
1707             sub _config_copy {
1708 0     0     my ($params, $session, $instance) = @_;
1709              
1710 0           my $response;
1711 0           my %caterr = (
1712             1 => "In Progress",
1713             2 => "Success",
1714             3 => "No Response",
1715             4 => "Too Many Retries",
1716             5 => "No Buffers",
1717             6 => "No Processes",
1718             7 => "Bad Checksum",
1719             8 => "Bad Length",
1720             9 => "Bad Flash",
1721             10 => "Server Error",
1722             11 => "User Cancelled",
1723             12 => "Wrong Code",
1724             13 => "File Not Found",
1725             14 => "Invalid TFTP Host",
1726             15 => "Invalid TFTP Module",
1727             16 => "Access Violation",
1728             17 => "Unknown Status",
1729             18 => "Invalid Storage Device",
1730             19 => "Insufficient Space On Storage Device",
1731             20 => "Insufficient Dram Size",
1732             21 => "Incompatible Image"
1733             );
1734              
1735 0 0         if ($params->{'catos'}) {
1736 0           $response = $session->set_request('1.3.6.1.4.1.9.5.1.5.1.0', OCTET_STRING, $params->{'tftpserver'});
1737 0           $response = $session->set_request('1.3.6.1.4.1.9.5.1.5.2.0', OCTET_STRING, $params->{'file'});
1738 0           $response = $session->set_request('1.3.6.1.4.1.9.5.1.5.3.0', INTEGER, 1);
1739 0 0         if ($params->{'op'} eq 'put') {
1740 0           $response = $session->set_request('1.3.6.1.4.1.9.5.1.5.4.0', INTEGER, 2)
1741             } else {
1742 0           $response = $session->set_request('1.3.6.1.4.1.9.5.1.5.4.0', INTEGER, 3)
1743             }
1744              
1745             # loop and check response - error if timeout
1746 0           $response = $session->get_request('1.3.6.1.4.1.9.5.1.5.5.0');
1747 0           my $loop = 0;
1748 0           while ($response->{'1.3.6.1.4.1.9.5.1.5.5.0'} == 1) {
1749 0           $response = $session->get_request('1.3.6.1.4.1.9.5.1.5.5.0');
1750 0 0         if ($loop++ == $params->{'timeout'}) {
1751 0           $LASTERROR = "CatOS TFTP `$params->{'op'}' FAILED - timeout during completion verification";
1752 0           return -1
1753             }
1754 0           sleep 1
1755             }
1756              
1757 0 0         if ($response->{'1.3.6.1.4.1.9.5.1.5.5.0'} == 2) {
1758 0           return 0
1759             } else {
1760 0           $LASTERROR = "CatOS TFTP `$params->{'op'}' FAILED - " . $caterr{$response->{'1.3.6.1.4.1.9.5.1.5.5.0'}};
1761 0           return -1
1762             }
1763              
1764             # IOS
1765             } else {
1766             # ccCopyEntryRowStatus (5 = createAndWait, 6 = destroy)
1767 0           $response = $session->set_request('1.3.6.1.4.1.9.9.96.1.1.1.1.14.' . $instance, INTEGER, 6);
1768 0           $response = $session->set_request('1.3.6.1.4.1.9.9.96.1.1.1.1.14.' . $instance, INTEGER, 5);
1769              
1770             # ccCopyProtocol (1 = TFTP)
1771 0           $response = $session->set_request('1.3.6.1.4.1.9.9.96.1.1.1.1.2.' . $instance, INTEGER, 1);
1772              
1773 0 0         if (!defined($response)) {
1774 0           $LASTERROR = "IOS TFTP `$params->{'op'}' NOT SUPPORTED - trying old way";
1775 0 0         if ($params->{'family'} == $AF_INET6) {
1776 0           $LASTERROR = "IOS TFTP `$params->{'op'}' old way does not support IPv6";
1777 0           return -1
1778             }
1779 0 0         if ($params->{'op'} eq 'put') {
1780 0           $response = $session->set_request('1.3.6.1.4.1.9.2.1.50.' . $params->{'tftpserver'}, OCTET_STRING, $params->{'file'})
1781             } else {
1782 0           $response = $session->set_request('1.3.6.1.4.1.9.2.1.55.' . $params->{'tftpserver'}, OCTET_STRING, $params->{'file'})
1783             }
1784 0 0         if (defined($response)) {
1785 0           return 0
1786             } else {
1787 0           $LASTERROR = "IOS TFTP `$params->{'op'}' FAILED (new and old)";
1788 0           return -1
1789             }
1790             }
1791             # ccCopySourceFileType [.3] (1 = networkFile, 3 = startupConfig, 4 = runningConfig)
1792             # ccCopyDestFileType [.4] (1 = networkFile, 3 = startupConfig, 4 = runningConfig)
1793 0 0         if ($params->{'op'} eq 'put') {
1794 0           $response = $session->set_request('1.3.6.1.4.1.9.9.96.1.1.1.1.3.' . $instance, INTEGER, 1);
1795 0           $response = $session->set_request('1.3.6.1.4.1.9.9.96.1.1.1.1.4.' . $instance, INTEGER, $params->{'dest'})
1796             } else {
1797 0           $response = $session->set_request('1.3.6.1.4.1.9.9.96.1.1.1.1.3.' . $instance, INTEGER, $params->{'source'});
1798 0           $response = $session->set_request('1.3.6.1.4.1.9.9.96.1.1.1.1.4.' . $instance, INTEGER, 1)
1799             }
1800             # New way
1801             # ccCopyServerAddressType (1 = IPv4, 2 = IPv6)
1802 0 0         $response = $session->set_request('1.3.6.1.4.1.9.9.96.1.1.1.1.15.' . $instance, INTEGER, ($params->{'family'} == AF_INET) ? 1 : 2);
1803              
1804 0 0         if (defined($response)) {
1805             # ccCopyServerAddressRev1
1806 0           $response = $session->set_request('1.3.6.1.4.1.9.9.96.1.1.1.1.16.' . $instance, OCTET_STRING, $params->{'tftpserver'})
1807             } else {
1808             # Deprecated
1809             # ccCopyServerAddress
1810 0 0         if ($params->{'family'} == $AF_INET6) {
1811 0           $LASTERROR = "ccCopyServerAddressRev1 not supported (requried for IPv6)";
1812 0           return -1
1813             }
1814 0           $response = $session->set_request('1.3.6.1.4.1.9.9.96.1.1.1.1.5.' . $instance, IPADDRESS, $params->{'tftpserver'})
1815             }
1816             # ccCopyFileName
1817 0           $response = $session->set_request('1.3.6.1.4.1.9.9.96.1.1.1.1.6.' . $instance, OCTET_STRING, $params->{'file'})
1818             }
1819 0           return 1
1820             }
1821              
1822             sub _get_range {
1823 0     0     my ($opt) = @_;
1824              
1825             # If argument, it must be a number range in the form:
1826             # 1,9-11,7,3-5,15
1827 0 0         if ($opt !~ /^\d+([\,\-]\d+)*$/) {
1828 0           $LASTERROR = "Invalid range format `$opt'";
1829             return(undef)
1830 0           }
1831              
1832 0           my (@option, @temp, @ends);
1833              
1834             # Split the string at the commas first to get: 1 9-11 7 3-5 15
1835 0           @option = split(/,/, $opt);
1836              
1837             # Loop through remaining values for dashes which mean all numbers inclusive.
1838             # Thus, need to expand ranges and put values in array.
1839 0           for $opt (@option) {
1840              
1841             # If value has a dash '-', split and add 'missing' numbers.
1842 0 0         if ($opt =~ /-/) {
1843              
1844             # Ends are start and stop number of range. For example, $opt = 9-11:
1845             # $ends[0] = 9
1846             # $ends[1] = 11
1847 0           @ends = split(/-/, $opt);
1848              
1849 0           for ($ends[0]..$ends[1]) {
1850 0           push @temp, $_
1851             }
1852              
1853             # No dash '-', move on
1854             } else {
1855 0           push @temp, $opt
1856             }
1857             }
1858             # return the sorted values of the temp array
1859 0           @temp = sort { $a <=> $b } (@temp);
  0            
1860             return \@temp
1861 0           }
1862              
1863             sub _snmpgetnext {
1864 0     0     my ($session, $oid) = @_;
1865              
1866 0           my (@oids, @vals);
1867 0           my $base = $oid;
1868 0           my $result = 0;
1869              
1870 0           while (defined($result = $session->get_next_request( -varbindlist => [$oid] ))) {
1871 0           my ($o, $v) = each(%{$result});
  0            
1872 0 0         if (oid_base_match($base, $o)) {
1873 0           push @vals, $v;
1874 0           push @oids, $o;
1875 0           $oid = $o
1876             } else {
1877             last
1878 0           }
1879             }
1880 0 0 0       if ((@oids == 0) && (@vals == 0)) {
1881 0 0         if (defined($result = $session->get_request($oid))) {
1882 0           push @vals, $result->{$oid};
1883 0           push @oids, $oid
1884             } else {
1885             return(undef)
1886 0           }
1887             }
1888 0           return (\@oids, \@vals)
1889             }
1890              
1891             ########################################################
1892             # DNS hostname resolution
1893             # return:
1894             # $host->{name} = host - as passed in
1895             # $host->{host} = host - as passed in without :port
1896             # $host->{port} = OPTIONAL - if :port, then value of port
1897             # $host->{addr} = resolved numeric address
1898             # $host->{family} = AF_INET/6
1899             ############################
1900             sub _resolv {
1901 0     0     my ($name, $family) = @_;
1902              
1903 0           my %h;
1904 0           $h{name} = $name;
1905              
1906             # Default to IPv4 for backward compatiblity
1907             # THIS MAY CHANGE IN THE FUTURE!!!
1908 0 0         if (!defined($family)) {
1909 0           $family = AF_INET
1910             }
1911              
1912             # START - host:port
1913 0           my $cnt = 0;
1914              
1915             # Count ":"
1916 0           $cnt++ while ($name =~ m/:/g);
1917              
1918             # 0 = hostname or IPv4 address
1919 0 0         if ($cnt == 0) {
    0          
    0          
1920 0           $h{host} = $name
1921             # 1 = IPv4 address with port
1922             } elsif ($cnt == 1) {
1923 0           ($h{host}, $h{port}) = split /:/, $name
1924             # >=2 = IPv6 address
1925             } elsif ($cnt >= 2) {
1926             #IPv6 with port - [2001::1]:port
1927 0 0         if ($name =~ /^\[.*\]:\d{1,5}$/) {
1928 0           ($h{host}, $h{port}) = split /:([^:]+)$/, $name # split after last :
1929             # IPv6 without port
1930             } else {
1931 0           $h{host} = $name
1932             }
1933             }
1934              
1935             # Clean up host
1936 0           $h{host} =~ s/\[//g;
1937 0           $h{host} =~ s/\]//g;
1938             # Clean up port
1939 0 0 0       if (defined($h{port}) && (($h{port} !~ /^\d{1,5}$/) || ($h{port} < 1) || ($h{port} > 65535))) {
      0        
1940 0           $LASTERROR = "Invalid port `$h{port}' in `$name'";
1941             return undef
1942 0           }
1943             # END - host:port
1944              
1945             # address check
1946             # new way
1947 0 0         if ($Socket::VERSION >= 1.94) {
1948 0           my %hints = (
1949             family => $AF_UNSPEC,
1950             protocol => IPPROTO_TCP,
1951             flags => $AI_NUMERICHOST
1952             );
1953              
1954             # numeric address, return
1955 0           my ($err, @getaddr) = Socket::getaddrinfo($h{host}, undef, \%hints);
1956 0 0         if (defined($getaddr[0])) {
1957 0           $h{addr} = $h{host};
1958 0           $h{family} = $getaddr[0]->{family};
1959 0           return \%h
1960             }
1961             # old way
1962             } else {
1963             # numeric address, return
1964 0           my $ret = gethostbyname($h{host});
1965 0 0 0       if (defined($ret) && (inet_ntoa($ret) eq $h{host})) {
1966 0           $h{addr} = $h{host};
1967 0           $h{family} = AF_INET;
1968 0           return \%h
1969             }
1970             }
1971              
1972             # resolve
1973             # new way
1974 0 0         if ($Socket::VERSION >= 1.94) {
1975 0           my %hints = (
1976             family => $family,
1977             protocol => IPPROTO_TCP
1978             );
1979              
1980 0           my ($err, @getaddr) = Socket::getaddrinfo($h{host}, undef, \%hints);
1981 0 0         if (defined($getaddr[0])) {
1982 0           my ($err, $address) = Socket::getnameinfo($getaddr[0]->{addr}, $NI_NUMERICHOST);
1983 0 0         if (defined($address)) {
1984 0           $h{addr} = $address;
1985 0           $h{addr} =~ s/\%(.)*$//; # remove %ifID if IPv6
1986 0           $h{family} = $getaddr[0]->{family};
1987 0           return \%h
1988             } else {
1989 0           $LASTERROR = "getnameinfo($getaddr[0]->{addr}) failed - $err";
1990             return undef
1991 0           }
1992             } else {
1993 0 0         $LASTERROR = sprintf "getaddrinfo($h{host},,%s) failed - $err", ($family == AF_INET) ? "AF_INET" : "AF_INET6";
1994             return undef
1995 0           }
1996             # old way
1997             } else {
1998 0 0         if ($family == $AF_INET6) {
1999 0           $LASTERROR = "Socket >= 1.94 required for IPv6 - found Socket $Socket::VERSION";
2000             return undef
2001 0           }
2002              
2003 0           my @gethost = gethostbyname($h{host});
2004 0 0         if (defined($gethost[4])) {
2005 0           $h{addr} = inet_ntoa($gethost[4]);
2006 0           $h{family} = AF_INET;
2007 0           return \%h
2008             } else {
2009 0           $LASTERROR = "gethostbyname($h{host}) failed - $^E";
2010             return undef
2011 0           }
2012             }
2013             }
2014              
2015             ########################################################
2016             # End Private subs
2017             ########################################################
2018              
2019             1;
2020              
2021             __END__