File Coverage

blib/lib/SNMP/Trapinfo.pm

Criterion	Covered	Total	%
statement	155	156	99.3
branch	65	66	98.4
condition	11	12	91.6
subroutine	18	18	100.0
pod	6	11	54.5
total	255	263	96.9

package SNMP::Trapinfo;

use 5.008004;
use strict;
use warnings;
use Carp;
use Safe;		# Safe module, creates a compartment for eval's and tests for disabled commands

our $VERSION = '1.06';

sub AUTOLOAD {
        my $self = shift;
        my $attr = our $AUTOLOAD;
        $attr =~ s/.*:://;
        return if $attr =~ /^DESTROY$/;
        if (@_) {
                return $self->{$attr} = shift;
        } else {
                return $self->{$attr};
        }
}

sub new {
	my ($class, $data, $opts) = @_;
	croak "Must specify data source (either GLOB or scalar ref)" unless $data;
	my $self = {
			data => {},
			P => [],
			V => [],
			};
	$self = bless $self, $class;

	return $self->read($data, $opts);
}

sub trapname {
	my $self = shift;
	my $trapname = $self->data->{"SNMPv2-MIB::snmpTrapOID"};
	return $trapname || undef;
}

sub packet {
	my $self = shift;
	if ($_[0] && ref \$_[0] eq "SCALAR") {
		return $self->{packet} = shift;
	}
	my $opts;
	$opts = shift if (ref $_[0] eq "HASH");
	$_ = $self->{packet};
	if ($opts->{hide_passwords}) {
		$_ = $self->_hide_passwords( $_ );
	}
	return $_;
}

sub _hide_passwords {
    my ($self, $string) = @_;
    $string =~ s/\nSNMP-COMMUNITY-MIB::snmpTrapCommunity.0 "(.*?)"/\nSNMP-COMMUNITY-MIB::snmpTrapCommunity.0 "*****"/;
    return $string;
}

# Initialise the Safe compartment once
# Operators can be listed as follows
# perl -MOpcode=opdump -e 'opdump'
#
# http://search.cpan.org/~nwclark/perl-5.8.8/ext/Opcode/Opcode.pm
#
# We want to allow // m// s/// && || ! !~ != >= > == < <= =~ lt gt le ge ne eq not and or + - % * x .
#
my $cmp = new Safe;
$cmp->permit_only( qw( :base_core :base_mem :base_loop print sprintf prtf padsv padav padhv padany localtime rv2gv ) );

sub expand {
	my $self = shift;
	my $string = shift;
	return "" if ! defined $string;
	my $key;
	while ( ($key) = ($string =~ /\$\{([\w\-\.\*:]+)}/) ) {
		my $newval;
		my ($action, $line) = $key =~ /^([PV])(\d+)?$/;
		if ($action && $line) {
			$newval = $self->$action($line);
			if (!defined $newval) {
				$newval = "(null)";
			}
		} elsif ($key eq "DUMP") {
			my %h = %{$self->data};
			delete $h{"SNMP-COMMUNITY-MIB::snmpTrapCommunity"};
			$newval = join(" ", map {"$_=".$self->data->{$_}} (sort keys %h) );
		} elsif ($key eq "TRAPNAME") {
			$newval = $self->trapname;
		} elsif ($key eq "HOSTIP") {
			$newval = $self->hostip;
		} else {
			if ($key =~ /\*/) {
				$newval = $self->match_key($key);
				if (!defined $newval) {
					$newval =  "(null)";
				}
			} else {
				$newval = $self->data->{$key};
				if (!defined $newval) {
					$newval = "(null)";
				}
			}
		}

		# Must use same match as while loop
		# Otherwise possible infinite loop
		# though not sure why (see tests for examples)
		#$string =~ s/\${$key}/$newval/;
        $string =~ s/\$\{([\w\-\.\*:]+)\}/$newval/;
	}

	# eval calculation performed within Safe for security
	my $eval_re = qr/eval\s*{(.*?)}/;
	while ( ($key) = ($string =~ /$eval_re/) ) {
		my $eval_result = $cmp->reval($key) || '';
		$string  =~ s/$eval_re/$eval_result/;
	}
	return $string;
}

sub eval {
	my ($self, $string) = @_;
	my $code = $self->expand($string);
	$self->last_eval_string($code);

	my $rc = $cmp->reval("$code", 1);	# ($code to run, 1 for 'use strict;')
	if ($@) {
		return undef;
	} else {
		return $rc ? 1 : 0;
	}
}

sub match_key {
	my ($self, $key) = @_;
	my @parts = split('\.', $key);
	POSSIBLE: foreach my $possible (keys %{$self->data}) {
		my @possible = split('\.', $possible);
		next unless @possible == @parts;
		for (my $i=0; $i < @parts; $i++) {
			next if ($parts[$i] eq "*");
			if ($parts[$i] ne $possible[$i]) {
				next POSSIBLE;
			}
		}
		return $self->data->{$possible};
	}
	return undef;
}

sub cleanup_string {
	my $self = shift;
	my $string = shift;
	# This is an SNMP OID name...
	if ($string =~ /^[A-Za-z].*\:\:[A-Za-z].*$/) {
		# Drop single trailing digits
		if (! ($string =~ /\d\.\d+$/)) {
			$string =~ s/\.\d+$//;
		}
	}
	# Remove trailing spaces
	$string =~ s/ +$//;
	return $string;
}

sub read {
	my ($self, $data, $opts) = @_;
	if (ref \$data eq "GLOB") {
		local $/="#---next trap---#\n";
		$self->{packet} = <$data> || return undef;
		chomp($self->{packet});
	} elsif (ref \$data eq "REF") {
		$self->{packet} = $$data;
	} else {
		croak "Bad ref";
	}
	if ($opts->{hide_passwords}) {
		$self->{packet} = $self->_hide_passwords( $self->{packet} );
	}
	$self->{packet} =~ s/\n*$//;
	my @packet = split("\n", $self->{packet});
	{
		# Go through the array and look for lines that might be joinable.
		# Assume multi-lines are surrounded by quotes, so only one quote
		# character means join the next line onto the current one

		# Work from a copy of the packet in case we decide to make no changes
		my @copy_packet = @packet;
		my @new_packet;
		my $within_quotes=0;
		# use defined here to allow blank lines through
		while( defined( my $line = shift @copy_packet)) {
			if($within_quotes) {
				$new_packet[-1] .= "\n".$line;
				my $quotes = $new_packet[-1] =~ tr/"/"/;
				$within_quotes = 0 if( $quotes % 2 == 0 );
				next;
			}

			push(@new_packet, $line);

			{
				my $quotes = $new_packet[-1] =~ tr/"/"/;
				$within_quotes = 1 if( $quotes % 2 == 1 );
			}
		}

		# Only rewrite the packet if it looks like we have correctly
		# joined up all the lines
		@packet=@new_packet if($within_quotes == 0 );
	}
	chomp($_ = shift @packet);
	$self->hostname($_);
	$self->{P}->[0] = $_;

	return undef if (!@packet);	# No IP address given. This is a malformed packet

	chomp($_ = shift @packet);
	$self->{P}->[1] = $_;
	# Extra stuff around the IP packet in Net-SNMP 5.2.1
	s/^.*?\[//;
	s/\].*$//;
	$self->hostip($_);

	my $i = 1;	# Start at 1 because want to increment array at beginning because of next
	foreach $_ (@packet) {
		$i++;
		# Ignore spaces in middle
		my ($key, $value) = /^([^ ]+) +([^ ].*)$/s;
		# If syntax is wrong, ignore this line
		next unless defined $key;
		$key = $self->cleanup_string($key);
		if ($key ne "SNMPv2-MIB::snmpTrapOID") {
			$value = $self->cleanup_string($value);
		}
		$self->data->{$key} = $value;
		$key =~ s/^[^:]+:://;
		$self->{P}->[$i] = $key;
		$self->{V}->[$i] = $value;
	}
	return $self;
}

sub fully_translated {
	my $self = shift;
	if ($self->trapname =~ /\.\d+$/) {
		return 0;
	} else {
		return 1;
	}
}

sub P {
	my ($self, $line) = @_;
	$_ = $self->{P}->[--$line];
	return $_;
}

sub V {
	my ($self, $line) = @_;
	$_ = $self->{V}->[--$line];
	return $_;
}

1;
__END__