#!/usr/bin/perl -Tw

$ENV{PATH}="";	# keep taint happy
$0 .= "";	# string leading "perl" from ps listing

# submits spam as forwarded as attachment
#
# Version 0.3
#
# Copyright (C) 2005, Jeremy Laidman
# under the GNU General Public License.
# For details: http://www.gnu.org/licenses/gpl.txt

use MIME::Parser;

my $respond=1;

#-----------------------------------------------------------------#

sub respond {
	# respond to the sender
	my ($email,$rc,$message)=@_;
	my $result;
	if ($rc==1) {
		$result="failed";
	} elsif ($rc==0) {
		$result="succeeded";
	}
	open(MAIL,"|/usr/sbin/sendmail -t -oi -oem") or die "open: $!";
	print MAIL "From: spamassassin\n";
	print MAIL "Subject: spam submission $result\n";
	print MAIL "To: $email\n";
	print MAIL "\n";
	print MAIL "Your attempt to submit spam has $result".".\n"
		if length($result);
	print MAIL "$message\n";
	close(MAIL);
}

sub sa_learn {
	my $part=shift;
	my $spamham=shift;
	$ENV{HOME}="";
	open(SA,"|/usr/bin/sa-learn --${spamham}") or die "Unable to open sa-learn\n";
	#$$part->print_body(\*STDOUT);
	$$part->print_body(\*SA);
	close(SA);
}

sub get_subject {
	my $part=shift;
	my $subj=$$part->head->get("subject");
	return chomp($subj) if defined($subj);
	foreach $subpart ($$part->parts) {
		chomp($subj=$subpart->head->get("subject"));
		return $subj if defined($subj);
	}
	return undef;
}

#-----------------------------------------------------------------#

chdir "/tmp";	# MIME::Parser writes a temp file
my $parser=new MIME::Parser;
my $entity=$parser->parse(\*STDIN);

if ($parser->last_error) {
	die "MIME parse failed: ".$parser->last_error."\n";
}

#$entity->dump_skeleton;

my $subject=$entity->head->get("subject");
my $returnpath=$entity->head->get("return-path");
my $from=$entity->head->get("from");
my $replyto=$from;
$replyto=$returnpath if defined($returnpath);
chomp($replyto);
chomp($subject);
$respond=0 if $subject =~ /quiet/i;
my $spamham;
$spamham="spam" if lc($subject) =~ /^spam/ or lc($subject) =~ /spam$/;
$spamham="ham" if lc($subject) =~ /^ham/ or lc($subject) =~ /ham$/;
my $respmsg;

if (!length($spamham)) {
	$respmsg="Please specify your options in the subject\n";
	$respmsg .= "The subject must START with either of the words 'spam' or 'ham'.\n";
	$respmsg .= "You will receive a confirmation message, unless you add the word 'quiet'\n";
	$respmsg .= "Subject was [$subject]\n" if length($spamham);
	respond($replyto,-1,$respmsg);
	exit;
}

my @parts_to_learn;
foreach $part ($entity->parts) {
	my $mime_type=$part->mime_type;
	next unless lc($mime_type) eq lc("message/rfc822");
	push @parts_to_learn,$part;
}

if (scalar(@parts_to_learn) < 1) {
	respond($replyto,1,"no messages found");
}

my @subjlist;
foreach $part (@parts_to_learn) {
	sa_learn(\$part,$spamham);
	my $subj=get_subject(\$part);
	push @subjlist,$subj;
	#$part->dump_skeleton;
}

if ($respond) {
	$respmsg="SpamAssassin has been given ".
		scalar(@parts_to_learn)." message";
	$respmsg .= "s" if scalar(@parts_to_learn) != 1;
	$respmsg .= " to learn as $spamham - thanks for the feedback.";
	$respmsg .= "\n";
	$respmsg .= "The message subject(s) included:";
	$respmsg .= join("\n\t","",@subjlist,"");
	respond($replyto,0,$respmsg);
}