X-Git-Url: http://git.jankratochvil.net/?p=PerlMail.git;a=blobdiff_plain;f=My-Audit.pm;h=6619e11dc4cdc377163f7d15edb169fea1b7c242;hp=45c202ce89164207b3d171b3f9eb71a398b6be19;hb=6d6388726f6485433630527fdc5bd3a525d9a517;hpb=991fa5bfbdc7a0aecf47d1d13be2ce97547c7f94 diff --git a/My-Audit.pm b/My-Audit.pm index 45c202c..6619e11 100644 --- a/My-Audit.pm +++ b/My-Audit.pm @@ -4,7 +4,7 @@ sub audit_init { %audit_profile=( "btw" =>[], - "silent"=>["=btw" ,"did","syslog"], + "silent"=>["=btw" ,"did"], "log" =>["=silent","syslog"], "bell" =>["=log" ,"bell"], "sms" =>["=bell" ,"sms=1"], @@ -19,6 +19,11 @@ sub audit_init { "SqueezeControl"=>"max" ,"SQZ_OPTIMIZE_LEVEL"=>0 }, { "SqueezeControl"=>"max" ,"SQZ_OPTIMIZE_LEVEL"=>1 }, ); + @alternates_host=( + "jabberwock.ucw.cz", # short@ucw.cz + "atrey.karlin.mff.cuni.cz", # short@atrey.karlin.mff.cuni.cz + "k332.feld.cvut.cz", # short@k332.feld.cvut.cz + ); } sub audit @@ -34,16 +39,6 @@ sub audit || headerhas "From",'' ); - # spam detection - return if did sub { - local $store_profile="silent"; - local $_; - store "=spam-rbl" .";$_" if $_=$Audit->rblcheck(); - store "=spam-razor".($_ eq 1 ? "" : ";$_") if $_=razor2(); - # I don't send viruses but viruses propagate mails of mine - store "=spam-av" if headeris "X-Mailer",'ravmd/8.3.2'; - }; - # spam honeypots return if did sub { local $_; @@ -53,6 +48,7 @@ sub audit store "=spamo" if headeris "From",''; store "=spamo" if headeris "From",''; store "=spamo" if headeris "From",''; + store "=spamo" if headeris "From",''; { # weak detection: files with text/html w/o text/plain are usually a spam my @types_linear=map({ mime_type($_); } parts_linear()); @@ -61,6 +57,18 @@ sub audit store "=spamo-big5" if ($_=mimehead(body_first())->mime_attr("Content-Type.charset")) && /^big5/i; }; + # spam detection + return if did sub { + local $store_profile="silent"; + local $_; + store "=spam-abuse" .";$_","log" if $_=dnsbl '.blackholes.mail-abuse.org.' ,1; # all hosts + # we don't check all hosts as they can be "dialup" category, FIXME: check for it + store "=spam-five" .";$_","log" if $_=dnsbl '.blackholes.five-ten-sg.com.',0; # just first + store "=spam-razor".($_ eq 1 ? "" : ";$_") if $_=razor2(); + # I don't send viruses but viruses propagate mails of mine + store "=spam-av" if headeris "X-Mailer",'ravmd/8.3.2'; + }; + # special delivery store "=err","bell" and return if headerhas \&Received_for,''; @@ -93,6 +101,7 @@ sub audit + ); store "=gsm" if headeris "Sender" ,''; @@ -109,13 +118,14 @@ sub audit store "=gtkd","log" if headeris "List-Id" ,''; store "=mffstatnice","bell" if headeris "List-Post",''; store "=hw","log" if headeris "List-Post",''; - store "=gnokii","bell" if headeris "List-Id" ,''; + store "=gnokii","log" if headeris "List-Id" ,''; store "=winelic","log" if headeris "List-Id" ,''; store "=wined","log" if headeris "List-Id" ,''; - store "=winepat","log" if headeris "List-Id" ,''; + store "=winepat","silent" if headeris "List-Id" ,''; store "=winecvs","silent" if headeris "List-Id" ,''; + store "=wineann","log" if headeris "List-Id" ,''; store "=ros","log" if headeris "List-Post",''; - store "=roskernel","bell" if headeris "List-Post",''; + store "=roskernel","log" if headeris "List-Post",''; store "=roscvs","silent" if headeris "List-Post",''; store "=fsd","log" if headeris "X-Mailing-List",''; store "=surprise","sms" if headeris "List-Post",''; @@ -123,7 +133,7 @@ sub audit store "=tacacs","log" if headeris "Sender" ,''; store "=tacacsd","log" if headerhas \&Received_for,'devel@tacplus.org'; # TODO: fix when real list store "=pm","sms" if headeris "Sender" ,''; - store "=radary","sms" if headeris "Reply-To" ,''; + store "=radary","log" if headeris "Reply-To" ,''; store "=dnet","log" if headeris "Sender" ,'<@lists.distributed.net>'; store "=linux-input","log" if headeris "List-Post",''; store "=strom","bell" if headeris "List-Post",''; @@ -134,42 +144,74 @@ sub audit store "=4c","sms" if headeris "List-Post",'<4cinfo@atrey.karlin.mff.cuni.cz>'; store "=slashdot","bell" if headeris "From" ,''; store "=freshmeat","bell" if headeris "From" ,''; + store "=sourceforge","bell" if headeris "From" ,''; store "=gsmperlcvs","silent" if headeris("From" ,'') && $Audit->subject()=~/^'.*' has been updated!$/; # own webs store "=energie","bell" if headeris "From" ,qr/^EnergieWeb/; # Petr Koutecky does not mark his Stuff - store "=koutecky","bell" if headeris "From" ,''; + store "=koutecky","log" if headeris "From" ,''; store "=errm","bell" if $isFROM_MAILER && !did(); store "==","sms" if !did; } +sub audit_sms_address +{ +my($obj)=@_; + + my $address=$obj->address(); + if (my $alternates=muttrc_get("alternates")) { + return "I" if $address=~/$alternates/si; + } + my %aliases=muttrc_aliases(); + if (my $alias=$aliases{lc $address}) { + local $_=$alias; + s/\.cz$//i; + return $_; + } + local $_=$address; + s/\b(Bus)siness$/$1/i; + s/\.ident$//i; + return $_; +} + sub audit_sms { my(%args)=@_; - my $from=(@{$args{"from"}} ? join(",",map({ - s/\.cz$//i; - $_; - } @{$args{"from"}})) : "?"); - local $_=$args{"body"}; - + my $from=(@{$args{"from"}} ? join(",",map({ audit_sms_address($_); } @{$args{"from"}})) : "?"); + local $_; + + $_=$args{"subject"}; + # headers + s/(?:Re|Aw|Odp|Fw|Fwd|OT)(?:\[\d+\])?://ig; + # former subject + s/\bbylo:.*$//i; + s/\[\s*WAS:.*\]\s*$//i; + # trim + s/^\s*//s; + s/\s*$//s; + my $subject=$_; + + $_=$args{"body"}; # max. 9 lines of .sig s/\n-- (?:\n[^\n]*){0,9}$//gs; # "Original Message"/"Puvodni zprava" etc. up to empty line - s/(^|\n)[\s^\n]*-----[\w\s]*-----[\s^\n]*(?:\n[^\n]+)*\n{2,}(?:\s*[^>\s].*$)?/\n/gs; + # "- - - Original message: - - -" is by "Lotus Notes Release 5.0.5 September 22, 2000" + s/(^|\n)[\s^\n]*(?:-----[\w\s]*-----|- - - Original message: - - -)[\s^\n]*(?:\n[^\n]+)*\n{2,}(?:\s*[^>\s].*$)?/\n/gs; # Remove "..." lines (is it used by anyone except me?) s/^\Q...\E$/*/gm; # quoting "> " - s/^\s*[>][>\s]*.*$/*/gm; + s/^(?:\s*[[:upper:]]{0,3}>)+.*$/*/gm; s/(?:^|\n)(?:\*\n+)+/\n*\n/gs; # attributions - s/^.*\b(?:wrote|writes):\s*$//gm; + s/^.*\b(?:wrote|writes|napsal jste):\s*$//gm; + my $body=$_; - return [$from,"(".$args{"subject"}.")".$_]; + return [$from,"($subject)$body"]; } 1;