#!/usr/bin/perl

#
# This script recognizes a few extra headers:
#
# X-MT-Category
# 	Sets the category of the entry. Takes the name
# 	of the category as set in MT. Only one category
# 	is set, setting multiple categories comes later.
#
# X-MT-Ping
# 	TrackBack-URL to ping for this entry.
# 	Can ping multiple URLs, add one header for each
# 	URL

my($MT_DIR,$BLOG_ID,%authors); BEGIN {

#############################
# Settings:
#

$MT_DIR = '/var/www/slackerbit.ch/cgi-bin';
$BLOG_ID = 3;

# Mapping of public key fingerprint to author id
# 
%authors=("B63E44FF1D934DA61D3DD521BDF25D034907CA2A" => 1);

#
#############################

}

use strict;
use lib "$MT_DIR/lib";
use lib "$MT_DIR/extlib";
use MIME::Parser;
use MIME::Base64;
use MIME::QuotedPrint;
use Mail::Header;
use GnuPG;
use Data::Dumper;
use MT;
use MT::Entry;
use MT::Blog;
use MT::Placement;
use MT::Category;
use MT::ConfigMgr;
use File::Temp qw/tempfile/;


# Slurp in the whole message

my @message=<>;

my $head = new Mail::Header \@message, Modify => 1;

# Create tempfiles for the entry and the signature
# TODO: See if this can be done without tempfiles, in memory

my($bodyfh, $bodyfilename) = tempfile( DIR => "/tmp" );
my($sigfh, $sigfilename) = tempfile( DIR => "/tmp" );


# Parse the message and make sure that we have two parts, plain text and
# a pgp signature.
# TODO: Make this more robust

my $parser = new MIME::Parser;
$parser->output_under("/tmp");
my $entity = $parser->parse_data(\@message) or die "parse failed\n";

unless(2==$entity->parts)
{
	print("This is not a multipart signed mail\n");
	exit(100);
}
foreach my $part($entity->parts)
{
	if($part->head->mime_type=~/application\/pgp-signature/)
	{
		print $sigfh $part->stringify_body;
	}
	if($part->head->mime_type=~/text\/plain/)
	{
		
# According to RFC3156, we have to convert line endings to canonical [CR][LF]
# Fix suggested by Reverend Jim (http://revjim.net/)
# 
		my $tmp = $part->stringify;
		$tmp =~ s/\n/\r\n/g;
		print $bodyfh $tmp;
	}
}
close($bodyfh);
close($sigfh);

unless($bodyfh && $sigfh)
{
	print("I wasn't able to get a plain text and signature");
	exit(100); # This signals a "hard error" to qmail and the mail gets returned
}

# Now on to the fun part:
# Now we check if we have a good signature. If not, return to sender

my $gpg = new GnuPG(homedir=>'/home/vpopmail/.gnupg');
my $foo;
eval {$foo=$gpg->verify( signature => $sigfilename, file => $bodyfilename );};
unlink($bodyfilename);
unlink($sigfilename);

if($@)
{
	print("Error: $@");
	exit(100);
}
else
{
	my $authorid=$authors{$foo->{'fingerprint'}};
	$head->unfold();
	my $subject=decode_subject($head->get("Subject"));
	my $category=$head->get("X-MT-Category");
	my @pings=$head->get("X-MT-Ping");
	chomp($subject);
	my $MT = MT->new( Config => "$MT_DIR/mt.cfg" ) or die MT->errstr;
	my $BLOG = MT::Blog->load($BLOG_ID);
	my $entry = MT::Entry->new;
	$entry->blog_id($BLOG->id);
	$entry->author_id($authorid);
	$entry->status(MT::Entry::RELEASE());
	$entry->allow_comments($BLOG->allow_comments_default);
	$entry->allow_pings($BLOG->allow_pings_default);
	$entry->convert_breaks($BLOG->convert_paras); 
	$entry->title("$subject");
	$entry->text($entity->parts(0)->bodyhandle->as_string);
	if(@pings)
	{
		$entry->to_ping_urls(join "\n", @pings);
	}
	$entry->save or die $entry->errstr;
	$MT->ping(Blog => $BLOG, Entry => $entry) or die $MT->errstr;
	$BLOG->save or die $BLOG->errstr;
	if($category)
	{
		chomp($category);
		my $cat = MT::Category->load({label=>$category});
		if($cat)
		{
			my $place = MT::Placement->new;
			$place->entry_id($entry->id);
			$place->blog_id($entry->blog_id);
			$place->is_primary(1);
			$place->category_id($cat->id);
			$place->save or die $place->errstr;
		}
	}
	$entry->save or die $entry->errstr;
	$BLOG->save or die $BLOG->errstr;

	# This is needed so the category shows up during the rebuild.
	# Kudos to Kevin Shay (http://www.staggernation.com/) for finding this out.

	MT::ConfigMgr->instance->NoPlacementCache(1);	
	$MT->rebuild_entry( Entry => $entry, Blog => $BLOG, BuildDependencies => 1) or die $MT->errstr;
}

# Make MIME::Parser clean up any tempfiles used

$parser->filer->purge;

# Using umlauts in the Subject-Header causes mutt to encode them
# This munges them back into iso-8859-1

sub decode_subject
{
	my $str=shift;
	$str =~ s/= =/==/g;
	$str =~ s/=\?([^?]+)\?b\?([^?]*)\?=/decode_base64($2)/egi;
	$str =~ s/=\?([^?]+)\?q\?([^?]*)\?=/decode_qp($2)/egi;
	return $str;
				
}