diff -r 9755876da778 -r 5bdd42401211 mimecut.pl
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/mimecut.pl	Mon Sep 03 12:22:41 2007 +0000
@@ -0,0 +1,436 @@
+#!/usr/bin/perl
+#$Id$
+
+use strict;
+use warnings;
+use MIME::Parser;
+use MIME::Entity;
+use MIME::Head;
+use Getopt::Long;
+use File::Basename;
+
+my $ME      = basename $0;
+my $MEPID   = $$;
+my $CONFDIR = '.';
+my $LOGDIR  = '.';
+my $HELP    = <<EOF;
+Usage:
+    $ME [options] < mail
+    $ME [actions]
+
+Options:
+    -d, --debug
+        Output detailed information how the mail and its parts is parsed using
+        STDERR for output.
+
+    -l, --logfile
+        Writes the debug information to mimcut.log file instead of printing to
+        STDERR.
+
+    -t, --text
+        With this mode only plain/text mimes will pass the cut.
+
+    -f, --fake
+        Do not output anything to STDOUT. (This enables debugging but can't be
+        used with log and/or strain mode!)
+
+    -s, --strain
+        Will output the mail instantly and unchanged to STDOUT.
+
+Actions:
+    -m, --mimes
+        List each mime which is to be kept from mimes.conf.
+
+    -v, --vips
+        List allowed senders/RCPT's/CC's/BCC's who will get unchanged mail.
+
+    -p, --pod
+        In detail information about the way this script works.
+
+    -h, --help
+        Show this help screen and exit.
+EOF
+
+my $opt_debug;
+my $opt_log;
+my $opt_text;
+my $opt_fake;
+my $opt_strain;
+my $opt_mimes;
+my $opt_vips;
+my $opt_help;
+my $opt_pod;
+
+my $conf_mimes = "$CONFDIR/mimes.conf";
+my $conf_vips  = "$CONFDIR/vips.conf";
+my $vips;
+my $mimes;
+
+my $out_err;
+my $out_std;
+my $out_null;
+my $logfile;
+my $prefix = '';
+
+sub read_conf($);
+sub new_parser();
+sub get_mail_data($);
+sub new_mail(%);
+sub new_mail_send($);
+sub check_vip(%);
+sub check_multipart($$);
+sub check_part($$$);
+sub replace_part($$$);
+
+MAIN: {
+    Getopt::Long::Configure("bundling");
+    GetOptions("d|debug"  => \$opt_debug,
+               "l|log"    => \$opt_log,
+               "t|text"   => \$opt_text,
+               "s|strain" => \$opt_strain,
+               "f|fake"   => \$opt_fake,
+               "m|mimes"  => \$opt_mimes,
+               "v|vips"   => \$opt_vips,
+               "h|help"   => \$opt_help,
+               "p|pod"    => \$opt_pod,
+    ) or die "$ME: try\n  $ME --help\n";
+
+    if ($opt_help) {
+        print $HELP and exit 0;
+    }
+    if ($opt_pod) {
+        system("pod2usage -v 3 $0") and exit 0;
+    }
+
+    $out_std = *STDOUT;
+    open($out_null, '>', '/dev/null')
+        or die "$ME can't trash output!\n$!";
+    $out_err = $out_null;
+
+    if ($opt_fake) { $opt_debug = 1 }
+    if ($opt_log) {
+        die "$ME: can't fake in log mode!\n"
+            if ($opt_fake);
+        die "$ME: can't debug in log mode!\n"
+            if ($opt_debug);
+        open($logfile, ">> $LOGDIR/$ME.log")
+            or die "$ME: can't open logfile!\n";
+        $opt_debug = 1;
+        $out_err   = $logfile;
+    }
+    elsif ($opt_debug) { $out_err = *STDERR }
+
+    if ($opt_strain) {
+        if ($opt_fake) {
+            print $out_err "$ME: can't fake in strain mode!\n";
+            exit 0;
+        }
+        if ($opt_text) {
+            print $out_err "$ME: can't use text-only in strain mode!\n";
+            exit 0;
+        }
+    }
+
+    $mimes = read_conf($conf_mimes) unless $opt_text;
+    $vips = read_conf($conf_vips);
+
+    if ($opt_mimes) {
+        $mimes =~ s/\|/\n/g;
+        print "$mimes\n";
+        exit 0 unless $opt_vips;
+    }
+    if ($opt_vips) {
+        $vips =~ s/\|/\n/g;
+        print "$vips\n";
+        exit 0;
+    }
+
+    die "$ME: no mail on stdin!\n$!" if (-z *STDIN);
+
+    ###
+
+    my $mail = new_parser();
+    my %data = get_mail_data($mail);
+
+    print $out_err "\n$ME\[$MEPID\]: " . scalar localtime() . "\n";
+    print $out_err "<< " . $data{from} . "\n>> " . $data{to} . "\n";
+
+    if ($opt_strain) {
+        print $out_err "   STRAIN MODE\n";
+        new_mail_send($mail);
+        exit 0;
+    }
+
+    if (my $result = check_vip(%data)) {
+        print $out_err "   $result\n";
+        new_mail_send($mail);
+        exit 0;
+    }
+
+    if ($data{mtype} =~ /multipart/) {
+
+        my $hl1 = '-' x 32;
+        my $hl2 = '-' x 8;
+        my $hl3 = '-' x 36;
+        my $hl  = '-' x 78;
+
+        print $out_err ",$hl1.$hl2.$hl3.\n";
+        printf $out_err "| %-30s | %-6s | %-34s |\n", "part [subparts]",
+            "status", "filename";
+        print $out_err "+$hl1+$hl2+$hl3+\n";
+
+        my $mail_new = new_mail(%data);
+        $mail_new = check_multipart($mail, $mail_new);
+
+        print $out_err "`$hl1'$hl2'$hl3'\n";
+        new_mail_send($mail_new);
+        exit 0;
+
+    }
+    else {
+
+        print $out_err "** SINGLEPART\n";
+        new_mail_send($mail);
+        exit 0;
+    }
+}
+
+###
+
+sub read_conf($) {
+    my $conf = shift @_;
+
+    die "$ME: can't find $conf!\n" if (!-e $conf);
+
+    my $fh;
+    open($fh, "< $conf") or die "$ME: can't read $conf!\n";
+    my $re = join('|', my @re = grep (!/(?:^\s{0,}#|^\s{0,}$)/, <$fh>));
+    $re =~ s/(?:\n|\s)//g;
+    return $re;
+}
+
+sub new_parser() {
+    my $parser = new MIME::Parser;
+    $parser->output_to_core(1);
+    return $parser->parse(\*STDIN);
+}
+
+sub get_mail_data($) {
+    my $mail = shift @_;
+
+    my $mt = $mail->mime_type;
+    my $pr = $mail->preamble || '';
+    my $ep = $mail->epilogue || '';
+    my $da = $mail->head->get('Date') || '';
+    my $su = $mail->head->get('Subject') || '';
+    my $fr = $mail->head->get('From') || '';
+    my $to = $mail->head->get('To') || '';
+    my $cc = $mail->head->get('CC') || '';
+    my $bc = $mail->head->get('BCC') || '';
+
+    chomp($mt, $pr, $ep, $da, $su, $fr, $to, $cc, $bc);
+
+    my %data = (mtype    => $mt,
+                preamble => $pr,
+                epilogue => $ep,
+                date     => $da,
+                subject  => $su,
+                from     => $fr,
+                to       => $to,
+                cc       => $cc,
+                bcc      => $bc,
+    );
+
+    return (%data);
+}
+
+sub new_mail(%) {
+    my %data = @_;
+    my $mail_new = MIME::Entity->build(Type    => $data{mtype},
+                                       Date    => $data{date},
+                                       From    => $data{from},
+                                       To      => $data{to},
+                                       CC      => $data{cc},
+                                       BCC     => $data{bcc},
+                                       Subject => $data{subject},
+    );
+    return $mail_new;
+}
+
+sub new_mail_send($) {
+    my $mail = shift @_;
+    if (!$opt_fake) {
+        print $out_std "From $ME " . scalar localtime() . "\n";
+        $mail->print;
+    }
+}
+
+sub check_multipart($$) {
+    my ($multipart, $mail_new) = @_;
+    my $parts_count = $multipart->parts;
+
+    printf $out_err "| %-30s | %-6s | %-34s |\n",
+        "" . $prefix . $multipart->mime_type . " [$parts_count]", '', '';
+    $prefix = $prefix . " ";
+
+    my @parts = $multipart->parts;
+    foreach my $part (@parts) {
+        my $mtype = $part->mime_type;
+        check_part($part, $mtype, $mail_new) unless $mtype =~ /^multipart/;
+        $mail_new = check_multipart($part, $mail_new)
+            if $mtype =~ /^multipart/;
+    }
+    return $mail_new;
+}
+
+sub check_vip(%) {
+    if ($vips) {
+        my %data = @_;
+        return "VIP FROM" if $data{from} =~ /<(?:$vips)>/i;
+        return "VIP RCPT" if $data{to}   =~ /<(?:$vips)>/i;
+        return "VIP CC"   if $data{cc}   =~ /<(?:$vips)>/i;
+        return "VIP BCC"  if $data{bcc}  =~ /<(?:$vips)>/i;
+    }
+}
+
+sub check_part($$$) {
+    my ($part, $mtype, $mail_new) = @_;
+    my $status = 'cut';
+
+    my $disposition = ($part->get('Content-Disposition') =~ /filename="(.+)"/)
+        and my $filename = $1
+        if $part->get('Content-Disposition');
+    $filename = 'n/a' unless $filename;
+
+    if ($opt_text) {
+        if   ($mtype =~ m[text/plain]) { $status = 'kept' }
+        else                           { $status = 'cut' }
+    }
+    elsif ($mimes) {
+        if ($mtype =~ m[(?:$mimes)]) { $status = 'kept' }
+    }
+
+    if ($status eq 'kept') {
+        $mail_new->add_part($part);
+    }
+    elsif ($status eq 'cut') { replace_part($part, $filename, $mail_new) }
+
+    printf $out_err "| %-30s | %-6s | %34.34s |\n", "$prefix$mtype",
+        "$status", "$filename";
+}
+
+sub replace_part($$$) {
+
+    # TODO	part ersetzen ohne boundary zu verlieren
+    # 		kurze info zu mime/filetype oder so
+}
+
+=pod
+
+=head1 NAME
+
+mimecut -- entfernt oder ersetzt AnhE<auml>nge anhand MIME's
+
+=head1 SYNOPSIS
+
+=over
+
+=item B<mimecut> [OPTION] < Mail
+
+=item B<mimecut> [ACTION]
+
+=back
+
+=head1 DESCRIPTION
+
+Eine e-Mail, die E<uuml>ber STDIN an mimecut E<uuml>bergeben wird, wird auf
+Ihre Struktur untersucht. Ist sie keine multipart e-Mail erfolgt die Ausgabe
+sofort und ungeE<auml>ndert E<uuml>ber STDOUT.
+
+Ist die e-Mail multipart, werden die einzelnen parts, gegebenenfalls rekursiv
+durchlaufen und auf ihre mime-types hin analysiert. 
+mimecut benE<ouml>tigt zwei Konfigurationsdateien:
+
+=over
+
+=item B<mimes.conf>
+
+Hier sind die mime-types erfasst, welche in der e-Mail enthalten bleiben sollen.
+
+=item B<vips.conf>
+
+Die Liste der EmpfE<auml>nger/Sender/CC's/BCC's, welche ungekE<uuml>rzte e-Mails bekommen.
+
+=back
+
+Anhand der Konfiguration wird zunE<auml>chst der e-Mail header
+E<uuml>berprE<uuml>ft und falls keine VIP e-Mail vorliegt, werden die parts
+mit den zu entfernenden mimes abgetrennt.
+
+=head1 OPTIONS
+
+=over
+
+=item B<-d, --debug>
+
+Gibt einen Statusbericht auf STDERR aus.
+
+=item B<-l, --logfile>
+
+Schreibt das debug in oder hE<auml>ngt es an die Datei mimecut.log im Pfad von mimecut an.
+
+=item B<-t, --text>
+
+Entfernt alle AnhE<auml>nge mit einem anderen mimetype als plain/text.
+
+=item B<-f, --fake>
+
+Testet was passieren wE<uuml>rde, ohne jedoch eine e-Mail E<uuml>ber STDOUT auszugeben.
+(aktiviert automatisch B<-d>)
+
+=item B<-s, --strain>
+
+Gibt die e-Mail, ganz gleich VIP oder nicht, sofort und unverE<auml>ndert E<uuml>ber
+STDOUT aus
+
+=back
+
+=head1 ACTIONS
+
+=over
+
+=item B<-m, --mimes>
+
+Ausgabe der aus der mimes.conf eingelesenen MIME's.
+
+=item B<-v, --vips>
+
+Ausgabe der aus der vips.conf eingelesenen VIP-Adressen.
+
+=back
+
+=head1 OTHER
+
+=over
+
+=item B<-h, --help>
+
+Kurze Hilfe mit SYNOPSIS, OPTIONS & ACTIONS.
+
+=item B<-p, --pod>
+
+Diese Dokumentation.
+
+=back
+
+=head1 FILES
+
+=over
+
+=item B<mimes.conf>, B<vips.conf>, B<mimecut.log>
+
+=back
+
+=cut
+
+# vim:ft=perl:tw=78:ts=4