#!/usr/bin/perl -I../lib
#
# Copyright (c) 2005 Messiah College. This program is free software.
# You can redistribute it and/or modify it under the terms of the
# GNU Public License as found at http://www.fsf.org/copyleft/gpl.html.
#

use strict;
use warnings;
use IO::File;
use MIME::Entity;

use DKMessage;

use constant FROM_ADDR => 'admin@dktest.jason.long.name';
use constant DEFAULT_SUBJECT => "Results of Domain Keys test";
use constant RESULT_BCC => 'results@dktest.jason.long.name';

# create a temporary file for storing the message contents
my $fh = IO::File::new_tmpfile;

my $from_line = <STDIN>;
unless ($from_line =~ /^From (\S+)/)
{
	die "invalid delivery (no From line)\n";
}

my $from = $1;
my $subject = DEFAULT_SUBJECT;

# read message from stdin, catching from address and subject
my @message_lines;
while (<STDIN>)
{
	print $fh $_;
	push @message_lines, $_;

	if (/^Subject:\s*(.*)$/)
	{
		$subject = "Re: $1";
	}
}

# rewind message, and have DomainKeys verify it
$fh->seek(0, 0);
my $result;
my $result_detail;
eval
{
	my $mess = DKMessage->new_from_handle($fh);
	$result = $mess->verify;
	$result_detail = $mess->result_detail;
};
if ($@)
{
	my $E = $@;
	chomp $E;
	$result = "temperror";
	$result_detail = "$result ($E)";
}

# create a response message
my $top = MIME::Entity->build(
		Type => "multipart/mixed",
		From => FROM_ADDR,
		To => $from,
		Subject => $subject);

# part one, literal text containing result of test
$top->attach(
	Type => "text/plain",
	Data => [
		"*** This is an automated response ***\n\n",
		"This is the result of the message verification:\n",
		"  $result_detail\n",
		"\n",
		"Attached you will find the original message as plain text.\n\n",
		"Thank you for using the dkfilter Domain Key Auto Responder.\n",
		"This Auto Responder tests the verification routines of dkfilter-0.10.\n",
		"For more information about dkfilter, see http://jason.long.name/dkfilter/\n",
		"\n",
		"If you have any questions about this automated tester, or if you\n",
		"received this message in error, please send a note to\n",
		FROM_ADDR . "\n",
		]);

# part two, original message
$top->attach(
	Type => "text/plain",
	Filename => "rfc822.txt",
	Data => \@message_lines);

# send it
open MAIL, "| /usr/sbin/sendmail -t -i " . RESULT_BCC
	or die "open: $!";
$top->print(\*MAIL);
close MAIL;


syntax highlighted by Code2HTML, v. 0.9.1