File Coverage

blib/lib/Cisco/SNMP.pm
Criterion Covered Total %
statement 33 189 17.4
branch 0 72 0.0
condition 0 20 0.0
subroutine 11 21 52.3
pod 4 4 100.0
total 48 306 15.6


line stmt bran cond sub pod time code
1             package Cisco::SNMP;
2              
3             ##################################################
4             # AUTHOR = Michael Vincent
5             # www.VinsWorld.com
6             ##################################################
7              
8 13     13   71 use strict;
  13         27  
  13         549  
9 13     13   63 use warnings;
  13         25  
  13         541  
10              
11 13     13   7430 use version;
  13         24076  
  13         76  
12             our $VERSION = '1.02';
13              
14 13     13   2054 use Net::SNMP qw(:asn1 :snmp);
  13         99244  
  13         4383  
15              
16 13     13   7867 use Sys::Hostname;
  13         14923  
  13         886  
17 13     13   8903 use Socket qw(inet_ntoa AF_INET IPPROTO_TCP);
  13         49743  
  13         10114  
18              
19             my $AF_INET6 = eval { Socket::AF_INET6() };
20             my $AF_UNSPEC = eval { Socket::AF_UNSPEC() };
21             my $AI_NUMERICHOST = eval { Socket::AI_NUMERICHOST() };
22             my $NI_NUMERICHOST = eval { Socket::NI_NUMERICHOST() };
23              
24             our $LASTERROR;
25              
26             ##################################################
27             # Start Public Module
28             ##################################################
29              
30             sub new {
31 0     0 1 0 my $self = shift;
32 0   0     0 my $class = ref($self) || $self;
33              
34 0         0 my $family;
35 0         0 my %params = (
36             version => 1,
37             port => SNMP_PORT,
38             timeout => 5
39             );
40              
41 0         0 my %args;
42 0 0       0 if (@_ == 1) {
43 0         0 ($params{hostname}) = @_
44             } else {
45 0         0 %args = @_;
46 0         0 for (keys(%args)) {
47 0 0       0 if (/^-?family$/i) {
48 0 0       0 if ($args{$_} =~ /^(?:(?:(:?ip)?v?(?:4|6))|${\AF_INET}|$AF_INET6)$/) {
  0         0  
49 0 0       0 if ($args{$_} =~ /^(?:(?:(:?ip)?v?4)|${\AF_INET})$/) {
  0         0  
50 0         0 $params{domain} = 'udp';
51 0         0 $family = AF_INET
52             } else {
53 0         0 $params{domain} = 'udp6';
54 0         0 $family = $AF_INET6
55             }
56             } else {
57 0         0 $LASTERROR = "Invalid family `$args{$_}'";
58             return undef
59 0         0 }
60             # pass through
61             } else {
62 0         0 $params{$_} = $args{$_}
63             }
64             }
65             }
66              
67             # set default community string if not provided and SNMP version 1 or 2
68 0 0 0     0 if (($params{version} =~ /[1,2]/) && !defined $params{community}) {
69 0         0 $params{community} = 'private'
70             }
71              
72             # hostname must be defined
73 0 0       0 if (!defined $params{hostname}) {
74 0         0 $params{hostname} = hostname
75             }
76              
77             # resolve hostname our way
78 0 0       0 if (defined(my $ret = _resolv($params{hostname}, $family))) {
79 0         0 $params{hostname} = $ret->{addr};
80 0         0 $family = $ret->{family};
81 0 0       0 if ($family == AF_INET) {
82 0         0 $params{domain} = 'udp'
83             } else {
84 0         0 $params{domain} = 'udp6'
85             }
86             } else {
87             return undef
88 0         0 }
89              
90 0         0 my ($session, $error) = Net::SNMP->session(%params);
91              
92 0 0       0 if (!defined $session) {
93 0         0 $LASTERROR = "Error creating Net::SNMP object: $error";
94             return undef
95 0         0 }
96              
97 0         0 return bless {
98             %params, # merge user parameters
99             'family' => $family,
100             '_SESSION_' => $session
101             }, $class
102             }
103              
104             ### WARNINGS - use of Cisco::SNMP directly
105             # our $LOADED = 0;
106             # sub import {
107             # shift;
108             # if ((@_ == 0) && ($LOADED == 0) && ((caller(1))[3] eq 'main::BEGIN')) {
109             # my $warn = sprintf
110             # "\n" .
111             # "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\n" .
112             # "'use Cisco::SNMP;' directly is deprecated.\n" .
113             # "Instead, use the relevent sub module:\n" .
114             # "'use Cisco::SNMP::;'\n" .
115             # "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\n";
116             # warnings::warnif($warn)
117             # }
118             # $LOADED++;
119             # my @l = @_ ? @_ : qw(Config ARP Config CPU Entity Image Interface IP Line Memory Password ProxyPing Sensor System);
120             # eval join("", map { "require Cisco::SNMP::" . (/(\w+)/)[0] . ";\n" } @l) or die "Error - $@";
121             # }
122              
123             sub session {
124 0     0 1 0 my $self = shift;
125             return $self->{_SESSION_}
126 0         0 }
127              
128             sub close {
129 0     0 1 0 my $self = shift;
130             $self->{_SESSION_}->close()
131 0         0 }
132              
133             sub error {
134 0     0 1 0 my $self = shift;
135            
136 0         0 my $e = $LASTERROR;
137 0         0 undef $LASTERROR;
138 0         0 return $e
139             }
140              
141 13     13   109 no strict 'refs';
  13         24  
  13         6372  
142             sub _mk_accessors_array_1 {
143 63     63   64 my ($TYPE, $NAME) = @_;
144 63         375 *{$TYPE . $NAME} = sub {
145 0     0   0 my $self = shift;
146 0         0 my ($idx) = @_;
147              
148 0 0       0 if (!defined $idx) {
    0          
149 0         0 $idx = 0
150             } elsif ($idx !~ /^\d+$/) {
151 0         0 $Cisco::SNMP::LASTERROR = "Invalid $TYPE index `$idx'";
152             return undef
153 0         0 }
154 0         0 return $self->[$idx]->{$NAME}
155             }
156 63         172 }
157              
158             sub _mk_accessors_hash_1 {
159 54     54   73 my ($TYPE, $NAME) = @_;
160 54         332 *{$TYPE . $NAME} = sub {
161 0     0   0 my $self = shift;
162 0         0 my ($idx) = @_;
163              
164 0 0       0 if (!defined $idx) {
    0          
165 0         0 $idx = 0
166             } elsif ($idx !~ /^\d+$/) {
167 0         0 $Cisco::SNMP::LASTERROR = "Invalid $TYPE index `$idx'";
168             return undef
169 0         0 }
170 0         0 return $self->{$idx}->{$NAME}
171             }
172 54         163 }
173              
174             sub _mk_accessors_hash_2 {
175 12     12   20 my ($TYPE1, $TYPE2, $NAME) = @_;
176 12         77 *{$TYPE2 . $NAME} = sub {
177 0     0     my $self = shift;
178 0           my ($idx1, $idx2) = @_;
179              
180 0 0         if (!defined $idx2) {
    0          
    0          
181 0   0       $idx1 = $idx1 || 0;
182 0           $idx2 = 0
183             } elsif ($idx1 !~ /^\d+$/) {
184 0           $Cisco::SNMP::LASTERROR = "Invalid $TYPE1 index `$idx1'";
185             return undef
186 0           } elsif ($idx2 !~ /^\d+$/) {
187 0           $Cisco::SNMP::LASTERROR = "Invalid $TYPE2 index `$idx2'";
188             return undef
189 0           }
190 0           return $self->{$idx1}->[$idx2]->{$NAME}
191             }
192 12         43 }
193              
194 13     13   94 use strict 'refs';
  13         36  
  13         15942  
195              
196             ##################################################
197             # End Public Module
198             ##################################################
199              
200             ##################################################
201             # Start Private subs
202             ##################################################
203              
204             sub _get_range {
205 0     0     my ($opt) = @_;
206              
207             # If argument, it must be a number range in the form:
208             # 1,9-11,7,3-5,15
209 0 0         if ($opt !~ /^\d+([\,\-]\d+)*$/) {
210 0           $LASTERROR = "Invalid range format `$opt'";
211             return undef
212 0           }
213              
214 0           my (@option, @temp, @ends);
215              
216             # Split the string at the commas first to get: 1 9-11 7 3-5 15
217 0           @option = split(/,/, $opt);
218              
219             # Loop through remaining values for dashes which mean all numbers inclusive.
220             # Thus, need to expand ranges and put values in array.
221 0           for $opt (@option) {
222              
223             # If value has a dash '-', split and add 'missing' numbers.
224 0 0         if ($opt =~ /-/) {
225              
226             # Ends are start and stop number of range. For example, $opt = 9-11:
227             # $ends[0] = 9
228             # $ends[1] = 11
229 0           @ends = split(/-/, $opt);
230              
231 0           for ($ends[0]..$ends[1]) {
232 0           push @temp, $_
233             }
234              
235             # No dash '-', move on
236             } else {
237 0           push @temp, $opt
238             }
239             }
240             # return the sorted values of the temp array
241 0           @temp = sort { $a <=> $b } (@temp);
  0            
242             return \@temp
243 0           }
244              
245             sub _snmpwalk {
246 0     0     my ($session, $oid) = @_;
247              
248 0           my (@oids, @vals);
249 0           my $base = $oid;
250 0           my $result = 0;
251              
252 0           while (defined($result = $session->get_next_request(varbindlist => [$oid]))) {
253 0           my ($o, $v) = each(%{$result});
  0            
254 0 0         if (oid_base_match($base, $o)) {
255 0           push @vals, $v;
256 0           push @oids, $o;
257 0           $oid = $o
258             } else {
259             last
260 0           }
261             }
262 0 0 0       if ((@oids == 0) && (@vals == 0)) {
263 0 0         if (defined($result = $session->get_request($oid))) {
264 0           push @vals, $result->{$oid};
265 0           push @oids, $oid
266             } else {
267             return undef
268 0           }
269             }
270 0           return (\@oids, \@vals)
271             }
272              
273             ##################################################
274             # DNS hostname resolution
275             # return:
276             # $host->{name} = host - as passed in
277             # $host->{host} = host - as passed in without :port
278             # $host->{port} = OPTIONAL - if :port, then value of port
279             # $host->{addr} = resolved numeric address
280             # $host->{family} = AF_INET/6
281             ############################
282             sub _resolv {
283 0     0     my ($name, $family) = @_;
284              
285 0           my %h;
286 0           $h{name} = $name;
287              
288             # Default to IPv4 for backward compatiblity
289             # THIS MAY CHANGE IN THE FUTURE!!!
290 0 0         if (!defined $family) {
291 0           $family = AF_INET
292             }
293              
294             # START - host:port
295 0           my $cnt = 0;
296              
297             # Count ":"
298 0           $cnt++ while ($name =~ m/:/g);
299              
300             # 0 = hostname or IPv4 address
301 0 0         if ($cnt == 0) {
    0          
    0          
302 0           $h{host} = $name
303             # 1 = IPv4 address with port
304             } elsif ($cnt == 1) {
305 0           ($h{host}, $h{port}) = split /:/, $name
306             # >=2 = IPv6 address
307             } elsif ($cnt >= 2) {
308             #IPv6 with port - [2001::1]:port
309 0 0         if ($name =~ /^\[.*\]:\d{1,5}$/) {
310 0           ($h{host}, $h{port}) = split /:([^:]+)$/, $name # split after last :
311             # IPv6 without port
312             } else {
313 0           $h{host} = $name
314             }
315             }
316              
317             # Clean up host
318 0           $h{host} =~ s/\[//g;
319 0           $h{host} =~ s/\]//g;
320             # Clean up port
321 0 0 0       if (defined $h{port} && (($h{port} !~ /^\d{1,5}$/) || ($h{port} < 1) || ($h{port} > 65535))) {
      0        
322 0           $LASTERROR = "Invalid port `$h{port}' in `$name'";
323             return undef
324 0           }
325             # END - host:port
326              
327             # address check
328             # new way
329 0 0         if (version->parse($Socket::VERSION) >= version->parse(1.94)) {
330 0           my %hints = (
331             family => $AF_UNSPEC,
332             protocol => IPPROTO_TCP,
333             flags => $AI_NUMERICHOST
334             );
335              
336             # numeric address, return
337 0           my ($err, @getaddr) = Socket::getaddrinfo($h{host}, undef, \%hints);
338 0 0         if (defined $getaddr[0]) {
339 0           $h{addr} = $h{host};
340 0           $h{family} = $getaddr[0]->{family};
341 0           return \%h
342             }
343             # old way
344             } else {
345             # numeric address, return
346 0           my $ret = gethostbyname($h{host});
347 0 0 0       if (defined $ret && (inet_ntoa($ret) eq $h{host})) {
348 0           $h{addr} = $h{host};
349 0           $h{family} = AF_INET;
350 0           return \%h
351             }
352             }
353              
354             # resolve
355             # new way
356 0 0         if (version->parse($Socket::VERSION) >= version->parse(1.94)) {
357 0           my %hints = (
358             family => $family,
359             protocol => IPPROTO_TCP
360             );
361              
362 0           my ($err, @getaddr) = Socket::getaddrinfo($h{host}, undef, \%hints);
363 0 0         if (defined $getaddr[0]) {
364 0           my ($err, $address) = Socket::getnameinfo($getaddr[0]->{addr}, $NI_NUMERICHOST);
365 0 0         if (defined $address) {
366 0           $h{addr} = $address;
367 0           $h{addr} =~ s/\%(.)*$//; # remove %ifID if IPv6
368 0           $h{family} = $getaddr[0]->{family};
369 0           return \%h
370             } else {
371 0           $LASTERROR = "getnameinfo($getaddr[0]->{addr}) failed - $err";
372             return undef
373 0           }
374             } else {
375 0 0         $LASTERROR = sprintf "getaddrinfo($h{host},,%s) failed - $err", ($family == AF_INET) ? "AF_INET" : "AF_INET6";
376             return undef
377 0           }
378             # old way
379             } else {
380 0 0         if ($family == $AF_INET6) {
381 0           $LASTERROR = "Socket >= 1.94 required for IPv6 - found Socket $Socket::VERSION";
382             return undef
383 0           }
384              
385 0           my @gethost = gethostbyname($h{host});
386 0 0         if (defined $gethost[4]) {
387 0           $h{addr} = inet_ntoa($gethost[4]);
388 0           $h{family} = AF_INET;
389 0           return \%h
390             } else {
391 0           $LASTERROR = "gethostbyname($h{host}) failed - $^E";
392             return undef
393 0           }
394             }
395             }
396              
397             ##################################################
398             # End Private subs
399             ##################################################
400              
401             1;
402              
403             __END__