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   67595 use 5.008004;
  1         4  
4 1     1   6 use strict;
  1         2  
  1         32  
5 1     1   5 use warnings;
  1         2  
  1         23  
6 1     1   4 use Carp;
  1         10  
  1         77  
7 1     1   554 use Safe; # Safe module, creates a compartment for eval's and tests for disabled commands
  1         38168  
  1         1476  
8              
9             our $VERSION = '1.05';
10              
11             sub AUTOLOAD {
12 183     183   1326 my $self = shift;
13 183         279 my $attr = our $AUTOLOAD;
14 183         665 $attr =~ s/.*:://;
15 183 100       692 return if $attr =~ /^DESTROY$/;
16 170 100       315 if (@_) {
17 41         108 return $self->{$attr} = shift;
18             } else {
19 129         438 return $self->{$attr};
20             }
21             }
22              
23             sub new {
24 14     14 1 3008 my ($class, $data, $opts) = @_;
25 14 100       243 croak "Must specify data source (either GLOB or scalar ref)" unless $data;
26 13         42 my $self = {
27             data => {},
28             P => [],
29             V => [],
30             };
31 13         27 $self = bless $self, $class;
32              
33 13         35 return $self->read($data, $opts);
34             }
35              
36             sub trapname {
37 8     8 1 19 my $self = shift;
38 8         75 my $trapname = $self->data->{"SNMPv2-MIB::snmpTrapOID"};
39 8   100     41 return $trapname || undef;
40             }
41              
42             sub packet {
43 3     3 1 7 my $self = shift;
44 3 50 66     17 if ($_[0] && ref \$_[0] eq "SCALAR") {
45 0         0 return $self->{packet} = shift;
46             }
47 3         4 my $opts;
48 3 100       9 $opts = shift if (ref $_[0] eq "HASH");
49 3         7 $_ = $self->{packet};
50 3 100       10 if ($opts->{hide_passwords}) {
51 2         7 $_ = $self->_hide_passwords( $_ );
52             }
53 3         13 return $_;
54             }
55              
56             sub _hide_passwords {
57 4     4   8 my ($self, $string) = @_;
58 4         26 $string =~ s/\nSNMP-COMMUNITY-MIB::snmpTrapCommunity.0 "(.*?)"/\nSNMP-COMMUNITY-MIB::snmpTrapCommunity.0 "*****"/;
59 4         12 return $string;
60             }
61              
62             sub expand {
63 56     56 1 3268 my $self = shift;
64 56         85 my $string = shift;
65 56 100       136 return "" if ! defined $string;
66 55         81 my $key;
67 55         399 while ( ($key) = ($string =~ /\$\{([\w\-\.\*:]+)}/) ) {
68 59         93 my $newval;
69 59         234 my ($action, $line) = $key =~ /^([PV])(\d+)?$/;
70 59 100 100     291 if ($action && $line) {
    100          
    100          
    100          
71 23         65 $newval = $self->$action($line);
72 23 100       52 if (!defined $newval) {
73 8         13 $newval = "(null)";
74             }
75             } elsif ($key eq "DUMP") {
76 1         4 my %h = %{$self->data};
  1         5  
77 1         3 delete $h{"SNMP-COMMUNITY-MIB::snmpTrapCommunity"};
78 1         26 $newval = join(" ", map {"$_=".$self->data->{$_}} (sort keys %h) );
  6         22  
79             } elsif ($key eq "TRAPNAME") {
80 3         24 $newval = $self->trapname;
81             } elsif ($key eq "HOSTIP") {
82 1         7 $newval = $self->hostip;
83             } else {
84 31 100       64 if ($key =~ /\*/) {
85 7         16 $newval = $self->match_key($key);
86 7 100       19 if (!defined $newval) {
87 1         3 $newval = "(null)";
88             }
89             } else {
90 24         112 $newval = $self->data->{$key};
91 24 100       55 if (!defined $newval) {
92 4         7 $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         357 $string =~ s/\$\{([\w\-\.\*:]+)\}/$newval/;
102              
103             }
104 55         242 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 1055 my ($self, $string) = @_;
120 22         53 my $code = $self->expand($string);
121 22         118 $self->last_eval_string($code);
122              
123 22         86 my $rc = $cmp->reval("$code", 1); # ($code to run, 1 for 'use strict;')
124 22 100       12491 if ($@) {
125 4         24 return undef;
126             } else {
127 18 100       114 return $rc ? 1 : 0;
128             }
129             }
130              
131             sub match_key {
132 12     12 0 24 my ($self, $key) = @_;
133 12         41 my @parts = split('\.', $key);
134 12         17 POSSIBLE: foreach my $possible (keys %{$self->data}) {
  12         65  
135 103         197 my @possible = split('\.', $possible);
136 103 100       198 next unless @possible == @parts;
137 56         108 for (my $i=0; $i < @parts; $i++) {
138 73 100       126 next if ($parts[$i] eq "*");
139 64 100       115 if ($parts[$i] ne $possible[$i]) {
140 49         86 next POSSIBLE;
141             }
142             }
143 7         26 return $self->data->{$possible};
144             }
145 5         24 return undef;
146             }
147              
148             sub cleanup_string {
149 107     107 0 141 my $self = shift;
150 107         141 my $string = shift;
151             # This is an SNMP OID name...
152 107 100       274 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         174 $string =~ s/ +$//;
160 107         184 return $string;
161             }
162              
163             sub read {
164 13     13 0 27 my ($self, $data, $opts) = @_;
165 13 100       65 if (ref \$data eq "GLOB") {
    100          
166 3         13 local $/="#---next trap---#\n";
167 3   100     47 $self->{packet} = <$data> || return undef;
168 2         10 chomp($self->{packet});
169             } elsif (ref \$data eq "REF") {
170 8         22 $self->{packet} = $$data;
171             } else {
172 2         258 croak "Bad ref";
173             }
174 10 100       28 if ($opts->{hide_passwords}) {
175 2         7 $self->{packet} = $self->_hide_passwords( $self->{packet} );
176             }
177 10         357 $self->{packet} =~ s/\n*$//;
178 10         54 my @packet = split("\n", $self->{packet});
179 10         23 chomp($_ = shift @packet);
180 10         74 $self->hostname($_);
181 10         25 $self->{P}->[0] = $_;
182              
183 10 100       26 return undef if (!@packet); # No IP address given. This is a malformed packet
184              
185 9         18 chomp($_ = shift @packet);
186 9         17 $self->{P}->[1] = $_;
187             # Extra stuff around the IP packet in Net-SNMP 5.2.1
188 9         23 s/^.*?\[//;
189 9         44 s/\].*$//;
190 9         46 $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         81 $i++;
195             # Ignore spaces in middle
196 60         241 my ($key, $value) = /^([^ ]+) +([^ ].*)$/;
197             # If syntax is wrong, ignore this line
198 60 100       134 next unless defined $key;
199 57         104 $key = $self->cleanup_string($key);
200 57 100       121 if ($key ne "SNMPv2-MIB::snmpTrapOID") {
201 50         77 $value = $self->cleanup_string($value);
202             }
203 57         230 $self->data->{$key} = $value;
204 57         208 $key =~ s/^[^:]+:://;
205 57         125 $self->{P}->[$i] = $key;
206 57         119 $self->{V}->[$i] = $value;
207             }
208 9         55 return $self;
209             }
210              
211             sub fully_translated {
212 2     2 1 6 my $self = shift;
213 2 100       6 if ($self->trapname =~ /\.\d+$/) {
214 1         6 return 0;
215             } else {
216 1         6 return 1;
217             }
218             }
219              
220             sub P {
221 16     16 0 75 my ($self, $line) = @_;
222 16         50 $_ = $self->{P}->[--$line];
223 16         40 return $_;
224             }
225              
226             sub V {
227 15     15 0 33 my ($self, $line) = @_;
228 15         40 $_ = $self->{V}->[--$line];
229 15         40 return $_;
230             }
231              
232             1;
233             __END__