# HG changeset patch # User heiko # Date 1188831332 0 # Node ID b58ecd25d1f17f08fe3196995c6555b2801ea6ae # Parent c43594b89549e619a6d9b8950278df46a46457b9 - etwas umgeräumt diff -r c43594b89549 -r b58ecd25d1f1 mimecut.pl --- a/mimecut.pl Mon Sep 03 12:57:43 2007 +0000 +++ b/mimecut.pl Mon Sep 03 14:55:32 2007 +0000 @@ -1,5 +1,5 @@ -#!/usr/bin/perl -#$Id$ +#! /usr/bin/perl +# $Id$ use strict; use warnings; @@ -9,6 +9,11 @@ use Getopt::Long; use File::Basename; use FindBin qw($Bin); +use if $ENV{DEBUG} => "Smart::Comments", $ENV{DEBUG}; + +BEGIN { + delete @ENV{ "LANG", grep /^LC_/, keys %ENV }; +} my $ME = basename $0; my $MEPID = $$; @@ -64,22 +69,19 @@ my $conf_mimes = "$CONFDIR/mimes.conf"; my $conf_vips = "$CONFDIR/vips.conf"; -my $vips; -my $mimes; +my @vips; +my @mimes; -my $out_err; -my $out_std; my $logfile; -my $prefix = ''; sub read_conf($); sub new_parser(); -sub get_mail_data($); +sub get_mail_header($); sub new_mail(%); sub new_mail_send($); -sub check_vip(%); -sub check_multipart($$); -sub check_part($$$); +sub check_vip($%); +sub check_multipart($$$$); +sub check_part($$$$$); sub replace_part($$$); MAIN: { @@ -102,8 +104,6 @@ system("pod2usage -v 3 $0") and exit 0; } - $out_std = *STDOUT; - if ($opt_fake) { $opt_debug = 1 } if ($opt_log) { die "$ME: can't fake in log mode!\n" if $opt_fake; @@ -112,30 +112,30 @@ or die "$ME: can't open logfile!\n"; $opt_debug = 1; } - elsif (!$opt_debug) { open(STDERR, ">/dev/null") } + elsif (!$opt_debug) { open(STDERR, ">/dev/null") } if ($opt_strain) { if ($opt_fake) { - print $out_err "$ME: can't fake in strain mode!\n"; + warn "$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"; + warn "$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); + @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; + local $" = ", "; + print "mimes: @mimes\n"; + exit 0; } if ($opt_vips) { - $vips =~ s/\|/\n/g; - print "$vips\n"; + local $" = ", "; + print "vips: @vips\n"; exit 0; } @@ -143,47 +143,55 @@ ### - my $mail = new_parser(); - my %data = get_mail_data($mail); + my $parser = new MIME::Parser; + $parser->output_to_core(1); # FIXME: was ist bei sehr großen Mails? - print $out_err "\n$ME\[$MEPID\]: " . scalar localtime() . "\n"; - print $out_err "<< " . $data{from} . "\n>> " . $data{to} . "\n"; + my $mail = $parser->parse(\*STDIN); + my %header = get_mail_header($mail); + + warn "\n$ME\[$MEPID\]: @{[scalar localtime]}\n" + . "<<$header{from}\n" + . ">>$header{to}\n"; if ($opt_strain) { - print $out_err " STRAIN MODE\n"; + warn " 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; + { + #### checking vips: \@vips + my $result; + if (@vips and $result = check_vip(\@vips, %header)) { + warn " $result\n"; + new_mail_send($mail); + exit 0; + } } - if ($data{mtype} =~ /multipart/) { + if ($header{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]", + warn ",$hl1.$hl2.$hl3.\n"; + warn sprintf "| %-30s | %-6s | %-34s |\n", "part [subparts]", "status", "filename"; - print $out_err "+$hl1+$hl2+$hl3+\n"; + warn "+$hl1+$hl2+$hl3+\n"; - my $mail_new = new_mail(%data); - $mail_new = check_multipart($mail, $mail_new); + my $mail_new = new_mail(%header); + $mail_new = check_multipart(\@mimes, $mail, $mail_new, 0); - print $out_err "`$hl1'$hl2'$hl3'\n"; + warn "`$hl1'$hl2'$hl3'\n"; new_mail_send($mail_new); exit 0; } else { - print $out_err "** SINGLEPART\n"; + warn "** SINGLEPART\n"; new_mail_send($mail); exit 0; } @@ -198,110 +206,104 @@ 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); + return map { chomp; $_ } grep !/(?:^\s*#|^\s*$)/, <$fh>; } -sub get_mail_data($) { - my $mail = shift @_; +sub get_mail_header($) { + 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') || ''; + my %data; - chomp($mt, $pr, $ep, $da, $su, $fr, $to, $cc, $bc); + $data{mtype} = $mail->mime_type; + $data{preamble} = $mail->preamble || ''; + $data{epilogue} = $mail->epilogue || ''; + $data{date} = $mail->head->get('Date') || ''; + $data{subject} = $mail->head->get('Subject') || ''; + $data{from} = $mail->head->get('From') || ''; + $data{to} = $mail->head->get('To') || ''; + $data{cc} = $mail->head->get('CC') || ''; + $data{bcc} = $mail->head->get('BCC') || ''; - my %data = (mtype => $mt, - preamble => $pr, - epilogue => $ep, - date => $da, - subject => $su, - from => $fr, - to => $to, - cc => $cc, - bcc => $bc, - ); + map { chomp } values %data; 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; + return + MIME::Entity->build(Type => $data{mtype}, + Date => $data{date}, + From => $data{from}, + To => $data{to}, + CC => $data{cc}, + BCC => $data{bcc}, + Subject => $data{subject}, + ); } sub new_mail_send($) { my $mail = shift @_; if (!$opt_fake) { - print $out_std "From $ME " . scalar localtime() . "\n"; + print "From $ME " . scalar localtime() . "\n"; $mail->print; } } -sub check_multipart($$) { - my ($multipart, $mail_new) = @_; - my $parts_count = $multipart->parts; +sub check_multipart($$$$) { + my ($mimes, $old, $new, $level) = @_; + my $parts_count = $old->parts; - printf $out_err "| %-30s | %-6s | %-34s |\n", - "" . $prefix . $multipart->mime_type . " [$parts_count]", '', ''; - $prefix = $prefix . " "; + warn sprintf "| %-30s | %-6s | %-34s |\n", + " " x $level . $old->mime_type . " [$parts_count]", "", ""; - my @parts = $multipart->parts; + my @parts = $old->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/; + + if ($mtype =~ /multipart/) { + $new = check_multipart($mimes, $part, $new, $level + 1); + } + else { + check_part($mimes, $part, $mtype, $new, $level); + } } - return $mail_new; + + return $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_vip($%) { + my ($vips, %data) = @_; + my $re = join "|", map { $a = $_; $a =~ s/([^\da-z])/\\$1/gi; $a } @$vips; + my @matched; + + foreach (qw(from to cc bcc)) { + push @matched, "VIP $_" if $data{$_} =~ /$re/o; } + + return @matched if wantarray; + return join ", ", @matched; } -sub check_part($$$) { - my ($part, $mtype, $mail_new) = @_; +sub check_part($$$$$) { + my ($mimes, $part, $mtype, $mail_new, $level) = @_; my $status = 'cut'; + my $re = join "|", map { $a = $_; $a =~ s/([^\da-z])/\\$1/gi; $a } @$mimes; + 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' } + elsif ($re) { + if ($mtype =~ /$re/) { $status = 'kept' } } if ($status eq 'kept') { @@ -309,8 +311,10 @@ } elsif ($status eq 'cut') { replace_part($part, $filename, $mail_new) } - printf $out_err "| %-30s | %-6s | %34.34s |\n", "$prefix$mtype", - "$status", "$filename"; + warn sprintf "| %-30s | %-6s | %34.34s |\n", + " " x ($level+1) . $mtype, + $status, + $filename; } sub replace_part($$$) { diff -r c43594b89549 -r b58ecd25d1f1 vips.conf --- a/vips.conf Mon Sep 03 12:57:43 2007 +0000 +++ b/vips.conf Mon Sep 03 14:55:32 2007 +0000 @@ -3,3 +3,4 @@ # insert vip addresses who will receive uncut messages # one per line info@siemens.ch +pitti@platsch.de