From: short <>
Date: Fri, 11 Oct 2002 12:42:29 +0000 (+0000)
Subject: +@alternates_host to catch redirected mail w/o "for" header
X-Git-Tag: bp_lace~92
X-Git-Url: http://git.jankratochvil.net/?p=PerlMail.git;a=commitdiff_plain;h=07dc23479fff656e8e8c715d2e9177e3eab2ad2a

+@alternates_host to catch redirected mail w/o "for" header
BlackList spam checking improved (new &dnsbl)
&audit_sms: +subject stripping
---

diff --git a/My-Audit.pm b/My-Audit.pm
index 79ee8a1..781288d 100644
--- a/My-Audit.pm
+++ b/My-Audit.pm
@@ -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",	# k332.feld.cvut.cz
+			);
 }
 
 sub audit
@@ -38,10 +43,12 @@ sub audit
 	return if did sub {
 		local $store_profile="silent";
 		local $_;
-		store "=spam-rbl"                  .";$_"  if $_=$Audit->rblcheck();
-		store "=spam-razor".($_ eq 1 ? "" : ";$_") if $_=razor2();
+		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';
+		store "=spam-av"                                if headeris "X-Mailer",'ravmd/8.3.2';
 		};
 
 	# spam honeypots
@@ -155,10 +162,23 @@ my(%args)=@_;
 
 	my $from=(@{$args{"from"}} ? join(",",map({
 			s/\.cz$//i;
+			s/\b(Bus)siness$/$1/i;
 			$_;
 			} @{$args{"from"}})) : "?");
-	local $_=$args{"body"};
-
+	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
@@ -170,8 +190,9 @@ my(%args)=@_;
 	s/(?:^|\n)(?:\*\n+)+/\n*\n/gs;
 	# attributions
 	s/^.*\b(?:wrote|writes):\s*$//gm;
+	my $body=$_;
 
-	return [$from,"(".$args{"subject"}.")".$_];
+	return [$from,"($subject)$body"];
 }
 
 1;