#! /usr/bin/perl # # $Id$ # Copyright (C) 2002-2003 Jan Kratochvil # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA package PerlMail::Config; use vars qw($VERSION); $VERSION=do { my @r=(q$Revision$=~/\d+/g); sprintf "%d.".("%03d"x$#r),@r; }; use strict; use warnings; require Exporter; use vars qw(@ISA @EXPORT); @ISA=qw(Exporter); @EXPORT=qw( $HOME $Mail @ValidUsers $IdleMax $MaxBodySMS @SMSwebRcpt $SMSwebRcpt_username $Lock_pathname $PeerAddr $Socket_timeout $DB_table $DBI_database $DBI_user $DBI_pwd $clamscan_waitpid_timeout $sendmail_orig @addr_addon @h_rcpt @h_from %audit_profile @sms_squeezes @alternates_host @dnsbl_whitelist $Audit $is_pgp $opt_F $procmailFROM_MAILER $store_ignore $store_ignorenewmail $store_profile ); require Mail::Alias; use Carp qw(confess cluck); BEGIN { for (qw(headerhas store headeris did dnsbl store_muttrc_alternates Received_for parts_linear mime_type body_first body_simple is_multipart mimehead mimebody spamassassin clamscan header_remap lmtp_deliver)) { eval 'sub '.$_.' { return ::'.$_.'(@_); }'; } } # perlmail-accept & perlmail-sendmail # Various configuration files location is derived from it: our $HOME="/home/jkratoch"; # perlmail-accept # Mail folder: our $Mail="$HOME/Mail"; # Users respected for the 'idle' state (see $IdleMax): our @ValidUsers=qw(root lace short kratochvil _local jkratoch); # Maximum number of local console idle seconds while still considered as 'active user': our $IdleMax=10; # Maxium number of bytes to pass to Lingua::EN::Squeeze (performance optimization): our $MaxBodySMS=0x1000; # Telephone number to send SMSes by WWW::SMS to: our @SMSwebRcpt=qw(420 602 431329); # Some WWW::SMS modules require username: our $SMSwebRcpt_username="lace2"; our $lmtp_admin="cyrus"; our $lmtp_pwd; #{ # local *F; # open F,"$HOME/priv/lmtp.${lmtp_admin}.pwd" or die; # $lmtp_pwd=; # chomp $lmtp_pwd; # close F or die; # } our $lmtp_user_from="lace"; our $lmtp_user_to="lacemail"; our $clamscan_waitpid_timeout=3; # perlmail-submit # Global system lock for exclusive $DB_table access: our $Lock_pathname="/tmp/PerlMail.lock"; # 'workstation' hostname and port. Hostname may be dyndns: our $PeerAddr="kashome.dyn.jankratochvil.net.:852"; #our $PeerAddr="127.0.0.1:2852"; # 15sec is NOT enough as the remote peer must complete mail store: our $Socket_timeout=7600; # MySQL table name: our $DB_table="PerlMail_folder"; # MySQL database name: our $DBI_database="short"; # MySQL user name: our $DBI_user="short"; # MySQL user password: our $DBI_pwd=$HOME."/priv/mysql.".$DBI_user.".pwd"; # Pathname of the original sendmail(8) binary: our $sendmail_orig=(-x ($_="/usr/sbin/sendmail-orig") ? $_ : "/usr/sbin/sendmail"); # List of addresses to locally Bcc all mails to: # Mail-Alias-1.12 defaults to "/etc/mail/aliases" which does not exist on RedHat sendmail-8.12.5-7 # Mail-Alias-1.12 will clutter $_ ! our @addr_addon=(Mail::Alias->new("/etc/aliases")->exists("sentout") ? ("sentout") : ()); our $opt_F; # imported our $is_pgp; # imported # Generate new From address for the target $rcpt of type Mail::Address. # RedHat sendmail-8.9.3-20/src/conf.c/HdrInfo[]/\Q/* destination fields */\E # FIXME: Recognize "Resent-$_" headers for -t but when we are in 'resent' mode? our @h_rcpt=( # case in-sensitive! "To", "Cc", "Bcc", "Apparently-To", ); # ordering matters; first header found is substituted # last header is subsituted if no one is found our @h_from=( "Resent-From", "From", ); # My-Audit # Setup profile names. # First element of /^=/ form copies it referenced profile to be extended. # 'did' =>did() subroutine will return true for it. # 'syslog' =>Use syslog(3). # 'bell' =>Bell sound. # 'sms=\d+'=>Send SMS by WWW::SMS with specified maximum # of parts our %audit_profile=( "btw" =>["syslog"], "silent"=>["=btw" ,"did"], "log" =>["=silent","syslog"], "bell" =>["=log" ,"bell"], "sms" =>["=bell" ,"sms=1"], "crit" =>["=sms" ,"sms=3"], ); # Try the squeezing methods in this order: our @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 }, ); # Hostnames where we had alternate e-mail addresses: our @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 ); # Override DNS blacklists: our @dnsbl_whitelist=( "195.250.128.83", # smtp3.vol.cz; vol.cz.multistage.blackholes.five-ten-sg.com. "64.49.222.22", # mail.pm.org: rackspace.com.spam-support.blackholes.five-ten-sg.com. "208.147.243.5", # gambit.liquidcomm.net: cw.net.spam-support.blackholes.five-ten-sg.com. "213.235.135.70", # smtp.tiscali.cz: tiscali.cz.multistage.blackholes.five-ten-sg.com. "205.139.198.11", # eniac.disaster.com: cw.net.spam-support.blackholes.five-ten-sg.com. "127.0.0.2", # 2.0.0.127.relays.ordb.org. "65.113.40.131", # bozo.vmware.com: qwest.net.spam-support.blackholes.five-ten-sg.com. "66.218.85.33", # mta2.wss.scd.yahoo.com: yahoo.com.spam.blackholes.five-ten-sg.com. "212.80.76.42", # mx2.seznam.cz: seznam.cz.free.blackholes.five-ten-sg.com. "64.110.204.63", # hsdbrg64-110-204-63.sasknet.sk.ca: 64.110.202.181.sasknet.sk.ca.misc.spam.blackholes.five-ten-sg.com. "212.80.76.44", # mx1.seznam.cz: 44.76.80.212.blackholes.five-ten-sg.com. "212.80.76.29", # prace.seznam.cz: 212.80.76.42.seznam.cz.free.blackholes.five-ten-sg.com "193.252.22.30", # smtp1.wanadoo.fr: 30.22.252.193.blackholes.five-ten-sg.com "213.151.87.16", # posta.dobnet.cz: 16.87.151.213.relays.ordb.org "70.71.0.212", # Red Hat ); our $Audit; # imported our $procmailFROM_MAILER; # imported our $store_ignorenewmail; # imported our $store_profile; # imported our $store_ignore; # imported sub audit { $store_profile=undef(); # 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 honeypots return if did sub { local $_; # Do not local $store_file as it is our-imported $store_profile="silent"; store "=spam" 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 "=spam" if headeris "From",''; store "=spam" if headeris "From",''; store "=spam" if headeris "From",''; store "=spam" if headeris "From",''; store "=spam" if headeris "From",''; store "=spam" if headeris "From",''; store "=spam" if headeris "From",''; store "=spam" if headeris "From",''; store "=spam" if headeris "From",''; store "=spam" if headeris "From",''; store "=spam" if headeris "From",''; for my $header (qw(To Cc)) { store "=spam" if headerhas $header,''; store "=spam" if headerhas $header,''; store "=spam" if headerhas $header,''; store "=spam" if headerhas $header,''; } { # weak detection: files with text/html w/o text/plain are usually a spam my @types_linear=map({ mime_type($_); } parts_linear()); store "=spamhtml" if grep({ $_ eq "text/html"; } @types_linear) && !grep({ $_ eq "text/plain"; } @types_linear); } ### store "=spambig5" if ($_=mimehead(body_first())->mime_attr("Content-Type.charset")) && /^big5/i; }; $store_profile=undef(); my $nonrh; for ($Audit->get("Received")) { $nonrh=1 if /\sby\s+mx\d+\Q.redhat.com\E\s/s; } $nonrh=1 if !headeris("From",qr/[@]redhat.com/i); # spam detection return if did sub { # Internal RH mails are never spam. return if !$nonrh; # It is too expensive to scan the huge =caperr announcements by spamassassin(1). return if headeris("From",qr/^captive-[a-z]*@/); # Do not local $store_file as it is our-imported $store_profile="log"; local $_; ### store "=spam".";virus=$_" if $_=clamscan(); store "=spam".";spamassassin".($_ eq 1 ? "" : "=$_") if $_=spamassassin(); # Down? ### store "=spam".";$_" if $_=dnsbl '.relays.ordb.org.' ,1; # all hosts if (0) { store "=spam".";$_" 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".";$_" if $_=dnsbl '.blackholes.five-ten-sg.com.',0; # just first # I don't send viruses but viruses propagate mails of mine } store "=spam".";ravmd" if headeris "X-Mailer",'ravmd/8.3.2'; store "=spam".';short@ucw.cz+MAILER' if $isFROM_MAILER && headeris("To",''); if (!is_multipart()) { local $_=mimebody(body_first()); my %sites=map(($_=>1),qw( brandenburg.rz.fhtw-berlin.de forum.gofeminin.de service.spiegel.de www.aufenthaltstitel.de www.berlinonline.de www.deutschlandchronik.de www.heise.de www.leverkusener-aufbruch.com www.libasoli.de www.mjoelnirsseite.de www.npd-nrw.net www.npd.de www.rp-online.de www.spiegel.de www.taz.de www.unserforum.com www.zdf.de )); my $found; while (m{http://([^/]+)/}g) { do { $found=1; next; } if $sites{$1}; $found=0; last; } $found=1 if /^\s*Lese selbst:\n/s; store "=spam".';german-news' if $found; } }; $store_profile=undef(); # special delivery store "=err","bell" and return if headerhas \&Received_for,''; store "=host1","bell" and return if headerhas \&Received_for,qr/\Qjan.kratochvil+\E\S*\Q.at.host1.dyn.jankratochvil.net\E@/; # if (headeris "X-Calendar-Attachment",qr/./) { # store "=zimbra","btw"; # my $headless=$::Message; # $headless=~s{^From .*?\n}{} or cluck "No From header for Zimbra"; # local *CHILD; # if (!$::Dry) { # open CHILD,q{|sendmail jkratoch@calendar.corp.redhat.com} # or cluck "Cannot forward to Zimbra"; # print CHILD $headless or cluck; # close CHILD or cluck; # } # } # lists store "=mozillabug","log" if headeris "From" ,''; 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","silent" if headeris "List-Id" ,''; store "=gnomevfs","log" if headeris "List-Id" ,''; store "=hw","log" if headeris "List-Post",''; store "=gnokii","log" if headeris "List-Id" ,''; store "=winelic","silent" if headeris "List-Id" ,''; store "=wined","silent" if headeris "List-Id" ,''; store "=winepat","silent" if headeris "List-Id" ,''; store "=winecvs","silent" if headeris "List-Id" ,''; store "=wineann","silent" if headeris "List-Id" ,''; store "=wineconf","silent" if headeris "List-Id" ,''; store "=ros","silent" if headeris "List-Id" ,''; store "=roskernel","silent" if headeris "List-Id" ,''; store "=rosd","silent" if headeris "List-Id" ,''; store "=roscvs","silent" if headeris "List-Id" ,''; store "=rossvn","silent" if headeris "List-Id" ,''; store "=rosbug","silent" if headeris "Reply-To" ,''; store "=fsd","silent" if headeris "X-Mailing-List",''; store "=kernel","silent" if headeris "X-Mailing-List",''; store "=kernelnet","silent" if headeris "X-Mailing-List",''; store "=ia64","silent" if headeris "X-Mailing-List",''; store "=linuxjap","silent" if headeris "X-Mailing-List",''; store "=kernelann","silent" if headeris "X-Mailing-List",''; store "=sparse","silent" if headeris "X-Mailing-List",''; store "=smp","silent" if headeris "X-Mailing-List",''; store "=tacacs","silent" if headeris "Sender" ,''; store "=tacacs","silent" if headeris "Sender" ,''; store "=tacacs","silent" if headeris "List-Id" ,''; store "=pm","log" if headeris "List-Id" ,''; store "=radary","log" if headeris "Reply-To" ,''; store "=dnet","log" if headeris "Sender" ,'<@lists.distributed.net>'; store "=netinfo","log" if headeris "Sender" ,''; 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!$/; store "=libtoold","silent" if headeris "List-Id" ,''; store "=libtoolpat","silent" if headeris "List-Id" ,''; store "=automake","silent" if headeris "List-Id" ,''; store "=autoconf","log" if headeris "List-Id" ,''; store "=autoconfpat","log" if headeris "List-Id" ,''; store "=hurd","log" if headeris "List-Id" ,''; store "=gccbug","silent" if headeris "List-Post",''; store "=gccann","log" if headeris "List-Post",''; store "=gcc","silent" if headeris "List-Post",''; store "=gccpat","silent" if headeris "List-Post",''; store "=ntfsann","silent" if headeris "List-Id" ,''; store "=ntfsd","silent" if headeris "List-Id" ,''; store "=orbit","silent" if headeris "List-Id" ,''; store "=kannel","log" if headeris "List-Id" ,''; store "=kanneld","log" if headeris "List-Id" ,''; store "=mailmand","silent" if headeris "List-Id" ,''; store "=asterisk-perl","log" if headeris "List-Post",''; store "=i4l","silent" if headeris "List-Id" ,''; store "=glibc","silent" if headeris "List-Post",''; store "=fedann","bell" if headeris("List-Id" ,'') || headeris("List-Id" ,''); store "=fedpkg","bell" if headeris "List-Id" ,''; store "=federrata","log" if headeris "Return-Path",''; store "=fedtools","log" if headeris "List-Id" ,''; store "=freleng","log" if headeris "List-Id" ,''; if (headeris("List-Id" ,'') || headeris("List-Id" ,'')) { store "=fedd","log"; store "=feddgdb","log" if body_simple()=~/\bgdb\b/i; store "=feddlibunwind","log" if body_simple()=~/libunwind/i; } store "=bashbug","log" if headeris "List-Id" ,''; store "=zaurus","silent" if headeris "List-Id" ,''; store "=zaurusann","log" if headeris "List-Id" ,''; store "=zaurusd","silent" if headeris "List-Id" ,''; store "=zaurussoft","silent" if headeris "List-Id" ,''; store "=iptperl","silent" if headeris "List-Id" ,''; store "=www-sms","log" if headeris "List-Id" ,''; store "=httpdd","log" if headeris "list-post",''; store "=imja","log" if headeris "List-Id" ,''; store "=wince","log" if headeris "List-Post",''; store "=mysqlperl","log" if headeris "List-Id" ,''; store "=whiteann","log" if headeris "List-Id" ,''; store "=white","log" if headeris "List-Id" ,''; store "=centos","log" if headeris "List-Id" ,''; store "=centann","log" if headeris "List-Id" ,''; store "=modperldoc","log" if headeris "List-Id" ,''; store "=qemud","log" if headeris "List-Id" ,''; store "=diamond","log" if headeris "X-Replicator-Inst",'"www.diamondcard.us"'; store "=soap","log" if headeris "Sender" ,''; store "=nagiosd","log" if headeris "List-Id" ,''; store "=nagios","log" if headeris "List-Id" ,''; store "=grub","log" if headeris "List-Id" ,''; store "=gdb","log" if headeris "Mailing-List",'contact gdb-help@sourceware.org; run by ezmlm'; store "=gdbia64","log" if headeris("Mailing-List",'contact gdb-help@sourceware.org; run by ezmlm') && body_simple()=~/\b(?:ia64|itanium)\b/i; store "=gdbpr","log" if headeris "Mailing-List",'contact gdb-prs-help@sourceware.org; run by ezmlm'; store "=gdbpria64","log" if headeris("Mailing-List",'contact gdb-prs-help@sourceware.org; run by ezmlm') && body_simple()=~/\b(?:ia64|itanium)\b/i; store "=gdbpat","log" if headeris "Mailing-List",'contact gdb-patches-help@sourceware.org; run by ezmlm'; store "=gdbpatia64","log" if headeris("Mailing-List",'contact gdb-patches-help@sourceware.org; run by ezmlm') && body_simple()=~/\b(?:ia64|itanium)\b/i; store "=gdbann","log" if headeris "Mailing-List",'contact gdb-announce-help@sourceware.org; run by ezmlm'; store "=gdbcvs","log" if headeris "Mailing-List",'contact gdb-cvs-help@sourceware.org; run by ezmlm'; store "=gdbcvsall","log" if headeris "Mailing-List",'contact src-cvs-help@sourceware.org; run by ezmlm'; store "=binutils","log" if headeris "Mailing-List",'contact binutils-help@sourceware.org; run by ezmlm'; store "=binutilsbug","log" if headeris "List-Id" ,''; store "=buggnome","log" if headeris "From" ,''; store "=bugdesktop","log" if headeris "From" ,''; # Red Hat store "=wslog","log" if headeris("From" ,'') && headeris("Return-Path",''); store "=rhos","log" if headeris "List-Id" ,''; store "=rhosd","log" if headeris "List-Id" ,''; store "=rhmemo","silent" if headeris "List-Id" ,''; store "=rhann","log" if headeris "List-Id" ,''; store "=rheng","log" if headeris "List-Id" ,''; store "=rheurope","log" if headeris("List-Id" ,'') && headeris("X-loop" ,''); store "=rhbrno","log" if headeris("List-Id" ,'') &&!headeris("X-loop" ,''); store "=rhbrnomemo","log" if headeris "List-Id" ,''; store "=rhbrnopto","log" if headeris "List-Id" ,''; store "=rhbase","log" if headeris "List-Id" ,''; if (!did sub { store "=rhrhel","log" if headeris "X-BeenThere",''; store "=rhrhel","log" if headeris "X-BeenThere",''; store "=rheng","log" if headeris "X-BeenThere",''; }) { store "=rhtoolsteam","log" if headeris "List-Id" ,''; } store "=rhtools","log" if headeris "List-Id" ,''; store "=rhosteam","log" if headeris "List-Id" ,''; store "=rhbug","log" if headeris "X-BeenThere",''; store "=rhgdb","log" if headeris "List-Id" ,''; store "=rhit","log" if headeris "Return-Path",''; store "=rhcommit","log" if headeris("List-Id" ,'') || headeris("X-CVS-Server",''); store "=rhcommitgdb","log" if headeris "X-CVS-Directory",qr{^rpms/gdb(?:/.*)?$}; store "=rhcommitgcc","log" if headeris "X-CVS-Directory",qr{^rpms/gcc(?:/.*)?$}; store "=rhcommitlibunwind","log" if headeris "X-CVS-Directory",qr{^rpms/libunwind(?:/.*)?$}; store "=rhcommitstrace","log" if headeris "X-CVS-Directory",qr{^rpms/strace(?:/.*)?$}; store "=rhcommitbinutils","log" if headeris "X-CVS-Directory",qr{^rpms/binutils(?:/.*)?$}; store "=rhcommitinsight","log" if headeris "X-CVS-Directory",qr{^rpms/insight(?:/.*)?$}; store "=rhcommitptrace","log" if headeris "X-CVS-Directory",qr{^tests/kernel/syscalls/ptrace(?:/.*)? }; store "=rhcommitgdbtest","log" if headeris "X-CVS-Directory",qr{^tests/gdb/gdb-any(?:/.*)? }; store "=rhbrnowiki","log" if headeris("Return-Path",'') && headeris("From" ,'') && headeris("To" ,'') # `\Q=?' causes: Can't modify constant item in concatenation (.) or string && headeris("Subject" ,qr{^(?:\Q[Red Hat Czech] \E(?:Trivial )?Update of |=\Q?utf-8?q?=5BRed_Hat_Czech=5D_\E(?:Trivial_)?Update_of_)}); store "=rhts","log" if headeris "List-Id" ,''; store "=rhts","log" if headeris("List-Id" ,'') || headeris("List-Id" ,''); store "=rhwiki","log" if headeris "Return-Path",''; store "=rhinet","log" if headeris "List-id" ,''; if (headeris "Return-Path",'') { if (body_simple()=~/(?:jkratoch|jan.kratochvil)[@]\Qredhat.com\E/s) { store "=rhtsme","log"; } else { store "=rhtsbogus","log"; } } store "=rherrata","log" if $Audit->get("X-Erratatool-Component") || (headeris("Return-Path",'') && headeris("Subject",qr{^Changed Errata Request })); if (headeris "Subject" ,qr{^\Q[rpmdiff] INSPECTION: Erratum \E\d{4}:\d{4} .*\btest results\b}) { store "=rherrata","log"; # `[rpmdiff] INSPECTION:' came from `root@rpmdiff3.test.redhat.com'. } elsif ((headeris("To",'') || !$Audit->get("To") || $Audit->get("To") eq "undisclosed-recipients:;") && headeris("Return-Path",qr{^\Qroot@\E.*[.](?:(?:lab|rhts|eng).(?:bos|boston)|z900|test|englab.brq|nay)\Q.redhat.com\E$})) { store "=rhtsme","log"; } store "=rhtsme" if headeris "Subject" ,qr{^\Q[Beaker Job Completion] \E}; store "=buggcc","log" if headeris("Return-Path",'') || headeris("Return-Path",''); store "=frysk","log" if headeris "Mailing-List",'contact frysk-help@sourceware.org; run by ezmlm'; store "=fryskcvs","log" if headeris "List-Id" ,''; store "=bugsrc","log" if headeris "Return-Path",''; store "=rhwc","log" if headeris "Subject" ,'Cron $HOME/redhat/bin/rhwc'; store "=dwarf","log" if headeris "List-Id" ,''; store "=dwarf","log" if headeris "List-Id" ,''; store "=libunwind","log" if headeris "List-Id" ,''; store "=libunwindd","log" if headeris "List-Id" ,''; store "=rhsip","log" if headeris "List-Id" ,''; store "=fedaccount","log" if headeris("Return-Path",'') && headeris("To", '') && headeris("From", '') && headeris("Subject" ,'You need to create a bugzilla account for jkratoch@redhat.com'); store "=straced","log" if headeris "List-Id" ,''; if (headeris "Return-Path",'') { if ($Audit->subject()=~/^\d+ builds? marked for deletion$/) { store "=fkojidel","log"; } else { store "=fkoji","log"; } } if (headeris "Return-Path",'') { if ($Audit->subject()=~/^\d+ builds? marked for deletion$/) { store "=rhbrewdel","log"; } else { store "=rhbrew","log"; } } store "=utrace","log" if headeris "List-Id" ,''; store "=eud","log" if headeris "List-Id" ,''; store "=eud","log" if headeris "List-Id" ,''; store "=dup","log" if headeris "List-Id" ,''; store "=dupbug","log" if headeris "List-Id" ,''; store "=rheclipse","log" if headeris "List-Id" ,''; store "=rhtech","log" if headeris "List-Id" ,''; store "=rhgdb","log" if headeris "List-Id" ,''; store "=rhperf","log" if headeris "List-Id" ,''; store "=rhdebug","log" if headeris "List-Id" ,''; store "=rhsip","log" if headeris "List-Id" ,''; store "=fupdate","log" if headeris "Return-Path",''; store "=rhmedia","log" if headerhas "List-Id",''; store "=fia64","log" if headeris "List-Id" ,''; store "=archer","log" if headeris "List-Id" ,''; store "=archergit","log" if headeris "List-Post" ,''; store "=flive","log" if headeris("List-Id" ,'') || headeris("List-Id" ,''); store "=fspin","log" if headeris "List-Id" ,''; store "=rhstatus","log" if headeris "List-Id" ,''; store "=rhstatusteam","log" if headeris "List-Id" ,''; store "=fcrash","log" if headeris "List-Id" ,''; store "=gabi","log" if headeris "List-Id" ,''; store "=fupload","log" if headeris("X-Fedora-Upload",qr//) && headeris("Subject" ,qr/^File\s\S+\suploaded\sto\slookaside\scache\sby\s/); store "=rhpkg","log" if headeris "Return-Path",''; store "=gdbmail","log" if headeris "From" ,qr{^\Qdiffgdbdaymail by Jan Kratochvil \E$}; store "=vpx","log" if headeris("List-Id" ,'') || headeris("List-Id" ,''); if (($isFROM_MAILER && !did) || !did) { # lmtp_deliver $lmtp_admin,$lmtp_pwd,$lmtp_user_from,$lmtp_user_to; } # store "=errm","bell" if $isFROM_MAILER && !did(); if (!did) { store "==","sms"; spamassassin "sa-learn --ham"; } } 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/\b(Bus)siness$/$1/i; s/\.ident$//i; return $_; } local $_=$address; s/\.cz$//i; return $_; } # $args{"from"} # $args{"subject"} # $args{"body"} 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;