#-*-perl-*-
# $Id: ARF.pm.txt,v 1.1.1.1 2006/03/03 20:16:11 steve Exp $
# Time-stamp: <2005-05-04 18:52:00 (steve)>
# Copyright Word to the Wise LLC 2005

package MIME::ARF;

use 5.006;
use strict;
use warnings;

use MIME::Lite;
my $VERSION = 0.01;

sub new {
    my $class = shift;
    my %params = @_;
    my $self = {};
    $self->{META} = {
	Version => 1,
	'Feedback-Agent' => $params{iam} ." (MIME::ARF V$VERSION)"
    };
    $self->{PICKY} = 1;

    $params{Type} = 'multipart/report';
    $self->{REPORT} = {%params};
    $self->{PRELUDE} = "This is an automated report from a badly configured system based on MIME::ARF\r\n";

    bless($self, $class);
    return $self;
}

sub meta {
    my $self = shift;
    if(@_) {
	if($self->{PICKY}) {
	    my $v;
	    my %params = @_;
	    while(($_, $v) = each %params) {
		if(/^version$/i) {$self->version($v);}
		elsif(/^feedback-agent$/i) {$self->feedback_agent($v);}
		elsif(/^source-ip$/i) {$self->source_ip($v);}
		elsif(/^received-date$/i) {$self->received_date($v);}
		elsif(/^original-message-id$/i) {$self->original_message_id($v);}
		elsif(/^feedback-type$/i) {$self->feedback_type($v);}
		elsif(/^domain$/i) {$self->domain($v);}
		elsif(/^domain-verification-method$/i) {$self->domain_verification_method($v);}
		elsif(/^original-recipient$/i) {$self->original_recipient($v);}
		elsif(/^original-mail-from$/i) {$self->original_mail_from($v);}
		else {die "Unrecignised metadata: $_";}
	    }
	} else {
	    while(my ($k, $v) = each %{@_}) {
		$self->{META}->{$k} = $v;
	    }
	}
    }
    return %{ $self->{META} };
}

sub prelude {
    my $self = shift;
    if(@_) {$self->{PRELUDE} = $_[0]}
    return $self->{PRELUDE};
}

sub version {
    my $self = shift;
    if(@_) {$self->{META}->{'Version'} = $_[0] }
    return $self->{META}->{'Version'};
}

sub feedback_agent {
    my $self = shift;
    if(@_) {$self->{META}->{'Feedback-Agent'} = $_[0] }
    return $self->{META}->{'Feedback-Agent'};
}

sub source_ip {
    my $self = shift;
    die "Bad IP $_[0]" if $self->{PICKY} && $_[0] !~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/;
    if(@_) {$self->{META}->{'Source-IP'} = $_[0] }
    return $self->{META}->{'Source-IP'};
}

sub received_date {
    my $self = shift;
    die "Bad date format: $_[0]" if $self->{PICKY} && $_[0] !~ /^(?:(?:Mon|Tue|Wed|Thu|Fri|Sat|Sun),)?\s*\d{1,2}\s+(?:Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)\s+\d{4}\s+\d{2}:\d{2}:\d{2}\s*[+-]\d{4}$/;
    if(@_) {$self->{META}->{'Received-Date'} = $_[0] }
    return $self->{META}->{'Received-Date'};
}

sub original_message_id {
    my $self = shift;
    if(@_) {$self->{META}->{'Original-Message-ID'} = $_[0] }
    return $self->{META}->{'Original-Message-ID'};
}

sub feedback_type {
    my $self = shift;
    die "Bad Feedback Type $_[0]" if $self->{PICKY} && $_[0] !~ /^abuse|opt-out|virus$/;
    if(@_) {$self->{META}->{'Feedback-Type'} = $_[0] }
    return $self->{META}->{'Feedback-Type'};
}

sub domain {
    my $self = shift;
    if(@_) {$self->{META}->{'Domain'} = @_ }
    return $self->{META}->{'Domain'};    
}

sub domain_verification_method {
    my $self = shift;
    die "Bad Domain Verification Method: $_[0]" if $self->{PICKY} && $_[0] !~ /^domainkeys|iim|sender-id|spf$/;
    if(@_) {$self->{META}->{'Domain-Verification-Method'} = @_ }
    return $self->{META}->{'Domain-Verification-Method'};    
}

sub original_mail_from {
    my $self = shift;
    if(@_) {$self->{META}->{'Original-Mail-From'} = @_ }
    return $self->{META}->{'Original-Mail-From'};
}

sub original_recipient {
    my $self = shift;
    if(@_) {$self->{META}->{'Original-Recipient'} = @_ }
    return $self->{META}->{'Original-Recipient'};
}

sub attachmail( % ) {
    my $self = shift;
    my %params = @_;

    $params{Type} = 'message/rfc822';
    $self->{SPAM} = {%params};
}

sub message {
    my $self = shift;

    unless(exists $self->{REPORT}->{Subject}) {
	if(exists $self->{SPAM}->{Data}) {
	    if($self->{SPAM}->{Data} =~ /^Subject:\s*(.*)/mi) {
		$self->{REPORT}->{Subject} = $1;
	    }
	} elsif(exists $self->{SPAM}->{Path}) {
	    open IF, $self->{SPAM}->{Path} or die "Failed to open file: $!";
	    while(<IF>) {
		if(/^Subject:\s*(.*)/i) {
		    $self->{REPORT}->{Subject} = $1;
		    last;
		}
	    }
	    close IF;
	} elsif(exists $self->{SPAM}->{FH}) {
	    die "No Subject specified and message passed as filehandle";
	} else {
	    die "No Subject specified";
	}
    }

    my $msg = MIME::Lite->new(%{$self->{REPORT}});
    $msg->attr('content-type.report-type' => 'feedback-report');

    $msg->attach(Type     => 'text/plain',
		 Data     => $self->{PRELUDE},
		 Encoding => '7bit');

    my $mfr="";

    while(my ($k, $v) = each %{$self->{META}}) {
	$mfr .= "$k: $v\r\n";
    }

    $msg->attach(Type     => 'message/feedback-report',
		 Data     => $mfr,
		 Encoding => '7bit');

    $msg->attach(%{$self->{SPAM}});
    
    return $msg;
}

sub as_string {
    my $self = shift;
    return $self->message()->as_string;
}

sub print {
    my $self = shift;
    return $self->message()->print(@_);
}

sub send {
    my $self = shift;
    return $self->message()->send(@_);
}



1;