# $Id$ sub audit_init { %audit_profile=( "btw" =>[], "silent"=>["=btw" ,"did"], "log" =>["=silent","syslog"], "bell" =>["=log" ,"bell"], "sms" =>["=bell" ,"sms=1"], "crit" =>["=sms" ,"sms=3"], ); @sms_squeezes=( { "SqueezeControl"=>"noconv" }, { "SqueezeControl"=>"conv" ,"SQZ_OPTIMIZE_LEVEL"=>0 }, { "SqueezeControl"=>"conv" ,"SQZ_OPTIMIZE_LEVEL"=>1 }, { "SqueezeControl"=>"med" ,"SQZ_OPTIMIZE_LEVEL"=>0 }, { "SqueezeControl"=>"med" ,"SQZ_OPTIMIZE_LEVEL"=>1 }, { "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", # k332.feld.cvut.cz ); } sub audit { # TODO: storage? # never spawn new mail if FROM_MAILER # $isFROM_MAILER postponed after maillists as they may look as FROM_MAILER #use re 'debug'; my $isFROM_MAILER=$Audit->header()=~/$procmailFROM_MAILER/mio; $store_ignorenewmail=(0 || $isFROM_MAILER || headerhas "From",'' ); # 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'; }; # spam honeypots return if did sub { local $_; local $store_profile="silent"; store "=spamo-k332" if grep /^\Qshort\@k332.feld.cvut.cz\E/i,Received_for(); # TODO: foreign violation of RFC 822 section 4.4.4, Subject:.*Automatick.+odpov.+v.+nep.+tomnosti 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()); store "=spamo-html" if grep({ $_ eq "text/html"; } @types_linear) && !grep({ $_ eq "text/plain"; } @types_linear); } store "=spamo-big5" if ($_=mimehead(body_first())->mime_attr("Content-Type.charset")) && /^big5/i; }; # special delivery store "=err","bell" and return if headerhas \&Received_for,''; # ppl-wished foreign remapping, Reply-To is left untouched! header_remap("From",{ 'kerere@post.cz' =>'kamzik@k332.feld.cvut.cz', 'profes@mbox.vol.cz' =>'kratochvilova@egp.cz', 'jkrouzek@mbox.vol.cz' =>'krouzek@mbox.fsv.cuni.cz', 'jakub.gorner@lidovky.cz' =>'tonda@disnet.cz', 'jan.kolar@videoprogress.cz'=>'jenda.kolar@volny.cz', 'daniel.rulicek@cponline.cz'=>'daniel.rulicek@cpress.cz', 'pavel@suse.cz' =>'pavel@ucw.cz', }); # My obsolete e-mail addresses store_muttrc_alternates "=redirect-","btw"; # nasty public lists with $store_ignore { local $store_profile="bell"; local $store_ignore; $store_ignore="smsmail" if 1==$Audit->body() && length(join "",$Audit->body())<180; # SMS mail $store_ignore="sms OS" if $Audit->subject()=~/^Email pro: /; # "^Email pro: gsm@sh\.cvut\.cz$"; $store_ignore="list-moron" if grep { headeris "From",$_; } qw( <@mujoskar.cz> ); store "=gsm" if headeris "Sender" ,''; store "=gsmpand" if headeris "List-Post",''; } # lists store "=mozillabug","log" if headeris "From" ,''; store "=9kc","bell" if headeris "List-Post",''; store "=9kcd","bell" if headeris "List-Post",''; store "=9ku","log" if headeris "List-Id" ,'<9000.listman.net>'; store "=9kd","log" if headeris "Sender" ,''; store "=spong","log" if headeris "List-Id" ,''; store "=gtkd","log" if headeris "List-Id" ,''; store "=mffstatnice","bell" if headeris "List-Post",''; store "=hw","log" if headeris "List-Post",''; store "=gnokii","log" if headeris "List-Id" ,''; store "=winelic","log" if headeris "List-Id" ,''; store "=wined","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","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",''; store "=surprisesuse","sms" if headeris "Sender" ,''; 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","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",''; store "=netinfo","log" if headeris "Sender" ,''; store "=saintmj","log" if headeris "From" ,''; store "=saintmj","log" if headeris "From" ,''; store "=4cerr","bell" if headeris "From" ,''; 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 "=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","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({ 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 # "- - - 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*[[:upper:]]{0,3}>)+.*$/*/gm; s/(?:^|\n)(?:\*\n+)+/\n*\n/gs; # attributions s/^.*\b(?:wrote|writes|napsal jste):\s*$//gm; my $body=$_; return [$from,"($subject)$body"]; } 1;