--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/mimecut Mon Aug 20 12:19:23 2007 +0000
@@ -0,0 +1,437 @@
+#!/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 cut read 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 = 'kept';
+
+ 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 = 'cut' }
+ }
+
+ 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 von der e-Mail abgetrennt werden
+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