X-Git-Url: http://git.jankratochvil.net/?p=PerlMail.git;a=blobdiff_plain;f=perlmail-accept;h=20b5b2068d2cf7ca3219d203676180e94cfa09be;hp=f0586186a74496fe76cfd0a37446e4904de6dbf0;hb=bdb57ec197e5b173fc0a0331964ccf0c50cabf5b;hpb=e32c697b3f60065a62cec197b507d0557183fe8a

diff --git a/perlmail-accept b/perlmail-accept
index f058618..20b5b20 100755
--- a/perlmail-accept
+++ b/perlmail-accept
@@ -46,6 +46,11 @@ INIT {
 use File::Basename;
 BEGIN {
 	use lib $ENV{"PERLMAIL_BASEDIR"} || File::Basename::dirname($0);
+
+	# FIXME:
+	use lib "/home/lace/lib/perl5/site_perl/5.10.0";
+	use lib "/home/lace/lib64/perl5/site_perl/5.10.0/x86_64-linux-thread-multi";
+
 	use PerlMail::Config;
 	use PerlMail::Lib;
 	}
@@ -69,13 +74,13 @@ require HTTP::Request;
 require LWP::UserAgent;
 use URI::Escape 'uri_escape';
 require WWW::SMS;
-require Authen::SASL;	# Sanity check for &Net::SMTP::auth
+#require Authen::SASL;	# Sanity check for &Net::SMTP::auth
 use MIME::Base64;
 use IPC::Open3;
 use POSIX ":sys_wait_h";
 
 
-our($Message,@AuditStored,$DoBell);
+our($Message,@AuditStored,$DoBell,$Dry);
 my %alternates_host;	# from @alternates_host
 my %dnsbl_whitelist;	# from @dnsbl_whitelist
 
@@ -92,7 +97,6 @@ $procmailFROM_MAILER=qr'^(((Resent-)?(From|Sender)|X-Envelope-From):|>?From )[^>
 my $opt_mode;
 my $opt_smstest;	# 1 or $smscount
 my $opt_idle;
-my $opt_dry;
 my $opt_single;
 
 
@@ -386,7 +390,10 @@ my($name)=@_;
 
 	die "Nesting profile: $name" if 0x10<=(local $profile_eval_depth=$profile_eval_depth+1);
 	return @$name if ref $name;
-	die "Profile not found: $name" if !exists $audit_profile{$name};
+	if (!exists $audit_profile{$name}) {
+		cluck "Profile not found: $name";
+		return "did";
+	}
 	my @this=@{$audit_profile{$name}};
 	return (profile_eval($'),@this[1..$#this]) if $this[0] && $this[0]=~/^=/;
 	return @this;
@@ -421,15 +428,15 @@ my($folder,$profile,%args)=@_;
 	$profile=$store_profile if !$profile;
 	my %do=map({ (!/=/ ? ($_=>1) : ($`=>$')); } profile_eval($profile));
 	Sys::Syslog::syslog("info","%s%s%s: %s: %s",
-					(!$opt_dry ? "" : "--dry: "),
+					(!$Dry ? "" : "--dry: "),
 					(!$store_ignore ? "" : "IGNORED[$store_ignore]: "),
 					map({ cut($_); } $folder,address_show(unmime($Audit->from())),unmime($Audit->subject())),
 					)
-			if $do{"syslog"} || $opt_dry;
+			if $do{"syslog"} || $Dry;
 	$folder=~s/;.*$//s;
 	$folder="$Mail/".$' if $folder=~/^=/;
 	push @AuditStored,$folder if $do{"did"};
-	return if $store_ignore || $opt_dry;
+	return if $store_ignore || $Dry;
 	$DoBell++ if $do{"bell"};
 	write_message($folder) or die;
 	smssend_tryall $store_ignorenewmail,$do{"sms"},%args if $do{"sms"};
@@ -454,12 +461,12 @@ sub write_message
 {
 my($folder)=@_;
 
-	return 1 if $opt_dry;	# simulate OK
+	return 1 if $Dry;	# simulate OK
 	local *F;
 	open F,">>$folder" or do { warn "Append \"$folder\": $!"; return 0; };
 	{
 		local $_;
-		($_=Mail::Audit::audit_get_lock(\*F,$folder)) and do { warn "Lock \"$folder\": $!"; last; };
+		($_=$Audit->_audit_get_lock(\*F,$folder)) and do { warn "Lock \"$folder\": $!"; last; };
 		seek F,0,IO::Handle::SEEK_END or do { warn "Seek-end \"$folder\": $!"; last; };
 		# FIXME: Check for '^From ' to not to rely on our network peer
 		print F $Message or do { warn "Write to \"$folder\": $!"; last; };
@@ -518,7 +525,8 @@ sub spamassassin
 {
 my($cmd)=@_;
 
-	$cmd||="spamassassin --exit-code 1";
+	#$cmd||="nice spamassassin --exit-code 1 --mbox";
+	$cmd||="spamc -c -s 50000000";
 	# spamassassin has the specified exit code if IS spam, code 0 if NOT spam
 	# See &_spamchildcode for the code 1.
 	local *CHILD;
@@ -526,7 +534,7 @@ my($cmd)=@_;
 	# prevent Razor2's: Can't call method "log" on unblessed reference at Razor2/Client/Agent.pm line 212.
 	local $ENV{"HOME"}=$HOME;
 	# 2>/dev/null to prevent error messages to corrupt inetd() output of perlmail-accept(1)
-	open CHILD,"|$cmd --mbox >/dev/null 2>/dev/null"
+	open CHILD,"|$cmd >/dev/null 2>/dev/null"
 			or return 0;
 	print CHILD $Message;
 	close CHILD;
@@ -556,7 +564,7 @@ sub dnsbl
 {
 my($domain,$full,$timeout)=@_;
 
-	$timeout||=30;	# sec
+	$timeout||=2;	# sec
 	$Mail::Audit::MAPS::host=$domain;
 	for my $host (Received_for()) {
 		next if $host!~/^([^:@]*):/;
@@ -564,15 +572,18 @@ my($domain,$full,$timeout)=@_;
 		# $1 is DNS name, $ip is IP address
 		next if $alternates_host{$1};	# leave only foreign hosts
 		next if $dnsbl_whitelist{$ip};
-		{
-			package My::Audit::Faked;
-			sub received { return @{$_[0]->{"received"}}; }
-			}
-		my $self_faked={
-				"received"=>["[$ip]"],
-				};
-		bless $self_faked,"My::Audit::Faked";
-		my $code=Mail::Audit::rblcheck($self_faked,$timeout);
+
+#		FIXME: Faking
+#		{
+#			package My::Audit::Faked;
+#			sub received { return @{$_[0]->{"received"}}; }
+#			}
+#		my $self_faked=Mail::Audit->new();
+#		$self_faked->{"received"}=["[$ip]"];
+#		bless $self_faked,"My::Audit::Faked";
+#		my $code=Mail::Audit::rblcheck($self_faked,$timeout);
+		my $code=$Audit->rblcheck($timeout);
+
 		next if !$code;
 		# Some 0.0.0.0 etc. found for <linux-kernel@>, see: &Mail::Audit::MAPS::_checkit
 		# Do not: $code!='1 Invalid IP address '
@@ -587,7 +598,7 @@ sub clamscan
 {
 my($cmd)=@_;
 
-	$cmd||='clamscan --no-summary -';
+	$cmd||='nice clamscan --no-summary -';
 	# clamscan has exit code 1 if IS virus , code 0 if NOT virus
 	# Do not use IPC::Open2 as it would try to use our STDERR which is not valid by: local *STDERR;
 	local(*WR,*RD,*ERR);
@@ -706,6 +717,7 @@ sub headeris
 {
 my($header,$string)=@_;
 
+	cluck if !defined $string;
 	return _headercore(qr/\Q$string\E/i,1,$header,$string);
 }
 
@@ -789,7 +801,7 @@ die "GetOptions error" if !Getopt::Long::GetOptions(
 		  "inetd"    ,sub { $opt_mode=\&inetd; },
 		  "stdin"    ,sub { $opt_mode=\&stdin; },
 		  "single!"  ,\$opt_single,
-		  "dry"      ,\$opt_dry,
+		  "dry"      ,\$Dry,
 		  "smstest:s",sub { $opt_mode=\&stdin; $opt_smstest=($_[1] || 1); },
 		  "idle!"    ,\$opt_idle,
 		  "idletest" ,sub { syslogging_restore(); print((defined($_=useridle()) ? $_ : "<undef>")."\n"); exit 0; },