#!/usr/bin/perl
#===============================================================================
#
#         FILE:  colon_filter.pl
#
#        USAGE:  ./colon_filter.pl 
#
#  DESCRIPTION: remove unnecessary colons from incoming email so that rt 
#  CommandByEmail will not choke.  Check the message for spaminess too.
#
#      OPTIONS:  ---
# REQUIREMENTS:  Mail::Audit and the mail is checked by Spamassasin some 
#                time before the script sees it.
#        NOTES:  ---
#       AUTHOR:  Robert G. Werner, <rwerner@usscript.com>
#      COMPANY:  US Script, Inc.
#      VERSION:  1.0
#      CREATED:  03/02/2007 02:42:03 PM PST
#      UPDATED:  $Date: 2007/03/05 19:01:56 $
#     REVISION:  $Revision: 1.2 $
#===============================================================================

use warnings;
use strict;

use Mail::Audit;

my $mail = Mail::Audit->new( emergency => '/tmp/colon_filter/' );

# I already test all our mail through SpamAssasin so this header will 
# always be present.  
my $spam_score = $mail->get_header("X-Spam-Score");

# Only process mail with less than 5 on the spam score and the word 
# "some_phrase" in the subject.
if ( $spam_score < 5 &&  $mail->subject =~ /.*some_phrase.*/i ) 
{
    &munge_body;
}
else
{
    # Doesn't match any of our criteria so ...
    $mail->ignore();
}

# Remove the colon that confuses the CommandByEmail system and send 
# the incoming mail on.
sub munge_body {
    # contains the munged body
    my @newbody;

    # Deal with the mail differently if it's MIME encoded or not
    if ( $mail->is_mime ) 
    {
        foreach my $part ( $mail->parts() ) 
        {
            if ( $part->head->mime_type !~ qr{^(text/plain|message/rfc822)$}i ) 
            {
                next;
            } 
            else 
            {
                my @lines = $part->bodyhandle->as_lines();
                foreach ( @lines ) 
                {
                    s/^(\w+):(.*)$/${1}${2}/;
                    push( @newbody, $_ );
                }
                my $mbody = MIME::Body::Scalar->new( \@newbody );
                $part->bodyhandle( $mbody );
            }
        }
    } 
    else 
    {
        my $body = $mail->body;

        foreach ( @{$body} ) 
        {
            s/^(\w+):(.*)$/${1}${2}/;
            push( @newbody, $_)
        }

        $mail->body( \@newbody );
    }

    # Allow the script to handle -comment addresses too -RGW
    my ($to) = $mail->to() =~ /^(.*)\@example.com/;
    $mail->resend( $to . '@rt.example.com' );
}
