--- a/mimecut Fri Aug 24 10:06:45 2007 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,436 +0,0 @@
-#!/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