Mail::Abuse::Incident::Received - Parses Received: headers in an abuse report

Mail-Abuse documentation Contained in the Mail-Abuse distribution.

Index

Code Index:

NAME

Top

Mail::Abuse::Incident::Received - Parses Received: headers in an abuse report

SYNOPSIS

Top

  use Mail::Abuse::Report;
  use Mail::Abuse::Incident::Received;

  my $i = new Mail::Abuse::Incident::Received;
  my $report = new Mail::Abuse::Report (incidents => [$i] );

DESCRIPTION

Top

This class parses standard Received: headers included in a given abuse report.

Entries in the configuration file can control the behavior of this module. The following entries are recognized:

debug received

When set to a true value, causes some debug information to be produced via warn().

The functions provided by this module, are described below

parse($report)

Parses all the Received: headers, creating an instance with each combination of IP address and timestamp found.

Returns a list of objects of the same class, with the incident data (IP address, timestamp and other information) filled.

EXPORT

None by default.

HISTORY

Top

0.01

Original version; created by h2xs 1.2 with options

  -ACOXcfkn
	Mail::Abuse
	-v
	0.01

LICENSE AND WARRANTY

Top

This code and all accompanying software comes with NO WARRANTY. You use it at your own risk.

This code and all accompanying software can be used freely under the same terms as Perl itself.

AUTHOR

Top

Luis E. Muņoz <luismunoz@cpan.org>

SEE ALSO

Top

perl(1).

Mail-Abuse documentation Contained in the Mail-Abuse distribution. 
package Mail::Abuse::Incident::Received;

require 5.005_62;

use Carp;
use strict;
use warnings;
use NetAddr::IP;
use Date::Parse;

use base 'Mail::Abuse::Incident';

				# The code below should be in a single line

our $VERSION = do { my @r = (q$Revision: 1.4 $ =~ /\d+/g); sprintf " %d."."%03d" x $#r, @r };


use constant DEBUG	=> 'debug received';



sub _add_time ($$$)
{
    my $time = str2time($_[1], $_[2]) or return;

    for (@{$_[0]})
    {
	return if $_ == $time;
    }

    push @{$_[0]}, $time;
}

sub _add_ip ($$)
{
    my $ip = new NetAddr::IP $_[1] or return;

    for (@{$_[0]})
    {
	return if $_ == $ip;
    }

    push @{$_[0]}, $ip;
}


sub parse
{
    my $self	= shift;
    my $rep	= shift;

    my @ret = ();		# Default return
    my $count = 0;

    my $text = undef;

    my $debug = $rep->config ? $rep->config->{&DEBUG} : 0;

    warn "M::A::I::Received: debug\n" if $debug;

    if ($rep->normalized) 
    { 
	$text = $rep->body; 
    }
    else 
    { 
				# Skip the report headers and focus
				# on the offender's

	if ($ {$rep->text} =~ m!^\s*\n(.*)!xms)
	{
	    my $t = $1;
	    $text = \$t;
	}
	else
	{
	    $text = $rep->text; 
	}
    }

    unless ($$text and $$text =~ m!Received: !m)
    {
	warn "M::A::I::Received: No Received: headers in sight\n"
	    if $debug;
    }

    while ($$text and $$text =~ m!^(Received: .*?)(?=([-\w]+: |^\s*$))!msg)
    {
				# Analyze this Received: header
	my $header = $1;

	warn "M::A::I::Received: Matching header [$header]\n"
	    if $debug;

	my @a = ();
	my @t = ();
				# Add numeric IP addresses
	_add_ip \@a, $1 while $header =~ m/(\d+\.\d+\.\d+\.\d+)/g;

	_add_time \@t, $1, $rep->tz 
	    while $header =~ m/((\w+,\s+)?\d+\s\w+\s\d+\s[\d:]+\s[-+]?\w+)/g;

	for my $a (@a)
	{
	    for my $t (@t)
	    {
		my $i = $self->new();
		$i->ip($a);
		$i->time($t);
		$i->type('spam/Received');
		$i->data($header);
		
		warn "M::A::I::Received: Add incident for ", $i->ip, ", ",
		$i->time, "\n" if $debug;

		push @ret, $i;
	    }
	}
    }

    return @ret;
}

__END__