X-Git-Url: http://git.jankratochvil.net/?a=blobdiff_plain;f=PerlMail%2FConfig.pm;h=52bc3f852a9bcc9b961a80f663873a456a626515;hb=refs%2Fheads%2Flace;hp=14c57b8e256c1afc67b24a7d357cfa2fdf6f3fe6;hpb=08516d525371be043040d27483c62e8e84e06751;p=PerlMail.git

diff --git a/PerlMail/Config.pm b/PerlMail/Config.pm
index 14c57b8..52bc3f8 100644
--- a/PerlMail/Config.pm
+++ b/PerlMail/Config.pm
@@ -40,11 +40,12 @@ use vars qw(@ISA @EXPORT);
 		);
 
 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 is_multipart mimehead mimebody spamassassin clamscan header_remap lmtp_deliver)) {
+	for (qw(headerhas writeto 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)) {
 		eval 'sub '.$_.' { return ::'.$_.'(@_); }';
 		}
 	}
@@ -70,17 +71,6 @@ our $MaxBodySMS=0x1000;
 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=<F>;
-	chomp $lmtp_pwd;
-	close F or die;
-	}
-our $lmtp_user_from="lace";
-our $lmtp_user_to="lacemail";
 our $clamscan_waitpid_timeout=3;
 
 
@@ -89,7 +79,7 @@ our $clamscan_waitpid_timeout=3;
 # Global system lock for exclusive $DB_table access:
 our $Lock_pathname="/tmp/PerlMail.lock";
 # 'workstation' hostname and port. Hostname may be dyndns:
-our $PeerAddr="exuhome.dyn.jankratochvil.net.:852";
+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;
@@ -217,7 +207,7 @@ our @h_from=(
 # 'bell'   =>Bell sound.
 # 'sms=\d+'=>Send SMS by WWW::SMS with specified maximum # of parts
 our %audit_profile=(
-		"btw"   =>[],
+		"btw"   =>["syslog"],
 		"silent"=>["=btw"   ,"did"],
 		"log"   =>["=silent","syslog"],
 		"bell"  =>["=log"   ,"bell"],
@@ -258,6 +248,23 @@ our @dnsbl_whitelist=(
 		"213.151.87.16",	# posta.dobnet.cz: 16.87.151.213.relays.ordb.org
 		);
 
+sub dolist
+{
+	my($list)=@_;
+
+	my $mailed=0;
+	for my $alias ("",qw(admin bounces confirm join leave owner request subscribe unsubscribe)) {
+		my $head=$list.($alias?"-$alias":"");
+		my $mail=$head.'@jankratochvil.net';
+		if (headerhas("To",$mail)||headerhas("Cc",$mail)) {
+			writeto "|/usr/lib64/mailman/mail/lace/mailmanlace ".($alias||"post")." $list";
+			###writeto "|/usr/sbin/sendmail $head".'@localhost.localdomain';
+			$mailed++;
+		}
+	}
+	return $mailed;
+}
+
 our $Audit;	# imported
 our $procmailFROM_MAILER;	# imported
 our $store_ignorenewmail;	# imported
@@ -276,9 +283,22 @@ sub audit
 			|| headerhas "From",'<Regexp:^owner->'
 			);
 
+	return if did sub { store "=spy","log" if headeris "From",'<spy@jankratochvil.net>'; };
+
+	return if did sub { store "=hotelgatespam","log" if headeris("To",'<postmaster@hotelgate.hotelnet>'); };
+
+	# whitelist
+	my $whitelist;
+	$whitelist||=headeris("From",'<amapi11@seznam.cz>');
+	$whitelist||=headeris("From",'<llucie0@seznam.cz>');
+	$whitelist||=headeris("From",'<aaaanetka@seznamka.cz>');
+	$whitelist||=headeris("From",'<luciseksieber@centrum.cz>');
+	$whitelist||=headeris("From",'<lagica@azet.sk>');
+
 	# spam honeypots
 	return if did sub {
 		local $_;
+		return if $whitelist;
 		# 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();
@@ -290,6 +310,24 @@ sub audit
 		store "=spam"         if headeris "From",'<e4luck@lists.opt4email.com>';
 		store "=spam"         if headeris "From",'<mailcontests@lists.servitall.com>';
 		store "=spam"         if headeris "From",'<canda@lica.cz>';
+		store "=spam"         if headeris "From",'<newsletter@thecareernews.com>';
+		store "=spam"         if headeris "From",'<newsletter@jobseekerweekly.com>';
+		store "=spam"         if headeris "From",'<newsletter@jobmarketweekly.com>';
+		store "=spam"         if headeris "From",'<newsletter@career-digest.com>';
+		store "=spam"         if $Audit->subject() eq "Virus intercepted"
+		                      && body_simple()=~/^A message sent from\s.*\sto\s.*\scontained .* and has not been delivered[.]$/;
+		store "=spam"         if headeris "From",'<supportmrswing@mrswing.com>';
+		store "=spam"         if headeris "From",'<mrswing@mrswing.com>';
+		store "=spam"         if headeris "From",'<root@filmcity.cz>';
+		store "=spam"         if headeris "To"  ,'<web-www.filmcity.cz@jankratochvil.net>';
+		# Whitelist - HTML.
+		return if headeris("From",'<oznameni@aukro.cz>');
+		for my $header (qw(To Cc)) {
+			store "=spam" if headerhas $header,'<st@jankratochvil.net>';
+			store "=spam" if headerhas $header,'<est@jankratochvil.net>';
+			store "=spam" if headerhas $header,'<uest@jankratochvil.net>';
+			store "=spam" if headerhas $header,'<kratochvil.net@jankratochvil.net>';
+			}
 		{
 			# weak detection: files with text/html w/o text/plain are usually a spam
 			my @types_linear=map({ mime_type($_); } parts_linear());
@@ -299,17 +337,57 @@ sub audit
 		};
 	$store_profile=undef();
 
+	my %mailman=(
+			'<captive-admin@>'=>"=caperr",
+			'<captive-devel-admin@>'=>"=caperr",
+			'<captive-announce-admin@>'=>"=caperr",
+			'<4c-admin@>'=>"=4cerr",
+			);
+	return if did sub {
+		if (!did sub {
+				while ((my($mailaddr,$folder)=each(%mailman))) {
+					(my $maillistaddr=$mailaddr)=~s/-admin/-list$&/;
+					store $folder,"log" if (headeris("From",'<mailman-owner@vellum.cz>')&&headeris("To",$mailaddr))
+							|| headeris("From",$maillistaddr)
+							|| headeris("To",$maillistaddr)
+							|| headeris("From",$mailaddr);
+					}
+				}) {
+			store "=cap","bell"        if headeris "List-Id"  ,'<captive-list.jankratochvil.net>';
+			store "=capd","bell"       if headeris "List-Id"  ,'<captive-devel-list.jankratochvil.net>';
+			store "=capann","bell"     if headeris "List-Id"  ,'<captive-announce-list.jankratochvil.net>';
+			store "=4c","bell"         if headeris "List-Id"  ,'<4c-list.vellum.cz>';
+			}
+		};
+
+	{
+		my $mailed=0;
+		if ($Audit->header()!~/for <(?:4c|vmezihori1XXX)-(?:admin|owner|bounces)@/) {
+			for my $list qw(vmezihori1) {
+				$mailed+=dolist $list;
+			}
+		}
+		# return if $mailed;
+	}
+
 	# spam detection
 	return if did sub {
+		# It is too expensive to scan the huge =caperr announcements by spamassassin(1).
+		return if $whitelist;
+###		return if headeris("From",qr/^captive-[a-z]*@/);
+		return if headeris("From",'<logwatch@jankratochvil.net>');
 		# Do not local $store_file as it is our-imported
 		$store_profile="log";
 		local $_;
-		store "=spam".";virus=$_"            if $_=clamscan();
+###		store "=spam".";virus=$_"            if $_=clamscan();
 		store "=spam".";spamassassin".($_ eq 1 ? "" : "=$_") if $_=spamassassin();
-		store "=spam".";$_"                  if $_=dnsbl '.relays.ordb.org.' ,1;	# all hosts
+# 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",'<short@ucw.cz>');
@@ -319,23 +397,28 @@ sub audit
 					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;
-			$found=1 if /^\s*Lese selbst:\n/;
 			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;
 			}
 		};
@@ -379,13 +462,15 @@ sub audit
 				<barevnej@volny.cz>
 				);
 
-		store "=gsm"               if headeris  "Sender"   ,'<owner-gsm@sh.cvut.cz>';
+		store "=gsm"               if headeris  "X-BeenThere",'<gsm@lists.sh.cvut.cz>';
 		store "=gsmpand"           if headeris  "List-Post",'<gsm@pandora.cz>';
 		store "=9kc","log"         if headeris  "List-Post",'<n9k@pandora.cz>';
 		store "=9kcd","log"        if headeris  "List-Post",'<dev9k@pandora.cz>';
 		}
 	$store_profile=undef();
 
+	return                       if headeris "From"     ,'<surprise-dev-bounces@lists.sourceforge.net>';
+
 	# lists
 	store "=mozillabug","log"    if headeris "From"     ,'<bugzilla-daemon@mozilla.org>';
 	store "=9ku","log"           if headeris "List-Id"  ,'<9000.listman.net>';
@@ -427,8 +512,13 @@ sub audit
 	store "=linux-input","log"   if headeris "List-Post",'<linux-input@atrey.karlin.mff.cuni.cz>';
 	store "=strom","bell"        if headeris "List-Post",'<vodni-strom@atrey.karlin.mff.cuni.cz>';
 	store "=netinfo","log"       if headeris "Sender"   ,'<owner-netinfo-l@vol.cz>';
-	store "=saintmj","log"       if headeris "From"     ,'<netsaint@kam-enterprise.ms.mff.cuni.cz>';
+	store "=saintmj","log"       if headeris "From"     ,'<nagios@kam-enterprise.ms.mff.cuni.cz>';
+	store "=saintmj","log"       if headeris "From"     ,'<nagios@kam.mff.cuni.cz>';
 	store "=saintmj","log"       if headeris "From"     ,'<netsaint@kam.mff.cuni.cz>';
+	store "=saintjk","log"       if headeris "From"     ,'<nagios@gw.jklabs.cz>';
+	store "=saintjk","log"       if (headeris("From"     ,'<jklabs@manon.vellum.cz>')
+	                              || headeris("From"     ,'<jklabs@ollie.vellum.cz>'))
+	                             && headeris("To"       ,'<jklabs-nagios@jankratochvil.net>');
 	store "=4cerr","bell"        if headeris "From"     ,'<owner-4cinfo@atrey.karlin.mff.cuni.cz>';
 	store "=4c","sms"            if headeris "List-Post",'<4cinfo@atrey.karlin.mff.cuni.cz>';
 	store "=slashdot","bell"     if headeris "From"     ,'<slashdot@slashdot.org>';
@@ -442,36 +532,23 @@ sub audit
 	store "=autoconf","log"      if headeris "List-Id"  ,'<autoconf.gnu.org>';
 	store "=autoconfpat","log"   if headeris "List-Id"  ,'<autoconf-patches.gnu.org>';
 	store "=hurd","log"          if headeris "List-Id"  ,'<l4-hurd.gnu.org>';
-	my %mailman=(
-			'<captive-admin@>'=>"=caperr",
-			'<captive-devel-admin@>'=>"=caperr",
-			'<captive-announce-admin@>'=>"=caperr",
-			'<4c-admin@>'=>"=4cerr",
-			);
-	if (!did sub {
-			while ((my($mailaddr,$folder)=each(%mailman))) {
-				(my $maillistaddr=$mailaddr)=~s/-admin/-list$&/;
-				store $folder,"log" if (headeris("From",'<mailman-owner@vellum.cz>')&&headeris("To",$mailaddr))
-						|| headeris("From",$maillistaddr)
-						|| headeris("To",$maillistaddr)
-						|| headeris("From",$mailaddr);
-				}
-			}) {
-		store "=cap","bell"        if headeris "List-Id"  ,'<captive-list.jankratochvil.net>';
-		store "=capd","bell"       if headeris "List-Id"  ,'<captive-devel-list.jankratochvil.net>';
-		store "=capann","bell"     if headeris "List-Id"  ,'<captive-announce-list.jankratochvil.net>';
-		store "=4c","bell"         if headeris "List-Id"  ,'<4c-list.vellum.cz>';
-		}
+	store "=gccbug","silent"     if headeris "List-Post",'<gcc-bugs@gcc.gnu.org>';
+	store "=gccann","log"        if headeris "List-Post",'<gcc-announce@gcc.gnu.org>';
+	store "=gcc","silent"        if headeris "List-Post",'<gcc@gcc.gnu.org>';
+	store "=gccpat","silent"     if headeris "List-Post",'<gcc-patches@gcc.gnu.org>';
 	store "=ntfsann","silent"    if headeris "List-Id"  ,'<linux-ntfs-announce.lists.sourceforge.net>';
 	store "=ntfsd","silent"      if headeris "List-Id"  ,'<linux-ntfs-dev.lists.sourceforge.net>';
 	store "=orbit","silent"      if headeris "List-Id"  ,'<orbit-list.gnome.org>';
-	store "=kand","log"          if headeris "List-Id"  ,'<devel.kannel.org>';
+	store "=kannel","log"        if headeris "List-Id"  ,'<users.kannel.org>';
+	store "=kanneld","log"       if headeris "List-Id"  ,'<devel.kannel.org>';
 	store "=mailmand","silent"   if headeris "List-Id"  ,'<mailman-developers.python.org>';
 	store "=asterisk-perl","log" if headeris "List-Post",'<asterisk-perl@lists.gnuinter.net>';
 	store "=i4l","silent"        if headeris "List-Id"  ,'<isdn4linux.listserv.isdn4linux.de>';
-	store "=glibc","silent"      if headeris "Mailing-List",qr/\b\Qlibc-alpha-help\E@\Qsources.redhat.com\E\b/;
+	store "=glibc","silent"      if headeris "List-Post",'<libc-alpha@sourceware.org>';
 	store "=fedann","bell"       if headeris "List-Id"  ,'<fedora-announce-list.redhat.com>';
+	store "=fedpkg","bell"       if headeris "List-Id"  ,'<fedora-package-announce.redhat.com>';
 	store "=fedtools","log"      if headeris "List-Id"  ,'<fedora-tools-list.redhat.com>';
+	store "=fedd","log"          if headeris "List-Id"  ,'<fedora-devel-list.redhat.com>';
 	store "=bashbug","log"       if headeris "List-Id"  ,'<bug-bash.gnu.org>';
 	store "=zaurus","silent"     if headeris "List-Id"  ,'<openzaurus-users.lists.sourceforge.net>';
 	store "=zaurusann","log"     if headeris "List-Id"  ,'<openzaurus-announce.lists.sourceforge.net>';
@@ -486,23 +563,72 @@ sub audit
 	store "=www-sms","log"       if headeris "List-Id"  ,'<www-sms-developers.lists.sourceforge.net>';
 	store "=httpdd","log"        if headeris "list-post",'<dev@httpd.apache.org>';
 	store "=mms2log","log"       if headeris "Return-Path",'<root@node0.mms2.org>';
-	store "=hotelgatelog","log"  if headeris "Return-Path",'<root@hotelgate.hotelnet>';
+	store "=hotelgatelog","log"  if headeris("Return-Path",'<root@hotelgate.hotelnet>')
+	                                                    # `SMART error' should not be matched.
+	                             && headeris("Subject"  ,qr/^(?:Cron|Anacron|LogWatch) /);
 	store "=imja","log"          if headeris "List-Id"  ,'<im-ja-devel.lists.sourceforge.net>';
+	store "=wince","log"         if headeris "List-Post",'<wince@pandora.cz>';
+	store "=mysqlperl","log"     if headeris "List-Id"  ,'<perl.mysql.com>';
+	store "=whiteann","log"      if headeris "List-Id"  ,'<whitebox-announce.beau.org>';
+	store "=white","log"         if headeris "List-Id"  ,'<whitebox-users.beau.org>';
+	store "=centos","log"        if headeris "List-Id"  ,'<centos.centos.org>';
+	store "=modperldoc","log"    if headeris "List-Id"  ,'<docs-dev.perl.apache.org>';
+	store "=qemud","log"         if headeris "List-Id"  ,'<qemu-devel.nongnu.org>';
+	store "=diamond","log"       if headeris "X-Replicator-Inst",'"www.diamondcard.us"';
+	store "=soap","log"          if headeris "Sender"   ,'<owner-soap@DISCUSS.DEVELOP.COM>';
+	store "=nagiosd","log"       if headeris "List-Id"  ,'<nagios-devel.lists.sourceforge.net>';
+	store "=nagios","log"        if headeris "List-Id"  ,'<nagios-users.lists.sourceforge.net>';
+	store "=grub","log"          if headeris "List-Id"  ,'<grub-devel.gnu.org>';
+	store "=gdb","log"           if headeris "Mailing-List",'contact gdb-help@sourceware.org; run by ezmlm';
+	store "=gdbpr","log"         if headeris "Mailing-List",'contact gdb-prs-help@sourceware.org; run by ezmlm';
+	store "=gdbpat","log"        if headeris "Mailing-List",'contact gdb-patches-help@sourceware.org; run by ezmlm';
+	store "=gdbann","log"        if headeris "Mailing-List",'contact gdb-announce-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"  ,'<bug-binutils.gnu.org>';
+	store "=4c","bell"           if headeris "List-Id"  ,'<4c.jankratochvil.net>';
+	store "=dup","log"           if headeris "List-Id"  ,'<duplicity-talk.nongnu.org>';
+	store "=dupbug","log"        if headeris "List-Id"  ,'<duplicity-tracker.nongnu.org>';
+	store "=sue","log"           if headeris "Subject"  ,'Cron <lace@manon> $HOME/secure/sue';
+	store "=linkedin","log"      if headeris "From"     ,'<updates@linkedin.com>';
 
 	# Petr Koutecky does not mark his Stuff
 	store "=koutecky","log"      if headeris "Return-Path",'<velkyhroch@seznam.cz>';
 	store "=koutecky","log"      if headeris "Return-Path",'<pk.petr@centrum.cz>';
 	store "=koutecky","log"      if headeris "Return-Path",'<petr.koutecky@premisa.cz>';
+	store "=koutecky","log"      if headeris "Return-Path",'<Petr.Koutecky@pr4.pm.ds.mfcr.cz>';
+
+	store "=host0log","log"      if headeris("From"       ,'<logwatch@jankratochvil.net>')
+	                             && headeris("Return-Path",'<root@jankratochvil.net>');
+	store "=host1log","log"      if headeris("From"       ,'<logwatch@host1.dyn.jankratochvil.net>')
+	                             && headeris("Return-Path",'<root@host1.dyn.jankratochvil.net>');
+
+	if (headeris("To"         ,'<lace@jankratochvil.net>')
+	 && headeris("Return-Path",'<nobody@tangens.sinus.cz>')) {
+	 	if (body_simple()=~/^SIP request received from <sip:2143[@]tangens.sinus.cz>.* for 2143$/o) {
+			store "=callme","log";
+		} else {
+			store "=call","log";
+		}
+	}
 
-	if (($isFROM_MAILER && !did) || !did) {
-		lmtp_deliver $lmtp_admin,$lmtp_pwd,$lmtp_user_from,$lmtp_user_to;
+	{
+		my $mailed=0;
+		if ($Audit->header()!~/for <(?:4c|vmezihori1)-(?:admin|owner|bounces)@/) {
+			for my $list qw(mailman 4c) {
+				$mailed+=dolist $list;
+			}
 		}
+		# return if $mailed;
+	}
 
-	store "=errm","bell"         if $isFROM_MAILER && !did();
+	store "=errm","bell"         if $isFROM_MAILER && !did()
+	                             # qr/daemon@/ makes $isFROM_MAILER positive.
+	                             && !headeris("From",'<bugzilla-daemon@bugzilla.gnome.org>');
 
 	if (!did) {
 		store "==","sms";
-		spamassassin "$HOME/bin/sa-learn --ham";
+# FIXME: What to do with it?
+###		spamassassin "sa-learn --ham";
 		}
 }