File Coverage

blib/lib/Email/ARF/Hotmail.pm

Criterion	Covered	Total	%
statement	55	58	94.8
branch	10	12	83.3
condition	2	3	66.6
subroutine	9	9	100.0
pod	1	1	100.0
total	77	83	92.7

package Email::ARF::Hotmail;

use 5.010;
use strict;
use warnings;
use Email::ARF::Report;
use Email::MIME;
use Regexp::Common qw/net/;

require Exporter;

our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use Email::ARF::Hotmail ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(

) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(

);

our $VERSION = '0.12';
$VERSION = eval $VERSION;

use constant HOTMAIL_SENDER => '[e-mail]';

sub _is_hotmail_report {
  my $parsed = shift;
  foreach my $field (('X-Original-Sender', 'Sender', 'From')) {
	my $val = $parsed->header($field);
	if (defined $val) {
		$val =~ s/^\
		$val =~ s/\>$//;
	}

	if (defined($val) and $val eq HOTMAIL_SENDER) {
	  return 1;
	}
  }

  return 0;
}

sub create_report {
	my $class = shift;
	my $message = shift;

	my $parsed = Email::MIME->new($message);

	if (_is_hotmail_report($parsed)) {
	  # Get the original email and strip off all the extra header bits
	  my $part = ($parsed->parts)[0];
	  my $orig_email = $part->body;
	  my $hotmail_headers;
	  if ($orig_email =~ /Received: /) {
		$orig_email =~ s/^(.*?)\n(Received: )/$2/s;
		$hotmail_headers = Email::Simple::Header->new($1);
	  } else {
		$hotmail_headers = Email::Simple::Header->new($orig_email);
	  }

	  my $description = "An email abuse report from hotmail";
	  my %fields;
	  $fields{"Feedback-Type"} = "abuse";
	  $fields{"User-Agent"} = "Email::ARF::Hotmail-conversion";
	  $fields{"Version"} = "0.1";

	  my $subject = $parsed->header("Subject");

	  my $source_ip;

	  if ($subject =~ /complaint about message from ($RE{net}{IPv4})$/) {
		$source_ip = $1;
	  } else {
		die "Couldn't match subject: " . $subject;
	  }

	  $fields{"Source-IP"} = $source_ip;

	  my $or = $hotmail_headers->header('X-HmXmrOriginalRecipient');

	  if ($or) {
		$fields{'Original-Rcpt-To'} = $or;
	  }

	  my $original_email = Email::MIME->new($orig_email);

	  return Email::ARF::Report->create(
										original_email => $original_email,
										description => $description,
										fields => \%fields
									   );

	} else {
	  die "Not a hotmail abuse report";
	}
  }

1;
__END__