File Coverage

blib/lib/SNMP/Trapinfo.pm
Criterion Covered Total %
statement 136 137 99.2
branch 57 58 98.2
condition 9 10 90.0
subroutine 18 18 100.0
pod 6 11 54.5
total 226 234 96.5


line stmt bran cond sub pod time code
1             package SNMP::Trapinfo;
2              
3 1     1   68040 use 5.008004;
  1         4  
4 1     1   5 use strict;
  1         2  
  1         19  
5 1     1   4 use warnings;
  1         2  
  1         23  
6 1     1   5 use Carp;
  1         12  
  1         77  
7 1     1   529 use Safe; # Safe module, creates a compartment for eval's and tests for disabled commands
  1         36876  
  1         1491  
8              
9             our $VERSION = '1.04';
10              
11             sub AUTOLOAD {
12 183     183   1368 my $self = shift;
13 183         263 my $attr = our $AUTOLOAD;
14 183         622 $attr =~ s/.*:://;
15 183 100       722 return if $attr =~ /^DESTROY$/;
16 170 100       321 if (@_) {
17 41         100 return $self->{$attr} = shift;
18             } else {
19 129         435 return $self->{$attr};
20             }
21             }
22              
23             sub new {
24 14     14 1 3026 my ($class, $data, $opts) = @_;
25 14 100       236 croak "Must specify data source (either GLOB or scalar ref)" unless $data;
26 13         45 my $self = {
27             data => {},
28             P => [],
29             V => [],
30             };
31 13         28 $self = bless $self, $class;
32              
33 13         32 return $self->read($data, $opts);
34             }
35              
36             sub trapname {
37 8     8 1 16 my $self = shift;
38 8         39 my $trapname = $self->data->{"SNMPv2-MIB::snmpTrapOID"};
39 8   100     42 return $trapname || undef;
40             }
41              
42             sub packet {
43 3     3 1 7 my $self = shift;
44 3 50 66     30 if ($_[0] && ref \$_[0] eq "SCALAR") {
45 0         0 return $self->{packet} = shift;
46             }
47 3         5 my $opts;
48 3 100       10 $opts = shift if (ref $_[0] eq "HASH");
49 3         9 $_ = $self->{packet};
50 3 100       9 if ($opts->{hide_passwords}) {
51 2         8 $_ = $self->_hide_passwords( $_ );
52             }
53 3         13 return $_;
54             }
55              
56             sub _hide_passwords {
57 4     4   10 my ($self, $string) = @_;
58 4         28 $string =~ s/\nSNMP-COMMUNITY-MIB::snmpTrapCommunity.0 "(.*?)"/\nSNMP-COMMUNITY-MIB::snmpTrapCommunity.0 "*****"/;
59 4         13 return $string;
60             }
61              
62             sub expand {
63 56     56 1 3363 my $self = shift;
64 56         89 my $string = shift;
65 56 100       130 return "" if ! defined $string;
66 55         77 my $key;
67 55         349 while ( ($key) = ($string =~ /\$\{([\w\-\.\*:]+)}/) ) {
68 59         94 my $newval;
69 59         195 my ($action, $line) = $key =~ /^([PV])(\d+)?$/;
70 59 100 100     246 if ($action && $line) {
    100          
    100          
    100          
71 23         66 $newval = $self->$action($line);
72 23 100       55 if (!defined $newval) {
73 8         16 $newval = "(null)";
74             }
75             } elsif ($key eq "DUMP") {
76 1         2 my %h = %{$self->data};
  1         5  
77 1         4 delete $h{"SNMP-COMMUNITY-MIB::snmpTrapCommunity"};
78 1         11 $newval = join(" ", map {"$_=".$self->data->{$_}} (sort keys %h) );
  6         21  
79             } elsif ($key eq "TRAPNAME") {
80 3         20 $newval = $self->trapname;
81             } elsif ($key eq "HOSTIP") {
82 1         8 $newval = $self->hostip;
83             } else {
84 31 100       81 if ($key =~ /\*/) {
85 7         16 $newval = $self->match_key($key);
86 7 100       18 if (!defined $newval) {
87 1         3 $newval = "(null)";
88             }
89             } else {
90 24         108 $newval = $self->data->{$key};
91 24 100       56 if (!defined $newval) {
92 4         8 $newval = "(null)";
93             }
94             }
95             }
96              
97             # Must use same match as while loop
98             # Otherwise possible infinite loop
99             # though not sure why (see tests for examples)
100             #$string =~ s/\${$key}/$newval/;
101 59         339 $string =~ s/\$\{([\w\-\.\*:]+)\}/$newval/;
102              
103             }
104 55         252 return $string;
105             }
106              
107             # Initialise the Safe compartment once
108             # Operators can be listed as follows
109             # perl -MOpcode=opdump -e 'opdump'
110             #
111             # http://search.cpan.org/~nwclark/perl-5.8.8/ext/Opcode/Opcode.pm
112             #
113             # We want to allow // m// s/// && || ! !~ != >= > == < <= =~ lt gt le ge ne eq not and or + - % * x .
114             #
115             my $cmp = new Safe;
116             $cmp->permit_only( qw( :base_core :base_mem :base_loop print sprintf prtf padsv padav padhv padany localtime rv2gv ) );
117              
118             sub eval {
119 22     22 1 1060 my ($self, $string) = @_;
120 22         53 my $code = $self->expand($string);
121 22         120 $self->last_eval_string($code);
122              
123 22         89 my $rc = $cmp->reval("$code", 1); # ($code to run, 1 for 'use strict;')
124 22 100       12749 if ($@) {
125 4         25 return undef;
126             } else {
127 18 100       115 return $rc ? 1 : 0;
128             }
129             }
130              
131             sub match_key {
132 12     12 0 27 my ($self, $key) = @_;
133 12         40 my @parts = split('\.', $key);
134 12         29 POSSIBLE: foreach my $possible (keys %{$self->data}) {
  12         59  
135 77         148 my @possible = split('\.', $possible);
136 77 100       154 next unless @possible == @parts;
137 38         78 for (my $i=0; $i < @parts; $i++) {
138 55 100       99 next if ($parts[$i] eq "*");
139 46 100       91 if ($parts[$i] ne $possible[$i]) {
140 31         61 next POSSIBLE;
141             }
142             }
143 7         23 return $self->data->{$possible};
144             }
145 5         25 return undef;
146             }
147              
148             sub cleanup_string {
149 107     107 0 138 my $self = shift;
150 107         148 my $string = shift;
151             # This is an SNMP OID name...
152 107 100       276 if ($string =~ /^[A-Za-z].*\:\:[A-Za-z].*$/) {
153             # Drop single trailing digits
154 57 100       139 if (! ($string =~ /\d\.\d+$/)) {
155 51         142 $string =~ s/\.\d+$//;
156             }
157             }
158             # Remove trailing spaces
159 107         168 $string =~ s/ +$//;
160 107         192 return $string;
161             }
162              
163             sub read {
164 13     13 0 26 my ($self, $data, $opts) = @_;
165 13 100       53 if (ref \$data eq "GLOB") {
    100          
166 3         13 local $/="#---next trap---#\n";
167 3   100     45 $self->{packet} = <$data> || return undef;
168 2         11 chomp($self->{packet});
169             } elsif (ref \$data eq "REF") {
170 8         19 $self->{packet} = $$data;
171             } else {
172 2         270 croak "Bad ref";
173             }
174 10 100       24 if ($opts->{hide_passwords}) {
175 2         7 $self->{packet} = $self->_hide_passwords( $self->{packet} );
176             }
177 10         342 $self->{packet} =~ s/\n*$//;
178 10         61 my @packet = split("\n", $self->{packet});
179 10         26 chomp($_ = shift @packet);
180 10         63 $self->hostname($_);
181 10         22 $self->{P}->[0] = $_;
182              
183 10 100       29 return undef if (!@packet); # No IP address given. This is a malformed packet
184              
185 9         16 chomp($_ = shift @packet);
186 9         19 $self->{P}->[1] = $_;
187             # Extra stuff around the IP packet in Net-SNMP 5.2.1
188 9         29 s/^.*?\[//;
189 9         39 s/\].*$//;
190 9         47 $self->hostip($_);
191              
192 9         13 my $i = 1; # Start at 1 because want to increment array at beginning because of next
193 9         22 foreach $_ (@packet) {
194 60         77 $i++;
195             # Ignore spaces in middle
196 60         244 my ($key, $value) = /^([^ ]+) +([^ ].*)$/;
197             # If syntax is wrong, ignore this line
198 60 100       127 next unless defined $key;
199 57         94 $key = $self->cleanup_string($key);
200 57 100       113 if ($key ne "SNMPv2-MIB::snmpTrapOID") {
201 50         92 $value = $self->cleanup_string($value);
202             }
203 57         178 $self->data->{$key} = $value;
204 57         192 $key =~ s/^[^:]+:://;
205 57         121 $self->{P}->[$i] = $key;
206 57         116 $self->{V}->[$i] = $value;
207             }
208 9         65 return $self;
209             }
210              
211             sub fully_translated {
212 2     2 1 5 my $self = shift;
213 2 100       7 if ($self->trapname =~ /\.\d+$/) {
214 1         5 return 0;
215             } else {
216 1         6 return 1;
217             }
218             }
219              
220             sub P {
221 16     16 0 33 my ($self, $line) = @_;
222 16         49 $_ = $self->{P}->[--$line];
223 16         55 return $_;
224             }
225              
226             sub V {
227 15     15 0 34 my ($self, $line) = @_;
228 15         37 $_ = $self->{V}->[--$line];
229 15         37 return $_;
230             }
231              
232             1;
233             __END__