Untitled

#!/usr/bin/perl

use MIME::Parser;
use Sys::Hostname;

#--------------------------------------------------------------------------------#
sub tempfail{
        print STDERR join("\n",@_),"\n";
        # indicate temporary failure to qmail
        exit 111;
}
#--------------------------------------------------------------------------------#
sub getnames {
        my ($ent,$name) = @_;
        defined($name) or $name = "'anonymous'";

        my @parts = $ent->parts;
        if (@parts) {
                my $i;
                foreach $i (0 .. $#parts) {       # dump each part...
                        getnames($parts[$i], ("$name, part ".(1+$i)));
                }
        } else {
                my $type = $ent->effective_type;
                my $io;
                my $tmpbod;
                my $line;
                unless ($type =~ /^(text|message|multipart)/) {
                        $name=$ent->head->recommended_filename;
                        push(@names,$name);
                }
        return 0;
        }
}
#--------------------------------------------------------------------------------#
sub mangle {
        my ($ent,$name) = @_;
        my $mystring;
        my $maxlines=80;
        defined($name) or $name = "'anonymous'";
        $mystring="***NOTE: This message has been altered\n"
                . "***NOTE: The following large attachments have been removed:\n"
                . join("\n",@names) . "\n***NOTE: Original message follows:\n\n";

        my @parts = $ent->parts;
        if (@parts) {
                my $i;
                foreach $i (0 .. $#parts) {       # dump each part...
                        mangle($parts[$i], ("$name, part ".(1+$i)));
                }
        } else {
                my $type = $ent->effective_type;
                my $io;
                my $tmpbod;
                my $line;
                if ($type =~ /^text\/(plain|html)$/) {
                        my $j=1;
                        if ($io = $ent->bodyhandle->open("r")) {
                                while ((defined($line = $io->getline)) && ($j <= $maxlines)){
                                        $tmpbod .= $line;
                                        $j++;
                                }
                                $io->close;
                        } else { tmpfail("Grr, argh: $!"); }

                        if ($type eq "text/plain"){
                                $tmpbod = "$mystring" . $tmpbod;
                                if ($j >= $maxlines){
                                        $tmpbod .= "\n\n***NOTE: This message has been truncated to $maxlines lines\n\n";
                                }
                        } elsif ($type eq "text/html"){
                                $tmpbod =~ s@(<body>)@$1\n<pre>\n$mystring</pre>\n@i;
                                if ($j >= $maxlines){
                                        $tmpbod .= "</table></div></table></div></table></div></table><pre>\n\n***NOTE: This message has been truncated to $maxlines lines</pre></body></html>\n\n";
                                }
                        }

                        if ($io = $ent->bodyhandle->open("w")) {
                                $io->print($tmpbod);
                                $io->close;
                        } else { tmpfail("Grr, argh: $!"); }
                }
        return 0;
        }
}
#--------------------------------------------------------------------------------#

my $parser = new MIME::Parser;

# Create and set the output directory:
$host = hostname;
$date = time();
$pid = $$;
$tmpdir="/var/tmp/mime-tmp-dir-${host}-${date}-${pid}";
(-d "$tmpdir") or mkdir("$tmpdir",0755) or tmpfail("$!");
(-w "$tmpdir") or tmpfail("Can't write to $tmpdir");
$parser->output_dir("$tmpdir");

# parse the message
$entity = $parser->read(\*STDIN) or tmpfail("couldn't parse MIME stream");

# add text strings
@names=();
getnames($entity);
mangle($entity);
chomp ($subject=$entity->head->get('Subject',0));
$entity->head->replace('Subject', "$subject - ***large attachments deleted*** ");

# delete all parts that aren't text or mime multipart
$entity->parts([ grep { $_->effective_type =~ /^(text|message|multipart)\// } $entity->parts ]);

# Fixup (or create) content-length headers
$entity->sync_headers(Length => 'COMPUTE', Nonstandard => 'ERASE');

# dump it
$entity->print(\*STDOUT);

# Clean up tmpfiles and then go to sleep
$parser->filer->purge;
rmdir("$tmpdir");