File Coverage

blib/lib/Net/SNMPTrapd.pm
Criterion Covered Total %
statement 27 246 10.9
branch 0 108 0.0
condition 0 39 0.0
subroutine 9 32 28.1
pod 21 21 100.0
total 57 446 12.7


line stmt bran cond sub pod time code
1             package Net::SNMPTrapd;
2              
3             ########################################################
4             # AUTHOR = Michael Vincent
5             # www.VinsWorld.com
6             ########################################################
7              
8 1     1   9195 use strict;
  1         2  
  1         42  
9 1     1   4 use warnings;
  1         1  
  1         22  
10 1     1   376 use Convert::ASN1;
  1         24380  
  1         41  
11 1     1   6 use Socket qw(inet_ntoa AF_INET IPPROTO_TCP);
  1         1  
  1         194  
12              
13             my $AF_INET6 = eval { Socket::AF_INET6() };
14             my $NI_NUMERICHOST = eval { Socket::NI_NUMERICHOST() };
15              
16             our $VERSION = '0.15';
17             our @ISA;
18              
19             my $HAVE_IO_Socket_IP = 0;
20 1     1   475 eval "use IO::Socket::IP -register";
  1         21120  
  1         6  
21             if(!$@) {
22             $HAVE_IO_Socket_IP = 1;
23             push @ISA, "IO::Socket::IP"
24             } else {
25             require IO::Socket::INET;
26             push @ISA, "IO::Socket::INET";
27             }
28              
29             ########################################################
30             # Start Variables
31             ########################################################
32 1     1   4 use constant SNMPTRAPD_DEFAULT_PORT => 162;
  1         1  
  1         49  
33 1     1   3 use constant SNMPTRAPD_RFC_SIZE => 484; # RFC limit
  1         1  
  1         29  
34 1     1   3 use constant SNMPTRAPD_REC_SIZE => 1472; # Recommended size
  1         1  
  1         27  
35 1     1   3 use constant SNMPTRAPD_MAX_SIZE => 65467; # Actual limit (65535 - IP/UDP)
  1         1  
  1         1725  
36              
37             my @TRAPTYPES = qw(COLDSTART WARMSTART LINKDOWN LINKUP AUTHFAIL EGPNEIGHBORLOSS ENTERPRISESPECIFIC);
38             my @PDUTYPES = qw(GetRequest GetNextRequest Response SetRequest Trap GetBulkRequest InformRequest SNMPv2-Trap Report);
39             our $LASTERROR;
40              
41             my $asn = Convert::ASN1->new;
42             $asn->prepare("
43             PDU ::= SEQUENCE {
44             version INTEGER,
45             community STRING,
46             pdu_type PDUs
47             }
48             PDUs ::= CHOICE {
49             response Response_PDU,
50             trap Trap_PDU,
51             inform_request InformRequest_PDU,
52             snmpv2_trap SNMPv2_Trap_PDU
53             }
54             Response_PDU ::= [2] IMPLICIT PDUv2
55             Trap_PDU ::= [4] IMPLICIT PDUv1
56             InformRequest_PDU ::= [6] IMPLICIT PDUv2
57             SNMPv2_Trap_PDU ::= [7] IMPLICIT PDUv2
58              
59             IPAddress ::= [APPLICATION 0] STRING
60             Counter32 ::= [APPLICATION 1] INTEGER
61             Guage32 ::= [APPLICATION 2] INTEGER
62             TimeTicks ::= [APPLICATION 3] INTEGER
63             Opaque ::= [APPLICATION 4] STRING
64             Counter64 ::= [APPLICATION 6] INTEGER
65              
66             PDUv1 ::= SEQUENCE {
67             ent_oid OBJECT IDENTIFIER,
68             agent_addr IPAddress,
69             generic_trap INTEGER,
70             specific_trap INTEGER,
71             timeticks TimeTicks,
72             varbindlist VARBINDS
73             }
74             PDUv2 ::= SEQUENCE {
75             request_id INTEGER,
76             error_status INTEGER,
77             error_index INTEGER,
78             varbindlist VARBINDS
79             }
80             VARBINDS ::= SEQUENCE OF SEQUENCE {
81             oid OBJECT IDENTIFIER,
82             value CHOICE {
83             integer INTEGER,
84             string STRING,
85             oid OBJECT IDENTIFIER,
86             ipaddr IPAddress,
87             counter32 Counter32,
88             guage32 Guage32,
89             timeticks TimeTicks,
90             opaque Opaque,
91             counter64 Counter64,
92             null NULL
93             }
94             }
95             ");
96             my $snmpasn = $asn->find('PDU');
97              
98             ########################################################
99             # End Variables
100             ########################################################
101              
102             ########################################################
103             # Start Public Module
104             ########################################################
105              
106             sub new {
107 0     0 1   my $self = shift;
108 0   0       my $class = ref($self) || $self;
109              
110             # Default parameters
111 0           my %params = (
112             'Proto' => 'udp',
113             'LocalPort' => SNMPTRAPD_DEFAULT_PORT,
114             'Timeout' => 10,
115             'Family' => AF_INET
116             );
117              
118 0 0         if (@_ == 1) {
119 0           $LASTERROR = "Insufficient number of args - @_";
120             return undef
121 0           } else {
122 0           my %cfg = @_;
123 0           for (keys(%cfg)) {
124 0 0         if (/^-?localport$/i) {
    0          
    0          
    0          
125 0           $params{LocalPort} = $cfg{$_}
126             } elsif (/^-?localaddr$/i) {
127 0           $params{LocalAddr} = $cfg{$_}
128             } elsif (/^-?family$/i) {
129 0 0         if ($cfg{$_} =~ /^(?:(?:(:?ip)?v?(?:4|6))|${\AF_INET}|$AF_INET6)$/) {
  0            
130 0 0         if ($cfg{$_} =~ /^(?:(?:(:?ip)?v?4)|${\AF_INET})$/) {
  0            
131 0           $params{Family} = AF_INET
132             } else {
133 0 0         if (!$HAVE_IO_Socket_IP) {
134 0           $LASTERROR = "IO::Socket::IP required for IPv6";
135             return undef
136 0           }
137 0           $params{Family} = $AF_INET6;
138 0 0         if ($^O ne 'MSWin32') {
139 0           $params{V6Only} = 1
140             }
141             }
142             } else {
143 0           $LASTERROR = "Invalid family - $cfg{$_}";
144             return undef
145 0           }
146             } elsif (/^-?timeout$/i) {
147 0 0         if ($cfg{$_} =~ /^\d+$/) {
148 0           $params{Timeout} = $cfg{$_}
149             } else {
150 0           $LASTERROR = "Invalid timeout - $cfg{$_}";
151             return undef
152 0           }
153             # pass through
154             } else {
155 0           $params{$_} = $cfg{$_}
156             }
157             }
158             }
159              
160 0 0         if (my $udpserver = $class->SUPER::new(%params)) {
161 0           return bless {
162             %params, # merge user parameters
163             '_UDPSERVER_' => $udpserver
164             }, $class
165             } else {
166 0           $LASTERROR = "Error opening socket for listener: $@";
167             return undef
168 0           }
169             }
170              
171             sub get_trap {
172 0     0 1   my $self = shift;
173 0   0       my $class = ref($self) || $self;
174              
175 0           my $trap;
176              
177 0           foreach my $key (keys(%{$self})) {
  0            
178             # everything but '_xxx_'
179 0 0         $key =~ /^\_.+\_$/ and next;
180 0           $trap->{$key} = $self->{$key}
181             }
182              
183 0           my $datagramsize = SNMPTRAPD_MAX_SIZE;
184 0 0         if (@_ == 1) {
185 0           $LASTERROR = "Insufficient number of args: @_";
186             return undef
187 0           } else {
188 0           my %args = @_;
189 0           for (keys(%args)) {
190             # -maxsize
191 0 0         if (/^-?(?:max)?size$/i) {
    0          
192 0 0         if ($args{$_} =~ /^\d+$/) {
    0          
    0          
193 0 0 0       if (($args{$_} >= 1) && ($args{$_} <= SNMPTRAPD_MAX_SIZE)) {
194 0           $datagramsize = $args{$_}
195             }
196             } elsif ($args{$_} =~ /^rfc$/i) {
197 0           $datagramsize = SNMPTRAPD_RFC_SIZE
198             } elsif ($args{$_} =~ /^rec(?:ommend)?(?:ed)?$/i) {
199 0           $datagramsize = SNMPTRAPD_REC_SIZE
200             } else {
201 0           $LASTERROR = "Not a valid size: $args{$_}";
202             return undef
203 0           }
204             # -timeout
205             } elsif (/^-?timeout$/i) {
206 0 0         if ($args{$_} =~ /^\d+$/) {
207 0           $trap->{Timeout} = $args{$_}
208             } else {
209 0           $LASTERROR = "Invalid timeout - $args{$_}";
210             return undef
211 0           }
212             }
213             }
214             }
215              
216 0           my $Timeout = $trap->{Timeout};
217 0           my $udpserver = $self->{_UDPSERVER_};
218 0           my $datagram;
219              
220 0 0         if ($Timeout != 0) {
221             # vars for IO select
222 0           my ($rin, $rout, $ein, $eout) = ('', '', '', '');
223 0           vec($rin, fileno($udpserver), 1) = 1;
224              
225             # check if a message is waiting
226 0 0         if (! select($rout=$rin, undef, $eout=$ein, $Timeout)) {
227 0           $LASTERROR = "Timed out waiting for datagram";
228 0           return(0)
229             }
230             }
231              
232             # read the message
233 0 0         if ($udpserver->recv($datagram, $datagramsize)) {
234              
235 0           $trap->{_UDPSERVER_} = $udpserver;
236 0           $trap->{_TRAP_}{PeerPort} = $udpserver->SUPER::peerport;
237 0           $trap->{_TRAP_}{PeerAddr} = $udpserver->SUPER::peerhost;
238 0           $trap->{_TRAP_}{datagram} = $datagram;
239              
240 0           return bless $trap, $class
241             }
242              
243 0           $LASTERROR = sprintf "Socket RECV error: $!";
244             return undef
245 0           }
246              
247             sub process_trap {
248 0     0 1   my $self = shift;
249 0   0       my $class = ref($self) || $self;
250              
251             ### Allow to be called as subroutine
252             # Net::SNMPTrapd->process_trap($data)
253 0 0 0       if (($self eq $class) && ($class eq __PACKAGE__)) {
254 0           my %th;
255 0           $self = \%th;
256 0           ($self->{_TRAP_}{datagram}) = @_
257             }
258             # Net::SNMPTrapd::process_trap($data)
259 0 0         if ($class ne __PACKAGE__) {
260 0           my %th;
261 0           $self = \%th;
262 0           ($self->{_TRAP_}{datagram}) = $class;
263 0           $class = __PACKAGE__
264             }
265              
266 0           my $RESPONSE = 1; # Default is to send Response PDU for InformRequest
267             # If more than 1 argument, parse the options
268 0 0         if (@_ != 1) {
269 0           my %args = @_;
270 0           for (keys(%args)) {
271             # -datagram
272 0 0 0       if ((/^-?data(?:gram)?$/i) || (/^-?pdu$/i)) {
    0          
273 0           $self->{_TRAP_}{datagram} = $args{$_}
274             # -noresponse
275             } elsif (/^-?noresponse$/i) {
276 0 0 0       if (($args{$_} =~ /^\d+$/) && ($args{$_} > 0)) {
277 0           $RESPONSE = 0
278             }
279             }
280             }
281             }
282              
283 0           my $trap;
284 0 0         if (!defined($trap = $snmpasn->decode($self->{_TRAP_}{datagram}))) {
285 0 0         $LASTERROR = sprintf "Error decoding PDU - %s", (defined($snmpasn->error) ? $snmpasn->error : "Unknown Convert::ASN1->decode() error. Consider $class dump()");
286             return undef
287 0           }
288             #DEBUG: use Data::Dumper; print Dumper \$trap;
289              
290             # Only understand SNMPv1 (0) and v2c (1)
291 0 0         if ($trap->{version} > 1) {
292 0           $LASTERROR = sprintf "Unrecognized SNMP version - %i", $trap->{version};
293             return undef
294 0           }
295              
296             # set PDU Type for later use
297 0           my $pdutype = sprintf "%s", keys(%{$trap->{pdu_type}});
  0            
298              
299             ### Assemble decoded trap object
300             # Common
301 0           $self->{_TRAP_}{version} = $trap->{version};
302 0           $self->{_TRAP_}{community} = $trap->{community};
303 0 0         if ($pdutype eq 'trap') {
    0          
    0          
304 0           $self->{_TRAP_}{pdu_type} = 4
305            
306             } elsif ($pdutype eq 'inform_request') {
307 0           $self->{_TRAP_}{pdu_type} = 6;
308              
309             # send response for InformRequest
310 0 0         if ($RESPONSE) {
311 0 0         if ((my $r = _InformRequest_Response(\$self, $trap, $pdutype)) ne 'OK') {
312 0           $LASTERROR = sprintf "Error sending InformRequest Response - %s", $r;
313             return undef
314 0           }
315             }
316              
317             } elsif ($pdutype eq 'snmpv2_trap') {
318 0           $self->{_TRAP_}{pdu_type} = 7
319             }
320              
321             # v1
322 0 0         if ($trap->{version} == 0) {
    0          
323 0           $self->{_TRAP_}{ent_oid} = $trap->{pdu_type}->{$pdutype}->{ent_oid};
324 0           $self->{_TRAP_}{agent_addr} = _inetNtoa($trap->{pdu_type}->{$pdutype}->{agent_addr});
325 0           $self->{_TRAP_}{generic_trap} = $trap->{pdu_type}->{$pdutype}->{generic_trap};
326 0           $self->{_TRAP_}{specific_trap} = $trap->{pdu_type}->{$pdutype}->{specific_trap};
327 0           $self->{_TRAP_}{timeticks} = $trap->{pdu_type}->{$pdutype}->{timeticks};
328              
329             # v2c
330             } elsif ($trap->{version} == 1) {
331 0           $self->{_TRAP_}{request_id} = $trap->{pdu_type}->{$pdutype}->{request_id};
332 0           $self->{_TRAP_}{error_status} = $trap->{pdu_type}->{$pdutype}->{error_status};
333 0           $self->{_TRAP_}{error_index} = $trap->{pdu_type}->{$pdutype}->{error_index};
334             }
335              
336             # varbinds
337 0           my @varbinds;
338 0           for my $i (0..$#{$trap->{pdu_type}->{$pdutype}->{varbindlist}}) {
  0            
339 0           my %oidval;
340 0           for (keys(%{$trap->{pdu_type}->{$pdutype}->{varbindlist}[$i]->{value}})) {
  0            
341             # defined
342 0 0         if (defined($trap->{pdu_type}->{$pdutype}->{varbindlist}[$i]->{value}{$_})) {
343             # special cases: IP address, null
344 0 0         if ($_ eq 'ipaddr') {
    0          
345 0           $oidval{$trap->{pdu_type}->{$pdutype}->{varbindlist}[$i]->{oid}} = _inetNtoa($trap->{pdu_type}->{$pdutype}->{varbindlist}[$i]->{value}{$_})
346             } elsif ($_ eq 'null') {
347 0           $oidval{$trap->{pdu_type}->{$pdutype}->{varbindlist}[$i]->{oid}} = '(NULL)'
348             # no special case: just assign it
349             } else {
350 0           $oidval{$trap->{pdu_type}->{$pdutype}->{varbindlist}[$i]->{oid}} = $trap->{pdu_type}->{$pdutype}->{varbindlist}[$i]->{value}{$_}
351             }
352             # not defined - ""
353             } else {
354 0           $oidval{$trap->{pdu_type}->{$pdutype}->{varbindlist}[$i]->{oid}} = ""
355             }
356             }
357 0           push @varbinds, \%oidval
358             }
359 0           $self->{_TRAP_}{varbinds} = \@varbinds;
360              
361 0           return bless $self, $class
362             }
363              
364             sub server {
365 0     0 1   my $self = shift;
366 0           return $self->{_UDPSERVER_}
367             }
368              
369             sub datagram {
370 0     0 1   my ($self, $arg) = @_;
371              
372 0 0 0       if (defined($arg) && ($arg >= 1)) {
373 0           return unpack ('H*', $self->{_TRAP_}{datagram})
374             } else {
375 0           return $self->{_TRAP_}{datagram}
376             }
377             }
378              
379             sub remoteaddr {
380 0     0 1   my $self = shift;
381 0           return $self->{_TRAP_}{PeerAddr}
382             }
383              
384             sub remoteport {
385 0     0 1   my $self = shift;
386 0           return $self->{_TRAP_}{PeerPort}
387             }
388              
389             sub version {
390 0     0 1   my $self = shift;
391 0           return $self->{_TRAP_}{version} + 1
392             }
393              
394             sub community {
395 0     0 1   my $self = shift;
396 0           return $self->{_TRAP_}{community}
397             }
398              
399             sub pdu_type {
400 0     0 1   my ($self, $arg) = @_;
401              
402 0 0 0       if (defined($arg) && ($arg >= 1)) {
403 0           return $self->{_TRAP_}{pdu_type}
404             } else {
405 0           return $PDUTYPES[$self->{_TRAP_}{pdu_type}]
406             }
407             }
408              
409             sub ent_OID {
410 0     0 1   my $self = shift;
411 0           return $self->{_TRAP_}{ent_oid}
412             }
413              
414             sub agentaddr {
415 0     0 1   my $self = shift;
416 0           return $self->{_TRAP_}{agent_addr}
417             }
418              
419             sub generic_trap {
420 0     0 1   my ($self, $arg) = @_;
421              
422 0 0 0       if (defined($arg) && ($arg >= 1)) {
423 0           return $self->{_TRAP_}{generic_trap}
424             } else {
425 0           return $TRAPTYPES[$self->{_TRAP_}{generic_trap}]
426             }
427             }
428              
429             sub specific_trap {
430 0     0 1   my $self = shift;
431 0           return $self->{_TRAP_}{specific_trap}
432             }
433              
434             sub timeticks {
435 0     0 1   my $self = shift;
436 0           return $self->{_TRAP_}{timeticks}
437             }
438              
439             sub request_ID {
440 0     0 1   my $self = shift;
441 0           return $self->{_TRAP_}{request_id}
442             }
443              
444             sub error_status {
445 0     0 1   my $self = shift;
446 0           return $self->{_TRAP_}{error_status}
447             }
448              
449             sub error_index {
450 0     0 1   my $self = shift;
451 0           return $self->{_TRAP_}{error_index}
452             }
453              
454             sub varbinds {
455 0     0 1   my $self = shift;
456 0           return $self->{_TRAP_}{varbinds}
457             }
458              
459             sub error {
460 0     0 1   return($LASTERROR)
461             }
462              
463             sub dump {
464 0     0 1   my $self = shift;
465 0   0       my $class = ref($self) || $self;
466              
467             ### Allow to be called as subroutine
468             # Net::SNMPTrapd->dump($datagram)
469 0 0 0       if (($self eq $class) && ($class eq __PACKAGE__)) {
470 0           my %th;
471 0           $self = \%th;
472 0           ($self->{_TRAP_}{datagram}) = @_
473             }
474             # Net::SNMPTrapd::dump($datagram)
475 0 0         if ($class ne __PACKAGE__) {
476 0           my %th;
477 0           $self = \%th;
478 0           ($self->{_TRAP_}{datagram}) = $class;
479 0           $class = __PACKAGE__
480             }
481              
482 0 0         if (defined($self->{_TRAP_}{datagram})) {
483 0           Convert::ASN1::asn_dump($self->{_TRAP_}{datagram});
484 0           Convert::ASN1::asn_hexdump($self->{_TRAP_}{datagram});
485             } else {
486 0           $LASTERROR = "Missing datagram to dump";
487             return undef
488 0           }
489              
490 0           return 1
491             }
492              
493             ########################################################
494             # End Public Module
495             ########################################################
496              
497             ########################################################
498             # Start Private subs
499             ########################################################
500              
501             sub _InformRequest_Response {
502              
503 0     0     my ($self, $trap, $pdutype) = @_;
504 0   0       my $class = ref($$self) || $$self;
505              
506             #DEBUG print "BUFFER = $buffer\n";
507 0 0         if (!defined $$self->{_UDPSERVER_}) {
508 0           return "Server not defined"
509             }
510              
511             # Change from request to response
512 0           $trap->{pdu_type}{response} = delete $trap->{pdu_type}{inform_request};
513 0           my $buffer = $snmpasn->encode($trap);
514 0 0         if (!defined($buffer)) {
515 0           return $snmpasn->error
516             }
517              
518             # send Inform response
519 0           my $socket = $$self->{_UDPSERVER_};
520 0           $socket->send($buffer);
521              
522             # Change back to request from response
523 0           $trap->{pdu_type}{inform_request} = delete $trap->{pdu_type}{response};
524 0           return "OK"
525             }
526              
527             sub _inetNtoa {
528 0     0     my ($addr) = @_;
529              
530 0 0         if ($Socket::VERSION >= 1.94) {
531 0           my $name;
532 0 0         if (length($addr) == 4) {
533 0           $name = Socket::pack_sockaddr_in(0, $addr)
534             } else {
535 0           $name = Socket::pack_sockaddr_in6(0, $addr)
536             }
537 0           my ($err, $address) = Socket::getnameinfo($name, $NI_NUMERICHOST);
538 0 0         if (defined($address)) {
539 0           return $address
540             } else {
541 0           $LASTERROR = "getnameinfo($addr) failed - $err";
542             return undef
543 0           }
544             } else {
545 0 0         if (length($addr) == 4) {
546 0           return inet_ntoa($addr)
547             } else {
548             # Poor man's IPv6
549 0           return join ':', (unpack '(a4)*', unpack ('H*', $addr))
550             }
551             }
552             }
553              
554             ########################################################
555             # End Private subs
556             ########################################################
557              
558             1;
559              
560             __END__