#!/usr/bin/perl -T

# This software is copyrighted
# Copyright 2007 by Jörg Habenicht (j.habenicht@planetsserver.com)
#
# nimmt emails von stdin entgegen.
# loescht ALLE anhaenge
# löscht HTML, wenn plaintext vorhanden ist, sonst wandelt HTML in plaintext um
#
# references:
# http://search.cpan.org/~rjbs/Email-MIME-Modifier-1.441/lib/Email/MIME/Modifier.pm
# http://search.cpan.org/~rjbs/Email-MIME-1.858/lib/Email/MIME.pm
# http://search.cpan.org/~rjbs/Email-Simple-1.998/lib/Email/Simple.pm
# http://en.wikipedia.org/wiki/Multipurpose_Internet_Mail_Extensions
#
# $Id: clean_virus_email.pl,v 1.13 2007/02/26 14:32:36 habenich Exp $


#  GPL License:
#
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.
#  
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#  
#  You should have received a copy of the GNU General Public License
#  along with this program; if not, write to the Free Software
#  Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
#


use strict;

use Email::MIME::Modifier;
use Email::MIME::Creator;
use Email::Send;
#use Email::Send::Test;	#only for testing
  
sub remove_attachments($);
sub convert_html($);


my $message = join "", <STDIN>;
#print $message;

# filtere den Namen des erkannten Virus heraus
my $virusname = "UNBEKANNT";
if ( $message =~ m/^X-Amavis-Alert: INFECTED, message contains virus: (.*)$/m )
{
  $virusname = $1;
}
#print "virus '$virusname'\n";


my $email = Email::MIME->new($message);

# stelle den originaeren content type fest,
# der container soll spaeter denselben type haben.
# content-types aufzaehlung aus wiki entnommen.
my $orig_content_type;
if ( $email->content_type =~ m/^(multipart\/(Mixed|Digest|Alternative|Related|Report|Signed|Encrypted|Form Data))/i )
{
  $orig_content_type = $1;
}
else
{
  $orig_content_type = 'multipart/mixed'
}
#print "'$orig_content_type'\n";


#print $email->debug_structure; #debug
remove_attachments($email);

#print $email->debug_structure; #debug
#print $email->as_string; #debug
#exit(0);
convert_html($email);

#print $email->debug_structure; #debug
#print $email->as_string; #debug


# email in eine andere email einpacken und dann verschicken
# Subject aendern
my @mparts = ();
my $body = <<MESS;
In dieser Email wurde das Virus $virusname erkannt.
Zur Sicherheit wurden alle Anhänge ersetzt und 
alles, was nicht reiner TEXT ist, in TEXT übersetzt.

Diese Email ist jetzt sicher zum Betrachen, und kann dazu dienen,
eventuelle Fehlmeldungen beim Absender zu melden.

Ihr Emailfilter bei
habenicht.homelinux.com
MESS

my $mail = Email::MIME->create(
             attributes => {
               content_type => "text/plain",
               #disposition  => "attachment",
               charset      => "iso-8859-1",
               encoding     => 'quoted-printable',
              },
             body=>$body,
            );
push @mparts, $mail;

# neuen container fuer die alten mime teile generieren
# originalen content-type beibehalten
$mail = Email::MIME->create(
             parts => [$email->parts],
            );
$mail->content_type_set( $orig_content_type );

push @mparts, $mail;


# alte email an neuer email anhaengen.
# content-type auf multipart/mixed setzen, damit beide teile gezeigt werden
$email->parts_set( \@mparts );
$email->content_type_set( 'multipart/mixed' );

# haeder erweitern
my $subject = $email->header("Subject");
#print "'$subject'\n";
$email->header_set("X-Virus_Cleaner" => "clean");
$email->header_set("Subject" => "(Virus erkannt und gelöscht) $subject");
#$subject = $email->header("Subject");
#print "'$subject'\n";


#print $email->debug_structure; #debug
#print $email->as_string; #debug



# email verschicken
if (1)
{
my $smtp = Email::Send->new({mailer => 'SMTP'});
$smtp->mailer_args([Host => 'localhost',
                    Port => 10025 ]);
#Email::Send::Test->clear;
#my $smtp = Email::Send->new({ mailer => 'Test' });

$smtp->send($email);
}

exit 0;




# //=------------------------=\\

# loesche alle attachments und ersetze sie 
# mit text/plain informationen, daß <DATEINAME> geloescht wurde
sub remove_attachments($) 
{
  my $email = shift;
  my @keep;
  foreach my $part ( $email->parts ) 
  {
    if ( defined($part->header('Content-Disposition')) and $part->header('Content-Disposition') =~ /^attachment/ )
    {
      my $filename = $part->filename;
      my $body = <<EOM;
Hier befand sich früher der Inhalt der Datei $filename.
Da der Virus "$virusname" erkannt wurde,
wurde die Datei gelöscht.
EOM
      my $newpart = Email::MIME->create(
                      attributes => {
                        content_type => "text/plain",
                        #disposition  => "attachment",
                        charset      => "iso-8859-1",
                        encoding     => 'quoted-printable',
                      },
                      body=>$body,
                    );
      #print $part->filename."\n";
      push @keep, $newpart;
    }
    else
    {
      push @keep, $part;
      #print $part->content_type;
      #print $part->body if ($part->content_type =~ m/text\/plain/);
    }

    # check recursive if multipart container
    if (defined($part->content_type) and $part->content_type =~ m"^message/rfc822")
    {
      my $partmail = Email::MIME->new($part->body);
      #print $part->body;
      #print $part->as_string;
      #exit 0;
      remove_attachments($partmail);
      #print $partmail->as_string;
      $part->body_set( $partmail->as_string );
      #push @keep, $part;
    }
    elsif (defined($part->content_type) and $part->content_type =~ /^(?:multipart|message)/)
    {
      remove_attachments($part)
    }
  }
  $email->parts_set( \@keep );
}


# convertiere alle contents, die nicht text/plain sind 
# mit "links" nach text/plain
sub convert_html($)
{
  my $email = shift;
  my @keep;
  foreach my $part ( $email->parts ) 
  {
    if ($part->content_type =~ m/text\/plain/)
    {
      # ist text/plain, behalten
      push @keep, $part;
    }
    elsif (defined($part->content_type) and $part->content_type =~ m"^message/rfc822")
    {
      my $partmail = Email::MIME->new($part->body);
      #print $part->body;
      #print $part->as_string;
      #exit 0;
      convert_html($partmail);
      #print $partmail->as_string;
      $part->body_set( $partmail->as_string );
      push @keep, $part;
    }
    # check recursive if multipart container
    elsif (defined($part->content_type) and $part->content_type =~ /^(?:multipart|message)/)
    {
      convert_html($part);
      push @keep, $part;
    }
    else
    {
      # ist etwas anderes, convertieren
      my $tmpfile = "/tmp/clean_virus_email.$$.tmp";
      open(TMPFILE, "> $tmpfile" ) || die "kann tmpfile $tmpfile nicht erzeugen";
      print TMPFILE $part->body;
      close TMPFILE;
      
      $ENV{'PATH'} = "/bin:/usr/bin";
      open(TMPFILE, "links -dump $tmpfile |") || die "kann pipe von $tmpfile nicht oeffnen";
      my $newbody = join "", <TMPFILE>;
      close TMPFILE;
      
      $newbody = "Achtung: zur Sicherheit wurde der HTML-Teil dieser Nachricht in ungefährlichen Text übersetzt\n\n". $newbody;

      my $newpart = Email::MIME->create(
                      attributes => {
                        content_type => "text/plain",
                        #disposition  => "attachment",
                        charset      => "iso-8859-1",
                        encoding     => 'quoted-printable',
                      },
                      body=>$newbody,
                    );
      #print $part->filename."\n";
      push @keep, $newpart;
      #print $part->content_type;
      #print $part->body if ($part->content_type =~ m/text\/plain/);
      
      unlink($tmpfile) || die "kann $tmpfile nicht loeschen";
    }

  }
  $email->parts_set( \@keep );
}

