Mail::Abuse::Incident::SpamCop - Parses SpamCop reports into Mail::Abuse::Reports

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

Index

Code Index:

NAME

Top

Mail::Abuse::Incident::SpamCop - Parses SpamCop reports into Mail::Abuse::Reports

SYNOPSIS

Top

  use Mail::Abuse::Report;
  use Mail::Abuse::Incident::SpamCop;

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

DESCRIPTION

Top

This class parses SpamCop incidents. See http://www.SpamCop.net/ for more information regarding their excellent service.

The following functions are provided for the customization of the behavior of the class.

parse($report)

Pushes all instances of SpamCop incidents into the given report, based on parsing of the text in the report itself.

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), http://www.SpamCop.net.

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

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.11 $ =~ /\d+/g); sprintf " %d."."%03d" x $#r, @r };


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

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

    my $text = undef;

    if ($rep->normalized)
    {
	$text = $rep->body;
	my $xmailer = $rep->header->get('X-Mailer') || '';
	my $subject = $rep->header->get('Subject') || '';
	#warn "# Match 1.a: normalized\n";
	return unless $xmailer =~ m!http://(www\.)?spamcop.net!;
	#warn "# Match 1.b: normalized\n";
	return unless $subject =~ m!\[SpamCop!;
	#warn "# Match 1: normalized\n";
    }
    else
    {
	$text = $rep->text;
	#warn "# Match 1.a: non-normalized\n";
	return unless $$text =~ m!^X-Mailer: http://(www\.)?spamcop.net/!m
	    or $$text =~ m!^X-SpamCop-sourceip: !m;
	#warn "# Match 1.b: non-normalized\n";
	return unless $$text =~ m!^Subject: .*\[SpamCop!m;
	#warn "# Match 1.c: non-normalized\n";
	return unless $$text =~ /[-\[] SpamCop/m;
	#warn "# Match 1: non-normalized\n";
    }

    return unless $$text =~ m!This message is brief!m;

    if ($$text =~ m!Email from (\d+\.\d+\.\d+\.\d+)\s+/\s+(.+)!)
    {
	my $ip		= new NetAddr::IP $1;
	my $date	= $2;
	return unless $ip;

	#warn "# Match 2: ip=$ip date=$date\n";

	# Remove truncated timezones
	$date =~ s/\([^\)]+$//;
	$date =~ s/\[.*$//;
	# Parse the date
	$date = str2time($date, $rep->tz);
	
	my $i = $self->new();
	$i->ip($ip);
	$i->time($date);
	$i->type('spam/SpamCop');
	
	$$text =~ m!(^http://(www\.)?spamcop.net/w3m.+)\s*$!m;
	
	$i->data($1 || 'no data');
	#warn "# Created incident $i\n";
	push @ret, $i;
    }

    return @ret;
}

__END__