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